1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
3 Copyright (C) 2006, 2007, 2008, 2009
4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H13PRO009
7 This file is part of GNU Emacs.
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
31 #include "dispextern.h"
33 #include "character.h"
34 #include "composite.h"
40 #endif /* HAVE_X_WINDOWS */
44 #endif /* HAVE_NTGUI */
51 extern Lisp_Object Qfontsize
;
54 Lisp_Object Qopentype
;
56 /* Important character set strings. */
57 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
59 #define DEFAULT_ENCODING Qiso8859_1
61 /* Unicode category `Cf'. */
62 static Lisp_Object QCf
;
64 /* Special vector of zero length. This is repeatedly used by (struct
65 font_driver *)->list when a specified font is not found. */
66 static Lisp_Object null_vector
;
68 static Lisp_Object Vfont_weight_table
, Vfont_slant_table
, Vfont_width_table
;
70 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
71 static Lisp_Object font_style_table
;
73 /* Structure used for tables mapping weight, slant, and width numeric
74 values and their names. */
79 /* The first one is a valid name as a face attribute.
80 The second one (if any) is a typical name in XLFD field. */
85 /* Table of weight numeric values and their names. This table must be
86 sorted by numeric values in ascending order. */
88 static struct table_entry weight_table
[] =
91 { 20, { "ultra-light", "ultralight" }},
92 { 40, { "extra-light", "extralight" }},
94 { 75, { "semi-light", "semilight", "demilight", "book" }},
95 { 100, { "normal", "medium", "regular", "unspecified" }},
96 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
98 { 205, { "extra-bold", "extrabold" }},
99 { 210, { "ultra-bold", "ultrabold", "black" }}
102 /* Table of slant numeric values and their names. This table must be
103 sorted by numeric values in ascending order. */
105 static struct table_entry slant_table
[] =
107 { 0, { "reverse-oblique", "ro" }},
108 { 10, { "reverse-italic", "ri" }},
109 { 100, { "normal", "r", "unspecified" }},
110 { 200, { "italic" ,"i", "ot" }},
111 { 210, { "oblique", "o" }}
114 /* Table of width numeric values and their names. This table must be
115 sorted by numeric values in ascending order. */
117 static struct table_entry width_table
[] =
119 { 50, { "ultra-condensed", "ultracondensed" }},
120 { 63, { "extra-condensed", "extracondensed" }},
121 { 75, { "condensed", "compressed", "narrow" }},
122 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
123 { 100, { "normal", "medium", "regular", "unspecified" }},
124 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
125 { 125, { "expanded" }},
126 { 150, { "extra-expanded", "extraexpanded" }},
127 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
130 extern Lisp_Object Qnormal
;
132 /* Symbols representing keys of normal font properties. */
133 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
;
134 extern Lisp_Object QCheight
, QCsize
, QCname
;
136 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
;
137 /* Symbols representing keys of font extra info. */
138 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
139 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
140 /* Symbols representing values of font spacing property. */
141 Lisp_Object Qc
, Qm
, Qp
, Qd
;
142 /* Special ADSTYLE properties to avoid fonts used for Latin
143 characters; used in xfont.c and ftfont.c. */
144 Lisp_Object Qja
, Qko
;
146 Lisp_Object Vfont_encoding_alist
;
148 /* Alist of font registry symbol and the corresponding charsets
149 information. The information is retrieved from
150 Vfont_encoding_alist on demand.
152 Eash element has the form:
153 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
157 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
158 encodes a character code to a glyph code of a font, and
159 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
160 character is supported by a font.
162 The latter form means that the information for REGISTRY couldn't be
164 static Lisp_Object font_charset_alist
;
166 /* List of all font drivers. Each font-backend (XXXfont.c) calls
167 register_font_driver in syms_of_XXXfont to register its font-driver
169 static struct font_driver_list
*font_driver_list
;
173 /* Creaters of font-related Lisp object. */
178 Lisp_Object font_spec
;
179 struct font_spec
*spec
180 = ((struct font_spec
*)
181 allocate_pseudovector (VECSIZE (struct font_spec
),
182 FONT_SPEC_MAX
, PVEC_FONT
));
183 XSETFONT (font_spec
, spec
);
190 Lisp_Object font_entity
;
191 struct font_entity
*entity
192 = ((struct font_entity
*)
193 allocate_pseudovector (VECSIZE (struct font_entity
),
194 FONT_ENTITY_MAX
, PVEC_FONT
));
195 XSETFONT (font_entity
, entity
);
199 /* Create a font-object whose structure size is SIZE. If ENTITY is
200 not nil, copy properties from ENTITY to the font-object. If
201 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
203 font_make_object (size
, entity
, pixelsize
)
208 Lisp_Object font_object
;
210 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
213 XSETFONT (font_object
, font
);
217 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
218 font
->props
[i
] = AREF (entity
, i
);
219 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
220 font
->props
[FONT_EXTRA_INDEX
]
221 = Fcopy_sequence (AREF (entity
, FONT_EXTRA_INDEX
));
224 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
230 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
231 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
232 static Lisp_Object font_matching_entity
P_ ((FRAME_PTR
, Lisp_Object
*,
235 /* Number of registered font drivers. */
236 static int num_font_drivers
;
239 /* Return a Lispy value of a font property value at STR and LEN bytes.
240 If STR is "*", it returns nil.
241 If FORCE_SYMBOL is zero and all characters in STR are digits, it
242 returns an integer. Otherwise, it returns a symbol interned from
246 font_intern_prop (str
, len
, force_symbol
)
256 if (len
== 1 && *str
== '*')
258 if (!force_symbol
&& len
>=1 && isdigit (*str
))
260 for (i
= 1; i
< len
; i
++)
261 if (! isdigit (str
[i
]))
264 return make_number (atoi (str
));
267 /* The following code is copied from the function intern (in
268 lread.c), and modified to suite our purpose. */
270 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
271 obarray
= check_obarray (obarray
);
272 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
273 if (len
== nchars
|| len
!= nbytes
)
274 /* CONTENTS contains no multibyte sequences or contains an invalid
275 multibyte sequence. We'll make a unibyte string. */
276 tem
= oblookup (obarray
, str
, len
, len
);
278 tem
= oblookup (obarray
, str
, nchars
, len
);
281 if (len
== nchars
|| len
!= nbytes
)
282 tem
= make_unibyte_string (str
, len
);
284 tem
= make_multibyte_string (str
, nchars
, len
);
285 return Fintern (tem
, obarray
);
288 /* Return a pixel size of font-spec SPEC on frame F. */
291 font_pixel_size (f
, spec
)
295 #ifdef HAVE_WINDOW_SYSTEM
296 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
305 font_assert (FLOATP (size
));
306 point_size
= XFLOAT_DATA (size
);
307 val
= AREF (spec
, FONT_DPI_INDEX
);
312 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
320 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
321 font vector. If VAL is not valid (i.e. not registered in
322 font_style_table), return -1 if NOERROR is zero, and return a
323 proper index if NOERROR is nonzero. In that case, register VAL in
324 font_style_table if VAL is a symbol, and return a closest index if
325 VAL is an integer. */
328 font_style_to_value (prop
, val
, noerror
)
329 enum font_property_index prop
;
333 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
334 int len
= ASIZE (table
);
340 Lisp_Object args
[2], elt
;
342 /* At first try exact match. */
343 for (i
= 0; i
< len
; i
++)
344 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
345 if (EQ (val
, AREF (AREF (table
, i
), j
)))
346 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
347 | (i
<< 4) | (j
- 1));
348 /* Try also with case-folding match. */
349 s
= SDATA (SYMBOL_NAME (val
));
350 for (i
= 0; i
< len
; i
++)
351 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
353 elt
= AREF (AREF (table
, i
), j
);
354 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
355 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
356 | (i
<< 4) | (j
- 1));
362 elt
= Fmake_vector (make_number (2), make_number (100));
365 args
[1] = Fmake_vector (make_number (1), elt
);
366 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
367 return (100 << 8) | (i
<< 4);
372 int numeric
= XINT (val
);
374 for (i
= 0, last_n
= -1; i
< len
; i
++)
376 int n
= XINT (AREF (AREF (table
, i
), 0));
379 return (n
<< 8) | (i
<< 4);
384 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
385 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
391 return ((last_n
<< 8) | ((i
- 1) << 4));
396 font_style_symbolic (font
, prop
, for_face
)
398 enum font_property_index prop
;
401 Lisp_Object val
= AREF (font
, prop
);
402 Lisp_Object table
, elt
;
407 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
408 i
= XINT (val
) & 0xFF;
409 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
410 elt
= AREF (table
, ((i
>> 4) & 0xF));
411 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
412 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
415 extern Lisp_Object Vface_alternative_font_family_alist
;
417 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
420 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
421 FONTNAME. ENCODING is a charset symbol that specifies the encoding
422 of the font. REPERTORY is a charset symbol or nil. */
425 find_font_encoding (fontname
)
426 Lisp_Object fontname
;
428 Lisp_Object tail
, elt
;
430 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
434 && STRINGP (XCAR (elt
))
435 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
436 && (SYMBOLP (XCDR (elt
))
437 ? CHARSETP (XCDR (elt
))
438 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
444 /* Return encoding charset and repertory charset for REGISTRY in
445 ENCODING and REPERTORY correspondingly. If correct information for
446 REGISTRY is available, return 0. Otherwise return -1. */
449 font_registry_charsets (registry
, encoding
, repertory
)
450 Lisp_Object registry
;
451 struct charset
**encoding
, **repertory
;
454 int encoding_id
, repertory_id
;
456 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
462 encoding_id
= XINT (XCAR (val
));
463 repertory_id
= XINT (XCDR (val
));
467 val
= find_font_encoding (SYMBOL_NAME (registry
));
468 if (SYMBOLP (val
) && CHARSETP (val
))
470 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
472 else if (CONSP (val
))
474 if (! CHARSETP (XCAR (val
)))
476 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
477 if (NILP (XCDR (val
)))
481 if (! CHARSETP (XCDR (val
)))
483 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
488 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
490 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
494 *encoding
= CHARSET_FROM_ID (encoding_id
);
496 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
501 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
506 /* Font property value validaters. See the comment of
507 font_property_table for the meaning of the arguments. */
509 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
510 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
511 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
512 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
513 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
514 static int get_font_prop_index
P_ ((Lisp_Object
));
517 font_prop_validate_symbol (prop
, val
)
518 Lisp_Object prop
, val
;
521 val
= Fintern (val
, Qnil
);
524 else if (EQ (prop
, QCregistry
))
525 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
531 font_prop_validate_style (style
, val
)
532 Lisp_Object style
, val
;
534 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
535 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
542 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
546 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
548 if ((n
& 0xF) + 1 >= ASIZE (elt
))
550 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
554 else if (SYMBOLP (val
))
556 int n
= font_style_to_value (prop
, val
, 0);
558 val
= n
>= 0 ? make_number (n
) : Qerror
;
566 font_prop_validate_non_neg (prop
, val
)
567 Lisp_Object prop
, val
;
569 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
574 font_prop_validate_spacing (prop
, val
)
575 Lisp_Object prop
, val
;
577 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
579 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
581 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
583 if (spacing
== 'c' || spacing
== 'C')
584 return make_number (FONT_SPACING_CHARCELL
);
585 if (spacing
== 'm' || spacing
== 'M')
586 return make_number (FONT_SPACING_MONO
);
587 if (spacing
== 'p' || spacing
== 'P')
588 return make_number (FONT_SPACING_PROPORTIONAL
);
589 if (spacing
== 'd' || spacing
== 'D')
590 return make_number (FONT_SPACING_DUAL
);
596 font_prop_validate_otf (prop
, val
)
597 Lisp_Object prop
, val
;
599 Lisp_Object tail
, tmp
;
602 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
603 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
604 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
607 if (! SYMBOLP (XCAR (val
)))
612 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
614 for (i
= 0; i
< 2; i
++)
621 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
622 if (! SYMBOLP (XCAR (tmp
)))
630 /* Structure of known font property keys and validater of the
634 /* Pointer to the key symbol. */
636 /* Function to validate PROP's value VAL, or NULL if any value is
637 ok. The value is VAL or its regularized value if VAL is valid,
638 and Qerror if not. */
639 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
640 } font_property_table
[] =
641 { { &QCtype
, font_prop_validate_symbol
},
642 { &QCfoundry
, font_prop_validate_symbol
},
643 { &QCfamily
, font_prop_validate_symbol
},
644 { &QCadstyle
, font_prop_validate_symbol
},
645 { &QCregistry
, font_prop_validate_symbol
},
646 { &QCweight
, font_prop_validate_style
},
647 { &QCslant
, font_prop_validate_style
},
648 { &QCwidth
, font_prop_validate_style
},
649 { &QCsize
, font_prop_validate_non_neg
},
650 { &QCdpi
, font_prop_validate_non_neg
},
651 { &QCspacing
, font_prop_validate_spacing
},
652 { &QCavgwidth
, font_prop_validate_non_neg
},
653 /* The order of the above entries must match with enum
654 font_property_index. */
655 { &QClang
, font_prop_validate_symbol
},
656 { &QCscript
, font_prop_validate_symbol
},
657 { &QCotf
, font_prop_validate_otf
}
660 /* Size (number of elements) of the above table. */
661 #define FONT_PROPERTY_TABLE_SIZE \
662 ((sizeof font_property_table) / (sizeof *font_property_table))
664 /* Return an index number of font property KEY or -1 if KEY is not an
665 already known property. */
668 get_font_prop_index (key
)
673 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
674 if (EQ (key
, *font_property_table
[i
].key
))
679 /* Validate the font property. The property key is specified by the
680 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
681 signal an error. The value is VAL or the regularized one. */
684 font_prop_validate (idx
, prop
, val
)
686 Lisp_Object prop
, val
;
688 Lisp_Object validated
;
693 prop
= *font_property_table
[idx
].key
;
696 idx
= get_font_prop_index (prop
);
700 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
701 if (EQ (validated
, Qerror
))
702 signal_error ("invalid font property", Fcons (prop
, val
));
707 /* Store VAL as a value of extra font property PROP in FONT while
708 keeping the sorting order. Don't check the validity of VAL. */
711 font_put_extra (font
, prop
, val
)
712 Lisp_Object font
, prop
, val
;
714 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
715 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
719 Lisp_Object prev
= Qnil
;
724 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
725 prev
= extra
, extra
= XCDR (extra
);
727 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
729 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
734 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
739 /* Font name parser and unparser */
741 static int parse_matrix
P_ ((char *));
742 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
743 static int font_parse_name
P_ ((char *, Lisp_Object
));
745 /* An enumerator for each field of an XLFD font name. */
746 enum xlfd_field_index
765 /* An enumerator for mask bit corresponding to each XLFD field. */
768 XLFD_FOUNDRY_MASK
= 0x0001,
769 XLFD_FAMILY_MASK
= 0x0002,
770 XLFD_WEIGHT_MASK
= 0x0004,
771 XLFD_SLANT_MASK
= 0x0008,
772 XLFD_SWIDTH_MASK
= 0x0010,
773 XLFD_ADSTYLE_MASK
= 0x0020,
774 XLFD_PIXEL_MASK
= 0x0040,
775 XLFD_POINT_MASK
= 0x0080,
776 XLFD_RESX_MASK
= 0x0100,
777 XLFD_RESY_MASK
= 0x0200,
778 XLFD_SPACING_MASK
= 0x0400,
779 XLFD_AVGWIDTH_MASK
= 0x0800,
780 XLFD_REGISTRY_MASK
= 0x1000,
781 XLFD_ENCODING_MASK
= 0x2000
785 /* Parse P pointing the pixel/point size field of the form
786 `[A B C D]' which specifies a transformation matrix:
792 by which all glyphs of the font are transformed. The spec says
793 that scalar value N for the pixel/point size is equivalent to:
794 A = N * resx/resy, B = C = 0, D = N.
796 Return the scalar value N if the form is valid. Otherwise return
807 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
810 matrix
[i
] = - strtod (p
+ 1, &end
);
812 matrix
[i
] = strtod (p
, &end
);
815 return (i
== 4 ? (int) matrix
[3] : -1);
818 /* Expand a wildcard field in FIELD (the first N fields are filled) to
819 multiple fields to fill in all 14 XLFD fields while restring a
820 field position by its contents. */
823 font_expand_wildcards (field
, n
)
824 Lisp_Object field
[XLFD_LAST_INDEX
];
828 Lisp_Object tmp
[XLFD_LAST_INDEX
];
829 /* Array of information about where this element can go. Nth
830 element is for Nth element of FIELD. */
832 /* Minimum possible field. */
834 /* Maxinum possible field. */
836 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
838 } range
[XLFD_LAST_INDEX
];
840 int range_from
, range_to
;
843 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
844 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
845 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
846 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
847 | XLFD_AVGWIDTH_MASK)
848 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
850 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
851 field. The value is shifted to left one bit by one in the
853 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
854 range_mask
= (range_mask
<< 1) | 1;
856 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
857 position-based retriction for FIELD[I]. */
858 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
859 i
++, range_from
++, range_to
++, range_mask
<<= 1)
861 Lisp_Object val
= field
[i
];
867 range
[i
].from
= range_from
;
868 range
[i
].to
= range_to
;
869 range
[i
].mask
= range_mask
;
873 /* The triplet FROM, TO, and MASK is a value-based
874 retriction for FIELD[I]. */
880 int numeric
= XINT (val
);
883 from
= to
= XLFD_ENCODING_INDEX
,
884 mask
= XLFD_ENCODING_MASK
;
885 else if (numeric
== 0)
886 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
887 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
888 else if (numeric
<= 48)
889 from
= to
= XLFD_PIXEL_INDEX
,
890 mask
= XLFD_PIXEL_MASK
;
892 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
893 mask
= XLFD_LARGENUM_MASK
;
895 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
896 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
897 mask
= XLFD_NULL_MASK
;
899 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
902 Lisp_Object name
= SYMBOL_NAME (val
);
904 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
905 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
906 mask
= XLFD_REGENC_MASK
;
908 from
= to
= XLFD_ENCODING_INDEX
,
909 mask
= XLFD_ENCODING_MASK
;
911 else if (range_from
<= XLFD_WEIGHT_INDEX
912 && range_to
>= XLFD_WEIGHT_INDEX
913 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
914 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
915 else if (range_from
<= XLFD_SLANT_INDEX
916 && range_to
>= XLFD_SLANT_INDEX
917 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
918 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
919 else if (range_from
<= XLFD_SWIDTH_INDEX
920 && range_to
>= XLFD_SWIDTH_INDEX
921 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
922 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
925 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
926 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
928 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
929 mask
= XLFD_SYMBOL_MASK
;
932 /* Merge position-based and value-based restrictions. */
934 while (from
< range_from
)
935 mask
&= ~(1 << from
++);
936 while (from
< 14 && ! (mask
& (1 << from
)))
938 while (to
> range_to
)
939 mask
&= ~(1 << to
--);
940 while (to
>= 0 && ! (mask
& (1 << to
)))
944 range
[i
].from
= from
;
946 range
[i
].mask
= mask
;
948 if (from
> range_from
|| to
< range_to
)
950 /* The range is narrowed by value-based restrictions.
951 Reflect it to the other fields. */
953 /* Following fields should be after FROM. */
955 /* Preceding fields should be before TO. */
956 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
958 /* Check FROM for non-wildcard field. */
959 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
961 while (range
[j
].from
< from
)
962 range
[j
].mask
&= ~(1 << range
[j
].from
++);
963 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
965 range
[j
].from
= from
;
968 from
= range
[j
].from
;
969 if (range
[j
].to
> to
)
971 while (range
[j
].to
> to
)
972 range
[j
].mask
&= ~(1 << range
[j
].to
--);
973 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
986 /* Decide all fileds from restrictions in RANGE. */
987 for (i
= j
= 0; i
< n
; i
++)
989 if (j
< range
[i
].from
)
991 if (i
== 0 || ! NILP (tmp
[i
- 1]))
992 /* None of TMP[X] corresponds to Jth field. */
994 for (; j
< range
[i
].from
; j
++)
999 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
1001 for (; j
< XLFD_LAST_INDEX
; j
++)
1003 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
1004 field
[XLFD_ENCODING_INDEX
]
1005 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1010 #ifdef ENABLE_CHECKING
1011 /* Match a 14-field XLFD pattern against a full XLFD font name. */
1013 font_match_xlfd (char *pattern
, char *name
)
1015 while (*pattern
&& *name
)
1017 if (*pattern
== *name
)
1019 else if (*pattern
== '*')
1020 if (*name
== pattern
[1])
1031 /* Make sure the font object matches the XLFD font name. */
1033 font_check_xlfd_parse (Lisp_Object font
, char *name
)
1035 char name_check
[256];
1036 font_unparse_xlfd (font
, 0, name_check
, 255);
1037 return font_match_xlfd (name_check
, name
);
1043 /* Parse NAME (null terminated) as XLFD and store information in FONT
1044 (font-spec or font-entity). Size property of FONT is set as
1046 specified XLFD fields FONT property
1047 --------------------- -------------
1048 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1049 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1050 POINT_SIZE POINT_SIZE/10 (Lisp float)
1052 If NAME is successfully parsed, return 0. Otherwise return -1.
1054 FONT is usually a font-spec, but when this function is called from
1055 X font backend driver, it is a font-entity. In that case, NAME is
1056 a fully specified XLFD. */
1059 font_parse_xlfd (name
, font
)
1063 int len
= strlen (name
);
1065 char *f
[XLFD_LAST_INDEX
+ 1];
1069 if (len
> 255 || !len
)
1070 /* Maximum XLFD name length is 255. */
1072 /* Accept "*-.." as a fully specified XLFD. */
1073 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1074 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1077 for (p
= name
+ i
; *p
; p
++)
1081 if (i
== XLFD_LAST_INDEX
)
1086 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1087 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1089 if (i
== XLFD_LAST_INDEX
)
1091 /* Fully specified XLFD. */
1094 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1095 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1096 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1097 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1099 val
= INTERN_FIELD_SYM (i
);
1102 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1104 ASET (font
, j
, make_number (n
));
1107 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1108 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1109 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1111 ASET (font
, FONT_REGISTRY_INDEX
,
1112 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1113 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1115 p
= f
[XLFD_PIXEL_INDEX
];
1116 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1117 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1120 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1122 ASET (font
, FONT_SIZE_INDEX
, val
);
1125 double point_size
= -1;
1127 font_assert (FONT_SPEC_P (font
));
1128 p
= f
[XLFD_POINT_INDEX
];
1130 point_size
= parse_matrix (p
);
1131 else if (isdigit (*p
))
1132 point_size
= atoi (p
), point_size
/= 10;
1133 if (point_size
>= 0)
1134 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1138 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1139 if (! NILP (val
) && ! INTEGERP (val
))
1141 ASET (font
, FONT_DPI_INDEX
, val
);
1142 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1145 val
= font_prop_validate_spacing (QCspacing
, val
);
1146 if (! INTEGERP (val
))
1148 ASET (font
, FONT_SPACING_INDEX
, val
);
1150 p
= f
[XLFD_AVGWIDTH_INDEX
];
1153 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1154 if (! NILP (val
) && ! INTEGERP (val
))
1156 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1160 int wild_card_found
= 0;
1161 Lisp_Object prop
[XLFD_LAST_INDEX
];
1163 if (FONT_ENTITY_P (font
))
1165 for (j
= 0; j
< i
; j
++)
1169 if (f
[j
][1] && f
[j
][1] != '-')
1172 wild_card_found
= 1;
1175 prop
[j
] = INTERN_FIELD (j
);
1177 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1179 if (! wild_card_found
)
1181 if (font_expand_wildcards (prop
, i
) < 0)
1184 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1185 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1186 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1187 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1188 if (! NILP (prop
[i
]))
1190 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1192 ASET (font
, j
, make_number (n
));
1194 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1195 val
= prop
[XLFD_REGISTRY_INDEX
];
1198 val
= prop
[XLFD_ENCODING_INDEX
];
1200 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1202 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1203 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1205 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1206 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1208 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1210 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1211 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1212 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1214 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1216 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1219 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1220 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1221 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1223 val
= font_prop_validate_spacing (QCspacing
,
1224 prop
[XLFD_SPACING_INDEX
]);
1225 if (! INTEGERP (val
))
1227 ASET (font
, FONT_SPACING_INDEX
, val
);
1229 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1230 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1236 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1237 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1238 0, use PIXEL_SIZE instead. */
1241 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1247 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1251 font_assert (FONTP (font
));
1253 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1256 if (i
== FONT_ADSTYLE_INDEX
)
1257 j
= XLFD_ADSTYLE_INDEX
;
1258 else if (i
== FONT_REGISTRY_INDEX
)
1259 j
= XLFD_REGISTRY_INDEX
;
1260 val
= AREF (font
, i
);
1263 if (j
== XLFD_REGISTRY_INDEX
)
1264 f
[j
] = "*-*", len
+= 4;
1266 f
[j
] = "*", len
+= 2;
1271 val
= SYMBOL_NAME (val
);
1272 if (j
== XLFD_REGISTRY_INDEX
1273 && ! strchr ((char *) SDATA (val
), '-'))
1275 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1276 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1278 f
[j
] = alloca (SBYTES (val
) + 3);
1279 sprintf (f
[j
], "%s-*", SDATA (val
));
1280 len
+= SBYTES (val
) + 3;
1284 f
[j
] = alloca (SBYTES (val
) + 4);
1285 sprintf (f
[j
], "%s*-*", SDATA (val
));
1286 len
+= SBYTES (val
) + 4;
1290 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1294 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1297 val
= font_style_symbolic (font
, i
, 0);
1299 f
[j
] = "*", len
+= 2;
1302 val
= SYMBOL_NAME (val
);
1303 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1307 val
= AREF (font
, FONT_SIZE_INDEX
);
1308 font_assert (NUMBERP (val
) || NILP (val
));
1316 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1317 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1320 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1322 else if (FLOATP (val
))
1324 i
= XFLOAT_DATA (val
) * 10;
1325 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1326 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1329 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1331 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1333 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1334 f
[XLFD_RESX_INDEX
] = alloca (22);
1335 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1339 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1340 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1342 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1344 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1345 : spacing
<= FONT_SPACING_DUAL
? "d"
1346 : spacing
<= FONT_SPACING_MONO
? "m"
1351 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1352 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1354 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1355 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
],
1356 "%d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1359 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1360 len
++; /* for terminating '\0'. */
1363 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1364 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1365 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1366 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1367 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1368 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1369 f
[XLFD_REGISTRY_INDEX
]);
1372 /* Parse NAME (null terminated) and store information in FONT
1373 (font-spec or font-entity). NAME is supplied in either the
1374 Fontconfig or GTK font name format. If NAME is successfully
1375 parsed, return 0. Otherwise return -1.
1377 The fontconfig format is
1379 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1383 FAMILY [PROPS...] [SIZE]
1385 This function tries to guess which format it is. */
1388 font_parse_fcname (name
, font
)
1393 char *size_beg
= NULL
, *size_end
= NULL
;
1394 char *props_beg
= NULL
, *family_end
= NULL
;
1395 int len
= strlen (name
);
1400 for (p
= name
; *p
; p
++)
1402 if (*p
== '\\' && p
[1])
1406 props_beg
= family_end
= p
;
1411 int decimal
= 0, size_found
= 1;
1412 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1415 if (*q
!= '.' || decimal
)
1434 /* A fontconfig name with size and/or property data. */
1435 if (family_end
> name
)
1438 family
= font_intern_prop (name
, family_end
- name
, 1);
1439 ASET (font
, FONT_FAMILY_INDEX
, family
);
1443 double point_size
= strtod (size_beg
, &size_end
);
1444 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1445 if (*size_end
== ':' && size_end
[1])
1446 props_beg
= size_end
;
1450 /* Now parse ":KEY=VAL" patterns. */
1453 for (p
= props_beg
; *p
; p
= q
)
1455 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1458 /* Must be an enumerated value. */
1462 val
= font_intern_prop (p
, q
- p
, 1);
1464 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1466 if (PROP_MATCH ("light", 5)
1467 || PROP_MATCH ("medium", 6)
1468 || PROP_MATCH ("demibold", 8)
1469 || PROP_MATCH ("bold", 4)
1470 || PROP_MATCH ("black", 5))
1471 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1472 else if (PROP_MATCH ("roman", 5)
1473 || PROP_MATCH ("italic", 6)
1474 || PROP_MATCH ("oblique", 7))
1475 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1476 else if (PROP_MATCH ("charcell", 8))
1477 ASET (font
, FONT_SPACING_INDEX
,
1478 make_number (FONT_SPACING_CHARCELL
));
1479 else if (PROP_MATCH ("mono", 4))
1480 ASET (font
, FONT_SPACING_INDEX
,
1481 make_number (FONT_SPACING_MONO
));
1482 else if (PROP_MATCH ("proportional", 12))
1483 ASET (font
, FONT_SPACING_INDEX
,
1484 make_number (FONT_SPACING_PROPORTIONAL
));
1493 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1494 prop
= FONT_SIZE_INDEX
;
1497 key
= font_intern_prop (p
, q
- p
, 1);
1498 prop
= get_font_prop_index (key
);
1502 for (q
= p
; *q
&& *q
!= ':'; q
++);
1503 val
= font_intern_prop (p
, q
- p
, 0);
1505 if (prop
>= FONT_FOUNDRY_INDEX
1506 && prop
< FONT_EXTRA_INDEX
)
1507 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1509 Ffont_put (font
, key
, val
);
1517 /* Either a fontconfig-style name with no size and property
1518 data, or a GTK-style name. */
1520 int word_len
, prop_found
= 0;
1522 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1528 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1536 double point_size
= strtod (p
, &q
);
1537 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1542 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1543 if (*q
== '\\' && q
[1])
1547 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1549 if (PROP_MATCH ("Ultra-Light", 11))
1552 prop
= font_intern_prop ("ultra-light", 11, 1);
1553 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1555 else if (PROP_MATCH ("Light", 5))
1558 prop
= font_intern_prop ("light", 5, 1);
1559 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1561 else if (PROP_MATCH ("Semi-Bold", 9))
1564 prop
= font_intern_prop ("semi-bold", 9, 1);
1565 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1567 else if (PROP_MATCH ("Bold", 4))
1570 prop
= font_intern_prop ("bold", 4, 1);
1571 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1573 else if (PROP_MATCH ("Italic", 6))
1576 prop
= font_intern_prop ("italic", 4, 1);
1577 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1579 else if (PROP_MATCH ("Oblique", 7))
1582 prop
= font_intern_prop ("oblique", 7, 1);
1583 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1587 return -1; /* Unknown property in GTK-style font name. */
1596 family
= font_intern_prop (name
, family_end
- name
, 1);
1597 ASET (font
, FONT_FAMILY_INDEX
, family
);
1604 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1605 NAME (NBYTES length), and return the name length. If
1606 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1609 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1615 Lisp_Object family
, foundry
;
1616 Lisp_Object tail
, val
;
1620 Lisp_Object styles
[3];
1621 char *style_names
[3] = { "weight", "slant", "width" };
1624 family
= AREF (font
, FONT_FAMILY_INDEX
);
1625 if (! NILP (family
))
1627 if (SYMBOLP (family
))
1629 family
= SYMBOL_NAME (family
);
1630 len
+= SBYTES (family
);
1636 val
= AREF (font
, FONT_SIZE_INDEX
);
1639 if (XINT (val
) != 0)
1640 pixel_size
= XINT (val
);
1642 len
+= 21; /* for ":pixelsize=NUM" */
1644 else if (FLOATP (val
))
1647 point_size
= (int) XFLOAT_DATA (val
);
1648 len
+= 11; /* for "-NUM" */
1651 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1652 if (! NILP (foundry
))
1654 if (SYMBOLP (foundry
))
1656 foundry
= SYMBOL_NAME (foundry
);
1657 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1663 for (i
= 0; i
< 3; i
++)
1665 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1666 if (! NILP (styles
[i
]))
1667 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1668 SDATA (SYMBOL_NAME (styles
[i
])));
1671 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1672 len
+= sprintf (work
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1673 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1674 len
+= strlen (":spacing=100");
1675 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1676 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1677 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1679 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1681 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1683 len
+= SBYTES (val
);
1684 else if (INTEGERP (val
))
1685 len
+= sprintf (work
, "%d", XINT (val
));
1686 else if (SYMBOLP (val
))
1687 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1693 if (! NILP (family
))
1694 p
+= sprintf (p
, "%s", SDATA (family
));
1698 p
+= sprintf (p
, "%d", point_size
);
1700 p
+= sprintf (p
, "-%d", point_size
);
1702 else if (pixel_size
> 0)
1703 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1704 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1705 p
+= sprintf (p
, ":foundry=%s",
1706 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1707 for (i
= 0; i
< 3; i
++)
1708 if (! NILP (styles
[i
]))
1709 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1710 SDATA (SYMBOL_NAME (styles
[i
])));
1711 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1712 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1713 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1714 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1715 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1717 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1718 p
+= sprintf (p
, ":scalable=true");
1720 p
+= sprintf (p
, ":scalable=false");
1725 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1726 NAME (NBYTES length), and return the name length. F is the frame
1727 on which the font is displayed; it is used to calculate the point
1731 font_unparse_gtkname (font
, f
, name
, nbytes
)
1739 Lisp_Object family
, weight
, slant
, size
;
1740 int point_size
= -1;
1742 family
= AREF (font
, FONT_FAMILY_INDEX
);
1743 if (! NILP (family
))
1745 if (! SYMBOLP (family
))
1747 family
= SYMBOL_NAME (family
);
1748 len
+= SBYTES (family
);
1751 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1752 if (EQ (weight
, Qnormal
))
1754 else if (! NILP (weight
))
1756 weight
= SYMBOL_NAME (weight
);
1757 len
+= SBYTES (weight
);
1760 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1761 if (EQ (slant
, Qnormal
))
1763 else if (! NILP (slant
))
1765 slant
= SYMBOL_NAME (slant
);
1766 len
+= SBYTES (slant
);
1769 size
= AREF (font
, FONT_SIZE_INDEX
);
1770 /* Convert pixel size to point size. */
1771 if (INTEGERP (size
))
1773 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1775 if (INTEGERP (font_dpi
))
1776 dpi
= XINT (font_dpi
);
1779 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1782 else if (FLOATP (size
))
1784 point_size
= (int) XFLOAT_DATA (size
);
1791 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1793 if (! NILP (weight
))
1796 p
+= sprintf (p
, " %s", SDATA (weight
));
1797 q
[1] = toupper (q
[1]);
1803 p
+= sprintf (p
, " %s", SDATA (slant
));
1804 q
[1] = toupper (q
[1]);
1808 p
+= sprintf (p
, " %d", point_size
);
1813 /* Parse NAME (null terminated) and store information in FONT
1814 (font-spec or font-entity). If NAME is successfully parsed, return
1815 0. Otherwise return -1. */
1818 font_parse_name (name
, font
)
1822 if (name
[0] == '-' || index (name
, '*') || index (name
, '?'))
1823 return font_parse_xlfd (name
, font
);
1824 return font_parse_fcname (name
, font
);
1828 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1829 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1833 font_parse_family_registry (family
, registry
, font_spec
)
1834 Lisp_Object family
, registry
, font_spec
;
1840 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1842 CHECK_STRING (family
);
1843 len
= SBYTES (family
);
1844 p0
= (char *) SDATA (family
);
1845 p1
= index (p0
, '-');
1848 if ((*p0
!= '*' && p1
- p0
> 0)
1849 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1850 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1853 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1856 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1858 if (! NILP (registry
))
1860 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1861 CHECK_STRING (registry
);
1862 len
= SBYTES (registry
);
1863 p0
= (char *) SDATA (registry
);
1864 p1
= index (p0
, '-');
1867 if (SDATA (registry
)[len
- 1] == '*')
1868 registry
= concat2 (registry
, build_string ("-*"));
1870 registry
= concat2 (registry
, build_string ("*-*"));
1872 registry
= Fdowncase (registry
);
1873 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1878 /* This part (through the next ^L) is still experimental and not
1879 tested much. We may drastically change codes. */
1885 #define LGSTRING_HEADER_SIZE 6
1886 #define LGSTRING_GLYPH_SIZE 8
1889 check_gstring (gstring
)
1890 Lisp_Object gstring
;
1895 CHECK_VECTOR (gstring
);
1896 val
= AREF (gstring
, 0);
1898 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1900 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1901 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1902 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1903 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1904 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1905 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1906 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1907 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1908 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1909 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1910 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1912 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1914 val
= LGSTRING_GLYPH (gstring
, i
);
1916 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1918 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1920 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1921 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1922 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1923 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1924 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1925 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1926 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1927 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1929 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1931 if (ASIZE (val
) < 3)
1933 for (j
= 0; j
< 3; j
++)
1934 CHECK_NUMBER (AREF (val
, j
));
1939 error ("Invalid glyph-string format");
1944 check_otf_features (otf_features
)
1945 Lisp_Object otf_features
;
1949 CHECK_CONS (otf_features
);
1950 CHECK_SYMBOL (XCAR (otf_features
));
1951 otf_features
= XCDR (otf_features
);
1952 CHECK_CONS (otf_features
);
1953 CHECK_SYMBOL (XCAR (otf_features
));
1954 otf_features
= XCDR (otf_features
);
1955 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1957 CHECK_SYMBOL (Fcar (val
));
1958 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1959 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1961 otf_features
= XCDR (otf_features
);
1962 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1964 CHECK_SYMBOL (Fcar (val
));
1965 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1966 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1973 Lisp_Object otf_list
;
1976 otf_tag_symbol (tag
)
1981 OTF_tag_name (tag
, name
);
1982 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1989 Lisp_Object val
= Fassoc (file
, otf_list
);
1993 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1996 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1997 val
= make_save_value (otf
, 0);
1998 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
2004 /* Return a list describing which scripts/languages FONT supports by
2005 which GSUB/GPOS features of OpenType tables. See the comment of
2006 (struct font_driver).otf_capability. */
2009 font_otf_capability (font
)
2013 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
2016 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
2019 for (i
= 0; i
< 2; i
++)
2021 OTF_GSUB_GPOS
*gsub_gpos
;
2022 Lisp_Object script_list
= Qnil
;
2025 if (OTF_get_features (otf
, i
== 0) < 0)
2027 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2028 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2030 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2031 Lisp_Object langsys_list
= Qnil
;
2032 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2035 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2037 OTF_LangSys
*langsys
;
2038 Lisp_Object feature_list
= Qnil
;
2039 Lisp_Object langsys_tag
;
2042 if (k
== script
->LangSysCount
)
2044 langsys
= &script
->DefaultLangSys
;
2049 langsys
= script
->LangSys
+ k
;
2051 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2053 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2055 OTF_Feature
*feature
2056 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2057 Lisp_Object feature_tag
2058 = otf_tag_symbol (feature
->FeatureTag
);
2060 feature_list
= Fcons (feature_tag
, feature_list
);
2062 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2065 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2070 XSETCAR (capability
, script_list
);
2072 XSETCDR (capability
, script_list
);
2078 /* Parse OTF features in SPEC and write a proper features spec string
2079 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2080 assured that the sufficient memory has already allocated for
2084 generate_otf_features (spec
, features
)
2094 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2100 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2105 else if (! asterisk
)
2107 val
= SYMBOL_NAME (val
);
2108 p
+= sprintf (p
, "%s", SDATA (val
));
2112 val
= SYMBOL_NAME (val
);
2113 p
+= sprintf (p
, "~%s", SDATA (val
));
2117 error ("OTF spec too long");
2121 font_otf_DeviceTable (device_table
)
2122 OTF_DeviceTable
*device_table
;
2124 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2126 return Fcons (make_number (len
),
2127 make_unibyte_string (device_table
->DeltaValue
, len
));
2131 font_otf_ValueRecord (value_format
, value_record
)
2133 OTF_ValueRecord
*value_record
;
2135 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2137 if (value_format
& OTF_XPlacement
)
2138 ASET (val
, 0, make_number (value_record
->XPlacement
));
2139 if (value_format
& OTF_YPlacement
)
2140 ASET (val
, 1, make_number (value_record
->YPlacement
));
2141 if (value_format
& OTF_XAdvance
)
2142 ASET (val
, 2, make_number (value_record
->XAdvance
));
2143 if (value_format
& OTF_YAdvance
)
2144 ASET (val
, 3, make_number (value_record
->YAdvance
));
2145 if (value_format
& OTF_XPlaDevice
)
2146 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2147 if (value_format
& OTF_YPlaDevice
)
2148 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2149 if (value_format
& OTF_XAdvDevice
)
2150 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2151 if (value_format
& OTF_YAdvDevice
)
2152 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2157 font_otf_Anchor (anchor
)
2162 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2163 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2164 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2165 if (anchor
->AnchorFormat
== 2)
2166 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2169 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2170 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2174 #endif /* HAVE_LIBOTF */
2180 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2181 static int font_compare
P_ ((const void *, const void *));
2182 static Lisp_Object font_sort_entities
P_ ((Lisp_Object
, Lisp_Object
,
2185 /* Return a rescaling ratio of FONT_ENTITY. */
2186 extern Lisp_Object Vface_font_rescale_alist
;
2189 font_rescale_ratio (font_entity
)
2190 Lisp_Object font_entity
;
2192 Lisp_Object tail
, elt
;
2193 Lisp_Object name
= Qnil
;
2195 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2198 if (FLOATP (XCDR (elt
)))
2200 if (STRINGP (XCAR (elt
)))
2203 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2204 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2205 return XFLOAT_DATA (XCDR (elt
));
2207 else if (FONT_SPEC_P (XCAR (elt
)))
2209 if (font_match_p (XCAR (elt
), font_entity
))
2210 return XFLOAT_DATA (XCDR (elt
));
2217 /* We sort fonts by scoring each of them against a specified
2218 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2219 the value is, the closer the font is to the font-spec.
2221 The lowest 2 bits of the score is used for driver type. The font
2222 available by the most preferred font driver is 0.
2224 Each 7-bit in the higher 28 bits are used for numeric properties
2225 WEIGHT, SLANT, WIDTH, and SIZE. */
2227 /* How many bits to shift to store the difference value of each font
2228 property in a score. Note that flots for FONT_TYPE_INDEX and
2229 FONT_REGISTRY_INDEX are not used. */
2230 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2232 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2233 The return value indicates how different ENTITY is compared with
2237 font_score (entity
, spec_prop
)
2238 Lisp_Object entity
, *spec_prop
;
2243 /* Score three style numeric fields. Maximum difference is 127. */
2244 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2245 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2247 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2252 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2255 /* Score the size. Maximum difference is 127. */
2256 i
= FONT_SIZE_INDEX
;
2257 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2258 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2260 /* We use the higher 6-bit for the actual size difference. The
2261 lowest bit is set if the DPI is different. */
2263 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2265 if (CONSP (Vface_font_rescale_alist
))
2266 pixel_size
*= font_rescale_ratio (entity
);
2267 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2271 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2272 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2274 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2275 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2277 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2284 /* Concatenate all elements of LIST into one vector. LIST is a list
2285 of font-entity vectors. */
2288 font_vconcat_entity_vectors (Lisp_Object list
)
2290 int nargs
= XINT (Flength (list
));
2291 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2294 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2295 args
[i
] = XCAR (list
);
2296 return Fvconcat (nargs
, args
);
2300 /* The structure for elements being sorted by qsort. */
2301 struct font_sort_data
2304 int font_driver_preference
;
2309 /* The comparison function for qsort. */
2312 font_compare (d1
, d2
)
2313 const void *d1
, *d2
;
2315 const struct font_sort_data
*data1
= d1
;
2316 const struct font_sort_data
*data2
= d2
;
2318 if (data1
->score
< data2
->score
)
2320 else if (data1
->score
> data2
->score
)
2322 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2326 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2327 If PREFER specifies a point-size, calculate the corresponding
2328 pixel-size from QCdpi property of PREFER or from the Y-resolution
2329 of FRAME before sorting.
2331 If BEST-ONLY is nonzero, return the best matching entity (that
2332 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2333 if BEST-ONLY is negative). Otherwise, return the sorted result as
2334 a single vector of font-entities.
2336 This function does no optimization for the case that the total
2337 number of elements is 1. The caller should avoid calling this in
2341 font_sort_entities (list
, prefer
, frame
, best_only
)
2342 Lisp_Object list
, prefer
, frame
;
2345 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2347 struct font_sort_data
*data
;
2348 unsigned best_score
;
2349 Lisp_Object best_entity
;
2350 struct frame
*f
= XFRAME (frame
);
2351 Lisp_Object tail
, vec
;
2354 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2355 prefer_prop
[i
] = AREF (prefer
, i
);
2356 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2357 prefer_prop
[FONT_SIZE_INDEX
]
2358 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2360 if (NILP (XCDR (list
)))
2362 /* What we have to take care of is this single vector. */
2364 maxlen
= ASIZE (vec
);
2368 /* We don't have to perform sort, so there's no need of creating
2369 a single vector. But, we must find the length of the longest
2372 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2373 if (maxlen
< ASIZE (XCAR (tail
)))
2374 maxlen
= ASIZE (XCAR (tail
));
2378 /* We have to create a single vector to sort it. */
2379 vec
= font_vconcat_entity_vectors (list
);
2380 maxlen
= ASIZE (vec
);
2383 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2384 best_score
= 0xFFFFFFFF;
2387 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2389 int font_driver_preference
= 0;
2390 Lisp_Object current_font_driver
;
2396 /* We are sure that the length of VEC > 0. */
2397 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2398 /* Score the elements. */
2399 for (i
= 0; i
< len
; i
++)
2401 data
[i
].entity
= AREF (vec
, i
);
2403 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2405 ? font_score (data
[i
].entity
, prefer_prop
)
2407 if (best_only
&& best_score
> data
[i
].score
)
2409 best_score
= data
[i
].score
;
2410 best_entity
= data
[i
].entity
;
2411 if (best_score
== 0)
2414 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2416 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2417 font_driver_preference
++;
2419 data
[i
].font_driver_preference
= font_driver_preference
;
2422 /* Sort if necessary. */
2425 qsort (data
, len
, sizeof *data
, font_compare
);
2426 for (i
= 0; i
< len
; i
++)
2427 ASET (vec
, i
, data
[i
].entity
);
2436 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2441 /* API of Font Service Layer. */
2443 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2444 sort_shift_bits. Finternal_set_font_selection_order calls this
2445 function with font_sort_order after setting up it. */
2448 font_update_sort_order (order
)
2453 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2455 int xlfd_idx
= order
[i
];
2457 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2458 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2459 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2460 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2461 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2462 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2464 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2469 font_check_otf_features (script
, langsys
, features
, table
)
2470 Lisp_Object script
, langsys
, features
, table
;
2475 table
= assq_no_quit (script
, table
);
2478 table
= XCDR (table
);
2479 if (! NILP (langsys
))
2481 table
= assq_no_quit (langsys
, table
);
2487 val
= assq_no_quit (Qnil
, table
);
2489 table
= XCAR (table
);
2493 table
= XCDR (table
);
2494 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2496 if (NILP (XCAR (features
)))
2501 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2507 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2510 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2512 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2514 script
= XCAR (spec
);
2518 langsys
= XCAR (spec
);
2529 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2530 XCAR (otf_capability
)))
2532 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2533 XCDR (otf_capability
)))
2540 /* Check if FONT (font-entity or font-object) matches with the font
2541 specification SPEC. */
2544 font_match_p (spec
, font
)
2545 Lisp_Object spec
, font
;
2547 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2548 Lisp_Object extra
, font_extra
;
2551 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2552 if (! NILP (AREF (spec
, i
))
2553 && ! NILP (AREF (font
, i
))
2554 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2556 props
= XFONT_SPEC (spec
)->props
;
2557 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2559 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2560 prop
[i
] = AREF (spec
, i
);
2561 prop
[FONT_SIZE_INDEX
]
2562 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2566 if (font_score (font
, props
) > 0)
2568 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2569 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2570 for (; CONSP (extra
); extra
= XCDR (extra
))
2572 Lisp_Object key
= XCAR (XCAR (extra
));
2573 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2575 if (EQ (key
, QClang
))
2577 val2
= assq_no_quit (key
, font_extra
);
2586 if (NILP (Fmemq (val
, val2
)))
2591 ? NILP (Fmemq (val
, XCDR (val2
)))
2595 else if (EQ (key
, QCscript
))
2597 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2603 /* All characters in the list must be supported. */
2604 for (; CONSP (val2
); val2
= XCDR (val2
))
2606 if (! NATNUMP (XCAR (val2
)))
2608 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2609 == FONT_INVALID_CODE
)
2613 else if (VECTORP (val2
))
2615 /* At most one character in the vector must be supported. */
2616 for (i
= 0; i
< ASIZE (val2
); i
++)
2618 if (! NATNUMP (AREF (val2
, i
)))
2620 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2621 != FONT_INVALID_CODE
)
2624 if (i
== ASIZE (val2
))
2629 else if (EQ (key
, QCotf
))
2633 if (! FONT_OBJECT_P (font
))
2635 fontp
= XFONT_OBJECT (font
);
2636 if (! fontp
->driver
->otf_capability
)
2638 val2
= fontp
->driver
->otf_capability (fontp
);
2639 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2650 Each font backend has the callback function get_cache, and it
2651 returns a cons cell of which cdr part can be freely used for
2652 caching fonts. The cons cell may be shared by multiple frames
2653 and/or multiple font drivers. So, we arrange the cdr part as this:
2655 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2657 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2658 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2659 cons (FONT-SPEC FONT-ENTITY ...). */
2661 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2662 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2663 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2664 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2665 struct font_driver
*));
2668 font_prepare_cache (f
, driver
)
2670 struct font_driver
*driver
;
2672 Lisp_Object cache
, val
;
2674 cache
= driver
->get_cache (f
);
2676 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2680 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2681 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2685 val
= XCDR (XCAR (val
));
2686 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2692 font_finish_cache (f
, driver
)
2694 struct font_driver
*driver
;
2696 Lisp_Object cache
, val
, tmp
;
2699 cache
= driver
->get_cache (f
);
2701 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2702 cache
= val
, val
= XCDR (val
);
2703 font_assert (! NILP (val
));
2704 tmp
= XCDR (XCAR (val
));
2705 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2706 if (XINT (XCAR (tmp
)) == 0)
2708 font_clear_cache (f
, XCAR (val
), driver
);
2709 XSETCDR (cache
, XCDR (val
));
2715 font_get_cache (f
, driver
)
2717 struct font_driver
*driver
;
2719 Lisp_Object val
= driver
->get_cache (f
);
2720 Lisp_Object type
= driver
->type
;
2722 font_assert (CONSP (val
));
2723 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2724 font_assert (CONSP (val
));
2725 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2726 val
= XCDR (XCAR (val
));
2730 static int num_fonts
;
2733 font_clear_cache (f
, cache
, driver
)
2736 struct font_driver
*driver
;
2738 Lisp_Object tail
, elt
;
2739 Lisp_Object tail2
, entity
;
2741 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2742 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2745 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2746 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2748 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2750 entity
= XCAR (tail2
);
2752 if (FONT_ENTITY_P (entity
)
2753 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2755 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2757 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2759 Lisp_Object val
= XCAR (objlist
);
2760 struct font
*font
= XFONT_OBJECT (val
);
2762 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2764 font_assert (font
&& driver
== font
->driver
);
2765 driver
->close (f
, font
);
2769 if (driver
->free_entity
)
2770 driver
->free_entity (entity
);
2775 XSETCDR (cache
, Qnil
);
2779 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2782 font_delete_unmatched (vec
, spec
, size
)
2783 Lisp_Object vec
, spec
;
2786 Lisp_Object entity
, val
;
2787 enum font_property_index prop
;
2790 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2792 entity
= AREF (vec
, i
);
2793 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2794 if (INTEGERP (AREF (spec
, prop
))
2795 && ((XINT (AREF (spec
, prop
)) >> 8)
2796 != (XINT (AREF (entity
, prop
)) >> 8)))
2797 prop
= FONT_SPEC_MAX
;
2798 if (prop
< FONT_SPEC_MAX
2800 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2802 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2805 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2806 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2807 prop
= FONT_SPEC_MAX
;
2809 if (prop
< FONT_SPEC_MAX
2810 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2811 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2812 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2813 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2814 prop
= FONT_SPEC_MAX
;
2815 if (prop
< FONT_SPEC_MAX
2816 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2817 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2818 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2819 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2820 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2821 prop
= FONT_SPEC_MAX
;
2822 if (prop
< FONT_SPEC_MAX
)
2823 val
= Fcons (entity
, val
);
2825 return (Fvconcat (1, &val
));
2829 /* Return a list of vectors of font-entities matching with SPEC on
2830 FRAME. The elements of the list are in the same of order of
2834 font_list_entities (frame
, spec
)
2835 Lisp_Object frame
, spec
;
2837 FRAME_PTR f
= XFRAME (frame
);
2838 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2839 Lisp_Object ftype
, val
;
2840 Lisp_Object list
= Qnil
;
2842 int need_filtering
= 0;
2845 font_assert (FONT_SPEC_P (spec
));
2847 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2848 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2849 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2850 size
= font_pixel_size (f
, spec
);
2854 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2855 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2856 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2857 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2859 ASET (scratch_font_spec
, i
, Qnil
);
2860 if (! NILP (AREF (spec
, i
)))
2862 if (i
== FONT_DPI_INDEX
)
2863 /* Skip FONT_SPACING_INDEX */
2866 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2867 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2869 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2871 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2873 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2875 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2876 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2883 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2887 val
= Fvconcat (1, &val
);
2888 copy
= Fcopy_font_spec (scratch_font_spec
);
2889 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2890 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2892 if (ASIZE (val
) > 0 && need_filtering
)
2893 val
= font_delete_unmatched (val
, spec
, size
);
2894 if (ASIZE (val
) > 0)
2895 list
= Fcons (val
, list
);
2898 list
= Fnreverse (list
);
2899 FONT_ADD_LOG ("list", spec
, list
);
2904 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2905 nil, is an array of face's attributes, which specifies preferred
2906 font-related attributes. */
2909 font_matching_entity (f
, attrs
, spec
)
2911 Lisp_Object
*attrs
, spec
;
2913 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2914 Lisp_Object ftype
, size
, entity
;
2916 Lisp_Object work
= Fcopy_font_spec (spec
);
2918 XSETFRAME (frame
, f
);
2919 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2920 size
= AREF (spec
, FONT_SIZE_INDEX
);
2923 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2924 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2925 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2926 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2929 for (; driver_list
; driver_list
= driver_list
->next
)
2931 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2933 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2936 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2937 entity
= assoc_no_quit (work
, XCDR (cache
));
2939 entity
= XCDR (entity
);
2942 entity
= driver_list
->driver
->match (frame
, work
);
2943 copy
= Fcopy_font_spec (work
);
2944 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2945 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2947 if (! NILP (entity
))
2950 FONT_ADD_LOG ("match", work
, entity
);
2955 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2956 opened font object. */
2959 font_open_entity (f
, entity
, pixel_size
)
2964 struct font_driver_list
*driver_list
;
2965 Lisp_Object objlist
, size
, val
, font_object
;
2967 int min_width
, height
;
2968 int scaled_pixel_size
;
2970 font_assert (FONT_ENTITY_P (entity
));
2971 size
= AREF (entity
, FONT_SIZE_INDEX
);
2972 if (XINT (size
) != 0)
2973 scaled_pixel_size
= pixel_size
= XINT (size
);
2974 else if (CONSP (Vface_font_rescale_alist
))
2975 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2977 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2978 objlist
= XCDR (objlist
))
2979 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2980 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2981 return XCAR (objlist
);
2983 val
= AREF (entity
, FONT_TYPE_INDEX
);
2984 for (driver_list
= f
->font_driver_list
;
2985 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2986 driver_list
= driver_list
->next
);
2990 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2991 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2992 FONT_ADD_LOG ("open", entity
, font_object
);
2993 if (NILP (font_object
))
2995 ASET (entity
, FONT_OBJLIST_INDEX
,
2996 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2997 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
3000 font
= XFONT_OBJECT (font_object
);
3001 min_width
= (font
->min_width
? font
->min_width
3002 : font
->average_width
? font
->average_width
3003 : font
->space_width
? font
->space_width
3005 height
= (font
->height
? font
->height
: 1);
3006 #ifdef HAVE_WINDOW_SYSTEM
3007 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
3008 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
3010 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
3011 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
3012 fonts_changed_p
= 1;
3016 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
3017 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
3018 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
3019 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
3027 /* Close FONT_OBJECT that is opened on frame F. */
3030 font_close_object (f
, font_object
)
3032 Lisp_Object font_object
;
3034 struct font
*font
= XFONT_OBJECT (font_object
);
3036 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
3037 /* Already closed. */
3039 FONT_ADD_LOG ("close", font_object
, Qnil
);
3040 font
->driver
->close (f
, font
);
3041 #ifdef HAVE_WINDOW_SYSTEM
3042 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
3043 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
3049 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
3050 FONT is a font-entity and it must be opened to check. */
3053 font_has_char (f
, font
, c
)
3060 if (FONT_ENTITY_P (font
))
3062 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
3063 struct font_driver_list
*driver_list
;
3065 for (driver_list
= f
->font_driver_list
;
3066 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
3067 driver_list
= driver_list
->next
);
3070 if (! driver_list
->driver
->has_char
)
3072 return driver_list
->driver
->has_char (font
, c
);
3075 font_assert (FONT_OBJECT_P (font
));
3076 fontp
= XFONT_OBJECT (font
);
3077 if (fontp
->driver
->has_char
)
3079 int result
= fontp
->driver
->has_char (font
, c
);
3084 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
3088 /* Return the glyph ID of FONT_OBJECT for character C. */
3091 font_encode_char (font_object
, c
)
3092 Lisp_Object font_object
;
3097 font_assert (FONT_OBJECT_P (font_object
));
3098 font
= XFONT_OBJECT (font_object
);
3099 return font
->driver
->encode_char (font
, c
);
3103 /* Return the name of FONT_OBJECT. */
3106 font_get_name (font_object
)
3107 Lisp_Object font_object
;
3109 font_assert (FONT_OBJECT_P (font_object
));
3110 return AREF (font_object
, FONT_NAME_INDEX
);
3114 /* Return the specification of FONT_OBJECT. */
3117 font_get_spec (font_object
)
3118 Lisp_Object font_object
;
3120 Lisp_Object spec
= font_make_spec ();
3123 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
3124 ASET (spec
, i
, AREF (font_object
, i
));
3125 ASET (spec
, FONT_SIZE_INDEX
,
3126 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
3131 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3132 could not be parsed by font_parse_name, return Qnil. */
3135 font_spec_from_name (font_name
)
3136 Lisp_Object font_name
;
3138 Lisp_Object spec
= Ffont_spec (0, NULL
);
3140 CHECK_STRING (font_name
);
3141 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3143 font_put_extra (spec
, QCname
, font_name
);
3149 font_clear_prop (attrs
, prop
)
3151 enum font_property_index prop
;
3153 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3157 if (! NILP (Ffont_get (font
, QCname
)))
3159 font
= Fcopy_font_spec (font
);
3160 font_put_extra (font
, QCname
, Qnil
);
3163 if (NILP (AREF (font
, prop
))
3164 && prop
!= FONT_FAMILY_INDEX
3165 && prop
!= FONT_FOUNDRY_INDEX
3166 && prop
!= FONT_WIDTH_INDEX
3167 && prop
!= FONT_SIZE_INDEX
)
3169 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3170 font
= Fcopy_font_spec (font
);
3171 ASET (font
, prop
, Qnil
);
3172 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3174 if (prop
== FONT_FAMILY_INDEX
)
3176 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3177 /* If we are setting the font family, we must also clear
3178 FONT_WIDTH_INDEX to avoid rejecting families that lack
3179 support for some widths. */
3180 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3182 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3183 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3184 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3185 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3186 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3187 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3189 else if (prop
== FONT_SIZE_INDEX
)
3191 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3192 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3193 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3195 else if (prop
== FONT_WIDTH_INDEX
)
3196 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3197 attrs
[LFACE_FONT_INDEX
] = font
;
3201 font_update_lface (f
, attrs
)
3207 spec
= attrs
[LFACE_FONT_INDEX
];
3208 if (! FONT_SPEC_P (spec
))
3211 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3212 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3213 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3214 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3215 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3216 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3217 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3218 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);
3219 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3220 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3221 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3225 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3230 val
= Ffont_get (spec
, QCdpi
);
3233 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3235 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3237 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3239 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3240 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3246 /* Selecte a font from ENTITIES (list of font-entity vectors) that
3247 supports C and matches best with ATTRS and PIXEL_SIZE. */
3250 font_select_entity (frame
, entities
, attrs
, pixel_size
, c
)
3251 Lisp_Object frame
, entities
, *attrs
;
3254 Lisp_Object font_entity
;
3257 FRAME_PTR f
= XFRAME (frame
);
3259 if (NILP (XCDR (entities
))
3260 && ASIZE (XCAR (entities
)) == 1)
3262 font_entity
= AREF (XCAR (entities
), 0);
3264 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3269 /* Sort fonts by properties specified in ATTRS. */
3270 prefer
= scratch_font_prefer
;
3272 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3273 ASET (prefer
, i
, Qnil
);
3274 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3276 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3278 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3279 ASET (prefer
, i
, AREF (face_font
, i
));
3281 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3282 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3283 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3284 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3285 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3286 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3287 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3289 return font_sort_entities (entities
, prefer
, frame
, c
);
3292 /* Return a font-entity satisfying SPEC and best matching with face's
3293 font related attributes in ATTRS. C, if not negative, is a
3294 character that the entity must support. */
3297 font_find_for_lface (f
, attrs
, spec
, c
)
3304 Lisp_Object frame
, entities
, val
;
3305 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3309 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3310 if (NILP (registry
[0]))
3312 registry
[0] = DEFAULT_ENCODING
;
3313 registry
[1] = Qascii_0
;
3314 registry
[2] = null_vector
;
3317 registry
[1] = null_vector
;
3319 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3321 struct charset
*encoding
, *repertory
;
3323 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3324 &encoding
, &repertory
) < 0)
3327 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3329 else if (c
> encoding
->max_char
)
3333 work
= Fcopy_font_spec (spec
);
3334 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3335 XSETFRAME (frame
, f
);
3336 size
= AREF (spec
, FONT_SIZE_INDEX
);
3337 pixel_size
= font_pixel_size (f
, spec
);
3338 if (pixel_size
== 0)
3340 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3342 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3344 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3345 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3346 if (! NILP (foundry
[0]))
3347 foundry
[1] = null_vector
;
3348 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3350 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3351 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3353 foundry
[2] = null_vector
;
3356 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3358 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3359 if (! NILP (adstyle
[0]))
3360 adstyle
[1] = null_vector
;
3361 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3363 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3365 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3367 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3369 adstyle
[2] = null_vector
;
3372 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3375 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3378 val
= AREF (work
, FONT_FAMILY_INDEX
);
3379 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3381 val
= attrs
[LFACE_FAMILY_INDEX
];
3382 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3386 family
= alloca ((sizeof family
[0]) * 2);
3388 family
[1] = null_vector
; /* terminator. */
3393 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3394 /* Font family names are case-sensitive under NS. */
3402 if (! NILP (alters
))
3404 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3405 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3406 family
[i
] = XCAR (alters
);
3407 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3409 family
[i
] = null_vector
;
3413 family
= alloca ((sizeof family
[0]) * 3);
3416 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3418 family
[i
] = null_vector
;
3422 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3424 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3425 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3427 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3428 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3430 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3431 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3433 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3434 entities
= font_list_entities (frame
, work
);
3435 if (! NILP (entities
))
3437 val
= font_select_entity (frame
, entities
,
3438 attrs
, pixel_size
, c
);
3451 font_open_for_lface (f
, entity
, attrs
, spec
)
3459 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3460 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3461 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3462 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3463 size
= font_pixel_size (f
, spec
);
3467 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3468 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3471 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3472 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3473 if (INTEGERP (height
))
3476 abort(); /* We should never end up here. */
3480 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3484 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3485 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3489 return font_open_entity (f
, entity
, size
);
3493 /* Find a font satisfying SPEC and best matching with face's
3494 attributes in ATTRS on FRAME, and return the opened
3498 font_load_for_lface (f
, attrs
, spec
)
3500 Lisp_Object
*attrs
, spec
;
3504 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3507 /* No font is listed for SPEC, but each font-backend may have
3508 the different criteria about "font matching". So, try
3510 entity
= font_matching_entity (f
, attrs
, spec
);
3514 return font_open_for_lface (f
, entity
, attrs
, spec
);
3518 /* Make FACE on frame F ready to use the font opened for FACE. */
3521 font_prepare_for_face (f
, face
)
3525 if (face
->font
->driver
->prepare_face
)
3526 face
->font
->driver
->prepare_face (f
, face
);
3530 /* Make FACE on frame F stop using the font opened for FACE. */
3533 font_done_for_face (f
, face
)
3537 if (face
->font
->driver
->done_face
)
3538 face
->font
->driver
->done_face (f
, face
);
3543 /* Open a font matching with font-spec SPEC on frame F. If no proper
3544 font is found, return Qnil. */
3547 font_open_by_spec (f
, spec
)
3551 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3553 /* We set up the default font-related attributes of a face to prefer
3555 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3556 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3557 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3559 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3561 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3563 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3565 return font_load_for_lface (f
, attrs
, spec
);
3569 /* Open a font matching with NAME on frame F. If no proper font is
3570 found, return Qnil. */
3573 font_open_by_name (f
, name
)
3577 Lisp_Object args
[2];
3581 args
[1] = make_unibyte_string (name
, strlen (name
));
3582 spec
= Ffont_spec (2, args
);
3583 return font_open_by_spec (f
, spec
);
3587 /* Register font-driver DRIVER. This function is used in two ways.
3589 The first is with frame F non-NULL. In this case, make DRIVER
3590 available (but not yet activated) on F. All frame creaters
3591 (e.g. Fx_create_frame) must call this function at least once with
3592 an available font-driver.
3594 The second is with frame F NULL. In this case, DRIVER is globally
3595 registered in the variable `font_driver_list'. All font-driver
3596 implementations must call this function in its syms_of_XXXX
3597 (e.g. syms_of_xfont). */
3600 register_font_driver (driver
, f
)
3601 struct font_driver
*driver
;
3604 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3605 struct font_driver_list
*prev
, *list
;
3607 if (f
&& ! driver
->draw
)
3608 error ("Unusable font driver for a frame: %s",
3609 SDATA (SYMBOL_NAME (driver
->type
)));
3611 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3612 if (EQ (list
->driver
->type
, driver
->type
))
3613 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3615 list
= xmalloc (sizeof (struct font_driver_list
));
3617 list
->driver
= driver
;
3622 f
->font_driver_list
= list
;
3624 font_driver_list
= list
;
3630 free_font_driver_list (f
)
3633 struct font_driver_list
*list
, *next
;
3635 for (list
= f
->font_driver_list
; list
; list
= next
)
3640 f
->font_driver_list
= NULL
;
3644 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3645 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3646 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3648 A caller must free all realized faces if any in advance. The
3649 return value is a list of font backends actually made used on
3653 font_update_drivers (f
, new_drivers
)
3655 Lisp_Object new_drivers
;
3657 Lisp_Object active_drivers
= Qnil
;
3658 struct font_driver
*driver
;
3659 struct font_driver_list
*list
;
3661 /* At first, turn off non-requested drivers, and turn on requested
3663 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3665 driver
= list
->driver
;
3666 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3671 if (driver
->end_for_frame
)
3672 driver
->end_for_frame (f
);
3673 font_finish_cache (f
, driver
);
3678 if (! driver
->start_for_frame
3679 || driver
->start_for_frame (f
) == 0)
3681 font_prepare_cache (f
, driver
);
3688 if (NILP (new_drivers
))
3691 if (! EQ (new_drivers
, Qt
))
3693 /* Re-order the driver list according to new_drivers. */
3694 struct font_driver_list
**list_table
, **next
;
3698 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3699 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3701 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3702 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3705 list_table
[i
++] = list
;
3707 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3709 list_table
[i
++] = list
;
3710 list_table
[i
] = NULL
;
3712 next
= &f
->font_driver_list
;
3713 for (i
= 0; list_table
[i
]; i
++)
3715 *next
= list_table
[i
];
3716 next
= &(*next
)->next
;
3720 if (! f
->font_driver_list
->on
)
3721 { /* None of the drivers is enabled: enable them all.
3722 Happens if you set the list of drivers to (xft x) in your .emacs
3723 and then use it under w32 or ns. */
3724 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3726 struct font_driver
*driver
= list
->driver
;
3727 eassert (! list
->on
);
3728 if (! driver
->start_for_frame
3729 || driver
->start_for_frame (f
) == 0)
3731 font_prepare_cache (f
, driver
);
3738 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3740 active_drivers
= nconc2 (active_drivers
,
3741 Fcons (list
->driver
->type
, Qnil
));
3742 return active_drivers
;
3746 font_put_frame_data (f
, driver
, data
)
3748 struct font_driver
*driver
;
3751 struct font_data_list
*list
, *prev
;
3753 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3754 prev
= list
, list
= list
->next
)
3755 if (list
->driver
== driver
)
3762 prev
->next
= list
->next
;
3764 f
->font_data_list
= list
->next
;
3772 list
= xmalloc (sizeof (struct font_data_list
));
3773 list
->driver
= driver
;
3774 list
->next
= f
->font_data_list
;
3775 f
->font_data_list
= list
;
3783 font_get_frame_data (f
, driver
)
3785 struct font_driver
*driver
;
3787 struct font_data_list
*list
;
3789 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3790 if (list
->driver
== driver
)
3798 /* Return the font used to draw character C by FACE at buffer position
3799 POS in window W. If STRING is non-nil, it is a string containing C
3800 at index POS. If C is negative, get C from the current buffer or
3804 font_at (c
, pos
, face
, w
, string
)
3813 Lisp_Object font_object
;
3815 multibyte
= (NILP (string
)
3816 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3817 : STRING_MULTIBYTE (string
));
3824 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3826 c
= FETCH_CHAR (pos_byte
);
3829 c
= FETCH_BYTE (pos
);
3835 multibyte
= STRING_MULTIBYTE (string
);
3838 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3840 str
= SDATA (string
) + pos_byte
;
3841 c
= STRING_CHAR (str
, 0);
3844 c
= SDATA (string
)[pos
];
3848 f
= XFRAME (w
->frame
);
3849 if (! FRAME_WINDOW_P (f
))
3856 if (STRINGP (string
))
3857 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3858 DEFAULT_FACE_ID
, 0);
3860 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3862 face
= FACE_FROM_ID (f
, face_id
);
3866 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3867 face
= FACE_FROM_ID (f
, face_id
);
3872 XSETFONT (font_object
, face
->font
);
3877 #ifdef HAVE_WINDOW_SYSTEM
3879 /* Check how many characters after POS (at most to *LIMIT) can be
3880 displayed by the same font on the window W. FACE, if non-NULL, is
3881 the face selected for the character at POS. If STRING is not nil,
3882 it is the string to check instead of the current buffer. In that
3883 case, FACE must be not NULL.
3885 The return value is the font-object for the character at POS.
3886 *LIMIT is set to the position where that font can't be used.
3888 It is assured that the current buffer (or STRING) is multibyte. */
3891 font_range (pos
, limit
, w
, face
, string
)
3892 EMACS_INT pos
, *limit
;
3897 EMACS_INT pos_byte
, ignore
, start
, start_byte
;
3899 Lisp_Object font_object
= Qnil
;
3903 pos_byte
= CHAR_TO_BYTE (pos
);
3908 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3910 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3916 pos_byte
= string_char_to_byte (string
, pos
);
3919 start
= pos
, start_byte
= pos_byte
;
3920 while (pos
< *limit
)
3922 Lisp_Object category
;
3925 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3927 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3928 if (NILP (font_object
))
3930 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3931 if (NILP (font_object
))
3936 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3937 if (! EQ (category
, QCf
)
3938 && ! CHAR_VARIATION_SELECTOR_P (c
)
3939 && font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3941 Lisp_Object f
= font_for_char (face
, c
, pos
- 1, string
);
3942 EMACS_INT i
, i_byte
;
3950 i
= start
, i_byte
= start_byte
;
3955 FETCH_CHAR_ADVANCE_NO_CHECK (c
, i
, i_byte
);
3957 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, i
, i_byte
);
3958 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3959 if (! EQ (category
, QCf
)
3960 && ! CHAR_VARIATION_SELECTOR_P (c
)
3961 && font_encode_char (f
, c
) == FONT_INVALID_CODE
)
3977 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3978 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3979 Return nil otherwise.
3980 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3981 which kind of font it is. It must be one of `font-spec', `font-entity',
3983 (object
, extra_type
)
3984 Lisp_Object object
, extra_type
;
3986 if (NILP (extra_type
))
3987 return (FONTP (object
) ? Qt
: Qnil
);
3988 if (EQ (extra_type
, Qfont_spec
))
3989 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3990 if (EQ (extra_type
, Qfont_entity
))
3991 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3992 if (EQ (extra_type
, Qfont_object
))
3993 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3994 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3997 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3998 doc
: /* Return a newly created font-spec with arguments as properties.
4000 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
4001 valid font property name listed below:
4003 `:family', `:weight', `:slant', `:width'
4005 They are the same as face attributes of the same name. See
4006 `set-face-attribute'.
4010 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
4014 VALUE must be a string or a symbol specifying the additional
4015 typographic style information of a font, e.g. ``sans''.
4019 VALUE must be a string or a symbol specifying the charset registry and
4020 encoding of a font, e.g. ``iso8859-1''.
4024 VALUE must be a non-negative integer or a floating point number
4025 specifying the font size. It specifies the font size in pixels (if
4026 VALUE is an integer), or in points (if VALUE is a float).
4030 VALUE must be a string of XLFD-style or fontconfig-style font name.
4034 VALUE must be a symbol representing a script that the font must
4035 support. It may be a symbol representing a subgroup of a script
4036 listed in the variable `script-representative-chars'.
4040 VALUE must be a symbol of two-letter ISO-639 language names,
4045 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
4046 required OpenType features.
4048 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
4049 LANGSYS-TAG: OpenType language system tag symbol,
4050 or nil for the default language system.
4051 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
4052 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
4054 GSUB and GPOS may contain `nil' element. In such a case, the font
4055 must not have any of the remaining elements.
4057 For instance, if the VALUE is `(thai nil nil (mark))', the font must
4058 be an OpenType font, and whose GPOS table of `thai' script's default
4059 language system must contain `mark' feature.
4061 usage: (font-spec ARGS...) */)
4066 Lisp_Object spec
= font_make_spec ();
4069 for (i
= 0; i
< nargs
; i
+= 2)
4071 Lisp_Object key
= args
[i
], val
;
4075 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
4078 if (EQ (key
, QCname
))
4081 font_parse_name ((char *) SDATA (val
), spec
);
4082 font_put_extra (spec
, key
, val
);
4086 int idx
= get_font_prop_index (key
);
4090 val
= font_prop_validate (idx
, Qnil
, val
);
4091 if (idx
< FONT_EXTRA_INDEX
)
4092 ASET (spec
, idx
, val
);
4094 font_put_extra (spec
, key
, val
);
4097 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
4103 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
4104 doc
: /* Return a copy of FONT as a font-spec. */)
4108 Lisp_Object new_spec
, tail
, prev
, extra
;
4112 new_spec
= font_make_spec ();
4113 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
4114 ASET (new_spec
, i
, AREF (font
, i
));
4115 extra
= Fcopy_sequence (AREF (font
, FONT_EXTRA_INDEX
));
4116 /* We must remove :font-entity property. */
4117 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
4118 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
4121 extra
= XCDR (extra
);
4123 XSETCDR (prev
, XCDR (tail
));
4126 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
4130 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
4131 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
4132 Every specified properties in FROM override the corresponding
4133 properties in TO. */)
4135 Lisp_Object from
, to
;
4137 Lisp_Object extra
, tail
;
4142 to
= Fcopy_font_spec (to
);
4143 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
4144 ASET (to
, i
, AREF (from
, i
));
4145 extra
= AREF (to
, FONT_EXTRA_INDEX
);
4146 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
4147 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
4149 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
4152 XSETCDR (slot
, XCDR (XCAR (tail
)));
4154 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
4156 ASET (to
, FONT_EXTRA_INDEX
, extra
);
4160 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
4161 doc
: /* Return the value of FONT's property KEY.
4162 FONT is a font-spec, a font-entity, or a font-object.
4163 KEY must be one of these symbols:
4164 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4165 :size, :name, :script
4166 See the documentation of `font-spec' for their meanings.
4167 If FONT is a font-entity or font-object, the value of :script may be
4168 a list of scripts that are supported by the font. */)
4170 Lisp_Object font
, key
;
4177 idx
= get_font_prop_index (key
);
4178 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4179 return font_style_symbolic (font
, idx
, 0);
4180 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4181 return AREF (font
, idx
);
4182 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
4185 #ifdef HAVE_WINDOW_SYSTEM
4187 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4188 doc
: /* Return a plist of face attributes generated by FONT.
4189 FONT is a font name, a font-spec, a font-entity, or a font-object.
4190 The return value is a list of the form
4192 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4194 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4195 compatible with `set-face-attribute'. Some of these key-attribute pairs
4196 may be omitted from the list if they are not specified by FONT.
4198 The optional argument FRAME specifies the frame that the face attributes
4199 are to be displayed on. If omitted, the selected frame is used. */)
4201 Lisp_Object font
, frame
;
4204 Lisp_Object plist
[10];
4209 frame
= selected_frame
;
4210 CHECK_LIVE_FRAME (frame
);
4215 int fontset
= fs_query_fontset (font
, 0);
4216 Lisp_Object name
= font
;
4218 font
= fontset_ascii (fontset
);
4219 font
= font_spec_from_name (name
);
4221 signal_error ("Invalid font name", name
);
4223 else if (! FONTP (font
))
4224 signal_error ("Invalid font object", font
);
4226 val
= AREF (font
, FONT_FAMILY_INDEX
);
4229 plist
[n
++] = QCfamily
;
4230 plist
[n
++] = SYMBOL_NAME (val
);
4233 val
= AREF (font
, FONT_SIZE_INDEX
);
4236 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4237 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4238 plist
[n
++] = QCheight
;
4239 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4241 else if (FLOATP (val
))
4243 plist
[n
++] = QCheight
;
4244 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4247 val
= FONT_WEIGHT_FOR_FACE (font
);
4250 plist
[n
++] = QCweight
;
4254 val
= FONT_SLANT_FOR_FACE (font
);
4257 plist
[n
++] = QCslant
;
4261 val
= FONT_WIDTH_FOR_FACE (font
);
4264 plist
[n
++] = QCwidth
;
4268 return Flist (n
, plist
);
4273 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4274 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
4275 (font_spec
, prop
, val
)
4276 Lisp_Object font_spec
, prop
, val
;
4280 CHECK_FONT_SPEC (font_spec
);
4281 idx
= get_font_prop_index (prop
);
4282 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4283 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
4285 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
4289 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4290 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4291 Optional 2nd argument FRAME specifies the target frame.
4292 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4293 Optional 4th argument PREFER, if non-nil, is a font-spec to
4294 control the order of the returned list. Fonts are sorted by
4295 how close they are to PREFER. */)
4296 (font_spec
, frame
, num
, prefer
)
4297 Lisp_Object font_spec
, frame
, num
, prefer
;
4299 Lisp_Object vec
, list
;
4303 frame
= selected_frame
;
4304 CHECK_LIVE_FRAME (frame
);
4305 CHECK_FONT_SPEC (font_spec
);
4313 if (! NILP (prefer
))
4314 CHECK_FONT_SPEC (prefer
);
4316 list
= font_list_entities (frame
, font_spec
);
4319 if (NILP (XCDR (list
))
4320 && ASIZE (XCAR (list
)) == 1)
4321 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4323 if (! NILP (prefer
))
4324 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4326 vec
= font_vconcat_entity_vectors (list
);
4327 if (n
== 0 || n
>= ASIZE (vec
))
4329 Lisp_Object args
[2];
4333 list
= Fappend (2, args
);
4337 for (list
= Qnil
, n
--; n
>= 0; n
--)
4338 list
= Fcons (AREF (vec
, n
), list
);
4343 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4344 doc
: /* List available font families on the current frame.
4345 Optional argument FRAME, if non-nil, specifies the target frame. */)
4350 struct font_driver_list
*driver_list
;
4354 frame
= selected_frame
;
4355 CHECK_LIVE_FRAME (frame
);
4358 for (driver_list
= f
->font_driver_list
; driver_list
;
4359 driver_list
= driver_list
->next
)
4360 if (driver_list
->driver
->list_family
)
4362 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4363 Lisp_Object tail
= list
;
4365 for (; CONSP (val
); val
= XCDR (val
))
4366 if (NILP (Fmemq (XCAR (val
), tail
))
4367 && SYMBOLP (XCAR (val
)))
4368 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4373 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4374 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4375 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4377 Lisp_Object font_spec
, frame
;
4379 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4386 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4387 doc
: /* Return XLFD name of FONT.
4388 FONT is a font-spec, font-entity, or font-object.
4389 If the name is too long for XLFD (maximum 255 chars), return nil.
4390 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4391 the consecutive wildcards are folded to one. */)
4392 (font
, fold_wildcards
)
4393 Lisp_Object font
, fold_wildcards
;
4400 if (FONT_OBJECT_P (font
))
4402 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4404 if (STRINGP (font_name
)
4405 && SDATA (font_name
)[0] == '-')
4407 if (NILP (fold_wildcards
))
4409 strcpy (name
, (char *) SDATA (font_name
));
4412 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4414 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4417 if (! NILP (fold_wildcards
))
4419 char *p0
= name
, *p1
;
4421 while ((p1
= strstr (p0
, "-*-*")))
4423 strcpy (p1
, p1
+ 2);
4428 return build_string (name
);
4431 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4432 doc
: /* Clear font cache. */)
4435 Lisp_Object list
, frame
;
4437 FOR_EACH_FRAME (list
, frame
)
4439 FRAME_PTR f
= XFRAME (frame
);
4440 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4442 for (; driver_list
; driver_list
= driver_list
->next
)
4443 if (driver_list
->on
)
4445 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4450 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4452 font_assert (! NILP (val
));
4453 val
= XCDR (XCAR (val
));
4454 if (XINT (XCAR (val
)) == 0)
4456 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4457 XSETCDR (cache
, XCDR (val
));
4467 font_fill_lglyph_metrics (glyph
, font_object
)
4468 Lisp_Object glyph
, font_object
;
4470 struct font
*font
= XFONT_OBJECT (font_object
);
4472 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4473 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4474 struct font_metrics metrics
;
4476 LGLYPH_SET_CODE (glyph
, ecode
);
4478 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4479 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4480 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4481 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4482 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4483 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4487 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4488 doc
: /* Shape the glyph-string GSTRING.
4489 Shaping means substituting glyphs and/or adjusting positions of glyphs
4490 to get the correct visual image of character sequences set in the
4491 header of the glyph-string.
4493 If the shaping was successful, the value is GSTRING itself or a newly
4494 created glyph-string. Otherwise, the value is nil. */)
4496 Lisp_Object gstring
;
4499 Lisp_Object font_object
, n
, glyph
;
4502 if (! composition_gstring_p (gstring
))
4503 signal_error ("Invalid glyph-string: ", gstring
);
4504 if (! NILP (LGSTRING_ID (gstring
)))
4506 font_object
= LGSTRING_FONT (gstring
);
4507 CHECK_FONT_OBJECT (font_object
);
4508 font
= XFONT_OBJECT (font_object
);
4509 if (! font
->driver
->shape
)
4512 /* Try at most three times with larger gstring each time. */
4513 for (i
= 0; i
< 3; i
++)
4515 n
= font
->driver
->shape (gstring
);
4518 gstring
= larger_vector (gstring
,
4519 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4522 if (i
== 3 || XINT (n
) == 0)
4525 glyph
= LGSTRING_GLYPH (gstring
, 0);
4526 from
= LGLYPH_FROM (glyph
);
4527 to
= LGLYPH_TO (glyph
);
4528 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4530 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4534 if (NILP (LGLYPH_ADJUSTMENT (this)))
4539 glyph
= LGSTRING_GLYPH (gstring
, j
);
4540 LGLYPH_SET_FROM (glyph
, from
);
4541 LGLYPH_SET_TO (glyph
, to
);
4543 from
= LGLYPH_FROM (this);
4544 to
= LGLYPH_TO (this);
4549 if (from
> LGLYPH_FROM (this))
4550 from
= LGLYPH_FROM (this);
4551 if (to
< LGLYPH_TO (this))
4552 to
= LGLYPH_TO (this);
4558 glyph
= LGSTRING_GLYPH (gstring
, j
);
4559 LGLYPH_SET_FROM (glyph
, from
);
4560 LGLYPH_SET_TO (glyph
, to
);
4562 return composition_gstring_put_cache (gstring
, XINT (n
));
4565 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4567 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4568 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4570 VARIATION-SELECTOR is a chracter code of variation selection
4571 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4572 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4573 (font_object
, character
)
4574 Lisp_Object font_object
, character
;
4576 unsigned variations
[256];
4581 CHECK_FONT_OBJECT (font_object
);
4582 CHECK_CHARACTER (character
);
4583 font
= XFONT_OBJECT (font_object
);
4584 if (! font
->driver
->get_variation_glyphs
)
4586 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4590 for (i
= 0; i
< 255; i
++)
4594 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4595 /* Stops GCC whining about limited range of data type. */
4596 EMACS_INT var
= variations
[i
];
4598 if (var
> MOST_POSITIVE_FIXNUM
)
4599 code
= Fcons (make_number ((variations
[i
]) >> 16),
4600 make_number ((variations
[i
]) & 0xFFFF));
4602 code
= make_number (variations
[i
]);
4603 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4610 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4611 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4612 OTF-FEATURES specifies which features to apply in this format:
4613 (SCRIPT LANGSYS GSUB GPOS)
4615 SCRIPT is a symbol specifying a script tag of OpenType,
4616 LANGSYS is a symbol specifying a langsys tag of OpenType,
4617 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4619 If LANGYS is nil, the default langsys is selected.
4621 The features are applied in the order they appear in the list. The
4622 symbol `*' means to apply all available features not present in this
4623 list, and the remaining features are ignored. For instance, (vatu
4624 pstf * haln) is to apply vatu and pstf in this order, then to apply
4625 all available features other than vatu, pstf, and haln.
4627 The features are applied to the glyphs in the range FROM and TO of
4628 the glyph-string GSTRING-IN.
4630 If some feature is actually applicable, the resulting glyphs are
4631 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4632 this case, the value is the number of produced glyphs.
4634 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4637 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4638 produced in GSTRING-OUT, and the value is nil.
4640 See the documentation of `font-make-gstring' for the format of
4642 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4643 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4645 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4650 check_otf_features (otf_features
);
4651 CHECK_FONT_OBJECT (font_object
);
4652 font
= XFONT_OBJECT (font_object
);
4653 if (! font
->driver
->otf_drive
)
4654 error ("Font backend %s can't drive OpenType GSUB table",
4655 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4656 CHECK_CONS (otf_features
);
4657 CHECK_SYMBOL (XCAR (otf_features
));
4658 val
= XCDR (otf_features
);
4659 CHECK_SYMBOL (XCAR (val
));
4660 val
= XCDR (otf_features
);
4663 len
= check_gstring (gstring_in
);
4664 CHECK_VECTOR (gstring_out
);
4665 CHECK_NATNUM (from
);
4667 CHECK_NATNUM (index
);
4669 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4670 args_out_of_range_3 (from
, to
, make_number (len
));
4671 if (XINT (index
) >= ASIZE (gstring_out
))
4672 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4673 num
= font
->driver
->otf_drive (font
, otf_features
,
4674 gstring_in
, XINT (from
), XINT (to
),
4675 gstring_out
, XINT (index
), 0);
4678 return make_number (num
);
4681 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4683 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4684 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4686 (SCRIPT LANGSYS FEATURE ...)
4687 See the documentation of `font-drive-otf' for more detail.
4689 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4690 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4691 character code corresponding to the glyph or nil if there's no
4692 corresponding character. */)
4693 (font_object
, character
, otf_features
)
4694 Lisp_Object font_object
, character
, otf_features
;
4697 Lisp_Object gstring_in
, gstring_out
, g
;
4698 Lisp_Object alternates
;
4701 CHECK_FONT_GET_OBJECT (font_object
, font
);
4702 if (! font
->driver
->otf_drive
)
4703 error ("Font backend %s can't drive OpenType GSUB table",
4704 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4705 CHECK_CHARACTER (character
);
4706 CHECK_CONS (otf_features
);
4708 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4709 g
= LGSTRING_GLYPH (gstring_in
, 0);
4710 LGLYPH_SET_CHAR (g
, XINT (character
));
4711 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4712 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4713 gstring_out
, 0, 1)) < 0)
4714 gstring_out
= Ffont_make_gstring (font_object
,
4715 make_number (ASIZE (gstring_out
) * 2));
4717 for (i
= 0; i
< num
; i
++)
4719 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4720 int c
= LGLYPH_CHAR (g
);
4721 unsigned code
= LGLYPH_CODE (g
);
4723 alternates
= Fcons (Fcons (make_number (code
),
4724 c
> 0 ? make_number (c
) : Qnil
),
4727 return Fnreverse (alternates
);
4733 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4734 doc
: /* Open FONT-ENTITY. */)
4735 (font_entity
, size
, frame
)
4736 Lisp_Object font_entity
;
4742 CHECK_FONT_ENTITY (font_entity
);
4744 frame
= selected_frame
;
4745 CHECK_LIVE_FRAME (frame
);
4748 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4751 CHECK_NUMBER_OR_FLOAT (size
);
4753 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4755 isize
= XINT (size
);
4759 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4762 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4763 doc
: /* Close FONT-OBJECT. */)
4764 (font_object
, frame
)
4765 Lisp_Object font_object
, frame
;
4767 CHECK_FONT_OBJECT (font_object
);
4769 frame
= selected_frame
;
4770 CHECK_LIVE_FRAME (frame
);
4771 font_close_object (XFRAME (frame
), font_object
);
4775 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4776 doc
: /* Return information about FONT-OBJECT.
4777 The value is a vector:
4778 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4781 NAME is a string of the font name (or nil if the font backend doesn't
4784 FILENAME is a string of the font file (or nil if the font backend
4785 doesn't provide a file name).
4787 PIXEL-SIZE is a pixel size by which the font is opened.
4789 SIZE is a maximum advance width of the font in pixels.
4791 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4794 CAPABILITY is a list whose first element is a symbol representing the
4795 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4796 remaining elements describe the details of the font capability.
4798 If the font is OpenType font, the form of the list is
4799 \(opentype GSUB GPOS)
4800 where GSUB shows which "GSUB" features the font supports, and GPOS
4801 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4802 lists of the format:
4803 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4805 If the font is not OpenType font, currently the length of the form is
4808 SCRIPT is a symbol representing OpenType script tag.
4810 LANGSYS is a symbol representing OpenType langsys tag, or nil
4811 representing the default langsys.
4813 FEATURE is a symbol representing OpenType feature tag.
4815 If the font is not OpenType font, CAPABILITY is nil. */)
4817 Lisp_Object font_object
;
4822 CHECK_FONT_GET_OBJECT (font_object
, font
);
4824 val
= Fmake_vector (make_number (9), Qnil
);
4825 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4826 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4827 ASET (val
, 2, make_number (font
->pixel_size
));
4828 ASET (val
, 3, make_number (font
->max_width
));
4829 ASET (val
, 4, make_number (font
->ascent
));
4830 ASET (val
, 5, make_number (font
->descent
));
4831 ASET (val
, 6, make_number (font
->space_width
));
4832 ASET (val
, 7, make_number (font
->average_width
));
4833 if (font
->driver
->otf_capability
)
4834 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4838 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4839 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4840 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4841 (font_object
, string
)
4842 Lisp_Object font_object
, string
;
4848 CHECK_FONT_GET_OBJECT (font_object
, font
);
4849 CHECK_STRING (string
);
4850 len
= SCHARS (string
);
4851 vec
= Fmake_vector (make_number (len
), Qnil
);
4852 for (i
= 0; i
< len
; i
++)
4854 Lisp_Object ch
= Faref (string
, make_number (i
));
4859 struct font_metrics metrics
;
4861 cod
= code
= font
->driver
->encode_char (font
, c
);
4862 if (code
== FONT_INVALID_CODE
)
4864 val
= Fmake_vector (make_number (6), Qnil
);
4865 if (cod
<= MOST_POSITIVE_FIXNUM
)
4866 ASET (val
, 0, make_number (code
));
4868 ASET (val
, 0, Fcons (make_number (code
>> 16),
4869 make_number (code
& 0xFFFF)));
4870 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4871 ASET (val
, 1, make_number (metrics
.lbearing
));
4872 ASET (val
, 2, make_number (metrics
.rbearing
));
4873 ASET (val
, 3, make_number (metrics
.width
));
4874 ASET (val
, 4, make_number (metrics
.ascent
));
4875 ASET (val
, 5, make_number (metrics
.descent
));
4881 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4882 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4883 FONT is a font-spec, font-entity, or font-object. */)
4885 Lisp_Object spec
, font
;
4887 CHECK_FONT_SPEC (spec
);
4890 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4893 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4894 doc
: /* Return a font-object for displaying a character at POSITION.
4895 Optional second arg WINDOW, if non-nil, is a window displaying
4896 the current buffer. It defaults to the currently selected window. */)
4897 (position
, window
, string
)
4898 Lisp_Object position
, window
, string
;
4905 CHECK_NUMBER_COERCE_MARKER (position
);
4906 pos
= XINT (position
);
4907 if (pos
< BEGV
|| pos
>= ZV
)
4908 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4912 CHECK_NUMBER (position
);
4913 CHECK_STRING (string
);
4914 pos
= XINT (position
);
4915 if (pos
< 0 || pos
>= SCHARS (string
))
4916 args_out_of_range (string
, position
);
4919 window
= selected_window
;
4920 CHECK_LIVE_WINDOW (window
);
4921 w
= XWINDOW (window
);
4923 return font_at (-1, pos
, NULL
, w
, string
);
4927 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4928 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4929 The value is a number of glyphs drawn.
4930 Type C-l to recover what previously shown. */)
4931 (font_object
, string
)
4932 Lisp_Object font_object
, string
;
4934 Lisp_Object frame
= selected_frame
;
4935 FRAME_PTR f
= XFRAME (frame
);
4941 CHECK_FONT_GET_OBJECT (font_object
, font
);
4942 CHECK_STRING (string
);
4943 len
= SCHARS (string
);
4944 code
= alloca (sizeof (unsigned) * len
);
4945 for (i
= 0; i
< len
; i
++)
4947 Lisp_Object ch
= Faref (string
, make_number (i
));
4951 code
[i
] = font
->driver
->encode_char (font
, c
);
4952 if (code
[i
] == FONT_INVALID_CODE
)
4955 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4957 if (font
->driver
->prepare_face
)
4958 font
->driver
->prepare_face (f
, face
);
4959 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4960 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4961 if (font
->driver
->done_face
)
4962 font
->driver
->done_face (f
, face
);
4964 return make_number (len
);
4968 #endif /* FONT_DEBUG */
4970 #ifdef HAVE_WINDOW_SYSTEM
4972 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4973 doc
: /* Return information about a font named NAME on frame FRAME.
4974 If FRAME is omitted or nil, use the selected frame.
4975 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4976 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4978 OPENED-NAME is the name used for opening the font,
4979 FULL-NAME is the full name of the font,
4980 SIZE is the pixelsize of the font,
4981 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4982 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4983 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4984 how to compose characters.
4985 If the named font is not yet loaded, return nil. */)
4987 Lisp_Object name
, frame
;
4992 Lisp_Object font_object
;
4994 (*check_window_system_func
) ();
4997 CHECK_STRING (name
);
4999 frame
= selected_frame
;
5000 CHECK_LIVE_FRAME (frame
);
5005 int fontset
= fs_query_fontset (name
, 0);
5008 name
= fontset_ascii (fontset
);
5009 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
5011 else if (FONT_OBJECT_P (name
))
5013 else if (FONT_ENTITY_P (name
))
5014 font_object
= font_open_entity (f
, name
, 0);
5017 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5018 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
5020 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
5022 if (NILP (font_object
))
5024 font
= XFONT_OBJECT (font_object
);
5026 info
= Fmake_vector (make_number (7), Qnil
);
5027 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
5028 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
5029 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
5030 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
5031 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
5032 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
5033 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
5036 /* As font_object is still in FONT_OBJLIST of the entity, we can't
5037 close it now. Perhaps, we should manage font-objects
5038 by `reference-count'. */
5039 font_close_object (f
, font_object
);
5046 #define BUILD_STYLE_TABLE(TBL) \
5047 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
5050 build_style_table (entry
, nelement
)
5051 struct table_entry
*entry
;
5055 Lisp_Object table
, elt
;
5057 table
= Fmake_vector (make_number (nelement
), Qnil
);
5058 for (i
= 0; i
< nelement
; i
++)
5060 for (j
= 0; entry
[i
].names
[j
]; j
++);
5061 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
5062 ASET (elt
, 0, make_number (entry
[i
].numeric
));
5063 for (j
= 0; entry
[i
].names
[j
]; j
++)
5064 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
5065 ASET (table
, i
, elt
);
5070 Lisp_Object Vfont_log
;
5072 /* The deferred font-log data of the form [ACTION ARG RESULT].
5073 If ACTION is not nil, that is added to the log when font_add_log is
5074 called next time. At that time, ACTION is set back to nil. */
5075 static Lisp_Object Vfont_log_deferred
;
5077 /* Prepend the font-related logging data in Vfont_log if it is not
5078 `t'. ACTION describes a kind of font-related action (e.g. listing,
5079 opening), ARG is the argument for the action, and RESULT is the
5080 result of the action. */
5082 font_add_log (action
, arg
, result
)
5084 Lisp_Object arg
, result
;
5086 Lisp_Object tail
, val
;
5089 if (EQ (Vfont_log
, Qt
))
5091 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5093 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
5095 ASET (Vfont_log_deferred
, 0, Qnil
);
5096 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5097 AREF (Vfont_log_deferred
, 2));
5102 Lisp_Object tail
, elt
;
5103 Lisp_Object equalstr
= build_string ("=");
5105 val
= Ffont_xlfd_name (arg
, Qt
);
5106 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5110 if (EQ (XCAR (elt
), QCscript
)
5111 && SYMBOLP (XCDR (elt
)))
5112 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5113 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5114 else if (EQ (XCAR (elt
), QClang
)
5115 && SYMBOLP (XCDR (elt
)))
5116 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5117 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5118 else if (EQ (XCAR (elt
), QCotf
)
5119 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5120 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5122 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5128 && VECTORP (XCAR (result
))
5129 && ASIZE (XCAR (result
)) > 0
5130 && FONTP (AREF (XCAR (result
), 0)))
5131 result
= font_vconcat_entity_vectors (result
);
5134 val
= Ffont_xlfd_name (result
, Qt
);
5135 if (! FONT_SPEC_P (result
))
5136 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5137 build_string (":"), val
);
5140 else if (CONSP (result
))
5142 result
= Fcopy_sequence (result
);
5143 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5147 val
= Ffont_xlfd_name (val
, Qt
);
5148 XSETCAR (tail
, val
);
5151 else if (VECTORP (result
))
5153 result
= Fcopy_sequence (result
);
5154 for (i
= 0; i
< ASIZE (result
); i
++)
5156 val
= AREF (result
, i
);
5158 val
= Ffont_xlfd_name (val
, Qt
);
5159 ASET (result
, i
, val
);
5162 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5165 /* Record a font-related logging data to be added to Vfont_log when
5166 font_add_log is called next time. ACTION, ARG, RESULT are the same
5170 font_deferred_log (action
, arg
, result
)
5172 Lisp_Object arg
, result
;
5174 if (EQ (Vfont_log
, Qt
))
5176 ASET (Vfont_log_deferred
, 0, build_string (action
));
5177 ASET (Vfont_log_deferred
, 1, arg
);
5178 ASET (Vfont_log_deferred
, 2, result
);
5181 extern void syms_of_ftfont
P_ (());
5182 extern void syms_of_xfont
P_ (());
5183 extern void syms_of_xftfont
P_ (());
5184 extern void syms_of_ftxfont
P_ (());
5185 extern void syms_of_bdffont
P_ (());
5186 extern void syms_of_w32font
P_ (());
5187 extern void syms_of_atmfont
P_ (());
5188 extern void syms_of_nsfont
P_ (());
5193 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5194 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5195 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5196 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5197 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5198 /* Note that the other elements in sort_shift_bits are not used. */
5200 staticpro (&font_charset_alist
);
5201 font_charset_alist
= Qnil
;
5203 DEFSYM (Qopentype
, "opentype");
5205 DEFSYM (Qascii_0
, "ascii-0");
5206 DEFSYM (Qiso8859_1
, "iso8859-1");
5207 DEFSYM (Qiso10646_1
, "iso10646-1");
5208 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5209 DEFSYM (Qunicode_sip
, "unicode-sip");
5213 DEFSYM (QCotf
, ":otf");
5214 DEFSYM (QClang
, ":lang");
5215 DEFSYM (QCscript
, ":script");
5216 DEFSYM (QCantialias
, ":antialias");
5218 DEFSYM (QCfoundry
, ":foundry");
5219 DEFSYM (QCadstyle
, ":adstyle");
5220 DEFSYM (QCregistry
, ":registry");
5221 DEFSYM (QCspacing
, ":spacing");
5222 DEFSYM (QCdpi
, ":dpi");
5223 DEFSYM (QCscalable
, ":scalable");
5224 DEFSYM (QCavgwidth
, ":avgwidth");
5225 DEFSYM (QCfont_entity
, ":font-entity");
5226 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5236 staticpro (&null_vector
);
5237 null_vector
= Fmake_vector (make_number (0), Qnil
);
5239 staticpro (&scratch_font_spec
);
5240 scratch_font_spec
= Ffont_spec (0, NULL
);
5241 staticpro (&scratch_font_prefer
);
5242 scratch_font_prefer
= Ffont_spec (0, NULL
);
5244 staticpro (&Vfont_log_deferred
);
5245 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5249 staticpro (&otf_list
);
5251 #endif /* HAVE_LIBOTF */
5255 defsubr (&Sfont_spec
);
5256 defsubr (&Sfont_get
);
5257 #ifdef HAVE_WINDOW_SYSTEM
5258 defsubr (&Sfont_face_attributes
);
5260 defsubr (&Sfont_put
);
5261 defsubr (&Slist_fonts
);
5262 defsubr (&Sfont_family_list
);
5263 defsubr (&Sfind_font
);
5264 defsubr (&Sfont_xlfd_name
);
5265 defsubr (&Sclear_font_cache
);
5266 defsubr (&Sfont_shape_gstring
);
5267 defsubr (&Sfont_variation_glyphs
);
5269 defsubr (&Sfont_drive_otf
);
5270 defsubr (&Sfont_otf_alternates
);
5274 defsubr (&Sopen_font
);
5275 defsubr (&Sclose_font
);
5276 defsubr (&Squery_font
);
5277 defsubr (&Sget_font_glyphs
);
5278 defsubr (&Sfont_match_p
);
5279 defsubr (&Sfont_at
);
5281 defsubr (&Sdraw_string
);
5283 #endif /* FONT_DEBUG */
5284 #ifdef HAVE_WINDOW_SYSTEM
5285 defsubr (&Sfont_info
);
5288 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5290 Alist of fontname patterns vs the corresponding encoding and repertory info.
5291 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5292 where ENCODING is a charset or a char-table,
5293 and REPERTORY is a charset, a char-table, or nil.
5295 If ENCODING and REPERTORY are the same, the element can have the form
5296 \(REGEXP . ENCODING).
5298 ENCODING is for converting a character to a glyph code of the font.
5299 If ENCODING is a charset, encoding a character by the charset gives
5300 the corresponding glyph code. If ENCODING is a char-table, looking up
5301 the table by a character gives the corresponding glyph code.
5303 REPERTORY specifies a repertory of characters supported by the font.
5304 If REPERTORY is a charset, all characters beloging to the charset are
5305 supported. If REPERTORY is a char-table, all characters who have a
5306 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5307 gets the repertory information by an opened font and ENCODING. */);
5308 Vfont_encoding_alist
= Qnil
;
5310 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5311 doc
: /* Vector of valid font weight values.
5312 Each element has the form:
5313 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5314 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5315 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5317 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5318 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5319 See `font-weight-table' for the format of the vector. */);
5320 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5322 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5323 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5324 See `font-weight-table' for the format of the vector. */);
5325 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5327 staticpro (&font_style_table
);
5328 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5329 ASET (font_style_table
, 0, Vfont_weight_table
);
5330 ASET (font_style_table
, 1, Vfont_slant_table
);
5331 ASET (font_style_table
, 2, Vfont_width_table
);
5333 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5334 *Logging list of font related actions and results.
5335 The value t means to suppress the logging.
5336 The initial value is set to nil if the environment variable
5337 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5340 #ifdef HAVE_WINDOW_SYSTEM
5341 #ifdef HAVE_FREETYPE
5343 #ifdef HAVE_X_WINDOWS
5348 #endif /* HAVE_XFT */
5349 #endif /* HAVE_X_WINDOWS */
5350 #else /* not HAVE_FREETYPE */
5351 #ifdef HAVE_X_WINDOWS
5353 #endif /* HAVE_X_WINDOWS */
5354 #endif /* not HAVE_FREETYPE */
5357 #endif /* HAVE_BDFFONT */
5360 #endif /* WINDOWSNT */
5363 #endif /* HAVE_NS */
5364 #endif /* HAVE_WINDOW_SYSTEM */
5370 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
5373 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5374 (do not change this comment) */