1 /* font.c -- "Font" primitives.
3 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
4 Free Software Foundation, Inc.
5 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
6 National Institute of Advanced Industrial Science and Technology (AIST)
7 Registration Number H13PRO009
9 This file is part of GNU Emacs.
11 GNU Emacs is free software: you can redistribute it and/or modify
12 it under the terms of the GNU General Public License as published by
13 the Free Software Foundation, either version 3 of the License, or
14 (at your option) any later version.
16 GNU Emacs is distributed in the hope that it will be useful,
17 but WITHOUT ANY WARRANTY; without even the implied warranty of
18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 GNU General Public License for more details.
21 You should have received a copy of the GNU General Public License
22 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
33 #include "dispextern.h"
35 #include "character.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 static Lisp_Object Vfont_weight_table
, Vfont_slant_table
, Vfont_width_table
;
68 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
69 static Lisp_Object font_style_table
;
71 /* Structure used for tables mapping weight, slant, and width numeric
72 values and their names. */
77 /* The first one is a valid name as a face attribute.
78 The second one (if any) is a typical name in XLFD field. */
82 /* Table of weight numeric values and their names. This table must be
83 sorted by numeric values in ascending order. */
85 static const struct table_entry weight_table
[] =
88 { 20, { "ultra-light", "ultralight" }},
89 { 40, { "extra-light", "extralight" }},
91 { 75, { "semi-light", "semilight", "demilight", "book" }},
92 { 100, { "normal", "medium", "regular", "unspecified" }},
93 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
95 { 205, { "extra-bold", "extrabold" }},
96 { 210, { "ultra-bold", "ultrabold", "black" }}
99 /* Table of slant numeric values and their names. This table must be
100 sorted by numeric values in ascending order. */
102 static const struct table_entry slant_table
[] =
104 { 0, { "reverse-oblique", "ro" }},
105 { 10, { "reverse-italic", "ri" }},
106 { 100, { "normal", "r", "unspecified" }},
107 { 200, { "italic" ,"i", "ot" }},
108 { 210, { "oblique", "o" }}
111 /* Table of width numeric values and their names. This table must be
112 sorted by numeric values in ascending order. */
114 static const struct table_entry width_table
[] =
116 { 50, { "ultra-condensed", "ultracondensed" }},
117 { 63, { "extra-condensed", "extracondensed" }},
118 { 75, { "condensed", "compressed", "narrow" }},
119 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
120 { 100, { "normal", "medium", "regular", "unspecified" }},
121 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
122 { 125, { "expanded" }},
123 { 150, { "extra-expanded", "extraexpanded" }},
124 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
127 Lisp_Object QCfoundry
;
128 static Lisp_Object QCadstyle
, QCregistry
;
129 /* Symbols representing keys of font extra info. */
130 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
131 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
132 /* Symbols representing values of font spacing property. */
133 Lisp_Object Qc
, Qm
, Qp
, 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 Lisp_Object QCuser_spec
;
140 Lisp_Object Vfont_encoding_alist
;
142 /* Alist of font registry symbol and the corresponding charsets
143 information. The information is retrieved from
144 Vfont_encoding_alist on demand.
146 Eash element has the form:
147 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
151 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
152 encodes a character code to a glyph code of a font, and
153 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
154 character is supported by a font.
156 The latter form means that the information for REGISTRY couldn't be
158 static Lisp_Object font_charset_alist
;
160 /* List of all font drivers. Each font-backend (XXXfont.c) calls
161 register_font_driver in syms_of_XXXfont to register its font-driver
163 static struct font_driver_list
*font_driver_list
;
167 /* Creaters of font-related Lisp object. */
170 font_make_spec (void)
172 Lisp_Object font_spec
;
173 struct font_spec
*spec
174 = ((struct font_spec
*)
175 allocate_pseudovector (VECSIZE (struct font_spec
),
176 FONT_SPEC_MAX
, PVEC_FONT
));
177 XSETFONT (font_spec
, spec
);
182 font_make_entity (void)
184 Lisp_Object font_entity
;
185 struct font_entity
*entity
186 = ((struct font_entity
*)
187 allocate_pseudovector (VECSIZE (struct font_entity
),
188 FONT_ENTITY_MAX
, PVEC_FONT
));
189 XSETFONT (font_entity
, entity
);
193 /* Create a font-object whose structure size is SIZE. If ENTITY is
194 not nil, copy properties from ENTITY to the font-object. If
195 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
197 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
199 Lisp_Object font_object
;
201 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
204 XSETFONT (font_object
, font
);
208 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
209 font
->props
[i
] = AREF (entity
, i
);
210 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
211 font
->props
[FONT_EXTRA_INDEX
]
212 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
215 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
221 static int font_pixel_size (FRAME_PTR f
, Lisp_Object
);
222 static Lisp_Object
font_open_entity (FRAME_PTR
, Lisp_Object
, int);
223 static Lisp_Object
font_matching_entity (FRAME_PTR
, Lisp_Object
*,
225 static unsigned font_encode_char (Lisp_Object
, int);
227 /* Number of registered font drivers. */
228 static int num_font_drivers
;
231 /* Return a Lispy value of a font property value at STR and LEN bytes.
232 If STR is "*", it returns nil.
233 If FORCE_SYMBOL is zero and all characters in STR are digits, it
234 returns an integer. Otherwise, it returns a symbol interned from
238 font_intern_prop (const char *str
, int len
, int force_symbol
)
243 EMACS_INT nbytes
, nchars
;
245 if (len
== 1 && *str
== '*')
247 if (!force_symbol
&& len
>=1 && isdigit (*str
))
249 for (i
= 1; i
< len
; i
++)
250 if (! isdigit (str
[i
]))
253 return make_number (atoi (str
));
256 /* The following code is copied from the function intern (in
257 lread.c), and modified to suite our purpose. */
259 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
260 obarray
= check_obarray (obarray
);
261 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
262 if (len
== nchars
|| len
!= nbytes
)
263 /* CONTENTS contains no multibyte sequences or contains an invalid
264 multibyte sequence. We'll make a unibyte string. */
265 tem
= oblookup (obarray
, str
, len
, len
);
267 tem
= oblookup (obarray
, str
, nchars
, len
);
270 if (len
== nchars
|| len
!= nbytes
)
271 tem
= make_unibyte_string (str
, len
);
273 tem
= make_multibyte_string (str
, nchars
, len
);
274 return Fintern (tem
, obarray
);
277 /* Return a pixel size of font-spec SPEC on frame F. */
280 font_pixel_size (FRAME_PTR f
, Lisp_Object spec
)
282 #ifdef HAVE_WINDOW_SYSTEM
283 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
292 font_assert (FLOATP (size
));
293 point_size
= XFLOAT_DATA (size
);
294 val
= AREF (spec
, FONT_DPI_INDEX
);
299 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
307 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
308 font vector. If VAL is not valid (i.e. not registered in
309 font_style_table), return -1 if NOERROR is zero, and return a
310 proper index if NOERROR is nonzero. In that case, register VAL in
311 font_style_table if VAL is a symbol, and return a closest index if
312 VAL is an integer. */
315 font_style_to_value (enum font_property_index prop
, Lisp_Object val
, int noerror
)
317 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
318 int len
= ASIZE (table
);
324 Lisp_Object args
[2], elt
;
326 /* At first try exact match. */
327 for (i
= 0; i
< len
; i
++)
328 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
329 if (EQ (val
, AREF (AREF (table
, i
), j
)))
330 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
331 | (i
<< 4) | (j
- 1));
332 /* Try also with case-folding match. */
333 s
= SDATA (SYMBOL_NAME (val
));
334 for (i
= 0; i
< len
; i
++)
335 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
337 elt
= AREF (AREF (table
, i
), j
);
338 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
339 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
340 | (i
<< 4) | (j
- 1));
346 elt
= Fmake_vector (make_number (2), make_number (100));
349 args
[1] = Fmake_vector (make_number (1), elt
);
350 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
351 return (100 << 8) | (i
<< 4);
356 int numeric
= XINT (val
);
358 for (i
= 0, last_n
= -1; i
< len
; i
++)
360 int n
= XINT (AREF (AREF (table
, i
), 0));
363 return (n
<< 8) | (i
<< 4);
368 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
369 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
375 return ((last_n
<< 8) | ((i
- 1) << 4));
380 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
, int for_face
)
382 Lisp_Object val
= AREF (font
, prop
);
383 Lisp_Object table
, elt
;
388 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
389 i
= XINT (val
) & 0xFF;
390 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
391 elt
= AREF (table
, ((i
>> 4) & 0xF));
392 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
393 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
396 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
397 FONTNAME. ENCODING is a charset symbol that specifies the encoding
398 of the font. REPERTORY is a charset symbol or nil. */
401 find_font_encoding (Lisp_Object fontname
)
403 Lisp_Object tail
, elt
;
405 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
409 && STRINGP (XCAR (elt
))
410 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
411 && (SYMBOLP (XCDR (elt
))
412 ? CHARSETP (XCDR (elt
))
413 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
419 /* Return encoding charset and repertory charset for REGISTRY in
420 ENCODING and REPERTORY correspondingly. If correct information for
421 REGISTRY is available, return 0. Otherwise return -1. */
424 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
427 int encoding_id
, repertory_id
;
429 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
435 encoding_id
= XINT (XCAR (val
));
436 repertory_id
= XINT (XCDR (val
));
440 val
= find_font_encoding (SYMBOL_NAME (registry
));
441 if (SYMBOLP (val
) && CHARSETP (val
))
443 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
445 else if (CONSP (val
))
447 if (! CHARSETP (XCAR (val
)))
449 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
450 if (NILP (XCDR (val
)))
454 if (! CHARSETP (XCDR (val
)))
456 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
461 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
463 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
467 *encoding
= CHARSET_FROM_ID (encoding_id
);
469 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
474 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
479 /* Font property value validaters. See the comment of
480 font_property_table for the meaning of the arguments. */
482 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
483 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
484 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
485 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
486 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
487 static int get_font_prop_index (Lisp_Object
);
490 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
493 val
= Fintern (val
, Qnil
);
496 else if (EQ (prop
, QCregistry
))
497 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
503 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
505 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
506 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
513 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
517 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
519 if ((n
& 0xF) + 1 >= ASIZE (elt
))
521 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
525 else if (SYMBOLP (val
))
527 int n
= font_style_to_value (prop
, val
, 0);
529 val
= n
>= 0 ? make_number (n
) : Qerror
;
537 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
539 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
544 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
546 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
548 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
550 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
552 if (spacing
== 'c' || spacing
== 'C')
553 return make_number (FONT_SPACING_CHARCELL
);
554 if (spacing
== 'm' || spacing
== 'M')
555 return make_number (FONT_SPACING_MONO
);
556 if (spacing
== 'p' || spacing
== 'P')
557 return make_number (FONT_SPACING_PROPORTIONAL
);
558 if (spacing
== 'd' || spacing
== 'D')
559 return make_number (FONT_SPACING_DUAL
);
565 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
567 Lisp_Object tail
, tmp
;
570 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
571 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
572 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
575 if (! SYMBOLP (XCAR (val
)))
580 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
582 for (i
= 0; i
< 2; i
++)
589 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
590 if (! SYMBOLP (XCAR (tmp
)))
598 /* Structure of known font property keys and validater of the
602 /* Pointer to the key symbol. */
604 /* Function to validate PROP's value VAL, or NULL if any value is
605 ok. The value is VAL or its regularized value if VAL is valid,
606 and Qerror if not. */
607 Lisp_Object (*validater
) (Lisp_Object prop
, Lisp_Object val
);
608 } font_property_table
[] =
609 { { &QCtype
, font_prop_validate_symbol
},
610 { &QCfoundry
, font_prop_validate_symbol
},
611 { &QCfamily
, font_prop_validate_symbol
},
612 { &QCadstyle
, font_prop_validate_symbol
},
613 { &QCregistry
, font_prop_validate_symbol
},
614 { &QCweight
, font_prop_validate_style
},
615 { &QCslant
, font_prop_validate_style
},
616 { &QCwidth
, font_prop_validate_style
},
617 { &QCsize
, font_prop_validate_non_neg
},
618 { &QCdpi
, font_prop_validate_non_neg
},
619 { &QCspacing
, font_prop_validate_spacing
},
620 { &QCavgwidth
, font_prop_validate_non_neg
},
621 /* The order of the above entries must match with enum
622 font_property_index. */
623 { &QClang
, font_prop_validate_symbol
},
624 { &QCscript
, font_prop_validate_symbol
},
625 { &QCotf
, font_prop_validate_otf
}
628 /* Size (number of elements) of the above table. */
629 #define FONT_PROPERTY_TABLE_SIZE \
630 ((sizeof font_property_table) / (sizeof *font_property_table))
632 /* Return an index number of font property KEY or -1 if KEY is not an
633 already known property. */
636 get_font_prop_index (Lisp_Object key
)
640 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
641 if (EQ (key
, *font_property_table
[i
].key
))
646 /* Validate the font property. The property key is specified by the
647 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
648 signal an error. The value is VAL or the regularized one. */
651 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
653 Lisp_Object validated
;
658 prop
= *font_property_table
[idx
].key
;
661 idx
= get_font_prop_index (prop
);
665 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
666 if (EQ (validated
, Qerror
))
667 signal_error ("invalid font property", Fcons (prop
, val
));
672 /* Store VAL as a value of extra font property PROP in FONT while
673 keeping the sorting order. Don't check the validity of VAL. */
676 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
678 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
679 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
683 Lisp_Object prev
= Qnil
;
686 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
687 prev
= extra
, extra
= XCDR (extra
);
690 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
692 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
698 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
703 /* Font name parser and unparser */
705 static int parse_matrix (const char *);
706 static int font_expand_wildcards (Lisp_Object
*, int);
707 static int font_parse_name (char *, Lisp_Object
);
709 /* An enumerator for each field of an XLFD font name. */
710 enum xlfd_field_index
729 /* An enumerator for mask bit corresponding to each XLFD field. */
732 XLFD_FOUNDRY_MASK
= 0x0001,
733 XLFD_FAMILY_MASK
= 0x0002,
734 XLFD_WEIGHT_MASK
= 0x0004,
735 XLFD_SLANT_MASK
= 0x0008,
736 XLFD_SWIDTH_MASK
= 0x0010,
737 XLFD_ADSTYLE_MASK
= 0x0020,
738 XLFD_PIXEL_MASK
= 0x0040,
739 XLFD_POINT_MASK
= 0x0080,
740 XLFD_RESX_MASK
= 0x0100,
741 XLFD_RESY_MASK
= 0x0200,
742 XLFD_SPACING_MASK
= 0x0400,
743 XLFD_AVGWIDTH_MASK
= 0x0800,
744 XLFD_REGISTRY_MASK
= 0x1000,
745 XLFD_ENCODING_MASK
= 0x2000
749 /* Parse P pointing the pixel/point size field of the form
750 `[A B C D]' which specifies a transformation matrix:
756 by which all glyphs of the font are transformed. The spec says
757 that scalar value N for the pixel/point size is equivalent to:
758 A = N * resx/resy, B = C = 0, D = N.
760 Return the scalar value N if the form is valid. Otherwise return
764 parse_matrix (const char *p
)
770 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
773 matrix
[i
] = - strtod (p
+ 1, &end
);
775 matrix
[i
] = strtod (p
, &end
);
778 return (i
== 4 ? (int) matrix
[3] : -1);
781 /* Expand a wildcard field in FIELD (the first N fields are filled) to
782 multiple fields to fill in all 14 XLFD fields while restring a
783 field position by its contents. */
786 font_expand_wildcards (Lisp_Object
*field
, int n
)
789 Lisp_Object tmp
[XLFD_LAST_INDEX
];
790 /* Array of information about where this element can go. Nth
791 element is for Nth element of FIELD. */
793 /* Minimum possible field. */
795 /* Maxinum possible field. */
797 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
799 } range
[XLFD_LAST_INDEX
];
801 int range_from
, range_to
;
804 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
805 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
806 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
807 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
808 | XLFD_AVGWIDTH_MASK)
809 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
811 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
812 field. The value is shifted to left one bit by one in the
814 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
815 range_mask
= (range_mask
<< 1) | 1;
817 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
818 position-based retriction for FIELD[I]. */
819 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
820 i
++, range_from
++, range_to
++, range_mask
<<= 1)
822 Lisp_Object val
= field
[i
];
828 range
[i
].from
= range_from
;
829 range
[i
].to
= range_to
;
830 range
[i
].mask
= range_mask
;
834 /* The triplet FROM, TO, and MASK is a value-based
835 retriction for FIELD[I]. */
841 int numeric
= XINT (val
);
844 from
= to
= XLFD_ENCODING_INDEX
,
845 mask
= XLFD_ENCODING_MASK
;
846 else if (numeric
== 0)
847 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
848 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
849 else if (numeric
<= 48)
850 from
= to
= XLFD_PIXEL_INDEX
,
851 mask
= XLFD_PIXEL_MASK
;
853 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
854 mask
= XLFD_LARGENUM_MASK
;
856 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
857 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
858 mask
= XLFD_NULL_MASK
;
860 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
863 Lisp_Object name
= SYMBOL_NAME (val
);
865 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
866 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
867 mask
= XLFD_REGENC_MASK
;
869 from
= to
= XLFD_ENCODING_INDEX
,
870 mask
= XLFD_ENCODING_MASK
;
872 else if (range_from
<= XLFD_WEIGHT_INDEX
873 && range_to
>= XLFD_WEIGHT_INDEX
874 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
875 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
876 else if (range_from
<= XLFD_SLANT_INDEX
877 && range_to
>= XLFD_SLANT_INDEX
878 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
879 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
880 else if (range_from
<= XLFD_SWIDTH_INDEX
881 && range_to
>= XLFD_SWIDTH_INDEX
882 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
883 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
886 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
887 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
889 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
890 mask
= XLFD_SYMBOL_MASK
;
893 /* Merge position-based and value-based restrictions. */
895 while (from
< range_from
)
896 mask
&= ~(1 << from
++);
897 while (from
< 14 && ! (mask
& (1 << from
)))
899 while (to
> range_to
)
900 mask
&= ~(1 << to
--);
901 while (to
>= 0 && ! (mask
& (1 << to
)))
905 range
[i
].from
= from
;
907 range
[i
].mask
= mask
;
909 if (from
> range_from
|| to
< range_to
)
911 /* The range is narrowed by value-based restrictions.
912 Reflect it to the other fields. */
914 /* Following fields should be after FROM. */
916 /* Preceding fields should be before TO. */
917 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
919 /* Check FROM for non-wildcard field. */
920 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
922 while (range
[j
].from
< from
)
923 range
[j
].mask
&= ~(1 << range
[j
].from
++);
924 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
926 range
[j
].from
= from
;
929 from
= range
[j
].from
;
930 if (range
[j
].to
> to
)
932 while (range
[j
].to
> to
)
933 range
[j
].mask
&= ~(1 << range
[j
].to
--);
934 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
947 /* Decide all fileds from restrictions in RANGE. */
948 for (i
= j
= 0; i
< n
; i
++)
950 if (j
< range
[i
].from
)
952 if (i
== 0 || ! NILP (tmp
[i
- 1]))
953 /* None of TMP[X] corresponds to Jth field. */
955 for (; j
< range
[i
].from
; j
++)
960 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
962 for (; j
< XLFD_LAST_INDEX
; j
++)
964 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
965 field
[XLFD_ENCODING_INDEX
]
966 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
971 /* Parse NAME (null terminated) as XLFD and store information in FONT
972 (font-spec or font-entity). Size property of FONT is set as
974 specified XLFD fields FONT property
975 --------------------- -------------
976 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
977 POINT_SIZE and RESY calculated pixel size (Lisp integer)
978 POINT_SIZE POINT_SIZE/10 (Lisp float)
980 If NAME is successfully parsed, return 0. Otherwise return -1.
982 FONT is usually a font-spec, but when this function is called from
983 X font backend driver, it is a font-entity. In that case, NAME is
984 a fully specified XLFD. */
987 font_parse_xlfd (char *name
, Lisp_Object font
)
989 int len
= strlen (name
);
991 char *f
[XLFD_LAST_INDEX
+ 1];
995 if (len
> 255 || !len
)
996 /* Maximum XLFD name length is 255. */
998 /* Accept "*-.." as a fully specified XLFD. */
999 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1000 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1003 for (p
= name
+ i
; *p
; p
++)
1007 if (i
== XLFD_LAST_INDEX
)
1012 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1013 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1015 if (i
== XLFD_LAST_INDEX
)
1017 /* Fully specified XLFD. */
1020 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1021 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1022 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1023 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1025 val
= INTERN_FIELD_SYM (i
);
1028 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1030 ASET (font
, j
, make_number (n
));
1033 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1034 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1035 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1037 ASET (font
, FONT_REGISTRY_INDEX
,
1038 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1039 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1041 p
= f
[XLFD_PIXEL_INDEX
];
1042 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1043 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1046 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1048 ASET (font
, FONT_SIZE_INDEX
, val
);
1049 else if (FONT_ENTITY_P (font
))
1053 double point_size
= -1;
1055 font_assert (FONT_SPEC_P (font
));
1056 p
= f
[XLFD_POINT_INDEX
];
1058 point_size
= parse_matrix (p
);
1059 else if (isdigit (*p
))
1060 point_size
= atoi (p
), point_size
/= 10;
1061 if (point_size
>= 0)
1062 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1066 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1067 if (! NILP (val
) && ! INTEGERP (val
))
1069 ASET (font
, FONT_DPI_INDEX
, val
);
1070 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1073 val
= font_prop_validate_spacing (QCspacing
, val
);
1074 if (! INTEGERP (val
))
1076 ASET (font
, FONT_SPACING_INDEX
, val
);
1078 p
= f
[XLFD_AVGWIDTH_INDEX
];
1081 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1082 if (! NILP (val
) && ! INTEGERP (val
))
1084 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1088 int wild_card_found
= 0;
1089 Lisp_Object prop
[XLFD_LAST_INDEX
];
1091 if (FONT_ENTITY_P (font
))
1093 for (j
= 0; j
< i
; j
++)
1097 if (f
[j
][1] && f
[j
][1] != '-')
1100 wild_card_found
= 1;
1103 prop
[j
] = INTERN_FIELD (j
);
1105 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1107 if (! wild_card_found
)
1109 if (font_expand_wildcards (prop
, i
) < 0)
1112 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1113 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1114 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1115 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1116 if (! NILP (prop
[i
]))
1118 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1120 ASET (font
, j
, make_number (n
));
1122 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1123 val
= prop
[XLFD_REGISTRY_INDEX
];
1126 val
= prop
[XLFD_ENCODING_INDEX
];
1128 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1130 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1131 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1133 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1134 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1136 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1138 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1139 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1140 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1142 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1144 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1147 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1148 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1149 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1151 val
= font_prop_validate_spacing (QCspacing
,
1152 prop
[XLFD_SPACING_INDEX
]);
1153 if (! INTEGERP (val
))
1155 ASET (font
, FONT_SPACING_INDEX
, val
);
1157 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1158 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1164 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1165 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1166 0, use PIXEL_SIZE instead. */
1169 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1171 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1175 font_assert (FONTP (font
));
1177 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1180 if (i
== FONT_ADSTYLE_INDEX
)
1181 j
= XLFD_ADSTYLE_INDEX
;
1182 else if (i
== FONT_REGISTRY_INDEX
)
1183 j
= XLFD_REGISTRY_INDEX
;
1184 val
= AREF (font
, i
);
1187 if (j
== XLFD_REGISTRY_INDEX
)
1188 f
[j
] = "*-*", len
+= 4;
1190 f
[j
] = "*", len
+= 2;
1195 val
= SYMBOL_NAME (val
);
1196 if (j
== XLFD_REGISTRY_INDEX
1197 && ! strchr ((char *) SDATA (val
), '-'))
1199 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1200 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1202 f
[j
] = alloca (SBYTES (val
) + 3);
1203 sprintf (f
[j
], "%s-*", SDATA (val
));
1204 len
+= SBYTES (val
) + 3;
1208 f
[j
] = alloca (SBYTES (val
) + 4);
1209 sprintf (f
[j
], "%s*-*", SDATA (val
));
1210 len
+= SBYTES (val
) + 4;
1214 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1218 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1221 val
= font_style_symbolic (font
, i
, 0);
1223 f
[j
] = "*", len
+= 2;
1226 val
= SYMBOL_NAME (val
);
1227 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1231 val
= AREF (font
, FONT_SIZE_INDEX
);
1232 font_assert (NUMBERP (val
) || NILP (val
));
1240 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1241 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1244 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1246 else if (FLOATP (val
))
1248 i
= XFLOAT_DATA (val
) * 10;
1249 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1250 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1253 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1255 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1257 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1258 f
[XLFD_RESX_INDEX
] = alloca (22);
1259 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1263 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1264 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1266 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1268 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1269 : spacing
<= FONT_SPACING_DUAL
? "d"
1270 : spacing
<= FONT_SPACING_MONO
? "m"
1275 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1276 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1278 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1279 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
], "%ld",
1280 (long) XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1283 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1284 len
++; /* for terminating '\0'. */
1287 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1288 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1289 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1290 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1291 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1292 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1293 f
[XLFD_REGISTRY_INDEX
]);
1296 /* Parse NAME (null terminated) and store information in FONT
1297 (font-spec or font-entity). NAME is supplied in either the
1298 Fontconfig or GTK font name format. If NAME is successfully
1299 parsed, return 0. Otherwise return -1.
1301 The fontconfig format is
1303 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1307 FAMILY [PROPS...] [SIZE]
1309 This function tries to guess which format it is. */
1312 font_parse_fcname (char *name
, Lisp_Object font
)
1315 char *size_beg
= NULL
, *size_end
= NULL
;
1316 char *props_beg
= NULL
, *family_end
= NULL
;
1317 int len
= strlen (name
);
1322 for (p
= name
; *p
; p
++)
1324 if (*p
== '\\' && p
[1])
1328 props_beg
= family_end
= p
;
1333 int decimal
= 0, size_found
= 1;
1334 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1337 if (*q
!= '.' || decimal
)
1356 Lisp_Object extra_props
= Qnil
;
1358 /* A fontconfig name with size and/or property data. */
1359 if (family_end
> name
)
1362 family
= font_intern_prop (name
, family_end
- name
, 1);
1363 ASET (font
, FONT_FAMILY_INDEX
, family
);
1367 double point_size
= strtod (size_beg
, &size_end
);
1368 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1369 if (*size_end
== ':' && size_end
[1])
1370 props_beg
= size_end
;
1374 /* Now parse ":KEY=VAL" patterns. */
1377 for (p
= props_beg
; *p
; p
= q
)
1379 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1382 /* Must be an enumerated value. */
1386 val
= font_intern_prop (p
, q
- p
, 1);
1388 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1390 if (PROP_MATCH ("light", 5)
1391 || PROP_MATCH ("medium", 6)
1392 || PROP_MATCH ("demibold", 8)
1393 || PROP_MATCH ("bold", 4)
1394 || PROP_MATCH ("black", 5))
1395 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1396 else if (PROP_MATCH ("roman", 5)
1397 || PROP_MATCH ("italic", 6)
1398 || PROP_MATCH ("oblique", 7))
1399 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1400 else if (PROP_MATCH ("charcell", 8))
1401 ASET (font
, FONT_SPACING_INDEX
,
1402 make_number (FONT_SPACING_CHARCELL
));
1403 else if (PROP_MATCH ("mono", 4))
1404 ASET (font
, FONT_SPACING_INDEX
,
1405 make_number (FONT_SPACING_MONO
));
1406 else if (PROP_MATCH ("proportional", 12))
1407 ASET (font
, FONT_SPACING_INDEX
,
1408 make_number (FONT_SPACING_PROPORTIONAL
));
1417 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1418 prop
= FONT_SIZE_INDEX
;
1421 key
= font_intern_prop (p
, q
- p
, 1);
1422 prop
= get_font_prop_index (key
);
1426 for (q
= p
; *q
&& *q
!= ':'; q
++);
1427 val
= font_intern_prop (p
, q
- p
, 0);
1429 if (prop
>= FONT_FOUNDRY_INDEX
1430 && prop
< FONT_EXTRA_INDEX
)
1431 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1434 extra_props
= nconc2 (extra_props
,
1435 Fcons (Fcons (key
, val
), Qnil
));
1442 if (! NILP (extra_props
))
1444 struct font_driver_list
*driver_list
= font_driver_list
;
1445 for ( ; driver_list
; driver_list
= driver_list
->next
)
1446 if (driver_list
->driver
->filter_properties
)
1447 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1453 /* Either a fontconfig-style name with no size and property
1454 data, or a GTK-style name. */
1456 int word_len
, prop_found
= 0;
1458 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1464 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1465 if (! isdigit (*q
) && *q
!= '.')
1472 double point_size
= strtod (p
, &q
);
1473 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1478 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1479 if (*q
== '\\' && q
[1])
1483 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1485 if (PROP_MATCH ("Ultra-Light", 11))
1488 prop
= font_intern_prop ("ultra-light", 11, 1);
1489 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1491 else if (PROP_MATCH ("Light", 5))
1494 prop
= font_intern_prop ("light", 5, 1);
1495 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1497 else if (PROP_MATCH ("Book", 4))
1500 prop
= font_intern_prop ("book", 4, 1);
1501 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1503 else if (PROP_MATCH ("Medium", 6))
1506 prop
= font_intern_prop ("medium", 6, 1);
1507 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1509 else if (PROP_MATCH ("Semi-Bold", 9))
1512 prop
= font_intern_prop ("semi-bold", 9, 1);
1513 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1515 else if (PROP_MATCH ("Bold", 4))
1518 prop
= font_intern_prop ("bold", 4, 1);
1519 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1521 else if (PROP_MATCH ("Italic", 6))
1524 prop
= font_intern_prop ("italic", 4, 1);
1525 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1527 else if (PROP_MATCH ("Oblique", 7))
1530 prop
= font_intern_prop ("oblique", 7, 1);
1531 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1533 else if (PROP_MATCH ("Semi-Condensed", 14))
1536 prop
= font_intern_prop ("semi-condensed", 14, 1);
1537 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, prop
);
1539 else if (PROP_MATCH ("Condensed", 9))
1542 prop
= font_intern_prop ("condensed", 9, 1);
1543 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, prop
);
1547 return -1; /* Unknown property in GTK-style font name. */
1556 family
= font_intern_prop (name
, family_end
- name
, 1);
1557 ASET (font
, FONT_FAMILY_INDEX
, family
);
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
;
1572 Lisp_Object tail
, val
;
1576 Lisp_Object styles
[3];
1577 const char *style_names
[3] = { "weight", "slant", "width" };
1580 family
= AREF (font
, FONT_FAMILY_INDEX
);
1581 if (! NILP (family
))
1583 if (SYMBOLP (family
))
1585 family
= SYMBOL_NAME (family
);
1586 len
+= SBYTES (family
);
1592 val
= AREF (font
, FONT_SIZE_INDEX
);
1595 if (XINT (val
) != 0)
1596 pixel_size
= XINT (val
);
1598 len
+= 21; /* for ":pixelsize=NUM" */
1600 else if (FLOATP (val
))
1603 point_size
= (int) XFLOAT_DATA (val
);
1604 len
+= 11; /* for "-NUM" */
1607 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1608 if (! NILP (foundry
))
1610 if (SYMBOLP (foundry
))
1612 foundry
= SYMBOL_NAME (foundry
);
1613 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1619 for (i
= 0; i
< 3; i
++)
1621 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1622 if (! NILP (styles
[i
]))
1623 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1624 SDATA (SYMBOL_NAME (styles
[i
])));
1627 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1628 len
+= sprintf (work
, ":dpi=%ld", (long)XINT (AREF (font
, FONT_DPI_INDEX
)));
1629 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1630 len
+= strlen (":spacing=100");
1631 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1632 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1633 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1635 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1637 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1639 len
+= SBYTES (val
);
1640 else if (INTEGERP (val
))
1641 len
+= sprintf (work
, "%ld", (long) XINT (val
));
1642 else if (SYMBOLP (val
))
1643 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1649 if (! NILP (family
))
1650 p
+= sprintf (p
, "%s", SDATA (family
));
1654 p
+= sprintf (p
, "%d", point_size
);
1656 p
+= sprintf (p
, "-%d", point_size
);
1658 else if (pixel_size
> 0)
1659 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1660 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1661 p
+= sprintf (p
, ":foundry=%s",
1662 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1663 for (i
= 0; i
< 3; i
++)
1664 if (! NILP (styles
[i
]))
1665 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1666 SDATA (SYMBOL_NAME (styles
[i
])));
1667 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1668 p
+= sprintf (p
, ":dpi=%ld", (long) XINT (AREF (font
, FONT_DPI_INDEX
)));
1669 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1670 p
+= sprintf (p
, ":spacing=%ld",
1671 (long) XINT (AREF (font
, FONT_SPACING_INDEX
)));
1672 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1674 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1675 p
+= sprintf (p
, ":scalable=true");
1677 p
+= sprintf (p
, ":scalable=false");
1682 /* Parse NAME (null terminated) and store information in FONT
1683 (font-spec or font-entity). If NAME is successfully parsed, return
1684 0. Otherwise return -1. */
1687 font_parse_name (char *name
, Lisp_Object font
)
1689 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1690 return font_parse_xlfd (name
, font
);
1691 return font_parse_fcname (name
, font
);
1695 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1696 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1700 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1706 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1708 CHECK_STRING (family
);
1709 len
= SBYTES (family
);
1710 p0
= (char *) SDATA (family
);
1711 p1
= strchr (p0
, '-');
1714 if ((*p0
!= '*' && p1
- p0
> 0)
1715 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1716 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1719 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1722 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1724 if (! NILP (registry
))
1726 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1727 CHECK_STRING (registry
);
1728 len
= SBYTES (registry
);
1729 p0
= (char *) SDATA (registry
);
1730 p1
= strchr (p0
, '-');
1733 if (SDATA (registry
)[len
- 1] == '*')
1734 registry
= concat2 (registry
, build_string ("-*"));
1736 registry
= concat2 (registry
, build_string ("*-*"));
1738 registry
= Fdowncase (registry
);
1739 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1744 /* This part (through the next ^L) is still experimental and not
1745 tested much. We may drastically change codes. */
1751 #define LGSTRING_HEADER_SIZE 6
1752 #define LGSTRING_GLYPH_SIZE 8
1755 check_gstring (gstring
)
1756 Lisp_Object gstring
;
1761 CHECK_VECTOR (gstring
);
1762 val
= AREF (gstring
, 0);
1764 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1766 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1767 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1768 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1769 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1770 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1771 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1772 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1773 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1774 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1775 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1776 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1778 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1780 val
= LGSTRING_GLYPH (gstring
, i
);
1782 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1784 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1786 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1787 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1788 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1789 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1790 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1791 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1792 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1793 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1795 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1797 if (ASIZE (val
) < 3)
1799 for (j
= 0; j
< 3; j
++)
1800 CHECK_NUMBER (AREF (val
, j
));
1805 error ("Invalid glyph-string format");
1810 check_otf_features (otf_features
)
1811 Lisp_Object otf_features
;
1815 CHECK_CONS (otf_features
);
1816 CHECK_SYMBOL (XCAR (otf_features
));
1817 otf_features
= XCDR (otf_features
);
1818 CHECK_CONS (otf_features
);
1819 CHECK_SYMBOL (XCAR (otf_features
));
1820 otf_features
= XCDR (otf_features
);
1821 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1823 CHECK_SYMBOL (Fcar (val
));
1824 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1825 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1827 otf_features
= XCDR (otf_features
);
1828 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1830 CHECK_SYMBOL (Fcar (val
));
1831 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1832 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1839 Lisp_Object otf_list
;
1842 otf_tag_symbol (tag
)
1847 OTF_tag_name (tag
, name
);
1848 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1855 Lisp_Object val
= Fassoc (file
, otf_list
);
1859 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1862 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1863 val
= make_save_value (otf
, 0);
1864 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1870 /* Return a list describing which scripts/languages FONT supports by
1871 which GSUB/GPOS features of OpenType tables. See the comment of
1872 (struct font_driver).otf_capability. */
1875 font_otf_capability (font
)
1879 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1882 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1885 for (i
= 0; i
< 2; i
++)
1887 OTF_GSUB_GPOS
*gsub_gpos
;
1888 Lisp_Object script_list
= Qnil
;
1891 if (OTF_get_features (otf
, i
== 0) < 0)
1893 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1894 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1896 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1897 Lisp_Object langsys_list
= Qnil
;
1898 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1901 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1903 OTF_LangSys
*langsys
;
1904 Lisp_Object feature_list
= Qnil
;
1905 Lisp_Object langsys_tag
;
1908 if (k
== script
->LangSysCount
)
1910 langsys
= &script
->DefaultLangSys
;
1915 langsys
= script
->LangSys
+ k
;
1917 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1919 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1921 OTF_Feature
*feature
1922 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1923 Lisp_Object feature_tag
1924 = otf_tag_symbol (feature
->FeatureTag
);
1926 feature_list
= Fcons (feature_tag
, feature_list
);
1928 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1931 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1936 XSETCAR (capability
, script_list
);
1938 XSETCDR (capability
, script_list
);
1944 /* Parse OTF features in SPEC and write a proper features spec string
1945 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1946 assured that the sufficient memory has already allocated for
1950 generate_otf_features (spec
, features
)
1960 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1966 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1971 else if (! asterisk
)
1973 val
= SYMBOL_NAME (val
);
1974 p
+= sprintf (p
, "%s", SDATA (val
));
1978 val
= SYMBOL_NAME (val
);
1979 p
+= sprintf (p
, "~%s", SDATA (val
));
1983 error ("OTF spec too long");
1987 font_otf_DeviceTable (device_table
)
1988 OTF_DeviceTable
*device_table
;
1990 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1992 return Fcons (make_number (len
),
1993 make_unibyte_string (device_table
->DeltaValue
, len
));
1997 font_otf_ValueRecord (value_format
, value_record
)
1999 OTF_ValueRecord
*value_record
;
2001 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2003 if (value_format
& OTF_XPlacement
)
2004 ASET (val
, 0, make_number (value_record
->XPlacement
));
2005 if (value_format
& OTF_YPlacement
)
2006 ASET (val
, 1, make_number (value_record
->YPlacement
));
2007 if (value_format
& OTF_XAdvance
)
2008 ASET (val
, 2, make_number (value_record
->XAdvance
));
2009 if (value_format
& OTF_YAdvance
)
2010 ASET (val
, 3, make_number (value_record
->YAdvance
));
2011 if (value_format
& OTF_XPlaDevice
)
2012 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2013 if (value_format
& OTF_YPlaDevice
)
2014 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2015 if (value_format
& OTF_XAdvDevice
)
2016 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2017 if (value_format
& OTF_YAdvDevice
)
2018 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2023 font_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 is used for driver type. The font
2084 available by the most preferred font driver is 0.
2086 Each 7-bit 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 flots 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 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2113 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2116 /* Score the size. Maximum difference is 127. */
2117 i
= FONT_SIZE_INDEX
;
2118 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2119 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2121 /* We use the higher 6-bit for the actual size difference. The
2122 lowest bit is set if the DPI is different. */
2124 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2126 if (CONSP (Vface_font_rescale_alist
))
2127 pixel_size
*= font_rescale_ratio (entity
);
2128 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2132 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2133 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2135 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2136 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2138 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2145 /* Concatenate all elements of LIST into one vector. LIST is a list
2146 of font-entity vectors. */
2149 font_vconcat_entity_vectors (Lisp_Object list
)
2151 int nargs
= XINT (Flength (list
));
2152 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2155 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2156 args
[i
] = XCAR (list
);
2157 return Fvconcat (nargs
, args
);
2161 /* The structure for elements being sorted by qsort. */
2162 struct font_sort_data
2165 int font_driver_preference
;
2170 /* The comparison function for qsort. */
2173 font_compare (const void *d1
, const void *d2
)
2175 const struct font_sort_data
*data1
= d1
;
2176 const struct font_sort_data
*data2
= d2
;
2178 if (data1
->score
< data2
->score
)
2180 else if (data1
->score
> data2
->score
)
2182 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2186 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2187 If PREFER specifies a point-size, calculate the corresponding
2188 pixel-size from QCdpi property of PREFER or from the Y-resolution
2189 of FRAME before sorting.
2191 If BEST-ONLY is nonzero, return the best matching entity (that
2192 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2193 if BEST-ONLY is negative). Otherwise, return the sorted result as
2194 a single vector of font-entities.
2196 This function does no optimization for the case that the total
2197 number of elements is 1. The caller should avoid calling this in
2201 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2203 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2205 struct font_sort_data
*data
;
2206 unsigned best_score
;
2207 Lisp_Object best_entity
;
2208 struct frame
*f
= XFRAME (frame
);
2209 Lisp_Object tail
, vec
;
2212 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2213 prefer_prop
[i
] = AREF (prefer
, i
);
2214 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2215 prefer_prop
[FONT_SIZE_INDEX
]
2216 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2218 if (NILP (XCDR (list
)))
2220 /* What we have to take care of is this single vector. */
2222 maxlen
= ASIZE (vec
);
2226 /* We don't have to perform sort, so there's no need of creating
2227 a single vector. But, we must find the length of the longest
2230 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2231 if (maxlen
< ASIZE (XCAR (tail
)))
2232 maxlen
= ASIZE (XCAR (tail
));
2236 /* We have to create a single vector to sort it. */
2237 vec
= font_vconcat_entity_vectors (list
);
2238 maxlen
= ASIZE (vec
);
2241 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2242 best_score
= 0xFFFFFFFF;
2245 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2247 int font_driver_preference
= 0;
2248 Lisp_Object current_font_driver
;
2254 /* We are sure that the length of VEC > 0. */
2255 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2256 /* Score the elements. */
2257 for (i
= 0; i
< len
; i
++)
2259 data
[i
].entity
= AREF (vec
, i
);
2261 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2263 ? font_score (data
[i
].entity
, prefer_prop
)
2265 if (best_only
&& best_score
> data
[i
].score
)
2267 best_score
= data
[i
].score
;
2268 best_entity
= data
[i
].entity
;
2269 if (best_score
== 0)
2272 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2274 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2275 font_driver_preference
++;
2277 data
[i
].font_driver_preference
= font_driver_preference
;
2280 /* Sort if necessary. */
2283 qsort (data
, len
, sizeof *data
, font_compare
);
2284 for (i
= 0; i
< len
; i
++)
2285 ASET (vec
, i
, data
[i
].entity
);
2294 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2299 /* API of Font Service Layer. */
2301 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2302 sort_shift_bits. Finternal_set_font_selection_order calls this
2303 function with font_sort_order after setting up it. */
2306 font_update_sort_order (int *order
)
2310 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2312 int xlfd_idx
= order
[i
];
2314 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2315 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2316 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2317 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2318 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2319 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2321 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2326 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
, Lisp_Object features
, Lisp_Object table
)
2331 table
= assq_no_quit (script
, table
);
2334 table
= XCDR (table
);
2335 if (! NILP (langsys
))
2337 table
= assq_no_quit (langsys
, table
);
2343 val
= assq_no_quit (Qnil
, table
);
2345 table
= XCAR (table
);
2349 table
= XCDR (table
);
2350 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2352 if (NILP (XCAR (features
)))
2357 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2363 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2366 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2368 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2370 script
= XCAR (spec
);
2374 langsys
= XCAR (spec
);
2385 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2386 XCAR (otf_capability
)))
2388 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2389 XCDR (otf_capability
)))
2396 /* Check if FONT (font-entity or font-object) matches with the font
2397 specification SPEC. */
2400 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2402 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2403 Lisp_Object extra
, font_extra
;
2406 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2407 if (! NILP (AREF (spec
, i
))
2408 && ! NILP (AREF (font
, i
))
2409 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2411 props
= XFONT_SPEC (spec
)->props
;
2412 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2414 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2415 prop
[i
] = AREF (spec
, i
);
2416 prop
[FONT_SIZE_INDEX
]
2417 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2421 if (font_score (font
, props
) > 0)
2423 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2424 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2425 for (; CONSP (extra
); extra
= XCDR (extra
))
2427 Lisp_Object key
= XCAR (XCAR (extra
));
2428 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2430 if (EQ (key
, QClang
))
2432 val2
= assq_no_quit (key
, font_extra
);
2441 if (NILP (Fmemq (val
, val2
)))
2446 ? NILP (Fmemq (val
, XCDR (val2
)))
2450 else if (EQ (key
, QCscript
))
2452 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2458 /* All characters in the list must be supported. */
2459 for (; CONSP (val2
); val2
= XCDR (val2
))
2461 if (! NATNUMP (XCAR (val2
)))
2463 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2464 == FONT_INVALID_CODE
)
2468 else if (VECTORP (val2
))
2470 /* At most one character in the vector must be supported. */
2471 for (i
= 0; i
< ASIZE (val2
); i
++)
2473 if (! NATNUMP (AREF (val2
, i
)))
2475 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2476 != FONT_INVALID_CODE
)
2479 if (i
== ASIZE (val2
))
2484 else if (EQ (key
, QCotf
))
2488 if (! FONT_OBJECT_P (font
))
2490 fontp
= XFONT_OBJECT (font
);
2491 if (! fontp
->driver
->otf_capability
)
2493 val2
= fontp
->driver
->otf_capability (fontp
);
2494 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2505 Each font backend has the callback function get_cache, and it
2506 returns a cons cell of which cdr part can be freely used for
2507 caching fonts. The cons cell may be shared by multiple frames
2508 and/or multiple font drivers. So, we arrange the cdr part as this:
2510 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2512 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2513 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2514 cons (FONT-SPEC FONT-ENTITY ...). */
2516 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2517 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2518 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2519 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2520 struct font_driver
*);
2523 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2525 Lisp_Object cache
, val
;
2527 cache
= driver
->get_cache (f
);
2529 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2533 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2534 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2538 val
= XCDR (XCAR (val
));
2539 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2545 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2547 Lisp_Object cache
, val
, tmp
;
2550 cache
= driver
->get_cache (f
);
2552 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2553 cache
= val
, val
= XCDR (val
);
2554 font_assert (! NILP (val
));
2555 tmp
= XCDR (XCAR (val
));
2556 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2557 if (XINT (XCAR (tmp
)) == 0)
2559 font_clear_cache (f
, XCAR (val
), driver
);
2560 XSETCDR (cache
, XCDR (val
));
2566 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2568 Lisp_Object val
= driver
->get_cache (f
);
2569 Lisp_Object type
= driver
->type
;
2571 font_assert (CONSP (val
));
2572 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2573 font_assert (CONSP (val
));
2574 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2575 val
= XCDR (XCAR (val
));
2579 static int num_fonts
;
2582 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2584 Lisp_Object tail
, elt
;
2585 Lisp_Object tail2
, entity
;
2587 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2588 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2591 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2592 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2594 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2596 entity
= XCAR (tail2
);
2598 if (FONT_ENTITY_P (entity
)
2599 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2601 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2603 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2605 Lisp_Object val
= XCAR (objlist
);
2606 struct font
*font
= XFONT_OBJECT (val
);
2608 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2610 font_assert (font
&& driver
== font
->driver
);
2611 driver
->close (f
, font
);
2615 if (driver
->free_entity
)
2616 driver
->free_entity (entity
);
2621 XSETCDR (cache
, Qnil
);
2625 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2627 /* Check each font-entity in VEC, and return a list of font-entities
2628 that satisfy this condition:
2629 (1) matches with SPEC and SIZE if SPEC is not nil, and
2630 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2634 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2636 Lisp_Object entity
, val
;
2637 enum font_property_index prop
;
2640 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2642 entity
= AREF (vec
, i
);
2643 if (! NILP (Vface_ignored_fonts
))
2646 Lisp_Object tail
, regexp
;
2648 if (font_unparse_xlfd (entity
, 0, name
, 256) >= 0)
2650 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2652 regexp
= XCAR (tail
);
2653 if (STRINGP (regexp
)
2654 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
2663 val
= Fcons (entity
, val
);
2666 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2667 if (INTEGERP (AREF (spec
, prop
))
2668 && ((XINT (AREF (spec
, prop
)) >> 8)
2669 != (XINT (AREF (entity
, prop
)) >> 8)))
2670 prop
= FONT_SPEC_MAX
;
2671 if (prop
< FONT_SPEC_MAX
2673 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2675 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2678 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2679 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2680 prop
= FONT_SPEC_MAX
;
2682 if (prop
< FONT_SPEC_MAX
2683 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2684 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2685 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2686 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2687 prop
= FONT_SPEC_MAX
;
2688 if (prop
< FONT_SPEC_MAX
2689 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2690 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2691 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2692 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2693 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2694 prop
= FONT_SPEC_MAX
;
2695 if (prop
< FONT_SPEC_MAX
)
2696 val
= Fcons (entity
, val
);
2698 return (Fvconcat (1, &val
));
2702 /* Return a list of vectors of font-entities matching with SPEC on
2703 FRAME. Each elements in the list is a vector of entities from the
2704 same font-driver. */
2707 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2709 FRAME_PTR f
= XFRAME (frame
);
2710 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2711 Lisp_Object ftype
, val
;
2712 Lisp_Object list
= Qnil
;
2714 int need_filtering
= 0;
2717 font_assert (FONT_SPEC_P (spec
));
2719 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2720 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2721 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2722 size
= font_pixel_size (f
, spec
);
2726 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2727 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2728 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2729 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2731 ASET (scratch_font_spec
, i
, Qnil
);
2732 if (! NILP (AREF (spec
, i
)))
2734 if (i
== FONT_DPI_INDEX
)
2735 /* Skip FONT_SPACING_INDEX */
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
= Fcopy_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
= Fcopy_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
= Fcopy_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
;
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 /* Return the specification of FONT_OBJECT. */
2985 font_get_spec (Lisp_Object font_object
)
2987 Lisp_Object spec
= font_make_spec ();
2990 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2991 ASET (spec
, i
, AREF (font_object
, i
));
2992 ASET (spec
, FONT_SIZE_INDEX
,
2993 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2998 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2999 could not be parsed by font_parse_name, return Qnil. */
3002 font_spec_from_name (Lisp_Object font_name
)
3004 Lisp_Object spec
= Ffont_spec (0, NULL
);
3006 CHECK_STRING (font_name
);
3007 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3009 font_put_extra (spec
, QCname
, font_name
);
3010 font_put_extra (spec
, QCuser_spec
, font_name
);
3016 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
3018 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3023 if (! NILP (Ffont_get (font
, QCname
)))
3025 font
= Fcopy_font_spec (font
);
3026 font_put_extra (font
, QCname
, Qnil
);
3029 if (NILP (AREF (font
, prop
))
3030 && prop
!= FONT_FAMILY_INDEX
3031 && prop
!= FONT_FOUNDRY_INDEX
3032 && prop
!= FONT_WIDTH_INDEX
3033 && prop
!= FONT_SIZE_INDEX
)
3035 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3036 font
= Fcopy_font_spec (font
);
3037 ASET (font
, prop
, Qnil
);
3038 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3040 if (prop
== FONT_FAMILY_INDEX
)
3042 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3043 /* If we are setting the font family, we must also clear
3044 FONT_WIDTH_INDEX to avoid rejecting families that lack
3045 support for some widths. */
3046 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3048 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3049 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3050 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3051 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3052 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3053 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3055 else if (prop
== FONT_SIZE_INDEX
)
3057 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3058 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3059 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3061 else if (prop
== FONT_WIDTH_INDEX
)
3062 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3063 attrs
[LFACE_FONT_INDEX
] = font
;
3066 /* Selecte a font from ENTITIES (list of font-entity vectors) that
3067 supports C and matches best with ATTRS and PIXEL_SIZE. */
3070 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
3072 Lisp_Object font_entity
;
3075 FRAME_PTR f
= XFRAME (frame
);
3077 if (NILP (XCDR (entities
))
3078 && ASIZE (XCAR (entities
)) == 1)
3080 font_entity
= AREF (XCAR (entities
), 0);
3082 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3087 /* Sort fonts by properties specified in ATTRS. */
3088 prefer
= scratch_font_prefer
;
3090 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3091 ASET (prefer
, i
, Qnil
);
3092 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3094 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3096 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3097 ASET (prefer
, i
, AREF (face_font
, i
));
3099 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3100 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3101 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3102 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3103 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3104 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3105 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3107 return font_sort_entities (entities
, prefer
, frame
, c
);
3110 /* Return a font-entity satisfying SPEC and best matching with face's
3111 font related attributes in ATTRS. C, if not negative, is a
3112 character that the entity must support. */
3115 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3118 Lisp_Object frame
, entities
, val
;
3119 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3123 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3124 if (NILP (registry
[0]))
3126 registry
[0] = DEFAULT_ENCODING
;
3127 registry
[1] = Qascii_0
;
3128 registry
[2] = null_vector
;
3131 registry
[1] = null_vector
;
3133 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3135 struct charset
*encoding
, *repertory
;
3137 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3138 &encoding
, &repertory
) < 0)
3141 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3143 else if (c
> encoding
->max_char
)
3147 work
= Fcopy_font_spec (spec
);
3148 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3149 XSETFRAME (frame
, f
);
3150 size
= AREF (spec
, FONT_SIZE_INDEX
);
3151 pixel_size
= font_pixel_size (f
, spec
);
3152 if (pixel_size
== 0)
3154 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3156 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3158 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3159 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3160 if (! NILP (foundry
[0]))
3161 foundry
[1] = null_vector
;
3162 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3164 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3165 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3167 foundry
[2] = null_vector
;
3170 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3172 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3173 if (! NILP (adstyle
[0]))
3174 adstyle
[1] = null_vector
;
3175 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3177 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3179 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3181 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3183 adstyle
[2] = null_vector
;
3186 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3189 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3192 val
= AREF (work
, FONT_FAMILY_INDEX
);
3193 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3195 val
= attrs
[LFACE_FAMILY_INDEX
];
3196 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3200 family
= alloca ((sizeof family
[0]) * 2);
3202 family
[1] = null_vector
; /* terminator. */
3207 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3208 /* Font family names are case-sensitive under NS. */
3216 if (! NILP (alters
))
3218 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3219 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3220 family
[i
] = XCAR (alters
);
3221 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3223 family
[i
] = null_vector
;
3227 family
= alloca ((sizeof family
[0]) * 3);
3230 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3232 family
[i
] = null_vector
;
3236 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3238 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3239 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3241 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3242 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3244 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3245 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3247 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3248 entities
= font_list_entities (frame
, work
);
3249 if (! NILP (entities
))
3251 val
= font_select_entity (frame
, entities
,
3252 attrs
, pixel_size
, c
);
3265 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3269 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3270 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3271 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3272 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3273 size
= font_pixel_size (f
, spec
);
3277 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3278 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3281 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3282 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3283 if (INTEGERP (height
))
3286 abort(); /* We should never end up here. */
3290 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3294 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3295 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3299 return font_open_entity (f
, entity
, size
);
3303 /* Find a font satisfying SPEC and best matching with face's
3304 attributes in ATTRS on FRAME, and return the opened
3308 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3310 Lisp_Object entity
, name
;
3312 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3315 /* No font is listed for SPEC, but each font-backend may have
3316 the different criteria about "font matching". So, try
3318 entity
= font_matching_entity (f
, attrs
, spec
);
3322 /* Don't lose the original name that was put in initially. We need
3323 it to re-apply the font when font parameters (like hinting or dpi) have
3325 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3328 name
= Ffont_get (spec
, QCuser_spec
);
3329 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3335 /* Make FACE on frame F ready to use the font opened for FACE. */
3338 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3340 if (face
->font
->driver
->prepare_face
)
3341 face
->font
->driver
->prepare_face (f
, face
);
3345 /* Make FACE on frame F stop using the font opened for FACE. */
3348 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3350 if (face
->font
->driver
->done_face
)
3351 face
->font
->driver
->done_face (f
, face
);
3356 /* Open a font matching with font-spec SPEC on frame F. If no proper
3357 font is found, return Qnil. */
3360 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3362 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3364 /* We set up the default font-related attributes of a face to prefer
3366 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3367 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3368 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3370 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3372 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3374 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3376 return font_load_for_lface (f
, attrs
, spec
);
3380 /* Open a font matching with NAME on frame F. If no proper font is
3381 found, return Qnil. */
3384 font_open_by_name (FRAME_PTR f
, const char *name
)
3386 Lisp_Object args
[2];
3387 Lisp_Object spec
, ret
;
3390 args
[1] = make_unibyte_string (name
, strlen (name
));
3391 spec
= Ffont_spec (2, args
);
3392 ret
= font_open_by_spec (f
, spec
);
3393 /* Do not lose name originally put in. */
3395 font_put_extra (ret
, QCuser_spec
, args
[1]);
3401 /* Register font-driver DRIVER. This function is used in two ways.
3403 The first is with frame F non-NULL. In this case, make DRIVER
3404 available (but not yet activated) on F. All frame creaters
3405 (e.g. Fx_create_frame) must call this function at least once with
3406 an available font-driver.
3408 The second is with frame F NULL. In this case, DRIVER is globally
3409 registered in the variable `font_driver_list'. All font-driver
3410 implementations must call this function in its syms_of_XXXX
3411 (e.g. syms_of_xfont). */
3414 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3416 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3417 struct font_driver_list
*prev
, *list
;
3419 if (f
&& ! driver
->draw
)
3420 error ("Unusable font driver for a frame: %s",
3421 SDATA (SYMBOL_NAME (driver
->type
)));
3423 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3424 if (EQ (list
->driver
->type
, driver
->type
))
3425 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3427 list
= xmalloc (sizeof (struct font_driver_list
));
3429 list
->driver
= driver
;
3434 f
->font_driver_list
= list
;
3436 font_driver_list
= list
;
3442 free_font_driver_list (FRAME_PTR f
)
3444 struct font_driver_list
*list
, *next
;
3446 for (list
= f
->font_driver_list
; list
; list
= next
)
3451 f
->font_driver_list
= NULL
;
3455 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3456 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3457 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3459 A caller must free all realized faces if any in advance. The
3460 return value is a list of font backends actually made used on
3464 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3466 Lisp_Object active_drivers
= Qnil
;
3467 struct font_driver
*driver
;
3468 struct font_driver_list
*list
;
3470 /* At first, turn off non-requested drivers, and turn on requested
3472 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3474 driver
= list
->driver
;
3475 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3480 if (driver
->end_for_frame
)
3481 driver
->end_for_frame (f
);
3482 font_finish_cache (f
, driver
);
3487 if (! driver
->start_for_frame
3488 || driver
->start_for_frame (f
) == 0)
3490 font_prepare_cache (f
, driver
);
3497 if (NILP (new_drivers
))
3500 if (! EQ (new_drivers
, Qt
))
3502 /* Re-order the driver list according to new_drivers. */
3503 struct font_driver_list
**list_table
, **next
;
3507 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3508 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3510 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3511 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3514 list_table
[i
++] = list
;
3516 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3518 list_table
[i
++] = list
;
3519 list_table
[i
] = NULL
;
3521 next
= &f
->font_driver_list
;
3522 for (i
= 0; list_table
[i
]; i
++)
3524 *next
= list_table
[i
];
3525 next
= &(*next
)->next
;
3529 if (! f
->font_driver_list
->on
)
3530 { /* None of the drivers is enabled: enable them all.
3531 Happens if you set the list of drivers to (xft x) in your .emacs
3532 and then use it under w32 or ns. */
3533 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3535 struct font_driver
*driver
= list
->driver
;
3536 eassert (! list
->on
);
3537 if (! driver
->start_for_frame
3538 || driver
->start_for_frame (f
) == 0)
3540 font_prepare_cache (f
, driver
);
3547 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3549 active_drivers
= nconc2 (active_drivers
,
3550 Fcons (list
->driver
->type
, Qnil
));
3551 return active_drivers
;
3555 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3557 struct font_data_list
*list
, *prev
;
3559 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3560 prev
= list
, list
= list
->next
)
3561 if (list
->driver
== driver
)
3568 prev
->next
= list
->next
;
3570 f
->font_data_list
= list
->next
;
3578 list
= xmalloc (sizeof (struct font_data_list
));
3579 list
->driver
= driver
;
3580 list
->next
= f
->font_data_list
;
3581 f
->font_data_list
= list
;
3589 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3591 struct font_data_list
*list
;
3593 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3594 if (list
->driver
== driver
)
3602 /* Sets attributes on a font. Any properties that appear in ALIST and
3603 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3604 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3605 arrays of strings. This function is intended for use by the font
3606 drivers to implement their specific font_filter_properties. */
3608 font_filter_properties (Lisp_Object font
,
3610 const char *const boolean_properties
[],
3611 const char *const non_boolean_properties
[])
3616 /* Set boolean values to Qt or Qnil */
3617 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3618 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3620 Lisp_Object key
= XCAR (XCAR (it
));
3621 Lisp_Object val
= XCDR (XCAR (it
));
3622 char *keystr
= SDATA (SYMBOL_NAME (key
));
3624 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3626 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3627 : SYMBOLP (val
) ? (const char *) SDATA (SYMBOL_NAME (val
))
3630 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3631 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3632 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3633 || strcmp ("Off", str
) == 0)
3638 Ffont_put (font
, key
, val
);
3642 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3643 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3645 Lisp_Object key
= XCAR (XCAR (it
));
3646 Lisp_Object val
= XCDR (XCAR (it
));
3647 char *keystr
= SDATA (SYMBOL_NAME (key
));
3648 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3649 Ffont_put (font
, key
, val
);
3654 /* Return the font used to draw character C by FACE at buffer position
3655 POS in window W. If STRING is non-nil, it is a string containing C
3656 at index POS. If C is negative, get C from the current buffer or
3660 font_at (int c
, EMACS_INT pos
, struct face
*face
, struct window
*w
,
3665 Lisp_Object font_object
;
3667 multibyte
= (NILP (string
)
3668 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3669 : STRING_MULTIBYTE (string
));
3676 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3678 c
= FETCH_CHAR (pos_byte
);
3681 c
= FETCH_BYTE (pos
);
3687 multibyte
= STRING_MULTIBYTE (string
);
3690 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3692 str
= SDATA (string
) + pos_byte
;
3693 c
= STRING_CHAR (str
);
3696 c
= SDATA (string
)[pos
];
3700 f
= XFRAME (w
->frame
);
3701 if (! FRAME_WINDOW_P (f
))
3708 if (STRINGP (string
))
3709 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3710 DEFAULT_FACE_ID
, 0);
3712 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3714 face
= FACE_FROM_ID (f
, face_id
);
3718 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3719 face
= FACE_FROM_ID (f
, face_id
);
3724 XSETFONT (font_object
, face
->font
);
3729 #ifdef HAVE_WINDOW_SYSTEM
3731 /* Check how many characters after POS (at most to *LIMIT) can be
3732 displayed by the same font on the window W. FACE, if non-NULL, is
3733 the face selected for the character at POS. If STRING is not nil,
3734 it is the string to check instead of the current buffer. In that
3735 case, FACE must be not NULL.
3737 The return value is the font-object for the character at POS.
3738 *LIMIT is set to the position where that font can't be used.
3740 It is assured that the current buffer (or STRING) is multibyte. */
3743 font_range (EMACS_INT pos
, EMACS_INT
*limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3745 EMACS_INT pos_byte
, ignore
;
3747 Lisp_Object font_object
= Qnil
;
3751 pos_byte
= CHAR_TO_BYTE (pos
);
3756 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3758 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3764 pos_byte
= string_char_to_byte (string
, pos
);
3767 while (pos
< *limit
)
3769 Lisp_Object category
;
3772 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3774 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3775 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3776 if (EQ (category
, QCf
)
3777 || CHAR_VARIATION_SELECTOR_P (c
))
3779 if (NILP (font_object
))
3781 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3782 if (NILP (font_object
))
3786 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3796 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3797 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3798 Return nil otherwise.
3799 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3800 which kind of font it is. It must be one of `font-spec', `font-entity',
3802 (Lisp_Object object
, Lisp_Object extra_type
)
3804 if (NILP (extra_type
))
3805 return (FONTP (object
) ? Qt
: Qnil
);
3806 if (EQ (extra_type
, Qfont_spec
))
3807 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3808 if (EQ (extra_type
, Qfont_entity
))
3809 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3810 if (EQ (extra_type
, Qfont_object
))
3811 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3812 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3815 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3816 doc
: /* Return a newly created font-spec with arguments as properties.
3818 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3819 valid font property name listed below:
3821 `:family', `:weight', `:slant', `:width'
3823 They are the same as face attributes of the same name. See
3824 `set-face-attribute'.
3828 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3832 VALUE must be a string or a symbol specifying the additional
3833 typographic style information of a font, e.g. ``sans''.
3837 VALUE must be a string or a symbol specifying the charset registry and
3838 encoding of a font, e.g. ``iso8859-1''.
3842 VALUE must be a non-negative integer or a floating point number
3843 specifying the font size. It specifies the font size in pixels (if
3844 VALUE is an integer), or in points (if VALUE is a float).
3848 VALUE must be a string of XLFD-style or fontconfig-style font name.
3852 VALUE must be a symbol representing a script that the font must
3853 support. It may be a symbol representing a subgroup of a script
3854 listed in the variable `script-representative-chars'.
3858 VALUE must be a symbol of two-letter ISO-639 language names,
3863 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3864 required OpenType features.
3866 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3867 LANGSYS-TAG: OpenType language system tag symbol,
3868 or nil for the default language system.
3869 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3870 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3872 GSUB and GPOS may contain `nil' element. In such a case, the font
3873 must not have any of the remaining elements.
3875 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3876 be an OpenType font, and whose GPOS table of `thai' script's default
3877 language system must contain `mark' feature.
3879 usage: (font-spec ARGS...) */)
3880 (int nargs
, Lisp_Object
*args
)
3882 Lisp_Object spec
= font_make_spec ();
3885 for (i
= 0; i
< nargs
; i
+= 2)
3887 Lisp_Object key
= args
[i
], val
;
3891 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3894 if (EQ (key
, QCname
))
3897 font_parse_name ((char *) SDATA (val
), spec
);
3898 font_put_extra (spec
, key
, val
);
3902 int idx
= get_font_prop_index (key
);
3906 val
= font_prop_validate (idx
, Qnil
, val
);
3907 if (idx
< FONT_EXTRA_INDEX
)
3908 ASET (spec
, idx
, val
);
3910 font_put_extra (spec
, key
, val
);
3913 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3919 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3920 doc
: /* Return a copy of FONT as a font-spec. */)
3923 Lisp_Object new_spec
, tail
, prev
, extra
;
3927 new_spec
= font_make_spec ();
3928 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3929 ASET (new_spec
, i
, AREF (font
, i
));
3930 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3931 /* We must remove :font-entity property. */
3932 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3933 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3936 extra
= XCDR (extra
);
3938 XSETCDR (prev
, XCDR (tail
));
3941 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3945 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3946 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3947 Every specified properties in FROM override the corresponding
3948 properties in TO. */)
3949 (Lisp_Object from
, Lisp_Object to
)
3951 Lisp_Object extra
, tail
;
3956 to
= Fcopy_font_spec (to
);
3957 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3958 ASET (to
, i
, AREF (from
, i
));
3959 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3960 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3961 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3963 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3966 XSETCDR (slot
, XCDR (XCAR (tail
)));
3968 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3970 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3974 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3975 doc
: /* Return the value of FONT's property KEY.
3976 FONT is a font-spec, a font-entity, or a font-object.
3977 KEY is any symbol, but these are reserved for specific meanings:
3978 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3979 :size, :name, :script, :otf
3980 See the documentation of `font-spec' for their meanings.
3981 In addition, if FONT is a font-entity or a font-object, values of
3982 :script and :otf are different from those of a font-spec as below:
3984 The value of :script may be a list of scripts that are supported by the font.
3986 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3987 representing the OpenType features supported by the font by this form:
3988 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3989 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3991 (Lisp_Object font
, Lisp_Object key
)
3999 idx
= get_font_prop_index (key
);
4000 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4001 return font_style_symbolic (font
, idx
, 0);
4002 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4003 return AREF (font
, idx
);
4004 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
4005 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
4007 struct font
*fontp
= XFONT_OBJECT (font
);
4009 if (fontp
->driver
->otf_capability
)
4010 val
= fontp
->driver
->otf_capability (fontp
);
4012 val
= Fcons (Qnil
, Qnil
);
4013 font_put_extra (font
, QCotf
, val
);
4020 #ifdef HAVE_WINDOW_SYSTEM
4022 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4023 doc
: /* Return a plist of face attributes generated by FONT.
4024 FONT is a font name, a font-spec, a font-entity, or a font-object.
4025 The return value is a list of the form
4027 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4029 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4030 compatible with `set-face-attribute'. Some of these key-attribute pairs
4031 may be omitted from the list if they are not specified by FONT.
4033 The optional argument FRAME specifies the frame that the face attributes
4034 are to be displayed on. If omitted, the selected frame is used. */)
4035 (Lisp_Object font
, Lisp_Object frame
)
4038 Lisp_Object plist
[10];
4043 frame
= selected_frame
;
4044 CHECK_LIVE_FRAME (frame
);
4049 int fontset
= fs_query_fontset (font
, 0);
4050 Lisp_Object name
= font
;
4052 font
= fontset_ascii (fontset
);
4053 font
= font_spec_from_name (name
);
4055 signal_error ("Invalid font name", name
);
4057 else if (! FONTP (font
))
4058 signal_error ("Invalid font object", font
);
4060 val
= AREF (font
, FONT_FAMILY_INDEX
);
4063 plist
[n
++] = QCfamily
;
4064 plist
[n
++] = SYMBOL_NAME (val
);
4067 val
= AREF (font
, FONT_SIZE_INDEX
);
4070 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4071 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4072 plist
[n
++] = QCheight
;
4073 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4075 else if (FLOATP (val
))
4077 plist
[n
++] = QCheight
;
4078 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4081 val
= FONT_WEIGHT_FOR_FACE (font
);
4084 plist
[n
++] = QCweight
;
4088 val
= FONT_SLANT_FOR_FACE (font
);
4091 plist
[n
++] = QCslant
;
4095 val
= FONT_WIDTH_FOR_FACE (font
);
4098 plist
[n
++] = QCwidth
;
4102 return Flist (n
, plist
);
4107 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4108 doc
: /* Set one property of FONT: give property KEY value VAL.
4109 FONT is a font-spec, a font-entity, or a font-object.
4111 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4112 accepted by the function `font-spec' (which see), VAL must be what
4113 allowed in `font-spec'.
4115 If FONT is a font-entity or a font-object, KEY must not be the one
4116 accepted by `font-spec'. */)
4117 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4121 idx
= get_font_prop_index (prop
);
4122 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4124 CHECK_FONT_SPEC (font
);
4125 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4129 if (EQ (prop
, QCname
)
4130 || EQ (prop
, QCscript
)
4131 || EQ (prop
, QClang
)
4132 || EQ (prop
, QCotf
))
4133 CHECK_FONT_SPEC (font
);
4136 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4141 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4142 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4143 Optional 2nd argument FRAME specifies the target frame.
4144 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4145 Optional 4th argument PREFER, if non-nil, is a font-spec to
4146 control the order of the returned list. Fonts are sorted by
4147 how close they are to PREFER. */)
4148 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4150 Lisp_Object vec
, list
;
4154 frame
= selected_frame
;
4155 CHECK_LIVE_FRAME (frame
);
4156 CHECK_FONT_SPEC (font_spec
);
4164 if (! NILP (prefer
))
4165 CHECK_FONT_SPEC (prefer
);
4167 list
= font_list_entities (frame
, font_spec
);
4170 if (NILP (XCDR (list
))
4171 && ASIZE (XCAR (list
)) == 1)
4172 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4174 if (! NILP (prefer
))
4175 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4177 vec
= font_vconcat_entity_vectors (list
);
4178 if (n
== 0 || n
>= ASIZE (vec
))
4180 Lisp_Object args
[2];
4184 list
= Fappend (2, args
);
4188 for (list
= Qnil
, n
--; n
>= 0; n
--)
4189 list
= Fcons (AREF (vec
, n
), list
);
4194 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4195 doc
: /* List available font families on the current frame.
4196 Optional argument FRAME, if non-nil, specifies the target frame. */)
4200 struct font_driver_list
*driver_list
;
4204 frame
= selected_frame
;
4205 CHECK_LIVE_FRAME (frame
);
4208 for (driver_list
= f
->font_driver_list
; driver_list
;
4209 driver_list
= driver_list
->next
)
4210 if (driver_list
->driver
->list_family
)
4212 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4213 Lisp_Object tail
= list
;
4215 for (; CONSP (val
); val
= XCDR (val
))
4216 if (NILP (Fmemq (XCAR (val
), tail
))
4217 && SYMBOLP (XCAR (val
)))
4218 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4223 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4224 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4225 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4226 (Lisp_Object font_spec
, Lisp_Object frame
)
4228 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4235 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4236 doc
: /* Return XLFD name of FONT.
4237 FONT is a font-spec, font-entity, or font-object.
4238 If the name is too long for XLFD (maximum 255 chars), return nil.
4239 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4240 the consecutive wildcards are folded to one. */)
4241 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4248 if (FONT_OBJECT_P (font
))
4250 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4252 if (STRINGP (font_name
)
4253 && SDATA (font_name
)[0] == '-')
4255 if (NILP (fold_wildcards
))
4257 strcpy (name
, (char *) SDATA (font_name
));
4260 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4262 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4265 if (! NILP (fold_wildcards
))
4267 char *p0
= name
, *p1
;
4269 while ((p1
= strstr (p0
, "-*-*")))
4271 strcpy (p1
, p1
+ 2);
4276 return build_string (name
);
4279 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4280 doc
: /* Clear font cache. */)
4283 Lisp_Object list
, frame
;
4285 FOR_EACH_FRAME (list
, frame
)
4287 FRAME_PTR f
= XFRAME (frame
);
4288 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4290 for (; driver_list
; driver_list
= driver_list
->next
)
4291 if (driver_list
->on
)
4293 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4294 Lisp_Object val
, tmp
;
4298 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4300 font_assert (! NILP (val
));
4301 tmp
= XCDR (XCAR (val
));
4302 if (XINT (XCAR (tmp
)) == 0)
4304 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4305 XSETCDR (cache
, XCDR (val
));
4315 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4317 struct font
*font
= XFONT_OBJECT (font_object
);
4319 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4320 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4321 struct font_metrics metrics
;
4323 LGLYPH_SET_CODE (glyph
, ecode
);
4325 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4326 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4327 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4328 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4329 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4330 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4334 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4335 doc
: /* Shape the glyph-string GSTRING.
4336 Shaping means substituting glyphs and/or adjusting positions of glyphs
4337 to get the correct visual image of character sequences set in the
4338 header of the glyph-string.
4340 If the shaping was successful, the value is GSTRING itself or a newly
4341 created glyph-string. Otherwise, the value is nil. */)
4342 (Lisp_Object gstring
)
4345 Lisp_Object font_object
, n
, glyph
;
4348 if (! composition_gstring_p (gstring
))
4349 signal_error ("Invalid glyph-string: ", gstring
);
4350 if (! NILP (LGSTRING_ID (gstring
)))
4352 font_object
= LGSTRING_FONT (gstring
);
4353 CHECK_FONT_OBJECT (font_object
);
4354 font
= XFONT_OBJECT (font_object
);
4355 if (! font
->driver
->shape
)
4358 /* Try at most three times with larger gstring each time. */
4359 for (i
= 0; i
< 3; i
++)
4361 n
= font
->driver
->shape (gstring
);
4364 gstring
= larger_vector (gstring
,
4365 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4368 if (i
== 3 || XINT (n
) == 0)
4370 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4371 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4373 glyph
= LGSTRING_GLYPH (gstring
, 0);
4374 from
= LGLYPH_FROM (glyph
);
4375 to
= LGLYPH_TO (glyph
);
4376 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4378 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4382 if (NILP (LGLYPH_ADJUSTMENT (this)))
4387 glyph
= LGSTRING_GLYPH (gstring
, j
);
4388 LGLYPH_SET_FROM (glyph
, from
);
4389 LGLYPH_SET_TO (glyph
, to
);
4391 from
= LGLYPH_FROM (this);
4392 to
= LGLYPH_TO (this);
4397 if (from
> LGLYPH_FROM (this))
4398 from
= LGLYPH_FROM (this);
4399 if (to
< LGLYPH_TO (this))
4400 to
= LGLYPH_TO (this);
4406 glyph
= LGSTRING_GLYPH (gstring
, j
);
4407 LGLYPH_SET_FROM (glyph
, from
);
4408 LGLYPH_SET_TO (glyph
, to
);
4410 return composition_gstring_put_cache (gstring
, XINT (n
));
4413 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4415 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4416 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4418 VARIATION-SELECTOR is a character code of variation selection
4419 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4420 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4421 (Lisp_Object font_object
, Lisp_Object character
)
4423 unsigned variations
[256];
4428 CHECK_FONT_OBJECT (font_object
);
4429 CHECK_CHARACTER (character
);
4430 font
= XFONT_OBJECT (font_object
);
4431 if (! font
->driver
->get_variation_glyphs
)
4433 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4437 for (i
= 0; i
< 255; i
++)
4441 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4442 /* Stops GCC whining about limited range of data type. */
4443 EMACS_INT var
= variations
[i
];
4445 if (var
> MOST_POSITIVE_FIXNUM
)
4446 code
= Fcons (make_number ((variations
[i
]) >> 16),
4447 make_number ((variations
[i
]) & 0xFFFF));
4449 code
= make_number (variations
[i
]);
4450 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4457 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4458 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4459 OTF-FEATURES specifies which features to apply in this format:
4460 (SCRIPT LANGSYS GSUB GPOS)
4462 SCRIPT is a symbol specifying a script tag of OpenType,
4463 LANGSYS is a symbol specifying a langsys tag of OpenType,
4464 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4466 If LANGYS is nil, the default langsys is selected.
4468 The features are applied in the order they appear in the list. The
4469 symbol `*' means to apply all available features not present in this
4470 list, and the remaining features are ignored. For instance, (vatu
4471 pstf * haln) is to apply vatu and pstf in this order, then to apply
4472 all available features other than vatu, pstf, and haln.
4474 The features are applied to the glyphs in the range FROM and TO of
4475 the glyph-string GSTRING-IN.
4477 If some feature is actually applicable, the resulting glyphs are
4478 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4479 this case, the value is the number of produced glyphs.
4481 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4484 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4485 produced in GSTRING-OUT, and the value is nil.
4487 See the documentation of `font-make-gstring' for the format of
4489 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4491 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4496 check_otf_features (otf_features
);
4497 CHECK_FONT_OBJECT (font_object
);
4498 font
= XFONT_OBJECT (font_object
);
4499 if (! font
->driver
->otf_drive
)
4500 error ("Font backend %s can't drive OpenType GSUB table",
4501 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4502 CHECK_CONS (otf_features
);
4503 CHECK_SYMBOL (XCAR (otf_features
));
4504 val
= XCDR (otf_features
);
4505 CHECK_SYMBOL (XCAR (val
));
4506 val
= XCDR (otf_features
);
4509 len
= check_gstring (gstring_in
);
4510 CHECK_VECTOR (gstring_out
);
4511 CHECK_NATNUM (from
);
4513 CHECK_NATNUM (index
);
4515 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4516 args_out_of_range_3 (from
, to
, make_number (len
));
4517 if (XINT (index
) >= ASIZE (gstring_out
))
4518 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4519 num
= font
->driver
->otf_drive (font
, otf_features
,
4520 gstring_in
, XINT (from
), XINT (to
),
4521 gstring_out
, XINT (index
), 0);
4524 return make_number (num
);
4527 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4529 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4530 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4532 (SCRIPT LANGSYS FEATURE ...)
4533 See the documentation of `font-drive-otf' for more detail.
4535 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4536 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4537 character code corresponding to the glyph or nil if there's no
4538 corresponding character. */)
4539 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4542 Lisp_Object gstring_in
, gstring_out
, g
;
4543 Lisp_Object alternates
;
4546 CHECK_FONT_GET_OBJECT (font_object
, font
);
4547 if (! font
->driver
->otf_drive
)
4548 error ("Font backend %s can't drive OpenType GSUB table",
4549 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4550 CHECK_CHARACTER (character
);
4551 CHECK_CONS (otf_features
);
4553 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4554 g
= LGSTRING_GLYPH (gstring_in
, 0);
4555 LGLYPH_SET_CHAR (g
, XINT (character
));
4556 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4557 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4558 gstring_out
, 0, 1)) < 0)
4559 gstring_out
= Ffont_make_gstring (font_object
,
4560 make_number (ASIZE (gstring_out
) * 2));
4562 for (i
= 0; i
< num
; i
++)
4564 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4565 int c
= LGLYPH_CHAR (g
);
4566 unsigned code
= LGLYPH_CODE (g
);
4568 alternates
= Fcons (Fcons (make_number (code
),
4569 c
> 0 ? make_number (c
) : Qnil
),
4572 return Fnreverse (alternates
);
4578 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4579 doc
: /* Open FONT-ENTITY. */)
4580 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4584 CHECK_FONT_ENTITY (font_entity
);
4586 frame
= selected_frame
;
4587 CHECK_LIVE_FRAME (frame
);
4590 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4593 CHECK_NUMBER_OR_FLOAT (size
);
4595 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4597 isize
= XINT (size
);
4601 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4604 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4605 doc
: /* Close FONT-OBJECT. */)
4606 (Lisp_Object font_object
, Lisp_Object frame
)
4608 CHECK_FONT_OBJECT (font_object
);
4610 frame
= selected_frame
;
4611 CHECK_LIVE_FRAME (frame
);
4612 font_close_object (XFRAME (frame
), font_object
);
4616 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4617 doc
: /* Return information about FONT-OBJECT.
4618 The value is a vector:
4619 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4622 NAME is a string of the font name (or nil if the font backend doesn't
4625 FILENAME is a string of the font file (or nil if the font backend
4626 doesn't provide a file name).
4628 PIXEL-SIZE is a pixel size by which the font is opened.
4630 SIZE is a maximum advance width of the font in pixels.
4632 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4635 CAPABILITY is a list whose first element is a symbol representing the
4636 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4637 remaining elements describe the details of the font capability.
4639 If the font is OpenType font, the form of the list is
4640 \(opentype GSUB GPOS)
4641 where GSUB shows which "GSUB" features the font supports, and GPOS
4642 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4643 lists of the format:
4644 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4646 If the font is not OpenType font, currently the length of the form is
4649 SCRIPT is a symbol representing OpenType script tag.
4651 LANGSYS is a symbol representing OpenType langsys tag, or nil
4652 representing the default langsys.
4654 FEATURE is a symbol representing OpenType feature tag.
4656 If the font is not OpenType font, CAPABILITY is nil. */)
4657 (Lisp_Object font_object
)
4662 CHECK_FONT_GET_OBJECT (font_object
, font
);
4664 val
= Fmake_vector (make_number (9), Qnil
);
4665 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4666 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4667 ASET (val
, 2, make_number (font
->pixel_size
));
4668 ASET (val
, 3, make_number (font
->max_width
));
4669 ASET (val
, 4, make_number (font
->ascent
));
4670 ASET (val
, 5, make_number (font
->descent
));
4671 ASET (val
, 6, make_number (font
->space_width
));
4672 ASET (val
, 7, make_number (font
->average_width
));
4673 if (font
->driver
->otf_capability
)
4674 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4678 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4680 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4681 FROM and TO are positions (integers or markers) specifying a region
4682 of the current buffer.
4683 If the optional fourth arg OBJECT is not nil, it is a string or a
4684 vector containing the target characters.
4686 Each element is a vector containing information of a glyph in this format:
4687 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4689 FROM is an index numbers of a character the glyph corresponds to.
4690 TO is the same as FROM.
4691 C is the character of the glyph.
4692 CODE is the glyph-code of C in FONT-OBJECT.
4693 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4694 ADJUSTMENT is always nil.
4695 If FONT-OBJECT doesn't have a glyph for a character,
4696 the corresponding element is nil. */)
4697 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4702 Lisp_Object
*chars
, vec
;
4705 CHECK_FONT_GET_OBJECT (font_object
, font
);
4708 EMACS_INT charpos
, bytepos
;
4710 validate_region (&from
, &to
);
4713 len
= XFASTINT (to
) - XFASTINT (from
);
4714 SAFE_ALLOCA_LISP (chars
, len
);
4715 charpos
= XFASTINT (from
);
4716 bytepos
= CHAR_TO_BYTE (charpos
);
4717 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4719 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4720 chars
[i
] = make_number (c
);
4723 else if (STRINGP (object
))
4725 const unsigned char *p
;
4727 CHECK_NUMBER (from
);
4729 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4730 || XINT (to
) > SCHARS (object
))
4731 args_out_of_range_3 (object
, from
, to
);
4734 len
= XFASTINT (to
) - XFASTINT (from
);
4735 SAFE_ALLOCA_LISP (chars
, len
);
4737 if (STRING_MULTIBYTE (object
))
4738 for (i
= 0; i
< len
; i
++)
4740 c
= STRING_CHAR_ADVANCE (p
);
4741 chars
[i
] = make_number (c
);
4744 for (i
= 0; i
< len
; i
++)
4745 chars
[i
] = make_number (p
[i
]);
4749 CHECK_VECTOR (object
);
4750 CHECK_NUMBER (from
);
4752 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4753 || XINT (to
) > ASIZE (object
))
4754 args_out_of_range_3 (object
, from
, to
);
4757 len
= XFASTINT (to
) - XFASTINT (from
);
4758 for (i
= 0; i
< len
; i
++)
4760 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4761 CHECK_CHARACTER (elt
);
4763 chars
= &(AREF (object
, XFASTINT (from
)));
4766 vec
= Fmake_vector (make_number (len
), Qnil
);
4767 for (i
= 0; i
< len
; i
++)
4770 int c
= XFASTINT (chars
[i
]);
4773 struct font_metrics metrics
;
4775 cod
= code
= font
->driver
->encode_char (font
, c
);
4776 if (code
== FONT_INVALID_CODE
)
4778 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4779 LGLYPH_SET_FROM (g
, i
);
4780 LGLYPH_SET_TO (g
, i
);
4781 LGLYPH_SET_CHAR (g
, c
);
4782 LGLYPH_SET_CODE (g
, code
);
4783 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4784 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4785 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4786 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4787 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4788 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4791 if (! VECTORP (object
))
4796 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4797 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4798 FONT is a font-spec, font-entity, or font-object. */)
4799 (Lisp_Object spec
, Lisp_Object font
)
4801 CHECK_FONT_SPEC (spec
);
4804 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4807 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4808 doc
: /* Return a font-object for displaying a character at POSITION.
4809 Optional second arg WINDOW, if non-nil, is a window displaying
4810 the current buffer. It defaults to the currently selected window. */)
4811 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4818 CHECK_NUMBER_COERCE_MARKER (position
);
4819 pos
= XINT (position
);
4820 if (pos
< BEGV
|| pos
>= ZV
)
4821 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4825 CHECK_NUMBER (position
);
4826 CHECK_STRING (string
);
4827 pos
= XINT (position
);
4828 if (pos
< 0 || pos
>= SCHARS (string
))
4829 args_out_of_range (string
, position
);
4832 window
= selected_window
;
4833 CHECK_LIVE_WINDOW (window
);
4834 w
= XWINDOW (window
);
4836 return font_at (-1, pos
, NULL
, w
, string
);
4840 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4841 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4842 The value is a number of glyphs drawn.
4843 Type C-l to recover what previously shown. */)
4844 (Lisp_Object font_object
, Lisp_Object string
)
4846 Lisp_Object frame
= selected_frame
;
4847 FRAME_PTR f
= XFRAME (frame
);
4853 CHECK_FONT_GET_OBJECT (font_object
, font
);
4854 CHECK_STRING (string
);
4855 len
= SCHARS (string
);
4856 code
= alloca (sizeof (unsigned) * len
);
4857 for (i
= 0; i
< len
; i
++)
4859 Lisp_Object ch
= Faref (string
, make_number (i
));
4863 code
[i
] = font
->driver
->encode_char (font
, c
);
4864 if (code
[i
] == FONT_INVALID_CODE
)
4867 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4869 if (font
->driver
->prepare_face
)
4870 font
->driver
->prepare_face (f
, face
);
4871 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4872 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4873 if (font
->driver
->done_face
)
4874 font
->driver
->done_face (f
, face
);
4876 return make_number (len
);
4880 #endif /* FONT_DEBUG */
4882 #ifdef HAVE_WINDOW_SYSTEM
4884 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4885 doc
: /* Return information about a font named NAME on frame FRAME.
4886 If FRAME is omitted or nil, use the selected frame.
4887 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4888 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4890 OPENED-NAME is the name used for opening the font,
4891 FULL-NAME is the full name of the font,
4892 SIZE is the pixelsize of the font,
4893 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4894 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4895 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4896 how to compose characters.
4897 If the named font is not yet loaded, return nil. */)
4898 (Lisp_Object name
, Lisp_Object frame
)
4903 Lisp_Object font_object
;
4905 (*check_window_system_func
) ();
4908 CHECK_STRING (name
);
4910 frame
= selected_frame
;
4911 CHECK_LIVE_FRAME (frame
);
4916 int fontset
= fs_query_fontset (name
, 0);
4919 name
= fontset_ascii (fontset
);
4920 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4922 else if (FONT_OBJECT_P (name
))
4924 else if (FONT_ENTITY_P (name
))
4925 font_object
= font_open_entity (f
, name
, 0);
4928 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4929 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4931 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4933 if (NILP (font_object
))
4935 font
= XFONT_OBJECT (font_object
);
4937 info
= Fmake_vector (make_number (7), Qnil
);
4938 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4939 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
4940 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4941 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4942 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4943 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4944 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4947 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4948 close it now. Perhaps, we should manage font-objects
4949 by `reference-count'. */
4950 font_close_object (f
, font_object
);
4957 #define BUILD_STYLE_TABLE(TBL) \
4958 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4961 build_style_table (const struct table_entry
*entry
, int nelement
)
4964 Lisp_Object table
, elt
;
4966 table
= Fmake_vector (make_number (nelement
), Qnil
);
4967 for (i
= 0; i
< nelement
; i
++)
4969 for (j
= 0; entry
[i
].names
[j
]; j
++);
4970 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4971 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4972 for (j
= 0; entry
[i
].names
[j
]; j
++)
4973 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4974 ASET (table
, i
, elt
);
4979 Lisp_Object Vfont_log
;
4981 /* The deferred font-log data of the form [ACTION ARG RESULT].
4982 If ACTION is not nil, that is added to the log when font_add_log is
4983 called next time. At that time, ACTION is set back to nil. */
4984 static Lisp_Object Vfont_log_deferred
;
4986 /* Prepend the font-related logging data in Vfont_log if it is not
4987 `t'. ACTION describes a kind of font-related action (e.g. listing,
4988 opening), ARG is the argument for the action, and RESULT is the
4989 result of the action. */
4991 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4993 Lisp_Object tail
, val
;
4996 if (EQ (Vfont_log
, Qt
))
4998 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5000 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
5002 ASET (Vfont_log_deferred
, 0, Qnil
);
5003 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5004 AREF (Vfont_log_deferred
, 2));
5009 Lisp_Object tail
, elt
;
5010 Lisp_Object equalstr
= build_string ("=");
5012 val
= Ffont_xlfd_name (arg
, Qt
);
5013 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5017 if (EQ (XCAR (elt
), QCscript
)
5018 && SYMBOLP (XCDR (elt
)))
5019 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5020 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5021 else if (EQ (XCAR (elt
), QClang
)
5022 && SYMBOLP (XCDR (elt
)))
5023 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5024 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5025 else if (EQ (XCAR (elt
), QCotf
)
5026 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5027 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5029 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5035 && VECTORP (XCAR (result
))
5036 && ASIZE (XCAR (result
)) > 0
5037 && FONTP (AREF (XCAR (result
), 0)))
5038 result
= font_vconcat_entity_vectors (result
);
5041 val
= Ffont_xlfd_name (result
, Qt
);
5042 if (! FONT_SPEC_P (result
))
5043 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5044 build_string (":"), val
);
5047 else if (CONSP (result
))
5049 result
= Fcopy_sequence (result
);
5050 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5054 val
= Ffont_xlfd_name (val
, Qt
);
5055 XSETCAR (tail
, val
);
5058 else if (VECTORP (result
))
5060 result
= Fcopy_sequence (result
);
5061 for (i
= 0; i
< ASIZE (result
); i
++)
5063 val
= AREF (result
, i
);
5065 val
= Ffont_xlfd_name (val
, Qt
);
5066 ASET (result
, i
, val
);
5069 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5072 /* Record a font-related logging data to be added to Vfont_log when
5073 font_add_log is called next time. ACTION, ARG, RESULT are the same
5077 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5079 if (EQ (Vfont_log
, Qt
))
5081 ASET (Vfont_log_deferred
, 0, build_string (action
));
5082 ASET (Vfont_log_deferred
, 1, arg
);
5083 ASET (Vfont_log_deferred
, 2, result
);
5089 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5090 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5091 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5092 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5093 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5094 /* Note that the other elements in sort_shift_bits are not used. */
5096 staticpro (&font_charset_alist
);
5097 font_charset_alist
= Qnil
;
5099 DEFSYM (Qopentype
, "opentype");
5101 DEFSYM (Qascii_0
, "ascii-0");
5102 DEFSYM (Qiso8859_1
, "iso8859-1");
5103 DEFSYM (Qiso10646_1
, "iso10646-1");
5104 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5105 DEFSYM (Qunicode_sip
, "unicode-sip");
5109 DEFSYM (QCotf
, ":otf");
5110 DEFSYM (QClang
, ":lang");
5111 DEFSYM (QCscript
, ":script");
5112 DEFSYM (QCantialias
, ":antialias");
5114 DEFSYM (QCfoundry
, ":foundry");
5115 DEFSYM (QCadstyle
, ":adstyle");
5116 DEFSYM (QCregistry
, ":registry");
5117 DEFSYM (QCspacing
, ":spacing");
5118 DEFSYM (QCdpi
, ":dpi");
5119 DEFSYM (QCscalable
, ":scalable");
5120 DEFSYM (QCavgwidth
, ":avgwidth");
5121 DEFSYM (QCfont_entity
, ":font-entity");
5122 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5132 DEFSYM (QCuser_spec
, "user-spec");
5134 staticpro (&null_vector
);
5135 null_vector
= Fmake_vector (make_number (0), Qnil
);
5137 staticpro (&scratch_font_spec
);
5138 scratch_font_spec
= Ffont_spec (0, NULL
);
5139 staticpro (&scratch_font_prefer
);
5140 scratch_font_prefer
= Ffont_spec (0, NULL
);
5142 staticpro (&Vfont_log_deferred
);
5143 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5147 staticpro (&otf_list
);
5149 #endif /* HAVE_LIBOTF */
5153 defsubr (&Sfont_spec
);
5154 defsubr (&Sfont_get
);
5155 #ifdef HAVE_WINDOW_SYSTEM
5156 defsubr (&Sfont_face_attributes
);
5158 defsubr (&Sfont_put
);
5159 defsubr (&Slist_fonts
);
5160 defsubr (&Sfont_family_list
);
5161 defsubr (&Sfind_font
);
5162 defsubr (&Sfont_xlfd_name
);
5163 defsubr (&Sclear_font_cache
);
5164 defsubr (&Sfont_shape_gstring
);
5165 defsubr (&Sfont_variation_glyphs
);
5167 defsubr (&Sfont_drive_otf
);
5168 defsubr (&Sfont_otf_alternates
);
5172 defsubr (&Sopen_font
);
5173 defsubr (&Sclose_font
);
5174 defsubr (&Squery_font
);
5175 defsubr (&Sfont_get_glyphs
);
5176 defsubr (&Sfont_match_p
);
5177 defsubr (&Sfont_at
);
5179 defsubr (&Sdraw_string
);
5181 #endif /* FONT_DEBUG */
5182 #ifdef HAVE_WINDOW_SYSTEM
5183 defsubr (&Sfont_info
);
5186 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5188 Alist of fontname patterns vs the corresponding encoding and repertory info.
5189 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5190 where ENCODING is a charset or a char-table,
5191 and REPERTORY is a charset, a char-table, or nil.
5193 If ENCODING and REPERTORY are the same, the element can have the form
5194 \(REGEXP . ENCODING).
5196 ENCODING is for converting a character to a glyph code of the font.
5197 If ENCODING is a charset, encoding a character by the charset gives
5198 the corresponding glyph code. If ENCODING is a char-table, looking up
5199 the table by a character gives the corresponding glyph code.
5201 REPERTORY specifies a repertory of characters supported by the font.
5202 If REPERTORY is a charset, all characters beloging to the charset are
5203 supported. If REPERTORY is a char-table, all characters who have a
5204 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5205 gets the repertory information by an opened font and ENCODING. */);
5206 Vfont_encoding_alist
= Qnil
;
5208 /* FIXME: These 3 vars are not quite what they appear: setq on them
5209 won't have any effect other than disconnect them from the style
5210 table used by the font display code. So we make them read-only,
5211 to avoid this confusing situation. */
5213 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5214 doc
: /* Vector of valid font weight values.
5215 Each element has the form:
5216 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5217 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5218 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5219 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5221 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5222 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5223 See `font-weight-table' for the format of the vector. */);
5224 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5225 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5227 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5228 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5229 See `font-weight-table' for the format of the vector. */);
5230 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5231 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5233 staticpro (&font_style_table
);
5234 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5235 ASET (font_style_table
, 0, Vfont_weight_table
);
5236 ASET (font_style_table
, 1, Vfont_slant_table
);
5237 ASET (font_style_table
, 2, Vfont_width_table
);
5239 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5240 *Logging list of font related actions and results.
5241 The value t means to suppress the logging.
5242 The initial value is set to nil if the environment variable
5243 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5246 #ifdef HAVE_WINDOW_SYSTEM
5247 #ifdef HAVE_FREETYPE
5249 #ifdef HAVE_X_WINDOWS
5254 #endif /* HAVE_XFT */
5255 #endif /* HAVE_X_WINDOWS */
5256 #else /* not HAVE_FREETYPE */
5257 #ifdef HAVE_X_WINDOWS
5259 #endif /* HAVE_X_WINDOWS */
5260 #endif /* not HAVE_FREETYPE */
5263 #endif /* HAVE_BDFFONT */
5266 #endif /* WINDOWSNT */
5269 #endif /* HAVE_NS */
5270 #endif /* HAVE_WINDOW_SYSTEM */
5276 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;