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/>. */
32 #include "dispextern.h"
34 #include "character.h"
35 #include "composite.h"
41 #endif /* HAVE_X_WINDOWS */
45 #endif /* HAVE_NTGUI */
52 extern Lisp_Object Qfontsize
;
55 Lisp_Object Qopentype
;
57 /* Important character set strings. */
58 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
60 #define DEFAULT_ENCODING Qiso8859_1
62 /* Unicode category `Cf'. */
63 static Lisp_Object QCf
;
65 /* Special vector of zero length. This is repeatedly used by (struct
66 font_driver *)->list when a specified font is not found. */
67 static Lisp_Object null_vector
;
69 static Lisp_Object Vfont_weight_table
, Vfont_slant_table
, Vfont_width_table
;
71 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
72 static Lisp_Object font_style_table
;
74 /* Structure used for tables mapping weight, slant, and width numeric
75 values and their names. */
80 /* The first one is a valid name as a face attribute.
81 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 const 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 const 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 const 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
], "%ld",
1356 (long) 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=%ld", (long)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
, "%ld", (long) 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=%ld", (long) XINT (AREF (font
, FONT_DPI_INDEX
)));
1713 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1714 p
+= sprintf (p
, ":spacing=%ld",
1715 (long) XINT (AREF (font
, FONT_SPACING_INDEX
)));
1716 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1718 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1719 p
+= sprintf (p
, ":scalable=true");
1721 p
+= sprintf (p
, ":scalable=false");
1726 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1727 NAME (NBYTES length), and return the name length. F is the frame
1728 on which the font is displayed; it is used to calculate the point
1732 font_unparse_gtkname (font
, f
, name
, nbytes
)
1740 Lisp_Object family
, weight
, slant
, size
;
1741 int point_size
= -1;
1743 family
= AREF (font
, FONT_FAMILY_INDEX
);
1744 if (! NILP (family
))
1746 if (! SYMBOLP (family
))
1748 family
= SYMBOL_NAME (family
);
1749 len
+= SBYTES (family
);
1752 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1753 if (EQ (weight
, Qnormal
))
1755 else if (! NILP (weight
))
1757 weight
= SYMBOL_NAME (weight
);
1758 len
+= SBYTES (weight
);
1761 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1762 if (EQ (slant
, Qnormal
))
1764 else if (! NILP (slant
))
1766 slant
= SYMBOL_NAME (slant
);
1767 len
+= SBYTES (slant
);
1770 size
= AREF (font
, FONT_SIZE_INDEX
);
1771 /* Convert pixel size to point size. */
1772 if (INTEGERP (size
))
1774 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1776 if (INTEGERP (font_dpi
))
1777 dpi
= XINT (font_dpi
);
1780 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1783 else if (FLOATP (size
))
1785 point_size
= (int) XFLOAT_DATA (size
);
1792 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1794 if (! NILP (weight
))
1797 p
+= sprintf (p
, " %s", SDATA (weight
));
1798 q
[1] = toupper (q
[1]);
1804 p
+= sprintf (p
, " %s", SDATA (slant
));
1805 q
[1] = toupper (q
[1]);
1809 p
+= sprintf (p
, " %d", point_size
);
1814 /* Parse NAME (null terminated) and store information in FONT
1815 (font-spec or font-entity). If NAME is successfully parsed, return
1816 0. Otherwise return -1. */
1819 font_parse_name (name
, font
)
1823 if (name
[0] == '-' || index (name
, '*') || index (name
, '?'))
1824 return font_parse_xlfd (name
, font
);
1825 return font_parse_fcname (name
, font
);
1829 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1830 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1834 font_parse_family_registry (family
, registry
, font_spec
)
1835 Lisp_Object family
, registry
, font_spec
;
1841 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1843 CHECK_STRING (family
);
1844 len
= SBYTES (family
);
1845 p0
= (char *) SDATA (family
);
1846 p1
= index (p0
, '-');
1849 if ((*p0
!= '*' && p1
- p0
> 0)
1850 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1851 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1854 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1857 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1859 if (! NILP (registry
))
1861 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1862 CHECK_STRING (registry
);
1863 len
= SBYTES (registry
);
1864 p0
= (char *) SDATA (registry
);
1865 p1
= index (p0
, '-');
1868 if (SDATA (registry
)[len
- 1] == '*')
1869 registry
= concat2 (registry
, build_string ("-*"));
1871 registry
= concat2 (registry
, build_string ("*-*"));
1873 registry
= Fdowncase (registry
);
1874 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1879 /* This part (through the next ^L) is still experimental and not
1880 tested much. We may drastically change codes. */
1886 #define LGSTRING_HEADER_SIZE 6
1887 #define LGSTRING_GLYPH_SIZE 8
1890 check_gstring (gstring
)
1891 Lisp_Object gstring
;
1896 CHECK_VECTOR (gstring
);
1897 val
= AREF (gstring
, 0);
1899 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1901 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1902 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1903 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1904 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1905 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1906 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1907 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1908 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1909 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1910 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1911 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1913 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1915 val
= LGSTRING_GLYPH (gstring
, i
);
1917 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1919 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1921 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1922 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1923 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1924 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1925 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1926 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1927 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1928 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1930 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1932 if (ASIZE (val
) < 3)
1934 for (j
= 0; j
< 3; j
++)
1935 CHECK_NUMBER (AREF (val
, j
));
1940 error ("Invalid glyph-string format");
1945 check_otf_features (otf_features
)
1946 Lisp_Object otf_features
;
1950 CHECK_CONS (otf_features
);
1951 CHECK_SYMBOL (XCAR (otf_features
));
1952 otf_features
= XCDR (otf_features
);
1953 CHECK_CONS (otf_features
);
1954 CHECK_SYMBOL (XCAR (otf_features
));
1955 otf_features
= XCDR (otf_features
);
1956 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1958 CHECK_SYMBOL (Fcar (val
));
1959 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1960 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1962 otf_features
= XCDR (otf_features
);
1963 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1965 CHECK_SYMBOL (Fcar (val
));
1966 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1967 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1974 Lisp_Object otf_list
;
1977 otf_tag_symbol (tag
)
1982 OTF_tag_name (tag
, name
);
1983 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1990 Lisp_Object val
= Fassoc (file
, otf_list
);
1994 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1997 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1998 val
= make_save_value (otf
, 0);
1999 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
2005 /* Return a list describing which scripts/languages FONT supports by
2006 which GSUB/GPOS features of OpenType tables. See the comment of
2007 (struct font_driver).otf_capability. */
2010 font_otf_capability (font
)
2014 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
2017 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
2020 for (i
= 0; i
< 2; i
++)
2022 OTF_GSUB_GPOS
*gsub_gpos
;
2023 Lisp_Object script_list
= Qnil
;
2026 if (OTF_get_features (otf
, i
== 0) < 0)
2028 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2029 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2031 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2032 Lisp_Object langsys_list
= Qnil
;
2033 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2036 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2038 OTF_LangSys
*langsys
;
2039 Lisp_Object feature_list
= Qnil
;
2040 Lisp_Object langsys_tag
;
2043 if (k
== script
->LangSysCount
)
2045 langsys
= &script
->DefaultLangSys
;
2050 langsys
= script
->LangSys
+ k
;
2052 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2054 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2056 OTF_Feature
*feature
2057 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2058 Lisp_Object feature_tag
2059 = otf_tag_symbol (feature
->FeatureTag
);
2061 feature_list
= Fcons (feature_tag
, feature_list
);
2063 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2066 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2071 XSETCAR (capability
, script_list
);
2073 XSETCDR (capability
, script_list
);
2079 /* Parse OTF features in SPEC and write a proper features spec string
2080 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2081 assured that the sufficient memory has already allocated for
2085 generate_otf_features (spec
, features
)
2095 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2101 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2106 else if (! asterisk
)
2108 val
= SYMBOL_NAME (val
);
2109 p
+= sprintf (p
, "%s", SDATA (val
));
2113 val
= SYMBOL_NAME (val
);
2114 p
+= sprintf (p
, "~%s", SDATA (val
));
2118 error ("OTF spec too long");
2122 font_otf_DeviceTable (device_table
)
2123 OTF_DeviceTable
*device_table
;
2125 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2127 return Fcons (make_number (len
),
2128 make_unibyte_string (device_table
->DeltaValue
, len
));
2132 font_otf_ValueRecord (value_format
, value_record
)
2134 OTF_ValueRecord
*value_record
;
2136 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2138 if (value_format
& OTF_XPlacement
)
2139 ASET (val
, 0, make_number (value_record
->XPlacement
));
2140 if (value_format
& OTF_YPlacement
)
2141 ASET (val
, 1, make_number (value_record
->YPlacement
));
2142 if (value_format
& OTF_XAdvance
)
2143 ASET (val
, 2, make_number (value_record
->XAdvance
));
2144 if (value_format
& OTF_YAdvance
)
2145 ASET (val
, 3, make_number (value_record
->YAdvance
));
2146 if (value_format
& OTF_XPlaDevice
)
2147 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2148 if (value_format
& OTF_YPlaDevice
)
2149 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2150 if (value_format
& OTF_XAdvDevice
)
2151 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2152 if (value_format
& OTF_YAdvDevice
)
2153 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2158 font_otf_Anchor (anchor
)
2163 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2164 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2165 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2166 if (anchor
->AnchorFormat
== 2)
2167 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2170 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2171 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2175 #endif /* HAVE_LIBOTF */
2181 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2182 static int font_compare
P_ ((const void *, const void *));
2183 static Lisp_Object font_sort_entities
P_ ((Lisp_Object
, Lisp_Object
,
2186 /* Return a rescaling ratio of FONT_ENTITY. */
2187 extern Lisp_Object Vface_font_rescale_alist
;
2190 font_rescale_ratio (font_entity
)
2191 Lisp_Object font_entity
;
2193 Lisp_Object tail
, elt
;
2194 Lisp_Object name
= Qnil
;
2196 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2199 if (FLOATP (XCDR (elt
)))
2201 if (STRINGP (XCAR (elt
)))
2204 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2205 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2206 return XFLOAT_DATA (XCDR (elt
));
2208 else if (FONT_SPEC_P (XCAR (elt
)))
2210 if (font_match_p (XCAR (elt
), font_entity
))
2211 return XFLOAT_DATA (XCDR (elt
));
2218 /* We sort fonts by scoring each of them against a specified
2219 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2220 the value is, the closer the font is to the font-spec.
2222 The lowest 2 bits of the score is used for driver type. The font
2223 available by the most preferred font driver is 0.
2225 Each 7-bit in the higher 28 bits are used for numeric properties
2226 WEIGHT, SLANT, WIDTH, and SIZE. */
2228 /* How many bits to shift to store the difference value of each font
2229 property in a score. Note that flots for FONT_TYPE_INDEX and
2230 FONT_REGISTRY_INDEX are not used. */
2231 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2233 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2234 The return value indicates how different ENTITY is compared with
2238 font_score (entity
, spec_prop
)
2239 Lisp_Object entity
, *spec_prop
;
2244 /* Score three style numeric fields. Maximum difference is 127. */
2245 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2246 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2248 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2253 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2256 /* Score the size. Maximum difference is 127. */
2257 i
= FONT_SIZE_INDEX
;
2258 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2259 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2261 /* We use the higher 6-bit for the actual size difference. The
2262 lowest bit is set if the DPI is different. */
2264 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2266 if (CONSP (Vface_font_rescale_alist
))
2267 pixel_size
*= font_rescale_ratio (entity
);
2268 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2272 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2273 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2275 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2276 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2278 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2285 /* Concatenate all elements of LIST into one vector. LIST is a list
2286 of font-entity vectors. */
2289 font_vconcat_entity_vectors (Lisp_Object list
)
2291 int nargs
= XINT (Flength (list
));
2292 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2295 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2296 args
[i
] = XCAR (list
);
2297 return Fvconcat (nargs
, args
);
2301 /* The structure for elements being sorted by qsort. */
2302 struct font_sort_data
2305 int font_driver_preference
;
2310 /* The comparison function for qsort. */
2313 font_compare (d1
, d2
)
2314 const void *d1
, *d2
;
2316 const struct font_sort_data
*data1
= d1
;
2317 const struct font_sort_data
*data2
= d2
;
2319 if (data1
->score
< data2
->score
)
2321 else if (data1
->score
> data2
->score
)
2323 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2327 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2328 If PREFER specifies a point-size, calculate the corresponding
2329 pixel-size from QCdpi property of PREFER or from the Y-resolution
2330 of FRAME before sorting.
2332 If BEST-ONLY is nonzero, return the best matching entity (that
2333 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2334 if BEST-ONLY is negative). Otherwise, return the sorted result as
2335 a single vector of font-entities.
2337 This function does no optimization for the case that the total
2338 number of elements is 1. The caller should avoid calling this in
2342 font_sort_entities (list
, prefer
, frame
, best_only
)
2343 Lisp_Object list
, prefer
, frame
;
2346 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2348 struct font_sort_data
*data
;
2349 unsigned best_score
;
2350 Lisp_Object best_entity
;
2351 struct frame
*f
= XFRAME (frame
);
2352 Lisp_Object tail
, vec
;
2355 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2356 prefer_prop
[i
] = AREF (prefer
, i
);
2357 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2358 prefer_prop
[FONT_SIZE_INDEX
]
2359 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2361 if (NILP (XCDR (list
)))
2363 /* What we have to take care of is this single vector. */
2365 maxlen
= ASIZE (vec
);
2369 /* We don't have to perform sort, so there's no need of creating
2370 a single vector. But, we must find the length of the longest
2373 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2374 if (maxlen
< ASIZE (XCAR (tail
)))
2375 maxlen
= ASIZE (XCAR (tail
));
2379 /* We have to create a single vector to sort it. */
2380 vec
= font_vconcat_entity_vectors (list
);
2381 maxlen
= ASIZE (vec
);
2384 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2385 best_score
= 0xFFFFFFFF;
2388 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2390 int font_driver_preference
= 0;
2391 Lisp_Object current_font_driver
;
2397 /* We are sure that the length of VEC > 0. */
2398 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2399 /* Score the elements. */
2400 for (i
= 0; i
< len
; i
++)
2402 data
[i
].entity
= AREF (vec
, i
);
2404 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2406 ? font_score (data
[i
].entity
, prefer_prop
)
2408 if (best_only
&& best_score
> data
[i
].score
)
2410 best_score
= data
[i
].score
;
2411 best_entity
= data
[i
].entity
;
2412 if (best_score
== 0)
2415 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2417 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2418 font_driver_preference
++;
2420 data
[i
].font_driver_preference
= font_driver_preference
;
2423 /* Sort if necessary. */
2426 qsort (data
, len
, sizeof *data
, font_compare
);
2427 for (i
= 0; i
< len
; i
++)
2428 ASET (vec
, i
, data
[i
].entity
);
2437 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2442 /* API of Font Service Layer. */
2444 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2445 sort_shift_bits. Finternal_set_font_selection_order calls this
2446 function with font_sort_order after setting up it. */
2449 font_update_sort_order (order
)
2454 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2456 int xlfd_idx
= order
[i
];
2458 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2459 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2460 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2461 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2462 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2463 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2465 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2470 font_check_otf_features (script
, langsys
, features
, table
)
2471 Lisp_Object script
, langsys
, features
, table
;
2476 table
= assq_no_quit (script
, table
);
2479 table
= XCDR (table
);
2480 if (! NILP (langsys
))
2482 table
= assq_no_quit (langsys
, table
);
2488 val
= assq_no_quit (Qnil
, table
);
2490 table
= XCAR (table
);
2494 table
= XCDR (table
);
2495 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2497 if (NILP (XCAR (features
)))
2502 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2508 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2511 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2513 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2515 script
= XCAR (spec
);
2519 langsys
= XCAR (spec
);
2530 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2531 XCAR (otf_capability
)))
2533 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2534 XCDR (otf_capability
)))
2541 /* Check if FONT (font-entity or font-object) matches with the font
2542 specification SPEC. */
2545 font_match_p (spec
, font
)
2546 Lisp_Object spec
, font
;
2548 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2549 Lisp_Object extra
, font_extra
;
2552 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2553 if (! NILP (AREF (spec
, i
))
2554 && ! NILP (AREF (font
, i
))
2555 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2557 props
= XFONT_SPEC (spec
)->props
;
2558 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2560 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2561 prop
[i
] = AREF (spec
, i
);
2562 prop
[FONT_SIZE_INDEX
]
2563 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2567 if (font_score (font
, props
) > 0)
2569 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2570 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2571 for (; CONSP (extra
); extra
= XCDR (extra
))
2573 Lisp_Object key
= XCAR (XCAR (extra
));
2574 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2576 if (EQ (key
, QClang
))
2578 val2
= assq_no_quit (key
, font_extra
);
2587 if (NILP (Fmemq (val
, val2
)))
2592 ? NILP (Fmemq (val
, XCDR (val2
)))
2596 else if (EQ (key
, QCscript
))
2598 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2604 /* All characters in the list must be supported. */
2605 for (; CONSP (val2
); val2
= XCDR (val2
))
2607 if (! NATNUMP (XCAR (val2
)))
2609 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2610 == FONT_INVALID_CODE
)
2614 else if (VECTORP (val2
))
2616 /* At most one character in the vector must be supported. */
2617 for (i
= 0; i
< ASIZE (val2
); i
++)
2619 if (! NATNUMP (AREF (val2
, i
)))
2621 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2622 != FONT_INVALID_CODE
)
2625 if (i
== ASIZE (val2
))
2630 else if (EQ (key
, QCotf
))
2634 if (! FONT_OBJECT_P (font
))
2636 fontp
= XFONT_OBJECT (font
);
2637 if (! fontp
->driver
->otf_capability
)
2639 val2
= fontp
->driver
->otf_capability (fontp
);
2640 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2651 Each font backend has the callback function get_cache, and it
2652 returns a cons cell of which cdr part can be freely used for
2653 caching fonts. The cons cell may be shared by multiple frames
2654 and/or multiple font drivers. So, we arrange the cdr part as this:
2656 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2658 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2659 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2660 cons (FONT-SPEC FONT-ENTITY ...). */
2662 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2663 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2664 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2665 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2666 struct font_driver
*));
2669 font_prepare_cache (f
, driver
)
2671 struct font_driver
*driver
;
2673 Lisp_Object cache
, val
;
2675 cache
= driver
->get_cache (f
);
2677 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2681 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2682 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2686 val
= XCDR (XCAR (val
));
2687 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2693 font_finish_cache (f
, driver
)
2695 struct font_driver
*driver
;
2697 Lisp_Object cache
, val
, tmp
;
2700 cache
= driver
->get_cache (f
);
2702 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2703 cache
= val
, val
= XCDR (val
);
2704 font_assert (! NILP (val
));
2705 tmp
= XCDR (XCAR (val
));
2706 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2707 if (XINT (XCAR (tmp
)) == 0)
2709 font_clear_cache (f
, XCAR (val
), driver
);
2710 XSETCDR (cache
, XCDR (val
));
2716 font_get_cache (f
, driver
)
2718 struct font_driver
*driver
;
2720 Lisp_Object val
= driver
->get_cache (f
);
2721 Lisp_Object type
= driver
->type
;
2723 font_assert (CONSP (val
));
2724 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2725 font_assert (CONSP (val
));
2726 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2727 val
= XCDR (XCAR (val
));
2731 static int num_fonts
;
2734 font_clear_cache (f
, cache
, driver
)
2737 struct font_driver
*driver
;
2739 Lisp_Object tail
, elt
;
2740 Lisp_Object tail2
, entity
;
2742 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2743 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2746 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2747 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2749 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2751 entity
= XCAR (tail2
);
2753 if (FONT_ENTITY_P (entity
)
2754 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2756 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2758 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2760 Lisp_Object val
= XCAR (objlist
);
2761 struct font
*font
= XFONT_OBJECT (val
);
2763 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2765 font_assert (font
&& driver
== font
->driver
);
2766 driver
->close (f
, font
);
2770 if (driver
->free_entity
)
2771 driver
->free_entity (entity
);
2776 XSETCDR (cache
, Qnil
);
2780 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2783 font_delete_unmatched (vec
, spec
, size
)
2784 Lisp_Object vec
, spec
;
2787 Lisp_Object entity
, val
;
2788 enum font_property_index prop
;
2791 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2793 entity
= AREF (vec
, i
);
2794 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2795 if (INTEGERP (AREF (spec
, prop
))
2796 && ((XINT (AREF (spec
, prop
)) >> 8)
2797 != (XINT (AREF (entity
, prop
)) >> 8)))
2798 prop
= FONT_SPEC_MAX
;
2799 if (prop
< FONT_SPEC_MAX
2801 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2803 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2806 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2807 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2808 prop
= FONT_SPEC_MAX
;
2810 if (prop
< FONT_SPEC_MAX
2811 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2812 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2813 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2814 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2815 prop
= FONT_SPEC_MAX
;
2816 if (prop
< FONT_SPEC_MAX
2817 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2818 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2819 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2820 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2821 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2822 prop
= FONT_SPEC_MAX
;
2823 if (prop
< FONT_SPEC_MAX
)
2824 val
= Fcons (entity
, val
);
2826 return (Fvconcat (1, &val
));
2830 /* Return a list of vectors of font-entities matching with SPEC on
2831 FRAME. The elements of the list are in the same of order of
2835 font_list_entities (frame
, spec
)
2836 Lisp_Object frame
, spec
;
2838 FRAME_PTR f
= XFRAME (frame
);
2839 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2840 Lisp_Object ftype
, val
;
2841 Lisp_Object list
= Qnil
;
2843 int need_filtering
= 0;
2846 font_assert (FONT_SPEC_P (spec
));
2848 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2849 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2850 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2851 size
= font_pixel_size (f
, spec
);
2855 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2856 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2857 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2858 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2860 ASET (scratch_font_spec
, i
, Qnil
);
2861 if (! NILP (AREF (spec
, i
)))
2863 if (i
== FONT_DPI_INDEX
)
2864 /* Skip FONT_SPACING_INDEX */
2867 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2868 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2870 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2872 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2874 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2876 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2877 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2884 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2888 val
= Fvconcat (1, &val
);
2889 copy
= Fcopy_font_spec (scratch_font_spec
);
2890 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2891 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2893 if (ASIZE (val
) > 0 && need_filtering
)
2894 val
= font_delete_unmatched (val
, spec
, size
);
2895 if (ASIZE (val
) > 0)
2896 list
= Fcons (val
, list
);
2899 list
= Fnreverse (list
);
2900 FONT_ADD_LOG ("list", spec
, list
);
2905 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2906 nil, is an array of face's attributes, which specifies preferred
2907 font-related attributes. */
2910 font_matching_entity (f
, attrs
, spec
)
2912 Lisp_Object
*attrs
, spec
;
2914 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2915 Lisp_Object ftype
, size
, entity
;
2917 Lisp_Object work
= Fcopy_font_spec (spec
);
2919 XSETFRAME (frame
, f
);
2920 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2921 size
= AREF (spec
, FONT_SIZE_INDEX
);
2924 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2925 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2926 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2927 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2930 for (; driver_list
; driver_list
= driver_list
->next
)
2932 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2934 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2937 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2938 entity
= assoc_no_quit (work
, XCDR (cache
));
2940 entity
= XCDR (entity
);
2943 entity
= driver_list
->driver
->match (frame
, work
);
2944 copy
= Fcopy_font_spec (work
);
2945 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2946 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2948 if (! NILP (entity
))
2951 FONT_ADD_LOG ("match", work
, entity
);
2956 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2957 opened font object. */
2960 font_open_entity (f
, entity
, pixel_size
)
2965 struct font_driver_list
*driver_list
;
2966 Lisp_Object objlist
, size
, val
, font_object
;
2968 int min_width
, height
;
2969 int scaled_pixel_size
;
2971 font_assert (FONT_ENTITY_P (entity
));
2972 size
= AREF (entity
, FONT_SIZE_INDEX
);
2973 if (XINT (size
) != 0)
2974 scaled_pixel_size
= pixel_size
= XINT (size
);
2975 else if (CONSP (Vface_font_rescale_alist
))
2976 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2978 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2979 objlist
= XCDR (objlist
))
2980 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2981 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2982 return XCAR (objlist
);
2984 val
= AREF (entity
, FONT_TYPE_INDEX
);
2985 for (driver_list
= f
->font_driver_list
;
2986 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2987 driver_list
= driver_list
->next
);
2991 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2992 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2993 FONT_ADD_LOG ("open", entity
, font_object
);
2994 if (NILP (font_object
))
2996 ASET (entity
, FONT_OBJLIST_INDEX
,
2997 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2998 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
3001 font
= XFONT_OBJECT (font_object
);
3002 min_width
= (font
->min_width
? font
->min_width
3003 : font
->average_width
? font
->average_width
3004 : font
->space_width
? font
->space_width
3006 height
= (font
->height
? font
->height
: 1);
3007 #ifdef HAVE_WINDOW_SYSTEM
3008 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
3009 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
3011 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
3012 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
3013 fonts_changed_p
= 1;
3017 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
3018 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
3019 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
3020 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
3028 /* Close FONT_OBJECT that is opened on frame F. */
3031 font_close_object (f
, font_object
)
3033 Lisp_Object font_object
;
3035 struct font
*font
= XFONT_OBJECT (font_object
);
3037 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
3038 /* Already closed. */
3040 FONT_ADD_LOG ("close", font_object
, Qnil
);
3041 font
->driver
->close (f
, font
);
3042 #ifdef HAVE_WINDOW_SYSTEM
3043 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
3044 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
3050 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
3051 FONT is a font-entity and it must be opened to check. */
3054 font_has_char (f
, font
, c
)
3061 if (FONT_ENTITY_P (font
))
3063 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
3064 struct font_driver_list
*driver_list
;
3066 for (driver_list
= f
->font_driver_list
;
3067 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
3068 driver_list
= driver_list
->next
);
3071 if (! driver_list
->driver
->has_char
)
3073 return driver_list
->driver
->has_char (font
, c
);
3076 font_assert (FONT_OBJECT_P (font
));
3077 fontp
= XFONT_OBJECT (font
);
3078 if (fontp
->driver
->has_char
)
3080 int result
= fontp
->driver
->has_char (font
, c
);
3085 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
3089 /* Return the glyph ID of FONT_OBJECT for character C. */
3092 font_encode_char (font_object
, c
)
3093 Lisp_Object font_object
;
3098 font_assert (FONT_OBJECT_P (font_object
));
3099 font
= XFONT_OBJECT (font_object
);
3100 return font
->driver
->encode_char (font
, c
);
3104 /* Return the name of FONT_OBJECT. */
3107 font_get_name (font_object
)
3108 Lisp_Object font_object
;
3110 font_assert (FONT_OBJECT_P (font_object
));
3111 return AREF (font_object
, FONT_NAME_INDEX
);
3115 /* Return the specification of FONT_OBJECT. */
3118 font_get_spec (font_object
)
3119 Lisp_Object font_object
;
3121 Lisp_Object spec
= font_make_spec ();
3124 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
3125 ASET (spec
, i
, AREF (font_object
, i
));
3126 ASET (spec
, FONT_SIZE_INDEX
,
3127 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
3132 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3133 could not be parsed by font_parse_name, return Qnil. */
3136 font_spec_from_name (font_name
)
3137 Lisp_Object font_name
;
3139 Lisp_Object spec
= Ffont_spec (0, NULL
);
3141 CHECK_STRING (font_name
);
3142 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3144 font_put_extra (spec
, QCname
, font_name
);
3150 font_clear_prop (attrs
, prop
)
3152 enum font_property_index prop
;
3154 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3158 if (! NILP (Ffont_get (font
, QCname
)))
3160 font
= Fcopy_font_spec (font
);
3161 font_put_extra (font
, QCname
, Qnil
);
3164 if (NILP (AREF (font
, prop
))
3165 && prop
!= FONT_FAMILY_INDEX
3166 && prop
!= FONT_FOUNDRY_INDEX
3167 && prop
!= FONT_WIDTH_INDEX
3168 && prop
!= FONT_SIZE_INDEX
)
3170 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3171 font
= Fcopy_font_spec (font
);
3172 ASET (font
, prop
, Qnil
);
3173 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3175 if (prop
== FONT_FAMILY_INDEX
)
3177 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3178 /* If we are setting the font family, we must also clear
3179 FONT_WIDTH_INDEX to avoid rejecting families that lack
3180 support for some widths. */
3181 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3183 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3184 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3185 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3186 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3187 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3188 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3190 else if (prop
== FONT_SIZE_INDEX
)
3192 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3193 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3194 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3196 else if (prop
== FONT_WIDTH_INDEX
)
3197 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3198 attrs
[LFACE_FONT_INDEX
] = font
;
3202 font_update_lface (f
, attrs
)
3208 spec
= attrs
[LFACE_FONT_INDEX
];
3209 if (! FONT_SPEC_P (spec
))
3212 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3213 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3214 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3215 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3216 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3217 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3218 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3219 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);
3220 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3221 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3222 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3226 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3231 val
= Ffont_get (spec
, QCdpi
);
3234 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3236 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3238 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3240 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3241 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3247 /* Selecte a font from ENTITIES (list of font-entity vectors) that
3248 supports C and matches best with ATTRS and PIXEL_SIZE. */
3251 font_select_entity (frame
, entities
, attrs
, pixel_size
, c
)
3252 Lisp_Object frame
, entities
, *attrs
;
3255 Lisp_Object font_entity
;
3258 FRAME_PTR f
= XFRAME (frame
);
3260 if (NILP (XCDR (entities
))
3261 && ASIZE (XCAR (entities
)) == 1)
3263 font_entity
= AREF (XCAR (entities
), 0);
3265 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3270 /* Sort fonts by properties specified in ATTRS. */
3271 prefer
= scratch_font_prefer
;
3273 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3274 ASET (prefer
, i
, Qnil
);
3275 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3277 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3279 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3280 ASET (prefer
, i
, AREF (face_font
, i
));
3282 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3283 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3284 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3285 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3286 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3287 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3288 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3290 return font_sort_entities (entities
, prefer
, frame
, c
);
3293 /* Return a font-entity satisfying SPEC and best matching with face's
3294 font related attributes in ATTRS. C, if not negative, is a
3295 character that the entity must support. */
3298 font_find_for_lface (f
, attrs
, spec
, c
)
3305 Lisp_Object frame
, entities
, val
;
3306 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3310 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3311 if (NILP (registry
[0]))
3313 registry
[0] = DEFAULT_ENCODING
;
3314 registry
[1] = Qascii_0
;
3315 registry
[2] = null_vector
;
3318 registry
[1] = null_vector
;
3320 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3322 struct charset
*encoding
, *repertory
;
3324 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3325 &encoding
, &repertory
) < 0)
3328 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3330 else if (c
> encoding
->max_char
)
3334 work
= Fcopy_font_spec (spec
);
3335 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3336 XSETFRAME (frame
, f
);
3337 size
= AREF (spec
, FONT_SIZE_INDEX
);
3338 pixel_size
= font_pixel_size (f
, spec
);
3339 if (pixel_size
== 0)
3341 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3343 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3345 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3346 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3347 if (! NILP (foundry
[0]))
3348 foundry
[1] = null_vector
;
3349 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3351 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3352 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3354 foundry
[2] = null_vector
;
3357 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3359 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3360 if (! NILP (adstyle
[0]))
3361 adstyle
[1] = null_vector
;
3362 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3364 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3366 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3368 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3370 adstyle
[2] = null_vector
;
3373 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3376 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3379 val
= AREF (work
, FONT_FAMILY_INDEX
);
3380 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3382 val
= attrs
[LFACE_FAMILY_INDEX
];
3383 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3387 family
= alloca ((sizeof family
[0]) * 2);
3389 family
[1] = null_vector
; /* terminator. */
3394 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3395 /* Font family names are case-sensitive under NS. */
3403 if (! NILP (alters
))
3405 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3406 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3407 family
[i
] = XCAR (alters
);
3408 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3410 family
[i
] = null_vector
;
3414 family
= alloca ((sizeof family
[0]) * 3);
3417 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3419 family
[i
] = null_vector
;
3423 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3425 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3426 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3428 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3429 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3431 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3432 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3434 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3435 entities
= font_list_entities (frame
, work
);
3436 if (! NILP (entities
))
3438 val
= font_select_entity (frame
, entities
,
3439 attrs
, pixel_size
, c
);
3452 font_open_for_lface (f
, entity
, attrs
, spec
)
3460 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3461 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3462 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3463 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3464 size
= font_pixel_size (f
, spec
);
3468 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3469 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3472 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3473 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3474 if (INTEGERP (height
))
3477 abort(); /* We should never end up here. */
3481 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3485 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3486 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3490 return font_open_entity (f
, entity
, size
);
3494 /* Find a font satisfying SPEC and best matching with face's
3495 attributes in ATTRS on FRAME, and return the opened
3499 font_load_for_lface (f
, attrs
, spec
)
3501 Lisp_Object
*attrs
, spec
;
3505 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3508 /* No font is listed for SPEC, but each font-backend may have
3509 the different criteria about "font matching". So, try
3511 entity
= font_matching_entity (f
, attrs
, spec
);
3515 return font_open_for_lface (f
, entity
, attrs
, spec
);
3519 /* Make FACE on frame F ready to use the font opened for FACE. */
3522 font_prepare_for_face (f
, face
)
3526 if (face
->font
->driver
->prepare_face
)
3527 face
->font
->driver
->prepare_face (f
, face
);
3531 /* Make FACE on frame F stop using the font opened for FACE. */
3534 font_done_for_face (f
, face
)
3538 if (face
->font
->driver
->done_face
)
3539 face
->font
->driver
->done_face (f
, face
);
3544 /* Open a font matching with font-spec SPEC on frame F. If no proper
3545 font is found, return Qnil. */
3548 font_open_by_spec (f
, spec
)
3552 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3554 /* We set up the default font-related attributes of a face to prefer
3556 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3557 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3558 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3560 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3562 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3564 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3566 return font_load_for_lface (f
, attrs
, spec
);
3570 /* Open a font matching with NAME on frame F. If no proper font is
3571 found, return Qnil. */
3574 font_open_by_name (f
, name
)
3578 Lisp_Object args
[2];
3582 args
[1] = make_unibyte_string (name
, strlen (name
));
3583 spec
= Ffont_spec (2, args
);
3584 return font_open_by_spec (f
, spec
);
3588 /* Register font-driver DRIVER. This function is used in two ways.
3590 The first is with frame F non-NULL. In this case, make DRIVER
3591 available (but not yet activated) on F. All frame creaters
3592 (e.g. Fx_create_frame) must call this function at least once with
3593 an available font-driver.
3595 The second is with frame F NULL. In this case, DRIVER is globally
3596 registered in the variable `font_driver_list'. All font-driver
3597 implementations must call this function in its syms_of_XXXX
3598 (e.g. syms_of_xfont). */
3601 register_font_driver (driver
, f
)
3602 struct font_driver
*driver
;
3605 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3606 struct font_driver_list
*prev
, *list
;
3608 if (f
&& ! driver
->draw
)
3609 error ("Unusable font driver for a frame: %s",
3610 SDATA (SYMBOL_NAME (driver
->type
)));
3612 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3613 if (EQ (list
->driver
->type
, driver
->type
))
3614 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3616 list
= xmalloc (sizeof (struct font_driver_list
));
3618 list
->driver
= driver
;
3623 f
->font_driver_list
= list
;
3625 font_driver_list
= list
;
3631 free_font_driver_list (f
)
3634 struct font_driver_list
*list
, *next
;
3636 for (list
= f
->font_driver_list
; list
; list
= next
)
3641 f
->font_driver_list
= NULL
;
3645 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3646 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3647 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3649 A caller must free all realized faces if any in advance. The
3650 return value is a list of font backends actually made used on
3654 font_update_drivers (f
, new_drivers
)
3656 Lisp_Object new_drivers
;
3658 Lisp_Object active_drivers
= Qnil
;
3659 struct font_driver
*driver
;
3660 struct font_driver_list
*list
;
3662 /* At first, turn off non-requested drivers, and turn on requested
3664 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3666 driver
= list
->driver
;
3667 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3672 if (driver
->end_for_frame
)
3673 driver
->end_for_frame (f
);
3674 font_finish_cache (f
, driver
);
3679 if (! driver
->start_for_frame
3680 || driver
->start_for_frame (f
) == 0)
3682 font_prepare_cache (f
, driver
);
3689 if (NILP (new_drivers
))
3692 if (! EQ (new_drivers
, Qt
))
3694 /* Re-order the driver list according to new_drivers. */
3695 struct font_driver_list
**list_table
, **next
;
3699 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3700 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3702 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3703 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3706 list_table
[i
++] = list
;
3708 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3710 list_table
[i
++] = list
;
3711 list_table
[i
] = NULL
;
3713 next
= &f
->font_driver_list
;
3714 for (i
= 0; list_table
[i
]; i
++)
3716 *next
= list_table
[i
];
3717 next
= &(*next
)->next
;
3721 if (! f
->font_driver_list
->on
)
3722 { /* None of the drivers is enabled: enable them all.
3723 Happens if you set the list of drivers to (xft x) in your .emacs
3724 and then use it under w32 or ns. */
3725 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3727 struct font_driver
*driver
= list
->driver
;
3728 eassert (! list
->on
);
3729 if (! driver
->start_for_frame
3730 || driver
->start_for_frame (f
) == 0)
3732 font_prepare_cache (f
, driver
);
3739 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3741 active_drivers
= nconc2 (active_drivers
,
3742 Fcons (list
->driver
->type
, Qnil
));
3743 return active_drivers
;
3747 font_put_frame_data (f
, driver
, data
)
3749 struct font_driver
*driver
;
3752 struct font_data_list
*list
, *prev
;
3754 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3755 prev
= list
, list
= list
->next
)
3756 if (list
->driver
== driver
)
3763 prev
->next
= list
->next
;
3765 f
->font_data_list
= list
->next
;
3773 list
= xmalloc (sizeof (struct font_data_list
));
3774 list
->driver
= driver
;
3775 list
->next
= f
->font_data_list
;
3776 f
->font_data_list
= list
;
3784 font_get_frame_data (f
, driver
)
3786 struct font_driver
*driver
;
3788 struct font_data_list
*list
;
3790 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3791 if (list
->driver
== driver
)
3799 /* Return the font used to draw character C by FACE at buffer position
3800 POS in window W. If STRING is non-nil, it is a string containing C
3801 at index POS. If C is negative, get C from the current buffer or
3805 font_at (c
, pos
, face
, w
, string
)
3814 Lisp_Object font_object
;
3816 multibyte
= (NILP (string
)
3817 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3818 : STRING_MULTIBYTE (string
));
3825 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3827 c
= FETCH_CHAR (pos_byte
);
3830 c
= FETCH_BYTE (pos
);
3836 multibyte
= STRING_MULTIBYTE (string
);
3839 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3841 str
= SDATA (string
) + pos_byte
;
3842 c
= STRING_CHAR (str
, 0);
3845 c
= SDATA (string
)[pos
];
3849 f
= XFRAME (w
->frame
);
3850 if (! FRAME_WINDOW_P (f
))
3857 if (STRINGP (string
))
3858 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3859 DEFAULT_FACE_ID
, 0);
3861 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3863 face
= FACE_FROM_ID (f
, face_id
);
3867 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3868 face
= FACE_FROM_ID (f
, face_id
);
3873 XSETFONT (font_object
, face
->font
);
3878 #ifdef HAVE_WINDOW_SYSTEM
3880 /* Check how many characters after POS (at most to *LIMIT) can be
3881 displayed by the same font on the window W. FACE, if non-NULL, is
3882 the face selected for the character at POS. If STRING is not nil,
3883 it is the string to check instead of the current buffer. In that
3884 case, FACE must be not NULL.
3886 The return value is the font-object for the character at POS.
3887 *LIMIT is set to the position where that font can't be used.
3889 It is assured that the current buffer (or STRING) is multibyte. */
3892 font_range (pos
, limit
, w
, face
, string
)
3893 EMACS_INT pos
, *limit
;
3898 EMACS_INT pos_byte
, ignore
, start
, start_byte
;
3900 Lisp_Object font_object
= Qnil
;
3904 pos_byte
= CHAR_TO_BYTE (pos
);
3909 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3911 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3917 pos_byte
= string_char_to_byte (string
, pos
);
3920 start
= pos
, start_byte
= pos_byte
;
3921 while (pos
< *limit
)
3923 Lisp_Object category
;
3926 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3928 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3929 if (NILP (font_object
))
3931 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3932 if (NILP (font_object
))
3937 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3938 if (! EQ (category
, QCf
)
3939 && ! CHAR_VARIATION_SELECTOR_P (c
)
3940 && font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3942 Lisp_Object f
= font_for_char (face
, c
, pos
- 1, string
);
3943 EMACS_INT i
, i_byte
;
3951 i
= start
, i_byte
= start_byte
;
3956 FETCH_CHAR_ADVANCE_NO_CHECK (c
, i
, i_byte
);
3958 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, i
, i_byte
);
3959 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3960 if (! EQ (category
, QCf
)
3961 && ! CHAR_VARIATION_SELECTOR_P (c
)
3962 && font_encode_char (f
, c
) == FONT_INVALID_CODE
)
3978 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3979 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3980 Return nil otherwise.
3981 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3982 which kind of font it is. It must be one of `font-spec', `font-entity',
3984 (object
, extra_type
)
3985 Lisp_Object object
, extra_type
;
3987 if (NILP (extra_type
))
3988 return (FONTP (object
) ? Qt
: Qnil
);
3989 if (EQ (extra_type
, Qfont_spec
))
3990 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3991 if (EQ (extra_type
, Qfont_entity
))
3992 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3993 if (EQ (extra_type
, Qfont_object
))
3994 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3995 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3998 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3999 doc
: /* Return a newly created font-spec with arguments as properties.
4001 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
4002 valid font property name listed below:
4004 `:family', `:weight', `:slant', `:width'
4006 They are the same as face attributes of the same name. See
4007 `set-face-attribute'.
4011 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
4015 VALUE must be a string or a symbol specifying the additional
4016 typographic style information of a font, e.g. ``sans''.
4020 VALUE must be a string or a symbol specifying the charset registry and
4021 encoding of a font, e.g. ``iso8859-1''.
4025 VALUE must be a non-negative integer or a floating point number
4026 specifying the font size. It specifies the font size in pixels (if
4027 VALUE is an integer), or in points (if VALUE is a float).
4031 VALUE must be a string of XLFD-style or fontconfig-style font name.
4035 VALUE must be a symbol representing a script that the font must
4036 support. It may be a symbol representing a subgroup of a script
4037 listed in the variable `script-representative-chars'.
4041 VALUE must be a symbol of two-letter ISO-639 language names,
4046 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
4047 required OpenType features.
4049 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
4050 LANGSYS-TAG: OpenType language system tag symbol,
4051 or nil for the default language system.
4052 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
4053 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
4055 GSUB and GPOS may contain `nil' element. In such a case, the font
4056 must not have any of the remaining elements.
4058 For instance, if the VALUE is `(thai nil nil (mark))', the font must
4059 be an OpenType font, and whose GPOS table of `thai' script's default
4060 language system must contain `mark' feature.
4062 usage: (font-spec ARGS...) */)
4067 Lisp_Object spec
= font_make_spec ();
4070 for (i
= 0; i
< nargs
; i
+= 2)
4072 Lisp_Object key
= args
[i
], val
;
4076 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
4079 if (EQ (key
, QCname
))
4082 font_parse_name ((char *) SDATA (val
), spec
);
4083 font_put_extra (spec
, key
, val
);
4087 int idx
= get_font_prop_index (key
);
4091 val
= font_prop_validate (idx
, Qnil
, val
);
4092 if (idx
< FONT_EXTRA_INDEX
)
4093 ASET (spec
, idx
, val
);
4095 font_put_extra (spec
, key
, val
);
4098 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
4104 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
4105 doc
: /* Return a copy of FONT as a font-spec. */)
4109 Lisp_Object new_spec
, tail
, prev
, extra
;
4113 new_spec
= font_make_spec ();
4114 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
4115 ASET (new_spec
, i
, AREF (font
, i
));
4116 extra
= Fcopy_sequence (AREF (font
, FONT_EXTRA_INDEX
));
4117 /* We must remove :font-entity property. */
4118 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
4119 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
4122 extra
= XCDR (extra
);
4124 XSETCDR (prev
, XCDR (tail
));
4127 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
4131 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
4132 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
4133 Every specified properties in FROM override the corresponding
4134 properties in TO. */)
4136 Lisp_Object from
, to
;
4138 Lisp_Object extra
, tail
;
4143 to
= Fcopy_font_spec (to
);
4144 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
4145 ASET (to
, i
, AREF (from
, i
));
4146 extra
= AREF (to
, FONT_EXTRA_INDEX
);
4147 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
4148 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
4150 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
4153 XSETCDR (slot
, XCDR (XCAR (tail
)));
4155 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
4157 ASET (to
, FONT_EXTRA_INDEX
, extra
);
4161 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
4162 doc
: /* Return the value of FONT's property KEY.
4163 FONT is a font-spec, a font-entity, or a font-object.
4164 KEY must be one of these symbols:
4165 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4166 :size, :name, :script
4167 See the documentation of `font-spec' for their meanings.
4168 If FONT is a font-entity or font-object, the value of :script may be
4169 a list of scripts that are supported by the font. */)
4171 Lisp_Object font
, key
;
4178 idx
= get_font_prop_index (key
);
4179 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4180 return font_style_symbolic (font
, idx
, 0);
4181 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4182 return AREF (font
, idx
);
4183 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
4186 #ifdef HAVE_WINDOW_SYSTEM
4188 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4189 doc
: /* Return a plist of face attributes generated by FONT.
4190 FONT is a font name, a font-spec, a font-entity, or a font-object.
4191 The return value is a list of the form
4193 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4195 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4196 compatible with `set-face-attribute'. Some of these key-attribute pairs
4197 may be omitted from the list if they are not specified by FONT.
4199 The optional argument FRAME specifies the frame that the face attributes
4200 are to be displayed on. If omitted, the selected frame is used. */)
4202 Lisp_Object font
, frame
;
4205 Lisp_Object plist
[10];
4210 frame
= selected_frame
;
4211 CHECK_LIVE_FRAME (frame
);
4216 int fontset
= fs_query_fontset (font
, 0);
4217 Lisp_Object name
= font
;
4219 font
= fontset_ascii (fontset
);
4220 font
= font_spec_from_name (name
);
4222 signal_error ("Invalid font name", name
);
4224 else if (! FONTP (font
))
4225 signal_error ("Invalid font object", font
);
4227 val
= AREF (font
, FONT_FAMILY_INDEX
);
4230 plist
[n
++] = QCfamily
;
4231 plist
[n
++] = SYMBOL_NAME (val
);
4234 val
= AREF (font
, FONT_SIZE_INDEX
);
4237 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4238 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4239 plist
[n
++] = QCheight
;
4240 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4242 else if (FLOATP (val
))
4244 plist
[n
++] = QCheight
;
4245 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4248 val
= FONT_WEIGHT_FOR_FACE (font
);
4251 plist
[n
++] = QCweight
;
4255 val
= FONT_SLANT_FOR_FACE (font
);
4258 plist
[n
++] = QCslant
;
4262 val
= FONT_WIDTH_FOR_FACE (font
);
4265 plist
[n
++] = QCwidth
;
4269 return Flist (n
, plist
);
4274 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4275 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
4276 (font_spec
, prop
, val
)
4277 Lisp_Object font_spec
, prop
, val
;
4281 CHECK_FONT_SPEC (font_spec
);
4282 idx
= get_font_prop_index (prop
);
4283 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4284 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
4286 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
4290 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4291 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4292 Optional 2nd argument FRAME specifies the target frame.
4293 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4294 Optional 4th argument PREFER, if non-nil, is a font-spec to
4295 control the order of the returned list. Fonts are sorted by
4296 how close they are to PREFER. */)
4297 (font_spec
, frame
, num
, prefer
)
4298 Lisp_Object font_spec
, frame
, num
, prefer
;
4300 Lisp_Object vec
, list
;
4304 frame
= selected_frame
;
4305 CHECK_LIVE_FRAME (frame
);
4306 CHECK_FONT_SPEC (font_spec
);
4314 if (! NILP (prefer
))
4315 CHECK_FONT_SPEC (prefer
);
4317 list
= font_list_entities (frame
, font_spec
);
4320 if (NILP (XCDR (list
))
4321 && ASIZE (XCAR (list
)) == 1)
4322 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4324 if (! NILP (prefer
))
4325 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4327 vec
= font_vconcat_entity_vectors (list
);
4328 if (n
== 0 || n
>= ASIZE (vec
))
4330 Lisp_Object args
[2];
4334 list
= Fappend (2, args
);
4338 for (list
= Qnil
, n
--; n
>= 0; n
--)
4339 list
= Fcons (AREF (vec
, n
), list
);
4344 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4345 doc
: /* List available font families on the current frame.
4346 Optional argument FRAME, if non-nil, specifies the target frame. */)
4351 struct font_driver_list
*driver_list
;
4355 frame
= selected_frame
;
4356 CHECK_LIVE_FRAME (frame
);
4359 for (driver_list
= f
->font_driver_list
; driver_list
;
4360 driver_list
= driver_list
->next
)
4361 if (driver_list
->driver
->list_family
)
4363 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4364 Lisp_Object tail
= list
;
4366 for (; CONSP (val
); val
= XCDR (val
))
4367 if (NILP (Fmemq (XCAR (val
), tail
))
4368 && SYMBOLP (XCAR (val
)))
4369 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4374 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4375 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4376 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4378 Lisp_Object font_spec
, frame
;
4380 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4387 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4388 doc
: /* Return XLFD name of FONT.
4389 FONT is a font-spec, font-entity, or font-object.
4390 If the name is too long for XLFD (maximum 255 chars), return nil.
4391 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4392 the consecutive wildcards are folded to one. */)
4393 (font
, fold_wildcards
)
4394 Lisp_Object font
, fold_wildcards
;
4401 if (FONT_OBJECT_P (font
))
4403 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4405 if (STRINGP (font_name
)
4406 && SDATA (font_name
)[0] == '-')
4408 if (NILP (fold_wildcards
))
4410 strcpy (name
, (char *) SDATA (font_name
));
4413 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4415 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4418 if (! NILP (fold_wildcards
))
4420 char *p0
= name
, *p1
;
4422 while ((p1
= strstr (p0
, "-*-*")))
4424 strcpy (p1
, p1
+ 2);
4429 return build_string (name
);
4432 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4433 doc
: /* Clear font cache. */)
4436 Lisp_Object list
, frame
;
4438 FOR_EACH_FRAME (list
, frame
)
4440 FRAME_PTR f
= XFRAME (frame
);
4441 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4443 for (; driver_list
; driver_list
= driver_list
->next
)
4444 if (driver_list
->on
)
4446 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4451 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4453 font_assert (! NILP (val
));
4454 val
= XCDR (XCAR (val
));
4455 if (XINT (XCAR (val
)) == 0)
4457 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4458 XSETCDR (cache
, XCDR (val
));
4468 font_fill_lglyph_metrics (glyph
, font_object
)
4469 Lisp_Object glyph
, font_object
;
4471 struct font
*font
= XFONT_OBJECT (font_object
);
4473 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4474 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4475 struct font_metrics metrics
;
4477 LGLYPH_SET_CODE (glyph
, ecode
);
4479 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4480 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4481 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4482 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4483 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4484 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4488 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4489 doc
: /* Shape the glyph-string GSTRING.
4490 Shaping means substituting glyphs and/or adjusting positions of glyphs
4491 to get the correct visual image of character sequences set in the
4492 header of the glyph-string.
4494 If the shaping was successful, the value is GSTRING itself or a newly
4495 created glyph-string. Otherwise, the value is nil. */)
4497 Lisp_Object gstring
;
4500 Lisp_Object font_object
, n
, glyph
;
4503 if (! composition_gstring_p (gstring
))
4504 signal_error ("Invalid glyph-string: ", gstring
);
4505 if (! NILP (LGSTRING_ID (gstring
)))
4507 font_object
= LGSTRING_FONT (gstring
);
4508 CHECK_FONT_OBJECT (font_object
);
4509 font
= XFONT_OBJECT (font_object
);
4510 if (! font
->driver
->shape
)
4513 /* Try at most three times with larger gstring each time. */
4514 for (i
= 0; i
< 3; i
++)
4516 n
= font
->driver
->shape (gstring
);
4519 gstring
= larger_vector (gstring
,
4520 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4523 if (i
== 3 || XINT (n
) == 0)
4526 glyph
= LGSTRING_GLYPH (gstring
, 0);
4527 from
= LGLYPH_FROM (glyph
);
4528 to
= LGLYPH_TO (glyph
);
4529 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4531 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4535 if (NILP (LGLYPH_ADJUSTMENT (this)))
4540 glyph
= LGSTRING_GLYPH (gstring
, j
);
4541 LGLYPH_SET_FROM (glyph
, from
);
4542 LGLYPH_SET_TO (glyph
, to
);
4544 from
= LGLYPH_FROM (this);
4545 to
= LGLYPH_TO (this);
4550 if (from
> LGLYPH_FROM (this))
4551 from
= LGLYPH_FROM (this);
4552 if (to
< LGLYPH_TO (this))
4553 to
= LGLYPH_TO (this);
4559 glyph
= LGSTRING_GLYPH (gstring
, j
);
4560 LGLYPH_SET_FROM (glyph
, from
);
4561 LGLYPH_SET_TO (glyph
, to
);
4563 return composition_gstring_put_cache (gstring
, XINT (n
));
4566 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4568 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4569 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4571 VARIATION-SELECTOR is a chracter code of variation selection
4572 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4573 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4574 (font_object
, character
)
4575 Lisp_Object font_object
, character
;
4577 unsigned variations
[256];
4582 CHECK_FONT_OBJECT (font_object
);
4583 CHECK_CHARACTER (character
);
4584 font
= XFONT_OBJECT (font_object
);
4585 if (! font
->driver
->get_variation_glyphs
)
4587 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4591 for (i
= 0; i
< 255; i
++)
4595 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4596 /* Stops GCC whining about limited range of data type. */
4597 EMACS_INT var
= variations
[i
];
4599 if (var
> MOST_POSITIVE_FIXNUM
)
4600 code
= Fcons (make_number ((variations
[i
]) >> 16),
4601 make_number ((variations
[i
]) & 0xFFFF));
4603 code
= make_number (variations
[i
]);
4604 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4611 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4612 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4613 OTF-FEATURES specifies which features to apply in this format:
4614 (SCRIPT LANGSYS GSUB GPOS)
4616 SCRIPT is a symbol specifying a script tag of OpenType,
4617 LANGSYS is a symbol specifying a langsys tag of OpenType,
4618 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4620 If LANGYS is nil, the default langsys is selected.
4622 The features are applied in the order they appear in the list. The
4623 symbol `*' means to apply all available features not present in this
4624 list, and the remaining features are ignored. For instance, (vatu
4625 pstf * haln) is to apply vatu and pstf in this order, then to apply
4626 all available features other than vatu, pstf, and haln.
4628 The features are applied to the glyphs in the range FROM and TO of
4629 the glyph-string GSTRING-IN.
4631 If some feature is actually applicable, the resulting glyphs are
4632 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4633 this case, the value is the number of produced glyphs.
4635 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4638 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4639 produced in GSTRING-OUT, and the value is nil.
4641 See the documentation of `font-make-gstring' for the format of
4643 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4644 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4646 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4651 check_otf_features (otf_features
);
4652 CHECK_FONT_OBJECT (font_object
);
4653 font
= XFONT_OBJECT (font_object
);
4654 if (! font
->driver
->otf_drive
)
4655 error ("Font backend %s can't drive OpenType GSUB table",
4656 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4657 CHECK_CONS (otf_features
);
4658 CHECK_SYMBOL (XCAR (otf_features
));
4659 val
= XCDR (otf_features
);
4660 CHECK_SYMBOL (XCAR (val
));
4661 val
= XCDR (otf_features
);
4664 len
= check_gstring (gstring_in
);
4665 CHECK_VECTOR (gstring_out
);
4666 CHECK_NATNUM (from
);
4668 CHECK_NATNUM (index
);
4670 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4671 args_out_of_range_3 (from
, to
, make_number (len
));
4672 if (XINT (index
) >= ASIZE (gstring_out
))
4673 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4674 num
= font
->driver
->otf_drive (font
, otf_features
,
4675 gstring_in
, XINT (from
), XINT (to
),
4676 gstring_out
, XINT (index
), 0);
4679 return make_number (num
);
4682 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4684 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4685 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4687 (SCRIPT LANGSYS FEATURE ...)
4688 See the documentation of `font-drive-otf' for more detail.
4690 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4691 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4692 character code corresponding to the glyph or nil if there's no
4693 corresponding character. */)
4694 (font_object
, character
, otf_features
)
4695 Lisp_Object font_object
, character
, otf_features
;
4698 Lisp_Object gstring_in
, gstring_out
, g
;
4699 Lisp_Object alternates
;
4702 CHECK_FONT_GET_OBJECT (font_object
, font
);
4703 if (! font
->driver
->otf_drive
)
4704 error ("Font backend %s can't drive OpenType GSUB table",
4705 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4706 CHECK_CHARACTER (character
);
4707 CHECK_CONS (otf_features
);
4709 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4710 g
= LGSTRING_GLYPH (gstring_in
, 0);
4711 LGLYPH_SET_CHAR (g
, XINT (character
));
4712 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4713 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4714 gstring_out
, 0, 1)) < 0)
4715 gstring_out
= Ffont_make_gstring (font_object
,
4716 make_number (ASIZE (gstring_out
) * 2));
4718 for (i
= 0; i
< num
; i
++)
4720 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4721 int c
= LGLYPH_CHAR (g
);
4722 unsigned code
= LGLYPH_CODE (g
);
4724 alternates
= Fcons (Fcons (make_number (code
),
4725 c
> 0 ? make_number (c
) : Qnil
),
4728 return Fnreverse (alternates
);
4734 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4735 doc
: /* Open FONT-ENTITY. */)
4736 (font_entity
, size
, frame
)
4737 Lisp_Object font_entity
;
4743 CHECK_FONT_ENTITY (font_entity
);
4745 frame
= selected_frame
;
4746 CHECK_LIVE_FRAME (frame
);
4749 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4752 CHECK_NUMBER_OR_FLOAT (size
);
4754 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4756 isize
= XINT (size
);
4760 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4763 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4764 doc
: /* Close FONT-OBJECT. */)
4765 (font_object
, frame
)
4766 Lisp_Object font_object
, frame
;
4768 CHECK_FONT_OBJECT (font_object
);
4770 frame
= selected_frame
;
4771 CHECK_LIVE_FRAME (frame
);
4772 font_close_object (XFRAME (frame
), font_object
);
4776 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4777 doc
: /* Return information about FONT-OBJECT.
4778 The value is a vector:
4779 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4782 NAME is a string of the font name (or nil if the font backend doesn't
4785 FILENAME is a string of the font file (or nil if the font backend
4786 doesn't provide a file name).
4788 PIXEL-SIZE is a pixel size by which the font is opened.
4790 SIZE is a maximum advance width of the font in pixels.
4792 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4795 CAPABILITY is a list whose first element is a symbol representing the
4796 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4797 remaining elements describe the details of the font capability.
4799 If the font is OpenType font, the form of the list is
4800 \(opentype GSUB GPOS)
4801 where GSUB shows which "GSUB" features the font supports, and GPOS
4802 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4803 lists of the format:
4804 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4806 If the font is not OpenType font, currently the length of the form is
4809 SCRIPT is a symbol representing OpenType script tag.
4811 LANGSYS is a symbol representing OpenType langsys tag, or nil
4812 representing the default langsys.
4814 FEATURE is a symbol representing OpenType feature tag.
4816 If the font is not OpenType font, CAPABILITY is nil. */)
4818 Lisp_Object font_object
;
4823 CHECK_FONT_GET_OBJECT (font_object
, font
);
4825 val
= Fmake_vector (make_number (9), Qnil
);
4826 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4827 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4828 ASET (val
, 2, make_number (font
->pixel_size
));
4829 ASET (val
, 3, make_number (font
->max_width
));
4830 ASET (val
, 4, make_number (font
->ascent
));
4831 ASET (val
, 5, make_number (font
->descent
));
4832 ASET (val
, 6, make_number (font
->space_width
));
4833 ASET (val
, 7, make_number (font
->average_width
));
4834 if (font
->driver
->otf_capability
)
4835 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4839 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4840 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4841 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4842 (font_object
, string
)
4843 Lisp_Object font_object
, string
;
4849 CHECK_FONT_GET_OBJECT (font_object
, font
);
4850 CHECK_STRING (string
);
4851 len
= SCHARS (string
);
4852 vec
= Fmake_vector (make_number (len
), Qnil
);
4853 for (i
= 0; i
< len
; i
++)
4855 Lisp_Object ch
= Faref (string
, make_number (i
));
4860 struct font_metrics metrics
;
4862 cod
= code
= font
->driver
->encode_char (font
, c
);
4863 if (code
== FONT_INVALID_CODE
)
4865 val
= Fmake_vector (make_number (6), Qnil
);
4866 if (cod
<= MOST_POSITIVE_FIXNUM
)
4867 ASET (val
, 0, make_number (code
));
4869 ASET (val
, 0, Fcons (make_number (code
>> 16),
4870 make_number (code
& 0xFFFF)));
4871 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4872 ASET (val
, 1, make_number (metrics
.lbearing
));
4873 ASET (val
, 2, make_number (metrics
.rbearing
));
4874 ASET (val
, 3, make_number (metrics
.width
));
4875 ASET (val
, 4, make_number (metrics
.ascent
));
4876 ASET (val
, 5, make_number (metrics
.descent
));
4882 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4883 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4884 FONT is a font-spec, font-entity, or font-object. */)
4886 Lisp_Object spec
, font
;
4888 CHECK_FONT_SPEC (spec
);
4891 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4894 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4895 doc
: /* Return a font-object for displaying a character at POSITION.
4896 Optional second arg WINDOW, if non-nil, is a window displaying
4897 the current buffer. It defaults to the currently selected window. */)
4898 (position
, window
, string
)
4899 Lisp_Object position
, window
, string
;
4906 CHECK_NUMBER_COERCE_MARKER (position
);
4907 pos
= XINT (position
);
4908 if (pos
< BEGV
|| pos
>= ZV
)
4909 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4913 CHECK_NUMBER (position
);
4914 CHECK_STRING (string
);
4915 pos
= XINT (position
);
4916 if (pos
< 0 || pos
>= SCHARS (string
))
4917 args_out_of_range (string
, position
);
4920 window
= selected_window
;
4921 CHECK_LIVE_WINDOW (window
);
4922 w
= XWINDOW (window
);
4924 return font_at (-1, pos
, NULL
, w
, string
);
4928 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4929 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4930 The value is a number of glyphs drawn.
4931 Type C-l to recover what previously shown. */)
4932 (font_object
, string
)
4933 Lisp_Object font_object
, string
;
4935 Lisp_Object frame
= selected_frame
;
4936 FRAME_PTR f
= XFRAME (frame
);
4942 CHECK_FONT_GET_OBJECT (font_object
, font
);
4943 CHECK_STRING (string
);
4944 len
= SCHARS (string
);
4945 code
= alloca (sizeof (unsigned) * len
);
4946 for (i
= 0; i
< len
; i
++)
4948 Lisp_Object ch
= Faref (string
, make_number (i
));
4952 code
[i
] = font
->driver
->encode_char (font
, c
);
4953 if (code
[i
] == FONT_INVALID_CODE
)
4956 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4958 if (font
->driver
->prepare_face
)
4959 font
->driver
->prepare_face (f
, face
);
4960 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4961 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4962 if (font
->driver
->done_face
)
4963 font
->driver
->done_face (f
, face
);
4965 return make_number (len
);
4969 #endif /* FONT_DEBUG */
4971 #ifdef HAVE_WINDOW_SYSTEM
4973 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4974 doc
: /* Return information about a font named NAME on frame FRAME.
4975 If FRAME is omitted or nil, use the selected frame.
4976 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4977 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4979 OPENED-NAME is the name used for opening the font,
4980 FULL-NAME is the full name of the font,
4981 SIZE is the pixelsize of the font,
4982 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4983 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4984 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4985 how to compose characters.
4986 If the named font is not yet loaded, return nil. */)
4988 Lisp_Object name
, frame
;
4993 Lisp_Object font_object
;
4995 (*check_window_system_func
) ();
4998 CHECK_STRING (name
);
5000 frame
= selected_frame
;
5001 CHECK_LIVE_FRAME (frame
);
5006 int fontset
= fs_query_fontset (name
, 0);
5009 name
= fontset_ascii (fontset
);
5010 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
5012 else if (FONT_OBJECT_P (name
))
5014 else if (FONT_ENTITY_P (name
))
5015 font_object
= font_open_entity (f
, name
, 0);
5018 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5019 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
5021 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
5023 if (NILP (font_object
))
5025 font
= XFONT_OBJECT (font_object
);
5027 info
= Fmake_vector (make_number (7), Qnil
);
5028 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
5029 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
5030 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
5031 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
5032 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
5033 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
5034 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
5037 /* As font_object is still in FONT_OBJLIST of the entity, we can't
5038 close it now. Perhaps, we should manage font-objects
5039 by `reference-count'. */
5040 font_close_object (f
, font_object
);
5047 #define BUILD_STYLE_TABLE(TBL) \
5048 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
5051 build_style_table (entry
, nelement
)
5052 struct table_entry
*entry
;
5056 Lisp_Object table
, elt
;
5058 table
= Fmake_vector (make_number (nelement
), Qnil
);
5059 for (i
= 0; i
< nelement
; i
++)
5061 for (j
= 0; entry
[i
].names
[j
]; j
++);
5062 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
5063 ASET (elt
, 0, make_number (entry
[i
].numeric
));
5064 for (j
= 0; entry
[i
].names
[j
]; j
++)
5065 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
5066 ASET (table
, i
, elt
);
5071 Lisp_Object Vfont_log
;
5073 /* The deferred font-log data of the form [ACTION ARG RESULT].
5074 If ACTION is not nil, that is added to the log when font_add_log is
5075 called next time. At that time, ACTION is set back to nil. */
5076 static Lisp_Object Vfont_log_deferred
;
5078 /* Prepend the font-related logging data in Vfont_log if it is not
5079 `t'. ACTION describes a kind of font-related action (e.g. listing,
5080 opening), ARG is the argument for the action, and RESULT is the
5081 result of the action. */
5083 font_add_log (action
, arg
, result
)
5085 Lisp_Object arg
, result
;
5087 Lisp_Object tail
, val
;
5090 if (EQ (Vfont_log
, Qt
))
5092 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5094 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
5096 ASET (Vfont_log_deferred
, 0, Qnil
);
5097 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5098 AREF (Vfont_log_deferred
, 2));
5103 Lisp_Object tail
, elt
;
5104 Lisp_Object equalstr
= build_string ("=");
5106 val
= Ffont_xlfd_name (arg
, Qt
);
5107 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5111 if (EQ (XCAR (elt
), QCscript
)
5112 && SYMBOLP (XCDR (elt
)))
5113 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5114 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5115 else if (EQ (XCAR (elt
), QClang
)
5116 && SYMBOLP (XCDR (elt
)))
5117 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5118 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5119 else if (EQ (XCAR (elt
), QCotf
)
5120 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5121 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5123 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5129 && VECTORP (XCAR (result
))
5130 && ASIZE (XCAR (result
)) > 0
5131 && FONTP (AREF (XCAR (result
), 0)))
5132 result
= font_vconcat_entity_vectors (result
);
5135 val
= Ffont_xlfd_name (result
, Qt
);
5136 if (! FONT_SPEC_P (result
))
5137 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5138 build_string (":"), val
);
5141 else if (CONSP (result
))
5143 result
= Fcopy_sequence (result
);
5144 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5148 val
= Ffont_xlfd_name (val
, Qt
);
5149 XSETCAR (tail
, val
);
5152 else if (VECTORP (result
))
5154 result
= Fcopy_sequence (result
);
5155 for (i
= 0; i
< ASIZE (result
); i
++)
5157 val
= AREF (result
, i
);
5159 val
= Ffont_xlfd_name (val
, Qt
);
5160 ASET (result
, i
, val
);
5163 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5166 /* Record a font-related logging data to be added to Vfont_log when
5167 font_add_log is called next time. ACTION, ARG, RESULT are the same
5171 font_deferred_log (action
, arg
, result
)
5173 Lisp_Object arg
, result
;
5175 if (EQ (Vfont_log
, Qt
))
5177 ASET (Vfont_log_deferred
, 0, build_string (action
));
5178 ASET (Vfont_log_deferred
, 1, arg
);
5179 ASET (Vfont_log_deferred
, 2, result
);
5182 extern void syms_of_ftfont
P_ (());
5183 extern void syms_of_xfont
P_ (());
5184 extern void syms_of_xftfont
P_ (());
5185 extern void syms_of_ftxfont
P_ (());
5186 extern void syms_of_bdffont
P_ (());
5187 extern void syms_of_w32font
P_ (());
5188 extern void syms_of_atmfont
P_ (());
5189 extern void syms_of_nsfont
P_ (());
5194 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5195 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5196 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5197 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5198 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5199 /* Note that the other elements in sort_shift_bits are not used. */
5201 staticpro (&font_charset_alist
);
5202 font_charset_alist
= Qnil
;
5204 DEFSYM (Qopentype
, "opentype");
5206 DEFSYM (Qascii_0
, "ascii-0");
5207 DEFSYM (Qiso8859_1
, "iso8859-1");
5208 DEFSYM (Qiso10646_1
, "iso10646-1");
5209 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5210 DEFSYM (Qunicode_sip
, "unicode-sip");
5214 DEFSYM (QCotf
, ":otf");
5215 DEFSYM (QClang
, ":lang");
5216 DEFSYM (QCscript
, ":script");
5217 DEFSYM (QCantialias
, ":antialias");
5219 DEFSYM (QCfoundry
, ":foundry");
5220 DEFSYM (QCadstyle
, ":adstyle");
5221 DEFSYM (QCregistry
, ":registry");
5222 DEFSYM (QCspacing
, ":spacing");
5223 DEFSYM (QCdpi
, ":dpi");
5224 DEFSYM (QCscalable
, ":scalable");
5225 DEFSYM (QCavgwidth
, ":avgwidth");
5226 DEFSYM (QCfont_entity
, ":font-entity");
5227 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5237 staticpro (&null_vector
);
5238 null_vector
= Fmake_vector (make_number (0), Qnil
);
5240 staticpro (&scratch_font_spec
);
5241 scratch_font_spec
= Ffont_spec (0, NULL
);
5242 staticpro (&scratch_font_prefer
);
5243 scratch_font_prefer
= Ffont_spec (0, NULL
);
5245 staticpro (&Vfont_log_deferred
);
5246 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5250 staticpro (&otf_list
);
5252 #endif /* HAVE_LIBOTF */
5256 defsubr (&Sfont_spec
);
5257 defsubr (&Sfont_get
);
5258 #ifdef HAVE_WINDOW_SYSTEM
5259 defsubr (&Sfont_face_attributes
);
5261 defsubr (&Sfont_put
);
5262 defsubr (&Slist_fonts
);
5263 defsubr (&Sfont_family_list
);
5264 defsubr (&Sfind_font
);
5265 defsubr (&Sfont_xlfd_name
);
5266 defsubr (&Sclear_font_cache
);
5267 defsubr (&Sfont_shape_gstring
);
5268 defsubr (&Sfont_variation_glyphs
);
5270 defsubr (&Sfont_drive_otf
);
5271 defsubr (&Sfont_otf_alternates
);
5275 defsubr (&Sopen_font
);
5276 defsubr (&Sclose_font
);
5277 defsubr (&Squery_font
);
5278 defsubr (&Sget_font_glyphs
);
5279 defsubr (&Sfont_match_p
);
5280 defsubr (&Sfont_at
);
5282 defsubr (&Sdraw_string
);
5284 #endif /* FONT_DEBUG */
5285 #ifdef HAVE_WINDOW_SYSTEM
5286 defsubr (&Sfont_info
);
5289 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5291 Alist of fontname patterns vs the corresponding encoding and repertory info.
5292 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5293 where ENCODING is a charset or a char-table,
5294 and REPERTORY is a charset, a char-table, or nil.
5296 If ENCODING and REPERTORY are the same, the element can have the form
5297 \(REGEXP . ENCODING).
5299 ENCODING is for converting a character to a glyph code of the font.
5300 If ENCODING is a charset, encoding a character by the charset gives
5301 the corresponding glyph code. If ENCODING is a char-table, looking up
5302 the table by a character gives the corresponding glyph code.
5304 REPERTORY specifies a repertory of characters supported by the font.
5305 If REPERTORY is a charset, all characters beloging to the charset are
5306 supported. If REPERTORY is a char-table, all characters who have a
5307 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5308 gets the repertory information by an opened font and ENCODING. */);
5309 Vfont_encoding_alist
= Qnil
;
5311 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5312 doc
: /* Vector of valid font weight values.
5313 Each element has the form:
5314 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5315 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5316 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5318 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5319 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5320 See `font-weight-table' for the format of the vector. */);
5321 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5323 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5324 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5325 See `font-weight-table' for the format of the vector. */);
5326 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5328 staticpro (&font_style_table
);
5329 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5330 ASET (font_style_table
, 0, Vfont_weight_table
);
5331 ASET (font_style_table
, 1, Vfont_slant_table
);
5332 ASET (font_style_table
, 2, Vfont_width_table
);
5334 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5335 *Logging list of font related actions and results.
5336 The value t means to suppress the logging.
5337 The initial value is set to nil if the environment variable
5338 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5341 #ifdef HAVE_WINDOW_SYSTEM
5342 #ifdef HAVE_FREETYPE
5344 #ifdef HAVE_X_WINDOWS
5349 #endif /* HAVE_XFT */
5350 #endif /* HAVE_X_WINDOWS */
5351 #else /* not HAVE_FREETYPE */
5352 #ifdef HAVE_X_WINDOWS
5354 #endif /* HAVE_X_WINDOWS */
5355 #endif /* not HAVE_FREETYPE */
5358 #endif /* HAVE_BDFFONT */
5361 #endif /* WINDOWSNT */
5364 #endif /* HAVE_NS */
5365 #endif /* HAVE_WINDOW_SYSTEM */
5371 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
5374 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5375 (do not change this comment) */