1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
3 Copyright (C) 2006, 2007, 2008, 2009
4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H13PRO009
7 This file is part of GNU Emacs.
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
31 #include "dispextern.h"
33 #include "character.h"
34 #include "composite.h"
40 #endif /* HAVE_X_WINDOWS */
44 #endif /* HAVE_NTGUI */
51 extern Lisp_Object Qfontsize
;
54 Lisp_Object Qopentype
;
56 /* Important character set strings. */
57 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
60 #define DEFAULT_ENCODING Qiso10646_1
62 #define DEFAULT_ENCODING Qiso8859_1
65 /* Unicode category `Cf'. */
66 static Lisp_Object QCf
;
68 /* Special vector of zero length. This is repeatedly used by (struct
69 font_driver *)->list when a specified font is not found. */
70 static Lisp_Object null_vector
;
72 static Lisp_Object Vfont_weight_table
, Vfont_slant_table
, Vfont_width_table
;
74 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
75 static Lisp_Object font_style_table
;
77 /* Structure used for tables mapping weight, slant, and width numeric
78 values and their names. */
83 /* The first one is a valid name as a face attribute.
84 The second one (if any) is a typical name in XLFD field. */
89 /* Table of weight numeric values and their names. This table must be
90 sorted by numeric values in ascending order. */
92 static struct table_entry weight_table
[] =
95 { 20, { "ultra-light", "ultralight" }},
96 { 40, { "extra-light", "extralight" }},
98 { 75, { "semi-light", "semilight", "demilight", "book" }},
99 { 100, { "normal", "medium", "regular", "unspecified" }},
100 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
102 { 205, { "extra-bold", "extrabold" }},
103 { 210, { "ultra-bold", "ultrabold", "black" }}
106 /* Table of slant numeric values and their names. This table must be
107 sorted by numeric values in ascending order. */
109 static struct table_entry slant_table
[] =
111 { 0, { "reverse-oblique", "ro" }},
112 { 10, { "reverse-italic", "ri" }},
113 { 100, { "normal", "r", "unspecified" }},
114 { 200, { "italic" ,"i", "ot" }},
115 { 210, { "oblique", "o" }}
118 /* Table of width numeric values and their names. This table must be
119 sorted by numeric values in ascending order. */
121 static struct table_entry width_table
[] =
123 { 50, { "ultra-condensed", "ultracondensed" }},
124 { 63, { "extra-condensed", "extracondensed" }},
125 { 75, { "condensed", "compressed", "narrow" }},
126 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
127 { 100, { "normal", "medium", "regular", "unspecified" }},
128 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
129 { 125, { "expanded" }},
130 { 150, { "extra-expanded", "extraexpanded" }},
131 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
134 extern Lisp_Object Qnormal
;
136 /* Symbols representing keys of normal font properties. */
137 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
;
138 extern Lisp_Object QCheight
, QCsize
, QCname
;
140 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
;
141 /* Symbols representing keys of font extra info. */
142 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
143 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
144 /* Symbols representing values of font spacing property. */
145 Lisp_Object Qc
, Qm
, Qp
, Qd
;
146 /* Special ADSTYLE properties to avoid fonts used for Latin
147 characters; used in xfont.c and ftfont.c. */
148 Lisp_Object Qja
, Qko
;
150 Lisp_Object Vfont_encoding_alist
;
152 /* Alist of font registry symbol and the corresponding charsets
153 information. The information is retrieved from
154 Vfont_encoding_alist on demand.
156 Eash element has the form:
157 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
161 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
162 encodes a character code to a glyph code of a font, and
163 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
164 character is supported by a font.
166 The latter form means that the information for REGISTRY couldn't be
168 static Lisp_Object font_charset_alist
;
170 /* List of all font drivers. Each font-backend (XXXfont.c) calls
171 register_font_driver in syms_of_XXXfont to register its font-driver
173 static struct font_driver_list
*font_driver_list
;
177 /* Creaters of font-related Lisp object. */
182 Lisp_Object font_spec
;
183 struct font_spec
*spec
184 = ((struct font_spec
*)
185 allocate_pseudovector (VECSIZE (struct font_spec
),
186 FONT_SPEC_MAX
, PVEC_FONT
));
187 XSETFONT (font_spec
, spec
);
194 Lisp_Object font_entity
;
195 struct font_entity
*entity
196 = ((struct font_entity
*)
197 allocate_pseudovector (VECSIZE (struct font_entity
),
198 FONT_ENTITY_MAX
, PVEC_FONT
));
199 XSETFONT (font_entity
, entity
);
203 /* Create a font-object whose structure size is SIZE. If ENTITY is
204 not nil, copy properties from ENTITY to the font-object. If
205 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
207 font_make_object (size
, entity
, pixelsize
)
212 Lisp_Object font_object
;
214 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
217 XSETFONT (font_object
, font
);
221 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
222 font
->props
[i
] = AREF (entity
, i
);
223 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
224 font
->props
[FONT_EXTRA_INDEX
]
225 = Fcopy_sequence (AREF (entity
, FONT_EXTRA_INDEX
));
228 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
234 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
235 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
236 static Lisp_Object font_matching_entity
P_ ((FRAME_PTR
, Lisp_Object
*,
239 /* Number of registered font drivers. */
240 static int num_font_drivers
;
243 /* Return a Lispy value of a font property value at STR and LEN bytes.
244 If STR is "*", it returns nil.
245 If FORCE_SYMBOL is zero and all characters in STR are digits, it
246 returns an integer. Otherwise, it returns a symbol interned from
250 font_intern_prop (str
, len
, force_symbol
)
260 if (len
== 1 && *str
== '*')
262 if (!force_symbol
&& len
>=1 && isdigit (*str
))
264 for (i
= 1; i
< len
; i
++)
265 if (! isdigit (str
[i
]))
268 return make_number (atoi (str
));
271 /* The following code is copied from the function intern (in
272 lread.c), and modified to suite our purpose. */
274 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
275 obarray
= check_obarray (obarray
);
276 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
277 if (len
== nchars
|| len
!= nbytes
)
278 /* CONTENTS contains no multibyte sequences or contains an invalid
279 multibyte sequence. We'll make a unibyte string. */
280 tem
= oblookup (obarray
, str
, len
, len
);
282 tem
= oblookup (obarray
, str
, nchars
, len
);
285 if (len
== nchars
|| len
!= nbytes
)
286 tem
= make_unibyte_string (str
, len
);
288 tem
= make_multibyte_string (str
, nchars
, len
);
289 return Fintern (tem
, obarray
);
292 /* Return a pixel size of font-spec SPEC on frame F. */
295 font_pixel_size (f
, spec
)
299 #ifdef HAVE_WINDOW_SYSTEM
300 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
309 font_assert (FLOATP (size
));
310 point_size
= XFLOAT_DATA (size
);
311 val
= AREF (spec
, FONT_DPI_INDEX
);
316 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
324 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
325 font vector. If VAL is not valid (i.e. not registered in
326 font_style_table), return -1 if NOERROR is zero, and return a
327 proper index if NOERROR is nonzero. In that case, register VAL in
328 font_style_table if VAL is a symbol, and return a closest index if
329 VAL is an integer. */
332 font_style_to_value (prop
, val
, noerror
)
333 enum font_property_index prop
;
337 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
338 int len
= ASIZE (table
);
344 Lisp_Object args
[2], elt
;
346 /* At first try exact match. */
347 for (i
= 0; i
< len
; i
++)
348 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
349 if (EQ (val
, AREF (AREF (table
, i
), j
)))
350 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
351 | (i
<< 4) | (j
- 1));
352 /* Try also with case-folding match. */
353 s
= SDATA (SYMBOL_NAME (val
));
354 for (i
= 0; i
< len
; i
++)
355 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
357 elt
= AREF (AREF (table
, i
), j
);
358 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
359 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
360 | (i
<< 4) | (j
- 1));
366 elt
= Fmake_vector (make_number (2), make_number (100));
369 args
[1] = Fmake_vector (make_number (1), elt
);
370 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
371 return (100 << 8) | (i
<< 4);
376 int numeric
= XINT (val
);
378 for (i
= 0, last_n
= -1; i
< len
; i
++)
380 int n
= XINT (AREF (AREF (table
, i
), 0));
383 return (n
<< 8) | (i
<< 4);
388 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
389 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
395 return ((last_n
<< 8) | ((i
- 1) << 4));
400 font_style_symbolic (font
, prop
, for_face
)
402 enum font_property_index prop
;
405 Lisp_Object val
= AREF (font
, prop
);
406 Lisp_Object table
, elt
;
411 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
412 i
= XINT (val
) & 0xFF;
413 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
414 elt
= AREF (table
, ((i
>> 4) & 0xF));
415 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
416 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
419 extern Lisp_Object Vface_alternative_font_family_alist
;
421 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
424 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
425 FONTNAME. ENCODING is a charset symbol that specifies the encoding
426 of the font. REPERTORY is a charset symbol or nil. */
429 find_font_encoding (fontname
)
430 Lisp_Object fontname
;
432 Lisp_Object tail
, elt
;
434 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
438 && STRINGP (XCAR (elt
))
439 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
440 && (SYMBOLP (XCDR (elt
))
441 ? CHARSETP (XCDR (elt
))
442 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
448 /* Return encoding charset and repertory charset for REGISTRY in
449 ENCODING and REPERTORY correspondingly. If correct information for
450 REGISTRY is available, return 0. Otherwise return -1. */
453 font_registry_charsets (registry
, encoding
, repertory
)
454 Lisp_Object registry
;
455 struct charset
**encoding
, **repertory
;
458 int encoding_id
, repertory_id
;
460 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
466 encoding_id
= XINT (XCAR (val
));
467 repertory_id
= XINT (XCDR (val
));
471 val
= find_font_encoding (SYMBOL_NAME (registry
));
472 if (SYMBOLP (val
) && CHARSETP (val
))
474 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
476 else if (CONSP (val
))
478 if (! CHARSETP (XCAR (val
)))
480 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
481 if (NILP (XCDR (val
)))
485 if (! CHARSETP (XCDR (val
)))
487 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
492 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
494 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
498 *encoding
= CHARSET_FROM_ID (encoding_id
);
500 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
505 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
510 /* Font property value validaters. See the comment of
511 font_property_table for the meaning of the arguments. */
513 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
514 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
515 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
516 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
517 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
518 static int get_font_prop_index
P_ ((Lisp_Object
));
521 font_prop_validate_symbol (prop
, val
)
522 Lisp_Object prop
, val
;
525 val
= Fintern (val
, Qnil
);
528 else if (EQ (prop
, QCregistry
))
529 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
535 font_prop_validate_style (style
, val
)
536 Lisp_Object style
, val
;
538 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
539 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
546 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
550 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
552 if ((n
& 0xF) + 1 >= ASIZE (elt
))
554 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
558 else if (SYMBOLP (val
))
560 int n
= font_style_to_value (prop
, val
, 0);
562 val
= n
>= 0 ? make_number (n
) : Qerror
;
570 font_prop_validate_non_neg (prop
, val
)
571 Lisp_Object prop
, val
;
573 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
578 font_prop_validate_spacing (prop
, val
)
579 Lisp_Object prop
, val
;
581 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
583 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
585 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
587 if (spacing
== 'c' || spacing
== 'C')
588 return make_number (FONT_SPACING_CHARCELL
);
589 if (spacing
== 'm' || spacing
== 'M')
590 return make_number (FONT_SPACING_MONO
);
591 if (spacing
== 'p' || spacing
== 'P')
592 return make_number (FONT_SPACING_PROPORTIONAL
);
593 if (spacing
== 'd' || spacing
== 'D')
594 return make_number (FONT_SPACING_DUAL
);
600 font_prop_validate_otf (prop
, val
)
601 Lisp_Object prop
, val
;
603 Lisp_Object tail
, tmp
;
606 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
607 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
608 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
611 if (! SYMBOLP (XCAR (val
)))
616 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
618 for (i
= 0; i
< 2; i
++)
625 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
626 if (! SYMBOLP (XCAR (tmp
)))
634 /* Structure of known font property keys and validater of the
638 /* Pointer to the key symbol. */
640 /* Function to validate PROP's value VAL, or NULL if any value is
641 ok. The value is VAL or its regularized value if VAL is valid,
642 and Qerror if not. */
643 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
644 } font_property_table
[] =
645 { { &QCtype
, font_prop_validate_symbol
},
646 { &QCfoundry
, font_prop_validate_symbol
},
647 { &QCfamily
, font_prop_validate_symbol
},
648 { &QCadstyle
, font_prop_validate_symbol
},
649 { &QCregistry
, font_prop_validate_symbol
},
650 { &QCweight
, font_prop_validate_style
},
651 { &QCslant
, font_prop_validate_style
},
652 { &QCwidth
, font_prop_validate_style
},
653 { &QCsize
, font_prop_validate_non_neg
},
654 { &QCdpi
, font_prop_validate_non_neg
},
655 { &QCspacing
, font_prop_validate_spacing
},
656 { &QCavgwidth
, font_prop_validate_non_neg
},
657 /* The order of the above entries must match with enum
658 font_property_index. */
659 { &QClang
, font_prop_validate_symbol
},
660 { &QCscript
, font_prop_validate_symbol
},
661 { &QCotf
, font_prop_validate_otf
}
664 /* Size (number of elements) of the above table. */
665 #define FONT_PROPERTY_TABLE_SIZE \
666 ((sizeof font_property_table) / (sizeof *font_property_table))
668 /* Return an index number of font property KEY or -1 if KEY is not an
669 already known property. */
672 get_font_prop_index (key
)
677 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
678 if (EQ (key
, *font_property_table
[i
].key
))
683 /* Validate the font property. The property key is specified by the
684 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
685 signal an error. The value is VAL or the regularized one. */
688 font_prop_validate (idx
, prop
, val
)
690 Lisp_Object prop
, val
;
692 Lisp_Object validated
;
697 prop
= *font_property_table
[idx
].key
;
700 idx
= get_font_prop_index (prop
);
704 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
705 if (EQ (validated
, Qerror
))
706 signal_error ("invalid font property", Fcons (prop
, val
));
711 /* Store VAL as a value of extra font property PROP in FONT while
712 keeping the sorting order. Don't check the validity of VAL. */
715 font_put_extra (font
, prop
, val
)
716 Lisp_Object font
, prop
, val
;
718 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
719 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
723 Lisp_Object prev
= Qnil
;
728 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
729 prev
= extra
, extra
= XCDR (extra
);
731 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
733 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
738 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
743 /* Font name parser and unparser */
745 static int parse_matrix
P_ ((char *));
746 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
747 static int font_parse_name
P_ ((char *, Lisp_Object
));
749 /* An enumerator for each field of an XLFD font name. */
750 enum xlfd_field_index
769 /* An enumerator for mask bit corresponding to each XLFD field. */
772 XLFD_FOUNDRY_MASK
= 0x0001,
773 XLFD_FAMILY_MASK
= 0x0002,
774 XLFD_WEIGHT_MASK
= 0x0004,
775 XLFD_SLANT_MASK
= 0x0008,
776 XLFD_SWIDTH_MASK
= 0x0010,
777 XLFD_ADSTYLE_MASK
= 0x0020,
778 XLFD_PIXEL_MASK
= 0x0040,
779 XLFD_POINT_MASK
= 0x0080,
780 XLFD_RESX_MASK
= 0x0100,
781 XLFD_RESY_MASK
= 0x0200,
782 XLFD_SPACING_MASK
= 0x0400,
783 XLFD_AVGWIDTH_MASK
= 0x0800,
784 XLFD_REGISTRY_MASK
= 0x1000,
785 XLFD_ENCODING_MASK
= 0x2000
789 /* Parse P pointing the pixel/point size field of the form
790 `[A B C D]' which specifies a transformation matrix:
796 by which all glyphs of the font are transformed. The spec says
797 that scalar value N for the pixel/point size is equivalent to:
798 A = N * resx/resy, B = C = 0, D = N.
800 Return the scalar value N if the form is valid. Otherwise return
811 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
814 matrix
[i
] = - strtod (p
+ 1, &end
);
816 matrix
[i
] = strtod (p
, &end
);
819 return (i
== 4 ? (int) matrix
[3] : -1);
822 /* Expand a wildcard field in FIELD (the first N fields are filled) to
823 multiple fields to fill in all 14 XLFD fields while restring a
824 field position by its contents. */
827 font_expand_wildcards (field
, n
)
828 Lisp_Object field
[XLFD_LAST_INDEX
];
832 Lisp_Object tmp
[XLFD_LAST_INDEX
];
833 /* Array of information about where this element can go. Nth
834 element is for Nth element of FIELD. */
836 /* Minimum possible field. */
838 /* Maxinum possible field. */
840 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
842 } range
[XLFD_LAST_INDEX
];
844 int range_from
, range_to
;
847 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
848 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
849 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
850 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
851 | XLFD_AVGWIDTH_MASK)
852 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
854 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
855 field. The value is shifted to left one bit by one in the
857 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
858 range_mask
= (range_mask
<< 1) | 1;
860 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
861 position-based retriction for FIELD[I]. */
862 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
863 i
++, range_from
++, range_to
++, range_mask
<<= 1)
865 Lisp_Object val
= field
[i
];
871 range
[i
].from
= range_from
;
872 range
[i
].to
= range_to
;
873 range
[i
].mask
= range_mask
;
877 /* The triplet FROM, TO, and MASK is a value-based
878 retriction for FIELD[I]. */
884 int numeric
= XINT (val
);
887 from
= to
= XLFD_ENCODING_INDEX
,
888 mask
= XLFD_ENCODING_MASK
;
889 else if (numeric
== 0)
890 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
891 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
892 else if (numeric
<= 48)
893 from
= to
= XLFD_PIXEL_INDEX
,
894 mask
= XLFD_PIXEL_MASK
;
896 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
897 mask
= XLFD_LARGENUM_MASK
;
899 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
900 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
901 mask
= XLFD_NULL_MASK
;
903 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
906 Lisp_Object name
= SYMBOL_NAME (val
);
908 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
909 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
910 mask
= XLFD_REGENC_MASK
;
912 from
= to
= XLFD_ENCODING_INDEX
,
913 mask
= XLFD_ENCODING_MASK
;
915 else if (range_from
<= XLFD_WEIGHT_INDEX
916 && range_to
>= XLFD_WEIGHT_INDEX
917 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
918 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
919 else if (range_from
<= XLFD_SLANT_INDEX
920 && range_to
>= XLFD_SLANT_INDEX
921 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
922 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
923 else if (range_from
<= XLFD_SWIDTH_INDEX
924 && range_to
>= XLFD_SWIDTH_INDEX
925 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
926 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
929 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
930 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
932 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
933 mask
= XLFD_SYMBOL_MASK
;
936 /* Merge position-based and value-based restrictions. */
938 while (from
< range_from
)
939 mask
&= ~(1 << from
++);
940 while (from
< 14 && ! (mask
& (1 << from
)))
942 while (to
> range_to
)
943 mask
&= ~(1 << to
--);
944 while (to
>= 0 && ! (mask
& (1 << to
)))
948 range
[i
].from
= from
;
950 range
[i
].mask
= mask
;
952 if (from
> range_from
|| to
< range_to
)
954 /* The range is narrowed by value-based restrictions.
955 Reflect it to the other fields. */
957 /* Following fields should be after FROM. */
959 /* Preceding fields should be before TO. */
960 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
962 /* Check FROM for non-wildcard field. */
963 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
965 while (range
[j
].from
< from
)
966 range
[j
].mask
&= ~(1 << range
[j
].from
++);
967 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
969 range
[j
].from
= from
;
972 from
= range
[j
].from
;
973 if (range
[j
].to
> to
)
975 while (range
[j
].to
> to
)
976 range
[j
].mask
&= ~(1 << range
[j
].to
--);
977 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
990 /* Decide all fileds from restrictions in RANGE. */
991 for (i
= j
= 0; i
< n
; i
++)
993 if (j
< range
[i
].from
)
995 if (i
== 0 || ! NILP (tmp
[i
- 1]))
996 /* None of TMP[X] corresponds to Jth field. */
998 for (; j
< range
[i
].from
; j
++)
1001 field
[j
++] = tmp
[i
];
1003 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
1005 for (; j
< XLFD_LAST_INDEX
; j
++)
1007 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
1008 field
[XLFD_ENCODING_INDEX
]
1009 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1014 #ifdef ENABLE_CHECKING
1015 /* Match a 14-field XLFD pattern against a full XLFD font name. */
1017 font_match_xlfd (char *pattern
, char *name
)
1019 while (*pattern
&& *name
)
1021 if (*pattern
== *name
)
1023 else if (*pattern
== '*')
1024 if (*name
== pattern
[1])
1035 /* Make sure the font object matches the XLFD font name. */
1037 font_check_xlfd_parse (Lisp_Object font
, char *name
)
1039 char name_check
[256];
1040 font_unparse_xlfd (font
, 0, name_check
, 255);
1041 return font_match_xlfd (name_check
, name
);
1047 /* Parse NAME (null terminated) as XLFD and store information in FONT
1048 (font-spec or font-entity). Size property of FONT is set as
1050 specified XLFD fields FONT property
1051 --------------------- -------------
1052 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1053 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1054 POINT_SIZE POINT_SIZE/10 (Lisp float)
1056 If NAME is successfully parsed, return 0. Otherwise return -1.
1058 FONT is usually a font-spec, but when this function is called from
1059 X font backend driver, it is a font-entity. In that case, NAME is
1060 a fully specified XLFD. */
1063 font_parse_xlfd (name
, font
)
1067 int len
= strlen (name
);
1069 char *f
[XLFD_LAST_INDEX
+ 1];
1073 if (len
> 255 || !len
)
1074 /* Maximum XLFD name length is 255. */
1076 /* Accept "*-.." as a fully specified XLFD. */
1077 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1078 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1081 for (p
= name
+ i
; *p
; p
++)
1085 if (i
== XLFD_LAST_INDEX
)
1090 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1091 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1093 if (i
== XLFD_LAST_INDEX
)
1095 /* Fully specified XLFD. */
1098 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1099 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1100 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1101 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1103 val
= INTERN_FIELD_SYM (i
);
1106 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1108 ASET (font
, j
, make_number (n
));
1111 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1112 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1113 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1115 ASET (font
, FONT_REGISTRY_INDEX
,
1116 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1117 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1119 p
= f
[XLFD_PIXEL_INDEX
];
1120 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1121 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1124 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1126 ASET (font
, FONT_SIZE_INDEX
, val
);
1129 double point_size
= -1;
1131 font_assert (FONT_SPEC_P (font
));
1132 p
= f
[XLFD_POINT_INDEX
];
1134 point_size
= parse_matrix (p
);
1135 else if (isdigit (*p
))
1136 point_size
= atoi (p
), point_size
/= 10;
1137 if (point_size
>= 0)
1138 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1142 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1143 if (! NILP (val
) && ! INTEGERP (val
))
1145 ASET (font
, FONT_DPI_INDEX
, val
);
1146 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1149 val
= font_prop_validate_spacing (QCspacing
, val
);
1150 if (! INTEGERP (val
))
1152 ASET (font
, FONT_SPACING_INDEX
, val
);
1154 p
= f
[XLFD_AVGWIDTH_INDEX
];
1157 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1158 if (! NILP (val
) && ! INTEGERP (val
))
1160 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1164 int wild_card_found
= 0;
1165 Lisp_Object prop
[XLFD_LAST_INDEX
];
1167 if (FONT_ENTITY_P (font
))
1169 for (j
= 0; j
< i
; j
++)
1173 if (f
[j
][1] && f
[j
][1] != '-')
1176 wild_card_found
= 1;
1179 prop
[j
] = INTERN_FIELD (j
);
1181 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1183 if (! wild_card_found
)
1185 if (font_expand_wildcards (prop
, i
) < 0)
1188 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1189 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1190 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1191 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1192 if (! NILP (prop
[i
]))
1194 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1196 ASET (font
, j
, make_number (n
));
1198 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1199 val
= prop
[XLFD_REGISTRY_INDEX
];
1202 val
= prop
[XLFD_ENCODING_INDEX
];
1204 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1206 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1207 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1209 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1210 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1212 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1214 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1215 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1216 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1218 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1220 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1223 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1224 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1225 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1227 val
= font_prop_validate_spacing (QCspacing
,
1228 prop
[XLFD_SPACING_INDEX
]);
1229 if (! INTEGERP (val
))
1231 ASET (font
, FONT_SPACING_INDEX
, val
);
1233 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1234 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1240 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1241 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1242 0, use PIXEL_SIZE instead. */
1245 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1251 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1255 font_assert (FONTP (font
));
1257 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1260 if (i
== FONT_ADSTYLE_INDEX
)
1261 j
= XLFD_ADSTYLE_INDEX
;
1262 else if (i
== FONT_REGISTRY_INDEX
)
1263 j
= XLFD_REGISTRY_INDEX
;
1264 val
= AREF (font
, i
);
1267 if (j
== XLFD_REGISTRY_INDEX
)
1268 f
[j
] = "*-*", len
+= 4;
1270 f
[j
] = "*", len
+= 2;
1275 val
= SYMBOL_NAME (val
);
1276 if (j
== XLFD_REGISTRY_INDEX
1277 && ! strchr ((char *) SDATA (val
), '-'))
1279 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1280 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1282 f
[j
] = alloca (SBYTES (val
) + 3);
1283 sprintf (f
[j
], "%s-*", SDATA (val
));
1284 len
+= SBYTES (val
) + 3;
1288 f
[j
] = alloca (SBYTES (val
) + 4);
1289 sprintf (f
[j
], "%s*-*", SDATA (val
));
1290 len
+= SBYTES (val
) + 4;
1294 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1298 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1301 val
= font_style_symbolic (font
, i
, 0);
1303 f
[j
] = "*", len
+= 2;
1306 val
= SYMBOL_NAME (val
);
1307 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1311 val
= AREF (font
, FONT_SIZE_INDEX
);
1312 font_assert (NUMBERP (val
) || NILP (val
));
1320 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1321 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1324 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1326 else if (FLOATP (val
))
1328 i
= XFLOAT_DATA (val
) * 10;
1329 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1330 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1333 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1335 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1337 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1338 f
[XLFD_RESX_INDEX
] = alloca (22);
1339 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1343 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1344 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1346 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1348 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1349 : spacing
<= FONT_SPACING_DUAL
? "d"
1350 : spacing
<= FONT_SPACING_MONO
? "m"
1355 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1356 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1358 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1359 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
],
1360 "%d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1363 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1364 len
++; /* for terminating '\0'. */
1367 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1368 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1369 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1370 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1371 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1372 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1373 f
[XLFD_REGISTRY_INDEX
]);
1376 /* Parse NAME (null terminated) and store information in FONT
1377 (font-spec or font-entity). NAME is supplied in either the
1378 Fontconfig or GTK font name format. If NAME is successfully
1379 parsed, return 0. Otherwise return -1.
1381 The fontconfig format is
1383 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1387 FAMILY [PROPS...] [SIZE]
1389 This function tries to guess which format it is. */
1392 font_parse_fcname (name
, font
)
1397 char *size_beg
= NULL
, *size_end
= NULL
;
1398 char *props_beg
= NULL
, *family_end
= NULL
;
1399 int len
= strlen (name
);
1404 for (p
= name
; *p
; p
++)
1406 if (*p
== '\\' && p
[1])
1410 props_beg
= family_end
= p
;
1415 int decimal
= 0, size_found
= 1;
1416 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1419 if (*q
!= '.' || decimal
)
1438 /* A fontconfig name with size and/or property data. */
1439 if (family_end
> name
)
1442 family
= font_intern_prop (name
, family_end
- name
, 1);
1443 ASET (font
, FONT_FAMILY_INDEX
, family
);
1447 double point_size
= strtod (size_beg
, &size_end
);
1448 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1449 if (*size_end
== ':' && size_end
[1])
1450 props_beg
= size_end
;
1454 /* Now parse ":KEY=VAL" patterns. */
1457 for (p
= props_beg
; *p
; p
= q
)
1459 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1462 /* Must be an enumerated value. */
1466 val
= font_intern_prop (p
, q
- p
, 1);
1468 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1470 if (PROP_MATCH ("light", 5)
1471 || PROP_MATCH ("medium", 6)
1472 || PROP_MATCH ("demibold", 8)
1473 || PROP_MATCH ("bold", 4)
1474 || PROP_MATCH ("black", 5))
1475 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1476 else if (PROP_MATCH ("roman", 5)
1477 || PROP_MATCH ("italic", 6)
1478 || PROP_MATCH ("oblique", 7))
1479 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1480 else if (PROP_MATCH ("charcell", 8))
1481 ASET (font
, FONT_SPACING_INDEX
,
1482 make_number (FONT_SPACING_CHARCELL
));
1483 else if (PROP_MATCH ("mono", 4))
1484 ASET (font
, FONT_SPACING_INDEX
,
1485 make_number (FONT_SPACING_MONO
));
1486 else if (PROP_MATCH ("proportional", 12))
1487 ASET (font
, FONT_SPACING_INDEX
,
1488 make_number (FONT_SPACING_PROPORTIONAL
));
1497 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1498 prop
= FONT_SIZE_INDEX
;
1501 key
= font_intern_prop (p
, q
- p
, 1);
1502 prop
= get_font_prop_index (key
);
1506 for (q
= p
; *q
&& *q
!= ':'; q
++);
1507 val
= font_intern_prop (p
, q
- p
, 0);
1509 if (prop
>= FONT_FOUNDRY_INDEX
1510 && prop
< FONT_EXTRA_INDEX
)
1511 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1513 Ffont_put (font
, key
, val
);
1521 /* Either a fontconfig-style name with no size and property
1522 data, or a GTK-style name. */
1524 int word_len
, prop_found
= 0;
1526 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1532 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1540 double point_size
= strtod (p
, &q
);
1541 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1546 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1547 if (*q
== '\\' && q
[1])
1551 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1553 if (PROP_MATCH ("Ultra-Light", 11))
1556 prop
= font_intern_prop ("ultra-light", 11, 1);
1557 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1559 else if (PROP_MATCH ("Light", 5))
1562 prop
= font_intern_prop ("light", 5, 1);
1563 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1565 else if (PROP_MATCH ("Semi-Bold", 9))
1568 prop
= font_intern_prop ("semi-bold", 9, 1);
1569 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1571 else if (PROP_MATCH ("Bold", 4))
1574 prop
= font_intern_prop ("bold", 4, 1);
1575 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1577 else if (PROP_MATCH ("Italic", 6))
1580 prop
= font_intern_prop ("italic", 4, 1);
1581 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1583 else if (PROP_MATCH ("Oblique", 7))
1586 prop
= font_intern_prop ("oblique", 7, 1);
1587 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1591 return -1; /* Unknown property in GTK-style font name. */
1600 family
= font_intern_prop (name
, family_end
- name
, 1);
1601 ASET (font
, FONT_FAMILY_INDEX
, family
);
1608 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1609 NAME (NBYTES length), and return the name length. If
1610 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1613 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1619 Lisp_Object family
, foundry
;
1620 Lisp_Object tail
, val
;
1624 Lisp_Object styles
[3];
1625 char *style_names
[3] = { "weight", "slant", "width" };
1628 family
= AREF (font
, FONT_FAMILY_INDEX
);
1629 if (! NILP (family
))
1631 if (SYMBOLP (family
))
1633 family
= SYMBOL_NAME (family
);
1634 len
+= SBYTES (family
);
1640 val
= AREF (font
, FONT_SIZE_INDEX
);
1643 if (XINT (val
) != 0)
1644 pixel_size
= XINT (val
);
1646 len
+= 21; /* for ":pixelsize=NUM" */
1648 else if (FLOATP (val
))
1651 point_size
= (int) XFLOAT_DATA (val
);
1652 len
+= 11; /* for "-NUM" */
1655 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1656 if (! NILP (foundry
))
1658 if (SYMBOLP (foundry
))
1660 foundry
= SYMBOL_NAME (foundry
);
1661 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1667 for (i
= 0; i
< 3; i
++)
1669 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1670 if (! NILP (styles
[i
]))
1671 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1672 SDATA (SYMBOL_NAME (styles
[i
])));
1675 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1676 len
+= sprintf (work
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1677 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1678 len
+= strlen (":spacing=100");
1679 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1680 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1681 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1683 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1685 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1687 len
+= SBYTES (val
);
1688 else if (INTEGERP (val
))
1689 len
+= sprintf (work
, "%d", XINT (val
));
1690 else if (SYMBOLP (val
))
1691 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1697 if (! NILP (family
))
1698 p
+= sprintf (p
, "%s", SDATA (family
));
1702 p
+= sprintf (p
, "%d", point_size
);
1704 p
+= sprintf (p
, "-%d", point_size
);
1706 else if (pixel_size
> 0)
1707 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1708 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1709 p
+= sprintf (p
, ":foundry=%s",
1710 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1711 for (i
= 0; i
< 3; i
++)
1712 if (! NILP (styles
[i
]))
1713 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1714 SDATA (SYMBOL_NAME (styles
[i
])));
1715 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1716 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1717 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1718 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1719 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1721 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1722 p
+= sprintf (p
, ":scalable=true");
1724 p
+= sprintf (p
, ":scalable=false");
1729 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1730 NAME (NBYTES length), and return the name length. F is the frame
1731 on which the font is displayed; it is used to calculate the point
1735 font_unparse_gtkname (font
, f
, name
, nbytes
)
1743 Lisp_Object family
, weight
, slant
, size
;
1744 int point_size
= -1;
1746 family
= AREF (font
, FONT_FAMILY_INDEX
);
1747 if (! NILP (family
))
1749 if (! SYMBOLP (family
))
1751 family
= SYMBOL_NAME (family
);
1752 len
+= SBYTES (family
);
1755 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1756 if (EQ (weight
, Qnormal
))
1758 else if (! NILP (weight
))
1760 weight
= SYMBOL_NAME (weight
);
1761 len
+= SBYTES (weight
);
1764 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1765 if (EQ (slant
, Qnormal
))
1767 else if (! NILP (slant
))
1769 slant
= SYMBOL_NAME (slant
);
1770 len
+= SBYTES (slant
);
1773 size
= AREF (font
, FONT_SIZE_INDEX
);
1774 /* Convert pixel size to point size. */
1775 if (INTEGERP (size
))
1777 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1779 if (INTEGERP (font_dpi
))
1780 dpi
= XINT (font_dpi
);
1783 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1786 else if (FLOATP (size
))
1788 point_size
= (int) XFLOAT_DATA (size
);
1795 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1797 if (! NILP (weight
))
1800 p
+= sprintf (p
, " %s", SDATA (weight
));
1801 q
[1] = toupper (q
[1]);
1807 p
+= sprintf (p
, " %s", SDATA (slant
));
1808 q
[1] = toupper (q
[1]);
1812 p
+= sprintf (p
, " %d", point_size
);
1817 /* Parse NAME (null terminated) and store information in FONT
1818 (font-spec or font-entity). If NAME is successfully parsed, return
1819 0. Otherwise return -1. */
1822 font_parse_name (name
, font
)
1826 if (name
[0] == '-' || index (name
, '*') || index (name
, '?'))
1827 return font_parse_xlfd (name
, font
);
1828 return font_parse_fcname (name
, font
);
1832 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1833 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1837 font_parse_family_registry (family
, registry
, font_spec
)
1838 Lisp_Object family
, registry
, font_spec
;
1844 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1846 CHECK_STRING (family
);
1847 len
= SBYTES (family
);
1848 p0
= (char *) SDATA (family
);
1849 p1
= index (p0
, '-');
1852 if ((*p0
!= '*' && p1
- p0
> 0)
1853 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1854 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1857 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1860 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1862 if (! NILP (registry
))
1864 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1865 CHECK_STRING (registry
);
1866 len
= SBYTES (registry
);
1867 p0
= (char *) SDATA (registry
);
1868 p1
= index (p0
, '-');
1871 if (SDATA (registry
)[len
- 1] == '*')
1872 registry
= concat2 (registry
, build_string ("-*"));
1874 registry
= concat2 (registry
, build_string ("*-*"));
1876 registry
= Fdowncase (registry
);
1877 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1882 /* This part (through the next ^L) is still experimental and not
1883 tested much. We may drastically change codes. */
1889 #define LGSTRING_HEADER_SIZE 6
1890 #define LGSTRING_GLYPH_SIZE 8
1893 check_gstring (gstring
)
1894 Lisp_Object gstring
;
1899 CHECK_VECTOR (gstring
);
1900 val
= AREF (gstring
, 0);
1902 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1904 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1905 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1906 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1907 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1908 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1909 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1910 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1911 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1912 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1913 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1914 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1916 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1918 val
= LGSTRING_GLYPH (gstring
, i
);
1920 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1922 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1924 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1925 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1926 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1927 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1928 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1929 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1930 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1931 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1933 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1935 if (ASIZE (val
) < 3)
1937 for (j
= 0; j
< 3; j
++)
1938 CHECK_NUMBER (AREF (val
, j
));
1943 error ("Invalid glyph-string format");
1948 check_otf_features (otf_features
)
1949 Lisp_Object otf_features
;
1953 CHECK_CONS (otf_features
);
1954 CHECK_SYMBOL (XCAR (otf_features
));
1955 otf_features
= XCDR (otf_features
);
1956 CHECK_CONS (otf_features
);
1957 CHECK_SYMBOL (XCAR (otf_features
));
1958 otf_features
= XCDR (otf_features
);
1959 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1961 CHECK_SYMBOL (Fcar (val
));
1962 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1963 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1965 otf_features
= XCDR (otf_features
);
1966 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1968 CHECK_SYMBOL (Fcar (val
));
1969 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1970 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1977 Lisp_Object otf_list
;
1980 otf_tag_symbol (tag
)
1985 OTF_tag_name (tag
, name
);
1986 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1993 Lisp_Object val
= Fassoc (file
, otf_list
);
1997 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
2000 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
2001 val
= make_save_value (otf
, 0);
2002 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
2008 /* Return a list describing which scripts/languages FONT supports by
2009 which GSUB/GPOS features of OpenType tables. See the comment of
2010 (struct font_driver).otf_capability. */
2013 font_otf_capability (font
)
2017 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
2020 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
2023 for (i
= 0; i
< 2; i
++)
2025 OTF_GSUB_GPOS
*gsub_gpos
;
2026 Lisp_Object script_list
= Qnil
;
2029 if (OTF_get_features (otf
, i
== 0) < 0)
2031 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2032 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2034 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2035 Lisp_Object langsys_list
= Qnil
;
2036 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2039 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2041 OTF_LangSys
*langsys
;
2042 Lisp_Object feature_list
= Qnil
;
2043 Lisp_Object langsys_tag
;
2046 if (k
== script
->LangSysCount
)
2048 langsys
= &script
->DefaultLangSys
;
2053 langsys
= script
->LangSys
+ k
;
2055 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2057 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2059 OTF_Feature
*feature
2060 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2061 Lisp_Object feature_tag
2062 = otf_tag_symbol (feature
->FeatureTag
);
2064 feature_list
= Fcons (feature_tag
, feature_list
);
2066 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2069 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2074 XSETCAR (capability
, script_list
);
2076 XSETCDR (capability
, script_list
);
2082 /* Parse OTF features in SPEC and write a proper features spec string
2083 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2084 assured that the sufficient memory has already allocated for
2088 generate_otf_features (spec
, features
)
2098 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2104 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2109 else if (! asterisk
)
2111 val
= SYMBOL_NAME (val
);
2112 p
+= sprintf (p
, "%s", SDATA (val
));
2116 val
= SYMBOL_NAME (val
);
2117 p
+= sprintf (p
, "~%s", SDATA (val
));
2121 error ("OTF spec too long");
2125 font_otf_DeviceTable (device_table
)
2126 OTF_DeviceTable
*device_table
;
2128 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2130 return Fcons (make_number (len
),
2131 make_unibyte_string (device_table
->DeltaValue
, len
));
2135 font_otf_ValueRecord (value_format
, value_record
)
2137 OTF_ValueRecord
*value_record
;
2139 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2141 if (value_format
& OTF_XPlacement
)
2142 ASET (val
, 0, make_number (value_record
->XPlacement
));
2143 if (value_format
& OTF_YPlacement
)
2144 ASET (val
, 1, make_number (value_record
->YPlacement
));
2145 if (value_format
& OTF_XAdvance
)
2146 ASET (val
, 2, make_number (value_record
->XAdvance
));
2147 if (value_format
& OTF_YAdvance
)
2148 ASET (val
, 3, make_number (value_record
->YAdvance
));
2149 if (value_format
& OTF_XPlaDevice
)
2150 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2151 if (value_format
& OTF_YPlaDevice
)
2152 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2153 if (value_format
& OTF_XAdvDevice
)
2154 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2155 if (value_format
& OTF_YAdvDevice
)
2156 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2161 font_otf_Anchor (anchor
)
2166 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2167 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2168 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2169 if (anchor
->AnchorFormat
== 2)
2170 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2173 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2174 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2178 #endif /* HAVE_LIBOTF */
2184 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2185 static int font_compare
P_ ((const void *, const void *));
2186 static Lisp_Object font_sort_entities
P_ ((Lisp_Object
, Lisp_Object
,
2189 /* Return a rescaling ratio of FONT_ENTITY. */
2190 extern Lisp_Object Vface_font_rescale_alist
;
2193 font_rescale_ratio (font_entity
)
2194 Lisp_Object font_entity
;
2196 Lisp_Object tail
, elt
;
2197 Lisp_Object name
= Qnil
;
2199 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2202 if (FLOATP (XCDR (elt
)))
2204 if (STRINGP (XCAR (elt
)))
2207 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2208 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2209 return XFLOAT_DATA (XCDR (elt
));
2211 else if (FONT_SPEC_P (XCAR (elt
)))
2213 if (font_match_p (XCAR (elt
), font_entity
))
2214 return XFLOAT_DATA (XCDR (elt
));
2221 /* We sort fonts by scoring each of them against a specified
2222 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2223 the value is, the closer the font is to the font-spec.
2225 The lowest 2 bits of the score is used for driver type. The font
2226 available by the most preferred font driver is 0.
2228 Each 7-bit in the higher 28 bits are used for numeric properties
2229 WEIGHT, SLANT, WIDTH, and SIZE. */
2231 /* How many bits to shift to store the difference value of each font
2232 property in a score. Note that flots for FONT_TYPE_INDEX and
2233 FONT_REGISTRY_INDEX are not used. */
2234 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2236 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2237 The return value indicates how different ENTITY is compared with
2241 font_score (entity
, spec_prop
)
2242 Lisp_Object entity
, *spec_prop
;
2247 /* Score three style numeric fields. Maximum difference is 127. */
2248 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2249 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2251 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2256 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2259 /* Score the size. Maximum difference is 127. */
2260 i
= FONT_SIZE_INDEX
;
2261 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2262 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2264 /* We use the higher 6-bit for the actual size difference. The
2265 lowest bit is set if the DPI is different. */
2267 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2269 if (CONSP (Vface_font_rescale_alist
))
2270 pixel_size
*= font_rescale_ratio (entity
);
2271 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2275 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2276 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2278 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2279 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2281 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2288 /* Concatenate all elements of LIST into one vector. LIST is a list
2289 of font-entity vectors. */
2292 font_vconcat_entity_vectors (Lisp_Object list
)
2294 int nargs
= XINT (Flength (list
));
2295 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2298 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2299 args
[i
] = XCAR (list
);
2300 return Fvconcat (nargs
, args
);
2304 /* The structure for elements being sorted by qsort. */
2305 struct font_sort_data
2308 int font_driver_preference
;
2313 /* The comparison function for qsort. */
2316 font_compare (d1
, d2
)
2317 const void *d1
, *d2
;
2319 const struct font_sort_data
*data1
= d1
;
2320 const struct font_sort_data
*data2
= d2
;
2322 if (data1
->score
< data2
->score
)
2324 else if (data1
->score
> data2
->score
)
2326 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2330 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2331 If PREFER specifies a point-size, calculate the corresponding
2332 pixel-size from QCdpi property of PREFER or from the Y-resolution
2333 of FRAME before sorting.
2335 If BEST-ONLY is nonzero, return the best matching entity (that
2336 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2337 if BEST-ONLY is negative). Otherwise, return the sorted result as
2338 a single vector of font-entities.
2340 This function does no optimization for the case that the total
2341 number of elements is 1. The caller should avoid calling this in
2345 font_sort_entities (list
, prefer
, frame
, best_only
)
2346 Lisp_Object list
, prefer
, frame
;
2349 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2351 struct font_sort_data
*data
;
2352 unsigned best_score
;
2353 Lisp_Object best_entity
;
2354 struct frame
*f
= XFRAME (frame
);
2355 Lisp_Object tail
, vec
;
2358 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2359 prefer_prop
[i
] = AREF (prefer
, i
);
2360 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2361 prefer_prop
[FONT_SIZE_INDEX
]
2362 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2364 if (NILP (XCDR (list
)))
2366 /* What we have to take care of is this single vector. */
2368 maxlen
= ASIZE (vec
);
2372 /* We don't have to perform sort, so there's no need of creating
2373 a single vector. But, we must find the length of the longest
2376 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2377 if (maxlen
< ASIZE (XCAR (tail
)))
2378 maxlen
= ASIZE (XCAR (tail
));
2382 /* We have to create a single vector to sort it. */
2383 vec
= font_vconcat_entity_vectors (list
);
2384 maxlen
= ASIZE (vec
);
2387 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2388 best_score
= 0xFFFFFFFF;
2391 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2393 int font_driver_preference
= 0;
2394 Lisp_Object current_font_driver
;
2400 /* We are sure that the length of VEC > 0. */
2401 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2402 /* Score the elements. */
2403 for (i
= 0; i
< len
; i
++)
2405 data
[i
].entity
= AREF (vec
, i
);
2407 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2409 ? font_score (data
[i
].entity
, prefer_prop
)
2411 if (best_only
&& best_score
> data
[i
].score
)
2413 best_score
= data
[i
].score
;
2414 best_entity
= data
[i
].entity
;
2415 if (best_score
== 0)
2418 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2420 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2421 font_driver_preference
++;
2423 data
[i
].font_driver_preference
= font_driver_preference
;
2426 /* Sort if necessary. */
2429 qsort (data
, len
, sizeof *data
, font_compare
);
2430 for (i
= 0; i
< len
; i
++)
2431 ASET (vec
, i
, data
[i
].entity
);
2440 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2445 /* API of Font Service Layer. */
2447 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2448 sort_shift_bits. Finternal_set_font_selection_order calls this
2449 function with font_sort_order after setting up it. */
2452 font_update_sort_order (order
)
2457 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2459 int xlfd_idx
= order
[i
];
2461 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2462 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2463 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2464 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2465 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2466 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2468 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2473 font_check_otf_features (script
, langsys
, features
, table
)
2474 Lisp_Object script
, langsys
, features
, table
;
2479 table
= assq_no_quit (script
, table
);
2482 table
= XCDR (table
);
2483 if (! NILP (langsys
))
2485 table
= assq_no_quit (langsys
, table
);
2491 val
= assq_no_quit (Qnil
, table
);
2493 table
= XCAR (table
);
2497 table
= XCDR (table
);
2498 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2500 if (NILP (XCAR (features
)))
2505 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2511 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2514 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2516 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2518 script
= XCAR (spec
);
2522 langsys
= XCAR (spec
);
2533 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2534 XCAR (otf_capability
)))
2536 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2537 XCDR (otf_capability
)))
2544 /* Check if FONT (font-entity or font-object) matches with the font
2545 specification SPEC. */
2548 font_match_p (spec
, font
)
2549 Lisp_Object spec
, font
;
2551 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2552 Lisp_Object extra
, font_extra
;
2555 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2556 if (! NILP (AREF (spec
, i
))
2557 && ! NILP (AREF (font
, i
))
2558 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2560 props
= XFONT_SPEC (spec
)->props
;
2561 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2563 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2564 prop
[i
] = AREF (spec
, i
);
2565 prop
[FONT_SIZE_INDEX
]
2566 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2570 if (font_score (font
, props
) > 0)
2572 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2573 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2574 for (; CONSP (extra
); extra
= XCDR (extra
))
2576 Lisp_Object key
= XCAR (XCAR (extra
));
2577 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2579 if (EQ (key
, QClang
))
2581 val2
= assq_no_quit (key
, font_extra
);
2590 if (NILP (Fmemq (val
, val2
)))
2595 ? NILP (Fmemq (val
, XCDR (val2
)))
2599 else if (EQ (key
, QCscript
))
2601 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2607 /* All characters in the list must be supported. */
2608 for (; CONSP (val2
); val2
= XCDR (val2
))
2610 if (! NATNUMP (XCAR (val2
)))
2612 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2613 == FONT_INVALID_CODE
)
2617 else if (VECTORP (val2
))
2619 /* At most one character in the vector must be supported. */
2620 for (i
= 0; i
< ASIZE (val2
); i
++)
2622 if (! NATNUMP (AREF (val2
, i
)))
2624 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2625 != FONT_INVALID_CODE
)
2628 if (i
== ASIZE (val2
))
2633 else if (EQ (key
, QCotf
))
2637 if (! FONT_OBJECT_P (font
))
2639 fontp
= XFONT_OBJECT (font
);
2640 if (! fontp
->driver
->otf_capability
)
2642 val2
= fontp
->driver
->otf_capability (fontp
);
2643 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2654 Each font backend has the callback function get_cache, and it
2655 returns a cons cell of which cdr part can be freely used for
2656 caching fonts. The cons cell may be shared by multiple frames
2657 and/or multiple font drivers. So, we arrange the cdr part as this:
2659 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2661 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2662 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2663 cons (FONT-SPEC FONT-ENTITY ...). */
2665 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2666 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2667 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2668 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2669 struct font_driver
*));
2672 font_prepare_cache (f
, driver
)
2674 struct font_driver
*driver
;
2676 Lisp_Object cache
, val
;
2678 cache
= driver
->get_cache (f
);
2680 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2684 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2685 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2689 val
= XCDR (XCAR (val
));
2690 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2696 font_finish_cache (f
, driver
)
2698 struct font_driver
*driver
;
2700 Lisp_Object cache
, val
, tmp
;
2703 cache
= driver
->get_cache (f
);
2705 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2706 cache
= val
, val
= XCDR (val
);
2707 font_assert (! NILP (val
));
2708 tmp
= XCDR (XCAR (val
));
2709 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2710 if (XINT (XCAR (tmp
)) == 0)
2712 font_clear_cache (f
, XCAR (val
), driver
);
2713 XSETCDR (cache
, XCDR (val
));
2719 font_get_cache (f
, driver
)
2721 struct font_driver
*driver
;
2723 Lisp_Object val
= driver
->get_cache (f
);
2724 Lisp_Object type
= driver
->type
;
2726 font_assert (CONSP (val
));
2727 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2728 font_assert (CONSP (val
));
2729 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2730 val
= XCDR (XCAR (val
));
2734 static int num_fonts
;
2737 font_clear_cache (f
, cache
, driver
)
2740 struct font_driver
*driver
;
2742 Lisp_Object tail
, elt
;
2743 Lisp_Object tail2
, entity
;
2745 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2746 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2749 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2750 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2752 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2754 entity
= XCAR (tail2
);
2756 if (FONT_ENTITY_P (entity
)
2757 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2759 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2761 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2763 Lisp_Object val
= XCAR (objlist
);
2764 struct font
*font
= XFONT_OBJECT (val
);
2766 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2768 font_assert (font
&& driver
== font
->driver
);
2769 driver
->close (f
, font
);
2773 if (driver
->free_entity
)
2774 driver
->free_entity (entity
);
2779 XSETCDR (cache
, Qnil
);
2783 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2786 font_delete_unmatched (vec
, spec
, size
)
2787 Lisp_Object vec
, spec
;
2790 Lisp_Object entity
, val
;
2791 enum font_property_index prop
;
2794 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2796 entity
= AREF (vec
, i
);
2797 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2798 if (INTEGERP (AREF (spec
, prop
))
2799 && ((XINT (AREF (spec
, prop
)) >> 8)
2800 != (XINT (AREF (entity
, prop
)) >> 8)))
2801 prop
= FONT_SPEC_MAX
;
2802 if (prop
< FONT_SPEC_MAX
2804 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2806 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2809 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2810 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2811 prop
= FONT_SPEC_MAX
;
2813 if (prop
< FONT_SPEC_MAX
2814 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2815 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2816 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2817 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2818 prop
= FONT_SPEC_MAX
;
2819 if (prop
< FONT_SPEC_MAX
2820 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2821 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2822 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2823 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2824 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2825 prop
= FONT_SPEC_MAX
;
2826 if (prop
< FONT_SPEC_MAX
)
2827 val
= Fcons (entity
, val
);
2829 return (Fvconcat (1, &val
));
2833 /* Return a list of vectors of font-entities matching with SPEC on
2834 FRAME. The elements of the list are in the same of order of
2838 font_list_entities (frame
, spec
)
2839 Lisp_Object frame
, spec
;
2841 FRAME_PTR f
= XFRAME (frame
);
2842 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2843 Lisp_Object ftype
, val
;
2844 Lisp_Object list
= Qnil
;
2846 int need_filtering
= 0;
2849 font_assert (FONT_SPEC_P (spec
));
2851 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2852 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2853 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2854 size
= font_pixel_size (f
, spec
);
2858 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2859 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2860 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2861 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2863 ASET (scratch_font_spec
, i
, Qnil
);
2864 if (! NILP (AREF (spec
, i
)))
2866 if (i
== FONT_DPI_INDEX
)
2867 /* Skip FONT_SPACING_INDEX */
2870 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2871 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2873 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2875 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2877 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2879 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2880 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2887 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2891 val
= Fvconcat (1, &val
);
2892 copy
= Fcopy_font_spec (scratch_font_spec
);
2893 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2894 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2896 if (ASIZE (val
) > 0 && need_filtering
)
2897 val
= font_delete_unmatched (val
, spec
, size
);
2898 if (ASIZE (val
) > 0)
2899 list
= Fcons (val
, list
);
2902 list
= Fnreverse (list
);
2903 FONT_ADD_LOG ("list", spec
, list
);
2908 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2909 nil, is an array of face's attributes, which specifies preferred
2910 font-related attributes. */
2913 font_matching_entity (f
, attrs
, spec
)
2915 Lisp_Object
*attrs
, spec
;
2917 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2918 Lisp_Object ftype
, size
, entity
;
2920 Lisp_Object work
= Fcopy_font_spec (spec
);
2922 XSETFRAME (frame
, f
);
2923 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2924 size
= AREF (spec
, FONT_SIZE_INDEX
);
2927 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2928 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2929 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2930 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2933 for (; driver_list
; driver_list
= driver_list
->next
)
2935 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2937 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2940 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2941 entity
= assoc_no_quit (work
, XCDR (cache
));
2943 entity
= XCDR (entity
);
2946 entity
= driver_list
->driver
->match (frame
, work
);
2947 copy
= Fcopy_font_spec (work
);
2948 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2949 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2951 if (! NILP (entity
))
2954 FONT_ADD_LOG ("match", work
, entity
);
2959 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2960 opened font object. */
2963 font_open_entity (f
, entity
, pixel_size
)
2968 struct font_driver_list
*driver_list
;
2969 Lisp_Object objlist
, size
, val
, font_object
;
2971 int min_width
, height
;
2972 int scaled_pixel_size
;
2974 font_assert (FONT_ENTITY_P (entity
));
2975 size
= AREF (entity
, FONT_SIZE_INDEX
);
2976 if (XINT (size
) != 0)
2977 scaled_pixel_size
= pixel_size
= XINT (size
);
2978 else if (CONSP (Vface_font_rescale_alist
))
2979 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2981 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2982 objlist
= XCDR (objlist
))
2983 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2984 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2985 return XCAR (objlist
);
2987 val
= AREF (entity
, FONT_TYPE_INDEX
);
2988 for (driver_list
= f
->font_driver_list
;
2989 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2990 driver_list
= driver_list
->next
);
2994 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2995 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2996 FONT_ADD_LOG ("open", entity
, font_object
);
2997 if (NILP (font_object
))
2999 ASET (entity
, FONT_OBJLIST_INDEX
,
3000 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
3001 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
3004 font
= XFONT_OBJECT (font_object
);
3005 min_width
= (font
->min_width
? font
->min_width
3006 : font
->average_width
? font
->average_width
3007 : font
->space_width
? font
->space_width
3009 height
= (font
->height
? font
->height
: 1);
3010 #ifdef HAVE_WINDOW_SYSTEM
3011 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
3012 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
3014 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
3015 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
3016 fonts_changed_p
= 1;
3020 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
3021 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
3022 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
3023 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
3031 /* Close FONT_OBJECT that is opened on frame F. */
3034 font_close_object (f
, font_object
)
3036 Lisp_Object font_object
;
3038 struct font
*font
= XFONT_OBJECT (font_object
);
3040 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
3041 /* Already closed. */
3043 FONT_ADD_LOG ("close", font_object
, Qnil
);
3044 font
->driver
->close (f
, font
);
3045 #ifdef HAVE_WINDOW_SYSTEM
3046 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
3047 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
3053 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
3054 FONT is a font-entity and it must be opened to check. */
3057 font_has_char (f
, font
, c
)
3064 if (FONT_ENTITY_P (font
))
3066 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
3067 struct font_driver_list
*driver_list
;
3069 for (driver_list
= f
->font_driver_list
;
3070 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
3071 driver_list
= driver_list
->next
);
3074 if (! driver_list
->driver
->has_char
)
3076 return driver_list
->driver
->has_char (font
, c
);
3079 font_assert (FONT_OBJECT_P (font
));
3080 fontp
= XFONT_OBJECT (font
);
3081 if (fontp
->driver
->has_char
)
3083 int result
= fontp
->driver
->has_char (font
, c
);
3088 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
3092 /* Return the glyph ID of FONT_OBJECT for character C. */
3095 font_encode_char (font_object
, c
)
3096 Lisp_Object font_object
;
3101 font_assert (FONT_OBJECT_P (font_object
));
3102 font
= XFONT_OBJECT (font_object
);
3103 return font
->driver
->encode_char (font
, c
);
3107 /* Return the name of FONT_OBJECT. */
3110 font_get_name (font_object
)
3111 Lisp_Object font_object
;
3113 font_assert (FONT_OBJECT_P (font_object
));
3114 return AREF (font_object
, FONT_NAME_INDEX
);
3118 /* Return the specification of FONT_OBJECT. */
3121 font_get_spec (font_object
)
3122 Lisp_Object font_object
;
3124 Lisp_Object spec
= font_make_spec ();
3127 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
3128 ASET (spec
, i
, AREF (font_object
, i
));
3129 ASET (spec
, FONT_SIZE_INDEX
,
3130 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
3135 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3136 could not be parsed by font_parse_name, return Qnil. */
3139 font_spec_from_name (font_name
)
3140 Lisp_Object font_name
;
3142 Lisp_Object spec
= Ffont_spec (0, NULL
);
3144 CHECK_STRING (font_name
);
3145 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3147 font_put_extra (spec
, QCname
, font_name
);
3153 font_clear_prop (attrs
, prop
)
3155 enum font_property_index prop
;
3157 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3161 if (! NILP (Ffont_get (font
, QCname
)))
3163 font
= Fcopy_font_spec (font
);
3164 font_put_extra (font
, QCname
, Qnil
);
3167 if (NILP (AREF (font
, prop
))
3168 && prop
!= FONT_FAMILY_INDEX
3169 && prop
!= FONT_FOUNDRY_INDEX
3170 && prop
!= FONT_WIDTH_INDEX
3171 && prop
!= FONT_SIZE_INDEX
)
3173 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3174 font
= Fcopy_font_spec (font
);
3175 ASET (font
, prop
, Qnil
);
3176 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3178 if (prop
== FONT_FAMILY_INDEX
)
3180 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3181 /* If we are setting the font family, we must also clear
3182 FONT_WIDTH_INDEX to avoid rejecting families that lack
3183 support for some widths. */
3184 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3186 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3187 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3188 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3189 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3190 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3191 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3193 else if (prop
== FONT_SIZE_INDEX
)
3195 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3196 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3197 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3199 else if (prop
== FONT_WIDTH_INDEX
)
3200 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3201 attrs
[LFACE_FONT_INDEX
] = font
;
3205 font_update_lface (f
, attrs
)
3211 spec
= attrs
[LFACE_FONT_INDEX
];
3212 if (! FONT_SPEC_P (spec
))
3215 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3216 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3217 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3218 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3219 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3220 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3221 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3222 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);
3223 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3224 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3225 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3229 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3234 val
= Ffont_get (spec
, QCdpi
);
3237 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3239 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3241 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3243 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3244 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3250 /* Selecte a font from ENTITIES (list of font-entity vectors) that
3251 supports C and matches best with ATTRS and PIXEL_SIZE. */
3254 font_select_entity (frame
, entities
, attrs
, pixel_size
, c
)
3255 Lisp_Object frame
, entities
, *attrs
;
3258 Lisp_Object font_entity
;
3261 FRAME_PTR f
= XFRAME (frame
);
3263 if (NILP (XCDR (entities
))
3264 && ASIZE (XCAR (entities
)) == 1)
3266 font_entity
= AREF (XCAR (entities
), 0);
3268 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3273 /* Sort fonts by properties specified in ATTRS. */
3274 prefer
= scratch_font_prefer
;
3276 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3277 ASET (prefer
, i
, Qnil
);
3278 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3280 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3282 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3283 ASET (prefer
, i
, AREF (face_font
, i
));
3285 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3286 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3287 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3288 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3289 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3290 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3291 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3293 return font_sort_entities (entities
, prefer
, frame
, c
);
3296 /* Return a font-entity satisfying SPEC and best matching with face's
3297 font related attributes in ATTRS. C, if not negative, is a
3298 character that the entity must support. */
3301 font_find_for_lface (f
, attrs
, spec
, c
)
3308 Lisp_Object frame
, entities
, val
;
3309 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3313 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3314 if (NILP (registry
[0]))
3316 registry
[0] = DEFAULT_ENCODING
;
3317 registry
[1] = Qascii_0
;
3318 registry
[2] = null_vector
;
3321 registry
[1] = null_vector
;
3323 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3325 struct charset
*encoding
, *repertory
;
3327 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3328 &encoding
, &repertory
) < 0)
3331 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3333 else if (c
> encoding
->max_char
)
3337 work
= Fcopy_font_spec (spec
);
3338 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3339 XSETFRAME (frame
, f
);
3340 size
= AREF (spec
, FONT_SIZE_INDEX
);
3341 pixel_size
= font_pixel_size (f
, spec
);
3342 if (pixel_size
== 0)
3344 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3346 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3348 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3349 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3350 if (! NILP (foundry
[0]))
3351 foundry
[1] = null_vector
;
3352 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3354 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3355 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3357 foundry
[2] = null_vector
;
3360 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3362 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3363 if (! NILP (adstyle
[0]))
3364 adstyle
[1] = null_vector
;
3365 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3367 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3369 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3371 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3373 adstyle
[2] = null_vector
;
3376 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3379 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3382 val
= AREF (work
, FONT_FAMILY_INDEX
);
3383 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3385 val
= attrs
[LFACE_FAMILY_INDEX
];
3386 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3390 family
= alloca ((sizeof family
[0]) * 2);
3392 family
[1] = null_vector
; /* terminator. */
3397 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3405 if (! NILP (alters
))
3407 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3408 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3409 family
[i
] = XCAR (alters
);
3410 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3412 family
[i
] = null_vector
;
3416 family
= alloca ((sizeof family
[0]) * 3);
3419 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3421 family
[i
] = null_vector
;
3425 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3427 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3428 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3430 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3431 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3433 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3434 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3436 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3437 entities
= font_list_entities (frame
, work
);
3438 if (! NILP (entities
))
3440 val
= font_select_entity (frame
, entities
,
3441 attrs
, pixel_size
, c
);
3454 font_open_for_lface (f
, entity
, attrs
, spec
)
3462 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3463 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3464 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3465 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3466 size
= font_pixel_size (f
, spec
);
3470 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3471 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3474 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3475 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3476 if (INTEGERP (height
))
3479 abort(); /* We should never end up here. */
3483 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3487 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3488 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3492 return font_open_entity (f
, entity
, size
);
3496 /* Find a font satisfying SPEC and best matching with face's
3497 attributes in ATTRS on FRAME, and return the opened
3501 font_load_for_lface (f
, attrs
, spec
)
3503 Lisp_Object
*attrs
, spec
;
3507 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3510 /* No font is listed for SPEC, but each font-backend may have
3511 the different criteria about "font matching". So, try
3513 entity
= font_matching_entity (f
, attrs
, spec
);
3517 return font_open_for_lface (f
, entity
, attrs
, spec
);
3521 /* Make FACE on frame F ready to use the font opened for FACE. */
3524 font_prepare_for_face (f
, face
)
3528 if (face
->font
->driver
->prepare_face
)
3529 face
->font
->driver
->prepare_face (f
, face
);
3533 /* Make FACE on frame F stop using the font opened for FACE. */
3536 font_done_for_face (f
, face
)
3540 if (face
->font
->driver
->done_face
)
3541 face
->font
->driver
->done_face (f
, face
);
3546 /* Open a font matching with font-spec SPEC on frame F. If no proper
3547 font is found, return Qnil. */
3550 font_open_by_spec (f
, spec
)
3554 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3556 /* We set up the default font-related attributes of a face to prefer
3558 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3559 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3560 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3562 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3564 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3566 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3568 return font_load_for_lface (f
, attrs
, spec
);
3572 /* Open a font matching with NAME on frame F. If no proper font is
3573 found, return Qnil. */
3576 font_open_by_name (f
, name
)
3580 Lisp_Object args
[2];
3584 args
[1] = make_unibyte_string (name
, strlen (name
));
3585 spec
= Ffont_spec (2, args
);
3586 return font_open_by_spec (f
, spec
);
3590 /* Register font-driver DRIVER. This function is used in two ways.
3592 The first is with frame F non-NULL. In this case, make DRIVER
3593 available (but not yet activated) on F. All frame creaters
3594 (e.g. Fx_create_frame) must call this function at least once with
3595 an available font-driver.
3597 The second is with frame F NULL. In this case, DRIVER is globally
3598 registered in the variable `font_driver_list'. All font-driver
3599 implementations must call this function in its syms_of_XXXX
3600 (e.g. syms_of_xfont). */
3603 register_font_driver (driver
, f
)
3604 struct font_driver
*driver
;
3607 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3608 struct font_driver_list
*prev
, *list
;
3610 if (f
&& ! driver
->draw
)
3611 error ("Unusable font driver for a frame: %s",
3612 SDATA (SYMBOL_NAME (driver
->type
)));
3614 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3615 if (EQ (list
->driver
->type
, driver
->type
))
3616 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3618 list
= xmalloc (sizeof (struct font_driver_list
));
3620 list
->driver
= driver
;
3625 f
->font_driver_list
= list
;
3627 font_driver_list
= list
;
3633 free_font_driver_list (f
)
3636 struct font_driver_list
*list
, *next
;
3638 for (list
= f
->font_driver_list
; list
; list
= next
)
3643 f
->font_driver_list
= NULL
;
3647 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3648 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3649 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3651 A caller must free all realized faces if any in advance. The
3652 return value is a list of font backends actually made used on
3656 font_update_drivers (f
, new_drivers
)
3658 Lisp_Object new_drivers
;
3660 Lisp_Object active_drivers
= Qnil
;
3661 struct font_driver
*driver
;
3662 struct font_driver_list
*list
;
3664 /* At first, turn off non-requested drivers, and turn on requested
3666 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3668 driver
= list
->driver
;
3669 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3674 if (driver
->end_for_frame
)
3675 driver
->end_for_frame (f
);
3676 font_finish_cache (f
, driver
);
3681 if (! driver
->start_for_frame
3682 || driver
->start_for_frame (f
) == 0)
3684 font_prepare_cache (f
, driver
);
3691 if (NILP (new_drivers
))
3694 if (! EQ (new_drivers
, Qt
))
3696 /* Re-order the driver list according to new_drivers. */
3697 struct font_driver_list
**list_table
, **next
;
3701 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3702 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3704 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3705 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3708 list_table
[i
++] = list
;
3710 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3712 list_table
[i
++] = list
;
3713 list_table
[i
] = NULL
;
3715 next
= &f
->font_driver_list
;
3716 for (i
= 0; list_table
[i
]; i
++)
3718 *next
= list_table
[i
];
3719 next
= &(*next
)->next
;
3723 if (! f
->font_driver_list
->on
)
3724 { /* None of the drivers is enabled: enable them all.
3725 Happens if you set the list of drivers to (xft x) in your .emacs
3726 and then use it under w32 or ns. */
3727 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3729 struct font_driver
*driver
= list
->driver
;
3730 eassert (! list
->on
);
3731 if (! driver
->start_for_frame
3732 || driver
->start_for_frame (f
) == 0)
3734 font_prepare_cache (f
, driver
);
3741 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3743 active_drivers
= nconc2 (active_drivers
,
3744 Fcons (list
->driver
->type
, Qnil
));
3745 return active_drivers
;
3749 font_put_frame_data (f
, driver
, data
)
3751 struct font_driver
*driver
;
3754 struct font_data_list
*list
, *prev
;
3756 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3757 prev
= list
, list
= list
->next
)
3758 if (list
->driver
== driver
)
3765 prev
->next
= list
->next
;
3767 f
->font_data_list
= list
->next
;
3775 list
= xmalloc (sizeof (struct font_data_list
));
3776 list
->driver
= driver
;
3777 list
->next
= f
->font_data_list
;
3778 f
->font_data_list
= list
;
3786 font_get_frame_data (f
, driver
)
3788 struct font_driver
*driver
;
3790 struct font_data_list
*list
;
3792 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3793 if (list
->driver
== driver
)
3801 /* Return the font used to draw character C by FACE at buffer position
3802 POS in window W. If STRING is non-nil, it is a string containing C
3803 at index POS. If C is negative, get C from the current buffer or
3807 font_at (c
, pos
, face
, w
, string
)
3816 Lisp_Object font_object
;
3818 multibyte
= (NILP (string
)
3819 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3820 : STRING_MULTIBYTE (string
));
3827 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3829 c
= FETCH_CHAR (pos_byte
);
3832 c
= FETCH_BYTE (pos
);
3838 multibyte
= STRING_MULTIBYTE (string
);
3841 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3843 str
= SDATA (string
) + pos_byte
;
3844 c
= STRING_CHAR (str
, 0);
3847 c
= SDATA (string
)[pos
];
3851 f
= XFRAME (w
->frame
);
3852 if (! FRAME_WINDOW_P (f
))
3859 if (STRINGP (string
))
3860 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3861 DEFAULT_FACE_ID
, 0);
3863 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3865 face
= FACE_FROM_ID (f
, face_id
);
3869 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3870 face
= FACE_FROM_ID (f
, face_id
);
3875 XSETFONT (font_object
, face
->font
);
3880 #ifdef HAVE_WINDOW_SYSTEM
3882 /* Check how many characters after POS (at most to *LIMIT) can be
3883 displayed by the same font on the window W. FACE, if non-NULL, is
3884 the face selected for the character at POS. If STRING is not nil,
3885 it is the string to check instead of the current buffer. In that
3886 case, FACE must be not NULL.
3888 The return value is the font-object for the character at POS.
3889 *LIMIT is set to the position where that font can't be used.
3891 It is assured that the current buffer (or STRING) is multibyte. */
3894 font_range (pos
, limit
, w
, face
, string
)
3895 EMACS_INT pos
, *limit
;
3900 EMACS_INT pos_byte
, ignore
, start
, start_byte
;
3902 Lisp_Object font_object
= Qnil
;
3906 pos_byte
= CHAR_TO_BYTE (pos
);
3911 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3913 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3919 pos_byte
= string_char_to_byte (string
, pos
);
3922 start
= pos
, start_byte
= pos_byte
;
3923 while (pos
< *limit
)
3925 Lisp_Object category
;
3928 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3930 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3931 if (NILP (font_object
))
3933 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3934 if (NILP (font_object
))
3939 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3940 if (! EQ (category
, QCf
)
3941 && ! CHAR_VARIATION_SELECTOR_P (c
)
3942 && font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3944 Lisp_Object f
= font_for_char (face
, c
, pos
- 1, string
);
3945 EMACS_INT i
, i_byte
;
3953 i
= start
, i_byte
= start_byte
;
3958 FETCH_CHAR_ADVANCE_NO_CHECK (c
, i
, i_byte
);
3960 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, i
, i_byte
);
3961 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3962 if (! EQ (category
, QCf
)
3963 && ! CHAR_VARIATION_SELECTOR_P (c
)
3964 && font_encode_char (f
, c
) == FONT_INVALID_CODE
)
3980 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3981 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3982 Return nil otherwise.
3983 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3984 which kind of font it is. It must be one of `font-spec', `font-entity',
3986 (object
, extra_type
)
3987 Lisp_Object object
, extra_type
;
3989 if (NILP (extra_type
))
3990 return (FONTP (object
) ? Qt
: Qnil
);
3991 if (EQ (extra_type
, Qfont_spec
))
3992 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3993 if (EQ (extra_type
, Qfont_entity
))
3994 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3995 if (EQ (extra_type
, Qfont_object
))
3996 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3997 wrong_type_argument (intern ("font-extra-type"), extra_type
);
4000 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
4001 doc
: /* Return a newly created font-spec with arguments as properties.
4003 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
4004 valid font property name listed below:
4006 `:family', `:weight', `:slant', `:width'
4008 They are the same as face attributes of the same name. See
4009 `set-face-attribute'.
4013 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
4017 VALUE must be a string or a symbol specifying the additional
4018 typographic style information of a font, e.g. ``sans''.
4022 VALUE must be a string or a symbol specifying the charset registry and
4023 encoding of a font, e.g. ``iso8859-1''.
4027 VALUE must be a non-negative integer or a floating point number
4028 specifying the font size. It specifies the font size in pixels (if
4029 VALUE is an integer), or in points (if VALUE is a float).
4033 VALUE must be a string of XLFD-style or fontconfig-style font name.
4037 VALUE must be a symbol representing a script that the font must
4038 support. It may be a symbol representing a subgroup of a script
4039 listed in the variable `script-representative-chars'.
4043 VALUE must be a symbol of two-letter ISO-639 language names,
4048 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
4049 required OpenType features.
4051 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
4052 LANGSYS-TAG: OpenType language system tag symbol,
4053 or nil for the default language system.
4054 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
4055 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
4057 GSUB and GPOS may contain `nil' element. In such a case, the font
4058 must not have any of the remaining elements.
4060 For instance, if the VALUE is `(thai nil nil (mark))', the font must
4061 be an OpenType font, and whose GPOS table of `thai' script's default
4062 language system must contain `mark' feature.
4064 usage: (font-spec ARGS...) */)
4069 Lisp_Object spec
= font_make_spec ();
4072 for (i
= 0; i
< nargs
; i
+= 2)
4074 Lisp_Object key
= args
[i
], val
;
4078 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
4081 if (EQ (key
, QCname
))
4084 font_parse_name ((char *) SDATA (val
), spec
);
4085 font_put_extra (spec
, key
, val
);
4089 int idx
= get_font_prop_index (key
);
4093 val
= font_prop_validate (idx
, Qnil
, val
);
4094 if (idx
< FONT_EXTRA_INDEX
)
4095 ASET (spec
, idx
, val
);
4097 font_put_extra (spec
, key
, val
);
4100 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
4106 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
4107 doc
: /* Return a copy of FONT as a font-spec. */)
4111 Lisp_Object new_spec
, tail
, prev
, extra
;
4115 new_spec
= font_make_spec ();
4116 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
4117 ASET (new_spec
, i
, AREF (font
, i
));
4118 extra
= Fcopy_sequence (AREF (font
, FONT_EXTRA_INDEX
));
4119 /* We must remove :font-entity property. */
4120 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
4121 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
4124 extra
= XCDR (extra
);
4126 XSETCDR (prev
, XCDR (tail
));
4129 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
4133 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
4134 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
4135 Every specified properties in FROM override the corresponding
4136 properties in TO. */)
4138 Lisp_Object from
, to
;
4140 Lisp_Object extra
, tail
;
4145 to
= Fcopy_font_spec (to
);
4146 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
4147 ASET (to
, i
, AREF (from
, i
));
4148 extra
= AREF (to
, FONT_EXTRA_INDEX
);
4149 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
4150 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
4152 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
4155 XSETCDR (slot
, XCDR (XCAR (tail
)));
4157 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
4159 ASET (to
, FONT_EXTRA_INDEX
, extra
);
4163 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
4164 doc
: /* Return the value of FONT's property KEY.
4165 FONT is a font-spec, a font-entity, or a font-object.
4166 KEY must be one of these symbols:
4167 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4168 :size, :name, :script
4169 See the documentation of `font-spec' for their meanings.
4170 If FONT is a font-entity or font-object, the value of :script may be
4171 a list of scripts that are supported by the font. */)
4173 Lisp_Object font
, key
;
4180 idx
= get_font_prop_index (key
);
4181 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4182 return font_style_symbolic (font
, idx
, 0);
4183 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4184 return AREF (font
, idx
);
4185 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
4188 #ifdef HAVE_WINDOW_SYSTEM
4190 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4191 doc
: /* Return a plist of face attributes generated by FONT.
4192 FONT is a font name, a font-spec, a font-entity, or a font-object.
4193 The return value is a list of the form
4195 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4197 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4198 compatible with `set-face-attribute'. Some of these key-attribute pairs
4199 may be omitted from the list if they are not specified by FONT.
4201 The optional argument FRAME specifies the frame that the face attributes
4202 are to be displayed on. If omitted, the selected frame is used. */)
4204 Lisp_Object font
, frame
;
4207 Lisp_Object plist
[10];
4212 frame
= selected_frame
;
4213 CHECK_LIVE_FRAME (frame
);
4218 int fontset
= fs_query_fontset (font
, 0);
4219 Lisp_Object name
= font
;
4221 font
= fontset_ascii (fontset
);
4222 font
= font_spec_from_name (name
);
4224 signal_error ("Invalid font name", name
);
4226 else if (! FONTP (font
))
4227 signal_error ("Invalid font object", font
);
4229 val
= AREF (font
, FONT_FAMILY_INDEX
);
4232 plist
[n
++] = QCfamily
;
4233 plist
[n
++] = SYMBOL_NAME (val
);
4236 val
= AREF (font
, FONT_SIZE_INDEX
);
4239 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4240 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4241 plist
[n
++] = QCheight
;
4242 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4244 else if (FLOATP (val
))
4246 plist
[n
++] = QCheight
;
4247 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4250 val
= FONT_WEIGHT_FOR_FACE (font
);
4253 plist
[n
++] = QCweight
;
4257 val
= FONT_SLANT_FOR_FACE (font
);
4260 plist
[n
++] = QCslant
;
4264 val
= FONT_WIDTH_FOR_FACE (font
);
4267 plist
[n
++] = QCwidth
;
4271 return Flist (n
, plist
);
4276 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4277 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
4278 (font_spec
, prop
, val
)
4279 Lisp_Object font_spec
, prop
, val
;
4283 CHECK_FONT_SPEC (font_spec
);
4284 idx
= get_font_prop_index (prop
);
4285 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4286 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
4288 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
4292 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4293 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4294 Optional 2nd argument FRAME specifies the target frame.
4295 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4296 Optional 4th argument PREFER, if non-nil, is a font-spec to
4297 control the order of the returned list. Fonts are sorted by
4298 how close they are to PREFER. */)
4299 (font_spec
, frame
, num
, prefer
)
4300 Lisp_Object font_spec
, frame
, num
, prefer
;
4302 Lisp_Object vec
, list
;
4306 frame
= selected_frame
;
4307 CHECK_LIVE_FRAME (frame
);
4308 CHECK_FONT_SPEC (font_spec
);
4316 if (! NILP (prefer
))
4317 CHECK_FONT_SPEC (prefer
);
4319 list
= font_list_entities (frame
, font_spec
);
4322 if (NILP (XCDR (list
))
4323 && ASIZE (XCAR (list
)) == 1)
4324 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4326 if (! NILP (prefer
))
4327 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4329 vec
= font_vconcat_entity_vectors (list
);
4330 if (n
== 0 || n
>= ASIZE (vec
))
4332 Lisp_Object args
[2];
4336 list
= Fappend (2, args
);
4340 for (list
= Qnil
, n
--; n
>= 0; n
--)
4341 list
= Fcons (AREF (vec
, n
), list
);
4346 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4347 doc
: /* List available font families on the current frame.
4348 Optional argument FRAME, if non-nil, specifies the target frame. */)
4353 struct font_driver_list
*driver_list
;
4357 frame
= selected_frame
;
4358 CHECK_LIVE_FRAME (frame
);
4361 for (driver_list
= f
->font_driver_list
; driver_list
;
4362 driver_list
= driver_list
->next
)
4363 if (driver_list
->driver
->list_family
)
4365 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4366 Lisp_Object tail
= list
;
4368 for (; CONSP (val
); val
= XCDR (val
))
4369 if (NILP (Fmemq (XCAR (val
), tail
))
4370 && SYMBOLP (XCAR (val
)))
4371 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4376 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4377 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4378 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4380 Lisp_Object font_spec
, frame
;
4382 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4389 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4390 doc
: /* Return XLFD name of FONT.
4391 FONT is a font-spec, font-entity, or font-object.
4392 If the name is too long for XLFD (maximum 255 chars), return nil.
4393 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4394 the consecutive wildcards are folded to one. */)
4395 (font
, fold_wildcards
)
4396 Lisp_Object font
, fold_wildcards
;
4403 if (FONT_OBJECT_P (font
))
4405 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4407 if (STRINGP (font_name
)
4408 && SDATA (font_name
)[0] == '-')
4410 if (NILP (fold_wildcards
))
4412 strcpy (name
, (char *) SDATA (font_name
));
4415 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4417 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4420 if (! NILP (fold_wildcards
))
4422 char *p0
= name
, *p1
;
4424 while ((p1
= strstr (p0
, "-*-*")))
4426 strcpy (p1
, p1
+ 2);
4431 return build_string (name
);
4434 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4435 doc
: /* Clear font cache. */)
4438 Lisp_Object list
, frame
;
4440 FOR_EACH_FRAME (list
, frame
)
4442 FRAME_PTR f
= XFRAME (frame
);
4443 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4445 for (; driver_list
; driver_list
= driver_list
->next
)
4446 if (driver_list
->on
)
4448 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4453 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4455 font_assert (! NILP (val
));
4456 val
= XCDR (XCAR (val
));
4457 if (XINT (XCAR (val
)) == 0)
4459 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4460 XSETCDR (cache
, XCDR (val
));
4470 font_fill_lglyph_metrics (glyph
, font_object
)
4471 Lisp_Object glyph
, font_object
;
4473 struct font
*font
= XFONT_OBJECT (font_object
);
4475 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4476 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4477 struct font_metrics metrics
;
4479 LGLYPH_SET_CODE (glyph
, ecode
);
4481 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4482 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4483 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4484 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4485 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4486 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4490 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4491 doc
: /* Shape the glyph-string GSTRING.
4492 Shaping means substituting glyphs and/or adjusting positions of glyphs
4493 to get the correct visual image of character sequences set in the
4494 header of the glyph-string.
4496 If the shaping was successful, the value is GSTRING itself or a newly
4497 created glyph-string. Otherwise, the value is nil. */)
4499 Lisp_Object gstring
;
4502 Lisp_Object font_object
, n
, glyph
;
4505 if (! composition_gstring_p (gstring
))
4506 signal_error ("Invalid glyph-string: ", gstring
);
4507 if (! NILP (LGSTRING_ID (gstring
)))
4509 font_object
= LGSTRING_FONT (gstring
);
4510 CHECK_FONT_OBJECT (font_object
);
4511 font
= XFONT_OBJECT (font_object
);
4512 if (! font
->driver
->shape
)
4515 /* Try at most three times with larger gstring each time. */
4516 for (i
= 0; i
< 3; i
++)
4518 n
= font
->driver
->shape (gstring
);
4521 gstring
= larger_vector (gstring
,
4522 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4525 if (i
== 3 || XINT (n
) == 0)
4528 glyph
= LGSTRING_GLYPH (gstring
, 0);
4529 from
= LGLYPH_FROM (glyph
);
4530 to
= LGLYPH_TO (glyph
);
4531 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4533 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4537 if (NILP (LGLYPH_ADJUSTMENT (this)))
4542 glyph
= LGSTRING_GLYPH (gstring
, j
);
4543 LGLYPH_SET_FROM (glyph
, from
);
4544 LGLYPH_SET_TO (glyph
, to
);
4546 from
= LGLYPH_FROM (this);
4547 to
= LGLYPH_TO (this);
4552 if (from
> LGLYPH_FROM (this))
4553 from
= LGLYPH_FROM (this);
4554 if (to
< LGLYPH_TO (this))
4555 to
= LGLYPH_TO (this);
4561 glyph
= LGSTRING_GLYPH (gstring
, j
);
4562 LGLYPH_SET_FROM (glyph
, from
);
4563 LGLYPH_SET_TO (glyph
, to
);
4565 return composition_gstring_put_cache (gstring
, XINT (n
));
4568 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4570 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4571 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4573 VARIATION-SELECTOR is a chracter code of variation selection
4574 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4575 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4576 (font_object
, character
)
4577 Lisp_Object font_object
, character
;
4579 unsigned variations
[256];
4584 CHECK_FONT_OBJECT (font_object
);
4585 CHECK_CHARACTER (character
);
4586 font
= XFONT_OBJECT (font_object
);
4587 if (! font
->driver
->get_variation_glyphs
)
4589 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4593 for (i
= 0; i
< 255; i
++)
4597 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4598 /* Stops GCC whining about limited range of data type. */
4599 EMACS_INT var
= variations
[i
];
4601 if (var
> MOST_POSITIVE_FIXNUM
)
4602 code
= Fcons (make_number ((variations
[i
]) >> 16),
4603 make_number ((variations
[i
]) & 0xFFFF));
4605 code
= make_number (variations
[i
]);
4606 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4613 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4614 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4615 OTF-FEATURES specifies which features to apply in this format:
4616 (SCRIPT LANGSYS GSUB GPOS)
4618 SCRIPT is a symbol specifying a script tag of OpenType,
4619 LANGSYS is a symbol specifying a langsys tag of OpenType,
4620 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4622 If LANGYS is nil, the default langsys is selected.
4624 The features are applied in the order they appear in the list. The
4625 symbol `*' means to apply all available features not present in this
4626 list, and the remaining features are ignored. For instance, (vatu
4627 pstf * haln) is to apply vatu and pstf in this order, then to apply
4628 all available features other than vatu, pstf, and haln.
4630 The features are applied to the glyphs in the range FROM and TO of
4631 the glyph-string GSTRING-IN.
4633 If some feature is actually applicable, the resulting glyphs are
4634 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4635 this case, the value is the number of produced glyphs.
4637 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4640 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4641 produced in GSTRING-OUT, and the value is nil.
4643 See the documentation of `font-make-gstring' for the format of
4645 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4646 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4648 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4653 check_otf_features (otf_features
);
4654 CHECK_FONT_OBJECT (font_object
);
4655 font
= XFONT_OBJECT (font_object
);
4656 if (! font
->driver
->otf_drive
)
4657 error ("Font backend %s can't drive OpenType GSUB table",
4658 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4659 CHECK_CONS (otf_features
);
4660 CHECK_SYMBOL (XCAR (otf_features
));
4661 val
= XCDR (otf_features
);
4662 CHECK_SYMBOL (XCAR (val
));
4663 val
= XCDR (otf_features
);
4666 len
= check_gstring (gstring_in
);
4667 CHECK_VECTOR (gstring_out
);
4668 CHECK_NATNUM (from
);
4670 CHECK_NATNUM (index
);
4672 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4673 args_out_of_range_3 (from
, to
, make_number (len
));
4674 if (XINT (index
) >= ASIZE (gstring_out
))
4675 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4676 num
= font
->driver
->otf_drive (font
, otf_features
,
4677 gstring_in
, XINT (from
), XINT (to
),
4678 gstring_out
, XINT (index
), 0);
4681 return make_number (num
);
4684 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4686 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4687 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4689 (SCRIPT LANGSYS FEATURE ...)
4690 See the documentation of `font-drive-otf' for more detail.
4692 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4693 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4694 character code corresponding to the glyph or nil if there's no
4695 corresponding character. */)
4696 (font_object
, character
, otf_features
)
4697 Lisp_Object font_object
, character
, otf_features
;
4700 Lisp_Object gstring_in
, gstring_out
, g
;
4701 Lisp_Object alternates
;
4704 CHECK_FONT_GET_OBJECT (font_object
, font
);
4705 if (! font
->driver
->otf_drive
)
4706 error ("Font backend %s can't drive OpenType GSUB table",
4707 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4708 CHECK_CHARACTER (character
);
4709 CHECK_CONS (otf_features
);
4711 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4712 g
= LGSTRING_GLYPH (gstring_in
, 0);
4713 LGLYPH_SET_CHAR (g
, XINT (character
));
4714 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4715 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4716 gstring_out
, 0, 1)) < 0)
4717 gstring_out
= Ffont_make_gstring (font_object
,
4718 make_number (ASIZE (gstring_out
) * 2));
4720 for (i
= 0; i
< num
; i
++)
4722 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4723 int c
= LGLYPH_CHAR (g
);
4724 unsigned code
= LGLYPH_CODE (g
);
4726 alternates
= Fcons (Fcons (make_number (code
),
4727 c
> 0 ? make_number (c
) : Qnil
),
4730 return Fnreverse (alternates
);
4736 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4737 doc
: /* Open FONT-ENTITY. */)
4738 (font_entity
, size
, frame
)
4739 Lisp_Object font_entity
;
4745 CHECK_FONT_ENTITY (font_entity
);
4747 frame
= selected_frame
;
4748 CHECK_LIVE_FRAME (frame
);
4751 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4754 CHECK_NUMBER_OR_FLOAT (size
);
4756 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4758 isize
= XINT (size
);
4762 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4765 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4766 doc
: /* Close FONT-OBJECT. */)
4767 (font_object
, frame
)
4768 Lisp_Object font_object
, frame
;
4770 CHECK_FONT_OBJECT (font_object
);
4772 frame
= selected_frame
;
4773 CHECK_LIVE_FRAME (frame
);
4774 font_close_object (XFRAME (frame
), font_object
);
4778 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4779 doc
: /* Return information about FONT-OBJECT.
4780 The value is a vector:
4781 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4784 NAME is a string of the font name (or nil if the font backend doesn't
4787 FILENAME is a string of the font file (or nil if the font backend
4788 doesn't provide a file name).
4790 PIXEL-SIZE is a pixel size by which the font is opened.
4792 SIZE is a maximum advance width of the font in pixels.
4794 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4797 CAPABILITY is a list whose first element is a symbol representing the
4798 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4799 remaining elements describe the details of the font capability.
4801 If the font is OpenType font, the form of the list is
4802 \(opentype GSUB GPOS)
4803 where GSUB shows which "GSUB" features the font supports, and GPOS
4804 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4805 lists of the format:
4806 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4808 If the font is not OpenType font, currently the length of the form is
4811 SCRIPT is a symbol representing OpenType script tag.
4813 LANGSYS is a symbol representing OpenType langsys tag, or nil
4814 representing the default langsys.
4816 FEATURE is a symbol representing OpenType feature tag.
4818 If the font is not OpenType font, CAPABILITY is nil. */)
4820 Lisp_Object font_object
;
4825 CHECK_FONT_GET_OBJECT (font_object
, font
);
4827 val
= Fmake_vector (make_number (9), Qnil
);
4828 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4829 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4830 ASET (val
, 2, make_number (font
->pixel_size
));
4831 ASET (val
, 3, make_number (font
->max_width
));
4832 ASET (val
, 4, make_number (font
->ascent
));
4833 ASET (val
, 5, make_number (font
->descent
));
4834 ASET (val
, 6, make_number (font
->space_width
));
4835 ASET (val
, 7, make_number (font
->average_width
));
4836 if (font
->driver
->otf_capability
)
4837 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4841 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4842 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4843 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4844 (font_object
, string
)
4845 Lisp_Object font_object
, string
;
4851 CHECK_FONT_GET_OBJECT (font_object
, font
);
4852 CHECK_STRING (string
);
4853 len
= SCHARS (string
);
4854 vec
= Fmake_vector (make_number (len
), Qnil
);
4855 for (i
= 0; i
< len
; i
++)
4857 Lisp_Object ch
= Faref (string
, make_number (i
));
4862 struct font_metrics metrics
;
4864 cod
= code
= font
->driver
->encode_char (font
, c
);
4865 if (code
== FONT_INVALID_CODE
)
4867 val
= Fmake_vector (make_number (6), Qnil
);
4868 if (cod
<= MOST_POSITIVE_FIXNUM
)
4869 ASET (val
, 0, make_number (code
));
4871 ASET (val
, 0, Fcons (make_number (code
>> 16),
4872 make_number (code
& 0xFFFF)));
4873 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4874 ASET (val
, 1, make_number (metrics
.lbearing
));
4875 ASET (val
, 2, make_number (metrics
.rbearing
));
4876 ASET (val
, 3, make_number (metrics
.width
));
4877 ASET (val
, 4, make_number (metrics
.ascent
));
4878 ASET (val
, 5, make_number (metrics
.descent
));
4884 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4885 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4886 FONT is a font-spec, font-entity, or font-object. */)
4888 Lisp_Object spec
, font
;
4890 CHECK_FONT_SPEC (spec
);
4893 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4896 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4897 doc
: /* Return a font-object for displaying a character at POSITION.
4898 Optional second arg WINDOW, if non-nil, is a window displaying
4899 the current buffer. It defaults to the currently selected window. */)
4900 (position
, window
, string
)
4901 Lisp_Object position
, window
, string
;
4908 CHECK_NUMBER_COERCE_MARKER (position
);
4909 pos
= XINT (position
);
4910 if (pos
< BEGV
|| pos
>= ZV
)
4911 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4915 CHECK_NUMBER (position
);
4916 CHECK_STRING (string
);
4917 pos
= XINT (position
);
4918 if (pos
< 0 || pos
>= SCHARS (string
))
4919 args_out_of_range (string
, position
);
4922 window
= selected_window
;
4923 CHECK_LIVE_WINDOW (window
);
4924 w
= XWINDOW (window
);
4926 return font_at (-1, pos
, NULL
, w
, string
);
4930 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4931 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4932 The value is a number of glyphs drawn.
4933 Type C-l to recover what previously shown. */)
4934 (font_object
, string
)
4935 Lisp_Object font_object
, string
;
4937 Lisp_Object frame
= selected_frame
;
4938 FRAME_PTR f
= XFRAME (frame
);
4944 CHECK_FONT_GET_OBJECT (font_object
, font
);
4945 CHECK_STRING (string
);
4946 len
= SCHARS (string
);
4947 code
= alloca (sizeof (unsigned) * len
);
4948 for (i
= 0; i
< len
; i
++)
4950 Lisp_Object ch
= Faref (string
, make_number (i
));
4954 code
[i
] = font
->driver
->encode_char (font
, c
);
4955 if (code
[i
] == FONT_INVALID_CODE
)
4958 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4960 if (font
->driver
->prepare_face
)
4961 font
->driver
->prepare_face (f
, face
);
4962 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4963 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4964 if (font
->driver
->done_face
)
4965 font
->driver
->done_face (f
, face
);
4967 return make_number (len
);
4971 #endif /* FONT_DEBUG */
4973 #ifdef HAVE_WINDOW_SYSTEM
4975 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4976 doc
: /* Return information about a font named NAME on frame FRAME.
4977 If FRAME is omitted or nil, use the selected frame.
4978 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4979 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4981 OPENED-NAME is the name used for opening the font,
4982 FULL-NAME is the full name of the font,
4983 SIZE is the pixelsize of the font,
4984 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4985 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4986 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4987 how to compose characters.
4988 If the named font is not yet loaded, return nil. */)
4990 Lisp_Object name
, frame
;
4995 Lisp_Object font_object
;
4997 (*check_window_system_func
) ();
5000 CHECK_STRING (name
);
5002 frame
= selected_frame
;
5003 CHECK_LIVE_FRAME (frame
);
5008 int fontset
= fs_query_fontset (name
, 0);
5011 name
= fontset_ascii (fontset
);
5012 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
5014 else if (FONT_OBJECT_P (name
))
5016 else if (FONT_ENTITY_P (name
))
5017 font_object
= font_open_entity (f
, name
, 0);
5020 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5021 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
5023 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
5025 if (NILP (font_object
))
5027 font
= XFONT_OBJECT (font_object
);
5029 info
= Fmake_vector (make_number (7), Qnil
);
5030 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
5031 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
5032 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
5033 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
5034 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
5035 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
5036 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
5039 /* As font_object is still in FONT_OBJLIST of the entity, we can't
5040 close it now. Perhaps, we should manage font-objects
5041 by `reference-count'. */
5042 font_close_object (f
, font_object
);
5049 #define BUILD_STYLE_TABLE(TBL) \
5050 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
5053 build_style_table (entry
, nelement
)
5054 struct table_entry
*entry
;
5058 Lisp_Object table
, elt
;
5060 table
= Fmake_vector (make_number (nelement
), Qnil
);
5061 for (i
= 0; i
< nelement
; i
++)
5063 for (j
= 0; entry
[i
].names
[j
]; j
++);
5064 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
5065 ASET (elt
, 0, make_number (entry
[i
].numeric
));
5066 for (j
= 0; entry
[i
].names
[j
]; j
++)
5067 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
5068 ASET (table
, i
, elt
);
5073 Lisp_Object Vfont_log
;
5075 /* The deferred font-log data of the form [ACTION ARG RESULT].
5076 If ACTION is not nil, that is added to the log when font_add_log is
5077 called next time. At that time, ACTION is set back to nil. */
5078 static Lisp_Object Vfont_log_deferred
;
5080 /* Prepend the font-related logging data in Vfont_log if it is not
5081 `t'. ACTION describes a kind of font-related action (e.g. listing,
5082 opening), ARG is the argument for the action, and RESULT is the
5083 result of the action. */
5085 font_add_log (action
, arg
, result
)
5087 Lisp_Object arg
, result
;
5089 Lisp_Object tail
, val
;
5092 if (EQ (Vfont_log
, Qt
))
5094 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5096 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
5098 ASET (Vfont_log_deferred
, 0, Qnil
);
5099 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5100 AREF (Vfont_log_deferred
, 2));
5105 Lisp_Object tail
, elt
;
5106 Lisp_Object equalstr
= build_string ("=");
5108 val
= Ffont_xlfd_name (arg
, Qt
);
5109 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5113 if (EQ (XCAR (elt
), QCscript
)
5114 && SYMBOLP (XCDR (elt
)))
5115 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5116 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5117 else if (EQ (XCAR (elt
), QClang
)
5118 && SYMBOLP (XCDR (elt
)))
5119 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5120 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5121 else if (EQ (XCAR (elt
), QCotf
)
5122 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5123 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5125 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5131 && VECTORP (XCAR (result
))
5132 && ASIZE (XCAR (result
)) > 0
5133 && FONTP (AREF (XCAR (result
), 0)))
5134 result
= font_vconcat_entity_vectors (result
);
5137 val
= Ffont_xlfd_name (result
, Qt
);
5138 if (! FONT_SPEC_P (result
))
5139 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5140 build_string (":"), val
);
5143 else if (CONSP (result
))
5145 result
= Fcopy_sequence (result
);
5146 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5150 val
= Ffont_xlfd_name (val
, Qt
);
5151 XSETCAR (tail
, val
);
5154 else if (VECTORP (result
))
5156 result
= Fcopy_sequence (result
);
5157 for (i
= 0; i
< ASIZE (result
); i
++)
5159 val
= AREF (result
, i
);
5161 val
= Ffont_xlfd_name (val
, Qt
);
5162 ASET (result
, i
, val
);
5165 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5168 /* Record a font-related logging data to be added to Vfont_log when
5169 font_add_log is called next time. ACTION, ARG, RESULT are the same
5173 font_deferred_log (action
, arg
, result
)
5175 Lisp_Object arg
, result
;
5177 if (EQ (Vfont_log
, Qt
))
5179 ASET (Vfont_log_deferred
, 0, build_string (action
));
5180 ASET (Vfont_log_deferred
, 1, arg
);
5181 ASET (Vfont_log_deferred
, 2, result
);
5184 extern void syms_of_ftfont
P_ (());
5185 extern void syms_of_xfont
P_ (());
5186 extern void syms_of_xftfont
P_ (());
5187 extern void syms_of_ftxfont
P_ (());
5188 extern void syms_of_bdffont
P_ (());
5189 extern void syms_of_w32font
P_ (());
5190 extern void syms_of_atmfont
P_ (());
5191 extern void syms_of_nsfont
P_ (());
5196 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5197 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5198 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5199 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5200 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5201 /* Note that the other elements in sort_shift_bits are not used. */
5203 staticpro (&font_charset_alist
);
5204 font_charset_alist
= Qnil
;
5206 DEFSYM (Qopentype
, "opentype");
5208 DEFSYM (Qascii_0
, "ascii-0");
5209 DEFSYM (Qiso8859_1
, "iso8859-1");
5210 DEFSYM (Qiso10646_1
, "iso10646-1");
5211 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5212 DEFSYM (Qunicode_sip
, "unicode-sip");
5216 DEFSYM (QCotf
, ":otf");
5217 DEFSYM (QClang
, ":lang");
5218 DEFSYM (QCscript
, ":script");
5219 DEFSYM (QCantialias
, ":antialias");
5221 DEFSYM (QCfoundry
, ":foundry");
5222 DEFSYM (QCadstyle
, ":adstyle");
5223 DEFSYM (QCregistry
, ":registry");
5224 DEFSYM (QCspacing
, ":spacing");
5225 DEFSYM (QCdpi
, ":dpi");
5226 DEFSYM (QCscalable
, ":scalable");
5227 DEFSYM (QCavgwidth
, ":avgwidth");
5228 DEFSYM (QCfont_entity
, ":font-entity");
5229 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5239 staticpro (&null_vector
);
5240 null_vector
= Fmake_vector (make_number (0), Qnil
);
5242 staticpro (&scratch_font_spec
);
5243 scratch_font_spec
= Ffont_spec (0, NULL
);
5244 staticpro (&scratch_font_prefer
);
5245 scratch_font_prefer
= Ffont_spec (0, NULL
);
5247 staticpro (&Vfont_log_deferred
);
5248 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5252 staticpro (&otf_list
);
5254 #endif /* HAVE_LIBOTF */
5258 defsubr (&Sfont_spec
);
5259 defsubr (&Sfont_get
);
5260 #ifdef HAVE_WINDOW_SYSTEM
5261 defsubr (&Sfont_face_attributes
);
5263 defsubr (&Sfont_put
);
5264 defsubr (&Slist_fonts
);
5265 defsubr (&Sfont_family_list
);
5266 defsubr (&Sfind_font
);
5267 defsubr (&Sfont_xlfd_name
);
5268 defsubr (&Sclear_font_cache
);
5269 defsubr (&Sfont_shape_gstring
);
5270 defsubr (&Sfont_variation_glyphs
);
5272 defsubr (&Sfont_drive_otf
);
5273 defsubr (&Sfont_otf_alternates
);
5277 defsubr (&Sopen_font
);
5278 defsubr (&Sclose_font
);
5279 defsubr (&Squery_font
);
5280 defsubr (&Sget_font_glyphs
);
5281 defsubr (&Sfont_match_p
);
5282 defsubr (&Sfont_at
);
5284 defsubr (&Sdraw_string
);
5286 #endif /* FONT_DEBUG */
5287 #ifdef HAVE_WINDOW_SYSTEM
5288 defsubr (&Sfont_info
);
5291 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5293 Alist of fontname patterns vs the corresponding encoding and repertory info.
5294 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5295 where ENCODING is a charset or a char-table,
5296 and REPERTORY is a charset, a char-table, or nil.
5298 If ENCODING and REPERTORY are the same, the element can have the form
5299 \(REGEXP . ENCODING).
5301 ENCODING is for converting a character to a glyph code of the font.
5302 If ENCODING is a charset, encoding a character by the charset gives
5303 the corresponding glyph code. If ENCODING is a char-table, looking up
5304 the table by a character gives the corresponding glyph code.
5306 REPERTORY specifies a repertory of characters supported by the font.
5307 If REPERTORY is a charset, all characters beloging to the charset are
5308 supported. If REPERTORY is a char-table, all characters who have a
5309 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5310 gets the repertory information by an opened font and ENCODING. */);
5311 Vfont_encoding_alist
= Qnil
;
5313 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5314 doc
: /* Vector of valid font weight values.
5315 Each element has the form:
5316 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5317 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5318 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5320 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5321 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5322 See `font-weight-table' for the format of the vector. */);
5323 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5325 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5326 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5327 See `font-weight-table' for the format of the vector. */);
5328 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5330 staticpro (&font_style_table
);
5331 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5332 ASET (font_style_table
, 0, Vfont_weight_table
);
5333 ASET (font_style_table
, 1, Vfont_slant_table
);
5334 ASET (font_style_table
, 2, Vfont_width_table
);
5336 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5337 *Logging list of font related actions and results.
5338 The value t means to suppress the logging.
5339 The initial value is set to nil if the environment variable
5340 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5343 #ifdef HAVE_WINDOW_SYSTEM
5344 #ifdef HAVE_FREETYPE
5346 #ifdef HAVE_X_WINDOWS
5351 #endif /* HAVE_XFT */
5352 #endif /* HAVE_X_WINDOWS */
5353 #else /* not HAVE_FREETYPE */
5354 #ifdef HAVE_X_WINDOWS
5356 #endif /* HAVE_X_WINDOWS */
5357 #endif /* not HAVE_FREETYPE */
5360 #endif /* HAVE_BDFFONT */
5363 #endif /* WINDOWSNT */
5366 #endif /* HAVE_NS */
5367 #endif /* HAVE_WINDOW_SYSTEM */
5373 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
5376 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5377 (do not change this comment) */