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 ASET (font
, FONT_DPI_INDEX
, INTERN_FIELD (XLFD_RESY_INDEX
));
1143 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1146 val
= font_prop_validate_spacing (QCspacing
, val
);
1147 if (! INTEGERP (val
))
1149 ASET (font
, FONT_SPACING_INDEX
, val
);
1151 p
= f
[XLFD_AVGWIDTH_INDEX
];
1154 ASET (font
, FONT_AVGWIDTH_INDEX
,
1155 font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0));
1159 int wild_card_found
= 0;
1160 Lisp_Object prop
[XLFD_LAST_INDEX
];
1162 if (FONT_ENTITY_P (font
))
1164 for (j
= 0; j
< i
; j
++)
1168 if (f
[j
][1] && f
[j
][1] != '-')
1171 wild_card_found
= 1;
1174 prop
[j
] = INTERN_FIELD (j
);
1176 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1178 if (! wild_card_found
)
1180 if (font_expand_wildcards (prop
, i
) < 0)
1183 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1184 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1185 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1186 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1187 if (! NILP (prop
[i
]))
1189 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1191 ASET (font
, j
, make_number (n
));
1193 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1194 val
= prop
[XLFD_REGISTRY_INDEX
];
1197 val
= prop
[XLFD_ENCODING_INDEX
];
1199 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1201 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1202 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1204 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1205 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1207 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1209 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1210 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1211 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1213 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1215 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1218 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1219 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1220 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1222 val
= font_prop_validate_spacing (QCspacing
,
1223 prop
[XLFD_SPACING_INDEX
]);
1224 if (! INTEGERP (val
))
1226 ASET (font
, FONT_SPACING_INDEX
, val
);
1228 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1229 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1235 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1236 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1237 0, use PIXEL_SIZE instead. */
1240 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1246 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1250 font_assert (FONTP (font
));
1252 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1255 if (i
== FONT_ADSTYLE_INDEX
)
1256 j
= XLFD_ADSTYLE_INDEX
;
1257 else if (i
== FONT_REGISTRY_INDEX
)
1258 j
= XLFD_REGISTRY_INDEX
;
1259 val
= AREF (font
, i
);
1262 if (j
== XLFD_REGISTRY_INDEX
)
1263 f
[j
] = "*-*", len
+= 4;
1265 f
[j
] = "*", len
+= 2;
1270 val
= SYMBOL_NAME (val
);
1271 if (j
== XLFD_REGISTRY_INDEX
1272 && ! strchr ((char *) SDATA (val
), '-'))
1274 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1275 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1277 f
[j
] = alloca (SBYTES (val
) + 3);
1278 sprintf (f
[j
], "%s-*", SDATA (val
));
1279 len
+= SBYTES (val
) + 3;
1283 f
[j
] = alloca (SBYTES (val
) + 4);
1284 sprintf (f
[j
], "%s*-*", SDATA (val
));
1285 len
+= SBYTES (val
) + 4;
1289 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1293 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1296 val
= font_style_symbolic (font
, i
, 0);
1298 f
[j
] = "*", len
+= 2;
1301 val
= SYMBOL_NAME (val
);
1302 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1306 val
= AREF (font
, FONT_SIZE_INDEX
);
1307 font_assert (NUMBERP (val
) || NILP (val
));
1315 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1316 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1319 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1321 else if (FLOATP (val
))
1323 i
= XFLOAT_DATA (val
) * 10;
1324 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1325 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1328 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1330 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1332 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1333 f
[XLFD_RESX_INDEX
] = alloca (22);
1334 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1338 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1339 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1341 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1343 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1344 : spacing
<= FONT_SPACING_DUAL
? "d"
1345 : spacing
<= FONT_SPACING_MONO
? "m"
1350 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1351 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1353 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1354 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
],
1355 "%d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1358 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1359 len
++; /* for terminating '\0'. */
1362 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1363 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1364 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1365 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1366 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1367 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1368 f
[XLFD_REGISTRY_INDEX
]);
1371 /* Parse NAME (null terminated) and store information in FONT
1372 (font-spec or font-entity). NAME is supplied in either the
1373 Fontconfig or GTK font name format. If NAME is successfully
1374 parsed, return 0. Otherwise return -1.
1376 The fontconfig format is
1378 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1382 FAMILY [PROPS...] [SIZE]
1384 This function tries to guess which format it is. */
1387 font_parse_fcname (name
, font
)
1392 char *size_beg
= NULL
, *size_end
= NULL
;
1393 char *props_beg
= NULL
, *family_end
= NULL
;
1394 int len
= strlen (name
);
1399 for (p
= name
; *p
; p
++)
1401 if (*p
== '\\' && p
[1])
1405 props_beg
= family_end
= p
;
1410 int decimal
= 0, size_found
= 1;
1411 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1414 if (*q
!= '.' || decimal
)
1433 /* A fontconfig name with size and/or property data. */
1434 if (family_end
> name
)
1437 family
= font_intern_prop (name
, family_end
- name
, 1);
1438 ASET (font
, FONT_FAMILY_INDEX
, family
);
1442 double point_size
= strtod (size_beg
, &size_end
);
1443 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1444 if (*size_end
== ':' && size_end
[1])
1445 props_beg
= size_end
;
1449 /* Now parse ":KEY=VAL" patterns. */
1452 for (p
= props_beg
; *p
; p
= q
)
1454 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1457 /* Must be an enumerated value. */
1461 val
= font_intern_prop (p
, q
- p
, 1);
1463 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1465 if (PROP_MATCH ("light", 5)
1466 || PROP_MATCH ("medium", 6)
1467 || PROP_MATCH ("demibold", 8)
1468 || PROP_MATCH ("bold", 4)
1469 || PROP_MATCH ("black", 5))
1470 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1471 else if (PROP_MATCH ("roman", 5)
1472 || PROP_MATCH ("italic", 6)
1473 || PROP_MATCH ("oblique", 7))
1474 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1475 else if (PROP_MATCH ("charcell", 8))
1476 ASET (font
, FONT_SPACING_INDEX
,
1477 make_number (FONT_SPACING_CHARCELL
));
1478 else if (PROP_MATCH ("mono", 4))
1479 ASET (font
, FONT_SPACING_INDEX
,
1480 make_number (FONT_SPACING_MONO
));
1481 else if (PROP_MATCH ("proportional", 12))
1482 ASET (font
, FONT_SPACING_INDEX
,
1483 make_number (FONT_SPACING_PROPORTIONAL
));
1492 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1493 prop
= FONT_SIZE_INDEX
;
1496 key
= font_intern_prop (p
, q
- p
, 1);
1497 prop
= get_font_prop_index (key
);
1501 for (q
= p
; *q
&& *q
!= ':'; q
++);
1502 val
= font_intern_prop (p
, q
- p
, 0);
1504 if (prop
>= FONT_FOUNDRY_INDEX
1505 && prop
< FONT_EXTRA_INDEX
)
1506 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1508 Ffont_put (font
, key
, val
);
1516 /* Either a fontconfig-style name with no size and property
1517 data, or a GTK-style name. */
1519 int word_len
, prop_found
= 0;
1521 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1527 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1535 double point_size
= strtod (p
, &q
);
1536 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1541 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1542 if (*q
== '\\' && q
[1])
1546 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1548 if (PROP_MATCH ("Ultra-Light", 11))
1551 prop
= font_intern_prop ("ultra-light", 11, 1);
1552 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1554 else if (PROP_MATCH ("Light", 5))
1557 prop
= font_intern_prop ("light", 5, 1);
1558 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1560 else if (PROP_MATCH ("Semi-Bold", 9))
1563 prop
= font_intern_prop ("semi-bold", 9, 1);
1564 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1566 else if (PROP_MATCH ("Bold", 4))
1569 prop
= font_intern_prop ("bold", 4, 1);
1570 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1572 else if (PROP_MATCH ("Italic", 6))
1575 prop
= font_intern_prop ("italic", 4, 1);
1576 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1578 else if (PROP_MATCH ("Oblique", 7))
1581 prop
= font_intern_prop ("oblique", 7, 1);
1582 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1586 return -1; /* Unknown property in GTK-style font name. */
1595 family
= font_intern_prop (name
, family_end
- name
, 1);
1596 ASET (font
, FONT_FAMILY_INDEX
, family
);
1603 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1604 NAME (NBYTES length), and return the name length. If
1605 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1608 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1614 Lisp_Object family
, foundry
;
1615 Lisp_Object tail
, val
;
1619 Lisp_Object styles
[3];
1620 char *style_names
[3] = { "weight", "slant", "width" };
1623 family
= AREF (font
, FONT_FAMILY_INDEX
);
1624 if (! NILP (family
))
1626 if (SYMBOLP (family
))
1628 family
= SYMBOL_NAME (family
);
1629 len
+= SBYTES (family
);
1635 val
= AREF (font
, FONT_SIZE_INDEX
);
1638 if (XINT (val
) != 0)
1639 pixel_size
= XINT (val
);
1641 len
+= 21; /* for ":pixelsize=NUM" */
1643 else if (FLOATP (val
))
1646 point_size
= (int) XFLOAT_DATA (val
);
1647 len
+= 11; /* for "-NUM" */
1650 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1651 if (! NILP (foundry
))
1653 if (SYMBOLP (foundry
))
1655 foundry
= SYMBOL_NAME (foundry
);
1656 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1662 for (i
= 0; i
< 3; i
++)
1664 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1665 if (! NILP (styles
[i
]))
1666 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1667 SDATA (SYMBOL_NAME (styles
[i
])));
1670 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1671 len
+= sprintf (work
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1672 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1673 len
+= strlen (":spacing=100");
1674 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1675 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1676 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1678 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1680 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1682 len
+= SBYTES (val
);
1683 else if (INTEGERP (val
))
1684 len
+= sprintf (work
, "%d", XINT (val
));
1685 else if (SYMBOLP (val
))
1686 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1692 if (! NILP (family
))
1693 p
+= sprintf (p
, "%s", SDATA (family
));
1697 p
+= sprintf (p
, "%d", point_size
);
1699 p
+= sprintf (p
, "-%d", point_size
);
1701 else if (pixel_size
> 0)
1702 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1703 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1704 p
+= sprintf (p
, ":foundry=%s",
1705 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1706 for (i
= 0; i
< 3; i
++)
1707 if (! NILP (styles
[i
]))
1708 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1709 SDATA (SYMBOL_NAME (styles
[i
])));
1710 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1711 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1712 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1713 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1714 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1716 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1717 p
+= sprintf (p
, ":scalable=true");
1719 p
+= sprintf (p
, ":scalable=false");
1724 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1725 NAME (NBYTES length), and return the name length. F is the frame
1726 on which the font is displayed; it is used to calculate the point
1730 font_unparse_gtkname (font
, f
, name
, nbytes
)
1738 Lisp_Object family
, weight
, slant
, size
;
1739 int point_size
= -1;
1741 family
= AREF (font
, FONT_FAMILY_INDEX
);
1742 if (! NILP (family
))
1744 if (! SYMBOLP (family
))
1746 family
= SYMBOL_NAME (family
);
1747 len
+= SBYTES (family
);
1750 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1751 if (EQ (weight
, Qnormal
))
1753 else if (! NILP (weight
))
1755 weight
= SYMBOL_NAME (weight
);
1756 len
+= SBYTES (weight
);
1759 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1760 if (EQ (slant
, Qnormal
))
1762 else if (! NILP (slant
))
1764 slant
= SYMBOL_NAME (slant
);
1765 len
+= SBYTES (slant
);
1768 size
= AREF (font
, FONT_SIZE_INDEX
);
1769 /* Convert pixel size to point size. */
1770 if (INTEGERP (size
))
1772 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1774 if (INTEGERP (font_dpi
))
1775 dpi
= XINT (font_dpi
);
1778 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1781 else if (FLOATP (size
))
1783 point_size
= (int) XFLOAT_DATA (size
);
1790 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1792 if (! NILP (weight
))
1795 p
+= sprintf (p
, " %s", SDATA (weight
));
1796 q
[1] = toupper (q
[1]);
1802 p
+= sprintf (p
, " %s", SDATA (slant
));
1803 q
[1] = toupper (q
[1]);
1807 p
+= sprintf (p
, " %d", point_size
);
1812 /* Parse NAME (null terminated) and store information in FONT
1813 (font-spec or font-entity). If NAME is successfully parsed, return
1814 0. Otherwise return -1. */
1817 font_parse_name (name
, font
)
1821 if (name
[0] == '-' || index (name
, '*') || index (name
, '?'))
1822 return font_parse_xlfd (name
, font
);
1823 return font_parse_fcname (name
, font
);
1827 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1828 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1832 font_parse_family_registry (family
, registry
, font_spec
)
1833 Lisp_Object family
, registry
, font_spec
;
1839 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1841 CHECK_STRING (family
);
1842 len
= SBYTES (family
);
1843 p0
= (char *) SDATA (family
);
1844 p1
= index (p0
, '-');
1847 if ((*p0
!= '*' && p1
- p0
> 0)
1848 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1849 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1852 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1855 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1857 if (! NILP (registry
))
1859 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1860 CHECK_STRING (registry
);
1861 len
= SBYTES (registry
);
1862 p0
= (char *) SDATA (registry
);
1863 p1
= index (p0
, '-');
1866 if (SDATA (registry
)[len
- 1] == '*')
1867 registry
= concat2 (registry
, build_string ("-*"));
1869 registry
= concat2 (registry
, build_string ("*-*"));
1871 registry
= Fdowncase (registry
);
1872 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1877 /* This part (through the next ^L) is still experimental and not
1878 tested much. We may drastically change codes. */
1884 #define LGSTRING_HEADER_SIZE 6
1885 #define LGSTRING_GLYPH_SIZE 8
1888 check_gstring (gstring
)
1889 Lisp_Object gstring
;
1894 CHECK_VECTOR (gstring
);
1895 val
= AREF (gstring
, 0);
1897 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1899 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1900 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1901 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1902 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1903 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1904 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1905 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1906 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1907 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1908 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1909 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1911 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1913 val
= LGSTRING_GLYPH (gstring
, i
);
1915 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1917 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1919 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1920 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1921 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1922 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1923 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1924 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1925 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1926 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1928 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1930 if (ASIZE (val
) < 3)
1932 for (j
= 0; j
< 3; j
++)
1933 CHECK_NUMBER (AREF (val
, j
));
1938 error ("Invalid glyph-string format");
1943 check_otf_features (otf_features
)
1944 Lisp_Object otf_features
;
1948 CHECK_CONS (otf_features
);
1949 CHECK_SYMBOL (XCAR (otf_features
));
1950 otf_features
= XCDR (otf_features
);
1951 CHECK_CONS (otf_features
);
1952 CHECK_SYMBOL (XCAR (otf_features
));
1953 otf_features
= XCDR (otf_features
);
1954 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1956 CHECK_SYMBOL (Fcar (val
));
1957 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1958 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1960 otf_features
= XCDR (otf_features
);
1961 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1963 CHECK_SYMBOL (Fcar (val
));
1964 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1965 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1972 Lisp_Object otf_list
;
1975 otf_tag_symbol (tag
)
1980 OTF_tag_name (tag
, name
);
1981 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1988 Lisp_Object val
= Fassoc (file
, otf_list
);
1992 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1995 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1996 val
= make_save_value (otf
, 0);
1997 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
2003 /* Return a list describing which scripts/languages FONT supports by
2004 which GSUB/GPOS features of OpenType tables. See the comment of
2005 (struct font_driver).otf_capability. */
2008 font_otf_capability (font
)
2012 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
2015 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
2018 for (i
= 0; i
< 2; i
++)
2020 OTF_GSUB_GPOS
*gsub_gpos
;
2021 Lisp_Object script_list
= Qnil
;
2024 if (OTF_get_features (otf
, i
== 0) < 0)
2026 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2027 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2029 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2030 Lisp_Object langsys_list
= Qnil
;
2031 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2034 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2036 OTF_LangSys
*langsys
;
2037 Lisp_Object feature_list
= Qnil
;
2038 Lisp_Object langsys_tag
;
2041 if (k
== script
->LangSysCount
)
2043 langsys
= &script
->DefaultLangSys
;
2048 langsys
= script
->LangSys
+ k
;
2050 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2052 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2054 OTF_Feature
*feature
2055 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2056 Lisp_Object feature_tag
2057 = otf_tag_symbol (feature
->FeatureTag
);
2059 feature_list
= Fcons (feature_tag
, feature_list
);
2061 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2064 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2069 XSETCAR (capability
, script_list
);
2071 XSETCDR (capability
, script_list
);
2077 /* Parse OTF features in SPEC and write a proper features spec string
2078 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2079 assured that the sufficient memory has already allocated for
2083 generate_otf_features (spec
, features
)
2093 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2099 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2104 else if (! asterisk
)
2106 val
= SYMBOL_NAME (val
);
2107 p
+= sprintf (p
, "%s", SDATA (val
));
2111 val
= SYMBOL_NAME (val
);
2112 p
+= sprintf (p
, "~%s", SDATA (val
));
2116 error ("OTF spec too long");
2120 font_otf_DeviceTable (device_table
)
2121 OTF_DeviceTable
*device_table
;
2123 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2125 return Fcons (make_number (len
),
2126 make_unibyte_string (device_table
->DeltaValue
, len
));
2130 font_otf_ValueRecord (value_format
, value_record
)
2132 OTF_ValueRecord
*value_record
;
2134 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2136 if (value_format
& OTF_XPlacement
)
2137 ASET (val
, 0, make_number (value_record
->XPlacement
));
2138 if (value_format
& OTF_YPlacement
)
2139 ASET (val
, 1, make_number (value_record
->YPlacement
));
2140 if (value_format
& OTF_XAdvance
)
2141 ASET (val
, 2, make_number (value_record
->XAdvance
));
2142 if (value_format
& OTF_YAdvance
)
2143 ASET (val
, 3, make_number (value_record
->YAdvance
));
2144 if (value_format
& OTF_XPlaDevice
)
2145 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2146 if (value_format
& OTF_YPlaDevice
)
2147 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2148 if (value_format
& OTF_XAdvDevice
)
2149 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2150 if (value_format
& OTF_YAdvDevice
)
2151 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2156 font_otf_Anchor (anchor
)
2161 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2162 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2163 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2164 if (anchor
->AnchorFormat
== 2)
2165 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2168 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2169 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2173 #endif /* HAVE_LIBOTF */
2179 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2180 static int font_compare
P_ ((const void *, const void *));
2181 static Lisp_Object font_sort_entities
P_ ((Lisp_Object
, Lisp_Object
,
2184 /* Return a rescaling ratio of FONT_ENTITY. */
2185 extern Lisp_Object Vface_font_rescale_alist
;
2188 font_rescale_ratio (font_entity
)
2189 Lisp_Object font_entity
;
2191 Lisp_Object tail
, elt
;
2192 Lisp_Object name
= Qnil
;
2194 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2197 if (FLOATP (XCDR (elt
)))
2199 if (STRINGP (XCAR (elt
)))
2202 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2203 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2204 return XFLOAT_DATA (XCDR (elt
));
2206 else if (FONT_SPEC_P (XCAR (elt
)))
2208 if (font_match_p (XCAR (elt
), font_entity
))
2209 return XFLOAT_DATA (XCDR (elt
));
2216 /* We sort fonts by scoring each of them against a specified
2217 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2218 the value is, the closer the font is to the font-spec.
2220 The lowest 2 bits of the score is used for driver type. The font
2221 available by the most preferred font driver is 0.
2223 Each 7-bit in the higher 28 bits are used for numeric properties
2224 WEIGHT, SLANT, WIDTH, and SIZE. */
2226 /* How many bits to shift to store the difference value of each font
2227 property in a score. Note that flots for FONT_TYPE_INDEX and
2228 FONT_REGISTRY_INDEX are not used. */
2229 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2231 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2232 The return value indicates how different ENTITY is compared with
2236 font_score (entity
, spec_prop
)
2237 Lisp_Object entity
, *spec_prop
;
2242 /* Score three style numeric fields. Maximum difference is 127. */
2243 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2244 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2246 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2251 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2254 /* Score the size. Maximum difference is 127. */
2255 i
= FONT_SIZE_INDEX
;
2256 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2257 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2259 /* We use the higher 6-bit for the actual size difference. The
2260 lowest bit is set if the DPI is different. */
2262 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2264 if (CONSP (Vface_font_rescale_alist
))
2265 pixel_size
*= font_rescale_ratio (entity
);
2266 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2270 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2271 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2273 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2274 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2276 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2283 /* Concatenate all elements of LIST into one vector. LIST is a list
2284 of font-entity vectors. */
2287 font_vconcat_entity_vectors (Lisp_Object list
)
2289 int nargs
= XINT (Flength (list
));
2290 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2293 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2294 args
[i
] = XCAR (list
);
2295 return Fvconcat (nargs
, args
);
2299 /* The structure for elements being sorted by qsort. */
2300 struct font_sort_data
2303 int font_driver_preference
;
2308 /* The comparison function for qsort. */
2311 font_compare (d1
, d2
)
2312 const void *d1
, *d2
;
2314 const struct font_sort_data
*data1
= d1
;
2315 const struct font_sort_data
*data2
= d2
;
2317 if (data1
->score
< data2
->score
)
2319 else if (data1
->score
> data2
->score
)
2321 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2325 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2326 If PREFER specifies a point-size, calculate the corresponding
2327 pixel-size from QCdpi property of PREFER or from the Y-resolution
2328 of FRAME before sorting.
2330 If BEST-ONLY is nonzero, return the best matching entity (that
2331 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2332 if BEST-ONLY is negative). Otherwise, return the sorted result as
2333 a single vector of font-entities.
2335 This function does no optimization for the case that the total
2336 number of elements is 1. The caller should avoid calling this in
2340 font_sort_entities (list
, prefer
, frame
, best_only
)
2341 Lisp_Object list
, prefer
, frame
;
2344 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2346 struct font_sort_data
*data
;
2347 unsigned best_score
;
2348 Lisp_Object best_entity
;
2349 struct frame
*f
= XFRAME (frame
);
2350 Lisp_Object tail
, vec
;
2353 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2354 prefer_prop
[i
] = AREF (prefer
, i
);
2355 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2356 prefer_prop
[FONT_SIZE_INDEX
]
2357 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2359 if (NILP (XCDR (list
)))
2361 /* What we have to take care of is this single vector. */
2363 maxlen
= ASIZE (vec
);
2367 /* We don't have to perform sort, so there's no need of creating
2368 a single vector. But, we must find the length of the longest
2371 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2372 if (maxlen
< ASIZE (XCAR (tail
)))
2373 maxlen
= ASIZE (XCAR (tail
));
2377 /* We have to create a single vector to sort it. */
2378 vec
= font_vconcat_entity_vectors (list
);
2379 maxlen
= ASIZE (vec
);
2382 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2383 best_score
= 0xFFFFFFFF;
2386 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2388 int font_driver_preference
= 0;
2389 Lisp_Object current_font_driver
;
2395 /* We are sure that the length of VEC > 0. */
2396 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2397 /* Score the elements. */
2398 for (i
= 0; i
< len
; i
++)
2400 data
[i
].entity
= AREF (vec
, i
);
2402 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2404 ? font_score (data
[i
].entity
, prefer_prop
)
2406 if (best_only
&& best_score
> data
[i
].score
)
2408 best_score
= data
[i
].score
;
2409 best_entity
= data
[i
].entity
;
2410 if (best_score
== 0)
2413 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2415 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2416 font_driver_preference
++;
2418 data
[i
].font_driver_preference
= font_driver_preference
;
2421 /* Sort if necessary. */
2424 qsort (data
, len
, sizeof *data
, font_compare
);
2425 for (i
= 0; i
< len
; i
++)
2426 ASET (vec
, i
, data
[i
].entity
);
2435 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2440 /* API of Font Service Layer. */
2442 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2443 sort_shift_bits. Finternal_set_font_selection_order calls this
2444 function with font_sort_order after setting up it. */
2447 font_update_sort_order (order
)
2452 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2454 int xlfd_idx
= order
[i
];
2456 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2457 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2458 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2459 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2460 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2461 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2463 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2468 font_check_otf_features (script
, langsys
, features
, table
)
2469 Lisp_Object script
, langsys
, features
, table
;
2474 table
= assq_no_quit (script
, table
);
2477 table
= XCDR (table
);
2478 if (! NILP (langsys
))
2480 table
= assq_no_quit (langsys
, table
);
2486 val
= assq_no_quit (Qnil
, table
);
2488 table
= XCAR (table
);
2492 table
= XCDR (table
);
2493 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2495 if (NILP (XCAR (features
)))
2500 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2506 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2509 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2511 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2513 script
= XCAR (spec
);
2517 langsys
= XCAR (spec
);
2528 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2529 XCAR (otf_capability
)))
2531 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2532 XCDR (otf_capability
)))
2539 /* Check if FONT (font-entity or font-object) matches with the font
2540 specification SPEC. */
2543 font_match_p (spec
, font
)
2544 Lisp_Object spec
, font
;
2546 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2547 Lisp_Object extra
, font_extra
;
2550 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2551 if (! NILP (AREF (spec
, i
))
2552 && ! NILP (AREF (font
, i
))
2553 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2555 props
= XFONT_SPEC (spec
)->props
;
2556 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2558 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2559 prop
[i
] = AREF (spec
, i
);
2560 prop
[FONT_SIZE_INDEX
]
2561 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2565 if (font_score (font
, props
) > 0)
2567 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2568 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2569 for (; CONSP (extra
); extra
= XCDR (extra
))
2571 Lisp_Object key
= XCAR (XCAR (extra
));
2572 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2574 if (EQ (key
, QClang
))
2576 val2
= assq_no_quit (key
, font_extra
);
2585 if (NILP (Fmemq (val
, val2
)))
2590 ? NILP (Fmemq (val
, XCDR (val2
)))
2594 else if (EQ (key
, QCscript
))
2596 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2602 /* All characters in the list must be supported. */
2603 for (; CONSP (val2
); val2
= XCDR (val2
))
2605 if (! NATNUMP (XCAR (val2
)))
2607 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2608 == FONT_INVALID_CODE
)
2612 else if (VECTORP (val2
))
2614 /* At most one character in the vector must be supported. */
2615 for (i
= 0; i
< ASIZE (val2
); i
++)
2617 if (! NATNUMP (AREF (val2
, i
)))
2619 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2620 != FONT_INVALID_CODE
)
2623 if (i
== ASIZE (val2
))
2628 else if (EQ (key
, QCotf
))
2632 if (! FONT_OBJECT_P (font
))
2634 fontp
= XFONT_OBJECT (font
);
2635 if (! fontp
->driver
->otf_capability
)
2637 val2
= fontp
->driver
->otf_capability (fontp
);
2638 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2649 Each font backend has the callback function get_cache, and it
2650 returns a cons cell of which cdr part can be freely used for
2651 caching fonts. The cons cell may be shared by multiple frames
2652 and/or multiple font drivers. So, we arrange the cdr part as this:
2654 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2656 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2657 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2658 cons (FONT-SPEC FONT-ENTITY ...). */
2660 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2661 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2662 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2663 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2664 struct font_driver
*));
2667 font_prepare_cache (f
, driver
)
2669 struct font_driver
*driver
;
2671 Lisp_Object cache
, val
;
2673 cache
= driver
->get_cache (f
);
2675 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2679 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2680 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2684 val
= XCDR (XCAR (val
));
2685 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2691 font_finish_cache (f
, driver
)
2693 struct font_driver
*driver
;
2695 Lisp_Object cache
, val
, tmp
;
2698 cache
= driver
->get_cache (f
);
2700 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2701 cache
= val
, val
= XCDR (val
);
2702 font_assert (! NILP (val
));
2703 tmp
= XCDR (XCAR (val
));
2704 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2705 if (XINT (XCAR (tmp
)) == 0)
2707 font_clear_cache (f
, XCAR (val
), driver
);
2708 XSETCDR (cache
, XCDR (val
));
2714 font_get_cache (f
, driver
)
2716 struct font_driver
*driver
;
2718 Lisp_Object val
= driver
->get_cache (f
);
2719 Lisp_Object type
= driver
->type
;
2721 font_assert (CONSP (val
));
2722 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2723 font_assert (CONSP (val
));
2724 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2725 val
= XCDR (XCAR (val
));
2729 static int num_fonts
;
2732 font_clear_cache (f
, cache
, driver
)
2735 struct font_driver
*driver
;
2737 Lisp_Object tail
, elt
;
2738 Lisp_Object tail2
, entity
;
2740 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2741 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2744 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2745 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2747 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2749 entity
= XCAR (tail2
);
2751 if (FONT_ENTITY_P (entity
)
2752 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2754 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2756 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2758 Lisp_Object val
= XCAR (objlist
);
2759 struct font
*font
= XFONT_OBJECT (val
);
2761 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2763 font_assert (font
&& driver
== font
->driver
);
2764 driver
->close (f
, font
);
2768 if (driver
->free_entity
)
2769 driver
->free_entity (entity
);
2774 XSETCDR (cache
, Qnil
);
2778 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2781 font_delete_unmatched (vec
, spec
, size
)
2782 Lisp_Object vec
, spec
;
2785 Lisp_Object entity
, val
;
2786 enum font_property_index prop
;
2789 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2791 entity
= AREF (vec
, i
);
2792 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2793 if (INTEGERP (AREF (spec
, prop
))
2794 && ((XINT (AREF (spec
, prop
)) >> 8)
2795 != (XINT (AREF (entity
, prop
)) >> 8)))
2796 prop
= FONT_SPEC_MAX
;
2797 if (prop
< FONT_SPEC_MAX
2799 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2801 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2804 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2805 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2806 prop
= FONT_SPEC_MAX
;
2808 if (prop
< FONT_SPEC_MAX
2809 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2810 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2811 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2812 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2813 prop
= FONT_SPEC_MAX
;
2814 if (prop
< FONT_SPEC_MAX
2815 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2816 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2817 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2818 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2819 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2820 prop
= FONT_SPEC_MAX
;
2821 if (prop
< FONT_SPEC_MAX
)
2822 val
= Fcons (entity
, val
);
2824 return (Fvconcat (1, &val
));
2828 /* Return a list of vectors of font-entities matching with SPEC on
2829 FRAME. The elements of the list are in the same of order of
2833 font_list_entities (frame
, spec
)
2834 Lisp_Object frame
, spec
;
2836 FRAME_PTR f
= XFRAME (frame
);
2837 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2838 Lisp_Object ftype
, val
;
2839 Lisp_Object list
= Qnil
;
2841 int need_filtering
= 0;
2844 font_assert (FONT_SPEC_P (spec
));
2846 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2847 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2848 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2849 size
= font_pixel_size (f
, spec
);
2853 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2854 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2855 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2856 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2858 ASET (scratch_font_spec
, i
, Qnil
);
2859 if (! NILP (AREF (spec
, i
)))
2861 if (i
== FONT_DPI_INDEX
)
2862 /* Skip FONT_SPACING_INDEX */
2865 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2866 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2868 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2870 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2872 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2874 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2875 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2882 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2886 val
= Fvconcat (1, &val
);
2887 copy
= Fcopy_font_spec (scratch_font_spec
);
2888 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2889 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2891 if (ASIZE (val
) > 0 && need_filtering
)
2892 val
= font_delete_unmatched (val
, spec
, size
);
2893 if (ASIZE (val
) > 0)
2894 list
= Fcons (val
, list
);
2897 list
= Fnreverse (list
);
2898 FONT_ADD_LOG ("list", spec
, list
);
2903 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2904 nil, is an array of face's attributes, which specifies preferred
2905 font-related attributes. */
2908 font_matching_entity (f
, attrs
, spec
)
2910 Lisp_Object
*attrs
, spec
;
2912 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2913 Lisp_Object ftype
, size
, entity
;
2915 Lisp_Object work
= Fcopy_font_spec (spec
);
2917 XSETFRAME (frame
, f
);
2918 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2919 size
= AREF (spec
, FONT_SIZE_INDEX
);
2922 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2923 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2924 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2925 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2928 for (; driver_list
; driver_list
= driver_list
->next
)
2930 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2932 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2935 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2936 entity
= assoc_no_quit (work
, XCDR (cache
));
2938 entity
= XCDR (entity
);
2941 entity
= driver_list
->driver
->match (frame
, work
);
2942 copy
= Fcopy_font_spec (work
);
2943 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2944 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2946 if (! NILP (entity
))
2949 FONT_ADD_LOG ("match", work
, entity
);
2954 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2955 opened font object. */
2958 font_open_entity (f
, entity
, pixel_size
)
2963 struct font_driver_list
*driver_list
;
2964 Lisp_Object objlist
, size
, val
, font_object
;
2966 int min_width
, height
;
2967 int scaled_pixel_size
;
2969 font_assert (FONT_ENTITY_P (entity
));
2970 size
= AREF (entity
, FONT_SIZE_INDEX
);
2971 if (XINT (size
) != 0)
2972 scaled_pixel_size
= pixel_size
= XINT (size
);
2973 else if (CONSP (Vface_font_rescale_alist
))
2974 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2976 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2977 objlist
= XCDR (objlist
))
2978 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2979 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2980 return XCAR (objlist
);
2982 val
= AREF (entity
, FONT_TYPE_INDEX
);
2983 for (driver_list
= f
->font_driver_list
;
2984 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2985 driver_list
= driver_list
->next
);
2989 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2990 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2991 FONT_ADD_LOG ("open", entity
, font_object
);
2992 if (NILP (font_object
))
2994 ASET (entity
, FONT_OBJLIST_INDEX
,
2995 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2996 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
2999 font
= XFONT_OBJECT (font_object
);
3000 min_width
= (font
->min_width
? font
->min_width
3001 : font
->average_width
? font
->average_width
3002 : font
->space_width
? font
->space_width
3004 height
= (font
->height
? font
->height
: 1);
3005 #ifdef HAVE_WINDOW_SYSTEM
3006 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
3007 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
3009 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
3010 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
3011 fonts_changed_p
= 1;
3015 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
3016 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
3017 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
3018 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
3026 /* Close FONT_OBJECT that is opened on frame F. */
3029 font_close_object (f
, font_object
)
3031 Lisp_Object font_object
;
3033 struct font
*font
= XFONT_OBJECT (font_object
);
3035 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
3036 /* Already closed. */
3038 FONT_ADD_LOG ("close", font_object
, Qnil
);
3039 font
->driver
->close (f
, font
);
3040 #ifdef HAVE_WINDOW_SYSTEM
3041 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
3042 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
3048 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
3049 FONT is a font-entity and it must be opened to check. */
3052 font_has_char (f
, font
, c
)
3059 if (FONT_ENTITY_P (font
))
3061 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
3062 struct font_driver_list
*driver_list
;
3064 for (driver_list
= f
->font_driver_list
;
3065 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
3066 driver_list
= driver_list
->next
);
3069 if (! driver_list
->driver
->has_char
)
3071 return driver_list
->driver
->has_char (font
, c
);
3074 font_assert (FONT_OBJECT_P (font
));
3075 fontp
= XFONT_OBJECT (font
);
3076 if (fontp
->driver
->has_char
)
3078 int result
= fontp
->driver
->has_char (font
, c
);
3083 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
3087 /* Return the glyph ID of FONT_OBJECT for character C. */
3090 font_encode_char (font_object
, c
)
3091 Lisp_Object font_object
;
3096 font_assert (FONT_OBJECT_P (font_object
));
3097 font
= XFONT_OBJECT (font_object
);
3098 return font
->driver
->encode_char (font
, c
);
3102 /* Return the name of FONT_OBJECT. */
3105 font_get_name (font_object
)
3106 Lisp_Object font_object
;
3108 font_assert (FONT_OBJECT_P (font_object
));
3109 return AREF (font_object
, FONT_NAME_INDEX
);
3113 /* Return the specification of FONT_OBJECT. */
3116 font_get_spec (font_object
)
3117 Lisp_Object font_object
;
3119 Lisp_Object spec
= font_make_spec ();
3122 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
3123 ASET (spec
, i
, AREF (font_object
, i
));
3124 ASET (spec
, FONT_SIZE_INDEX
,
3125 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
3130 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3131 could not be parsed by font_parse_name, return Qnil. */
3134 font_spec_from_name (font_name
)
3135 Lisp_Object font_name
;
3137 Lisp_Object spec
= Ffont_spec (0, NULL
);
3139 CHECK_STRING (font_name
);
3140 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3142 font_put_extra (spec
, QCname
, font_name
);
3148 font_clear_prop (attrs
, prop
)
3150 enum font_property_index prop
;
3152 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3156 if (! NILP (Ffont_get (font
, QCname
)))
3158 font
= Fcopy_font_spec (font
);
3159 font_put_extra (font
, QCname
, Qnil
);
3162 if (NILP (AREF (font
, prop
))
3163 && prop
!= FONT_FAMILY_INDEX
3164 && prop
!= FONT_FOUNDRY_INDEX
3165 && prop
!= FONT_WIDTH_INDEX
3166 && prop
!= FONT_SIZE_INDEX
)
3168 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3169 font
= Fcopy_font_spec (font
);
3170 ASET (font
, prop
, Qnil
);
3171 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3173 if (prop
== FONT_FAMILY_INDEX
)
3175 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3176 /* If we are setting the font family, we must also clear
3177 FONT_WIDTH_INDEX to avoid rejecting families that lack
3178 support for some widths. */
3179 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3181 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3182 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3183 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3184 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3185 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3186 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3188 else if (prop
== FONT_SIZE_INDEX
)
3190 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3191 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3192 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3194 else if (prop
== FONT_WIDTH_INDEX
)
3195 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3196 attrs
[LFACE_FONT_INDEX
] = font
;
3200 font_update_lface (f
, attrs
)
3206 spec
= attrs
[LFACE_FONT_INDEX
];
3207 if (! FONT_SPEC_P (spec
))
3210 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3211 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3212 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3213 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3214 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3215 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3216 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3217 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);
3218 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3219 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3220 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3224 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3229 val
= Ffont_get (spec
, QCdpi
);
3232 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3234 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3236 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3238 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3239 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3245 /* Selecte a font from ENTITIES (list of font-entity vectors) that
3246 supports C and matches best with ATTRS and PIXEL_SIZE. */
3249 font_select_entity (frame
, entities
, attrs
, pixel_size
, c
)
3250 Lisp_Object frame
, entities
, *attrs
;
3253 Lisp_Object font_entity
;
3256 FRAME_PTR f
= XFRAME (frame
);
3258 if (NILP (XCDR (entities
))
3259 && ASIZE (XCAR (entities
)) == 1)
3261 font_entity
= AREF (XCAR (entities
), 0);
3263 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3268 /* Sort fonts by properties specified in ATTRS. */
3269 prefer
= scratch_font_prefer
;
3271 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3272 ASET (prefer
, i
, Qnil
);
3273 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3275 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3277 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3278 ASET (prefer
, i
, AREF (face_font
, i
));
3280 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3281 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3282 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3283 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3284 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3285 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3286 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3288 return font_sort_entities (entities
, prefer
, frame
, c
);
3291 /* Return a font-entity satisfying SPEC and best matching with face's
3292 font related attributes in ATTRS. C, if not negative, is a
3293 character that the entity must support. */
3296 font_find_for_lface (f
, attrs
, spec
, c
)
3303 Lisp_Object frame
, entities
, val
;
3304 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3308 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3309 if (NILP (registry
[0]))
3311 registry
[0] = DEFAULT_ENCODING
;
3312 registry
[1] = Qascii_0
;
3313 registry
[2] = null_vector
;
3316 registry
[1] = null_vector
;
3318 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3320 struct charset
*encoding
, *repertory
;
3322 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3323 &encoding
, &repertory
) < 0)
3326 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3328 else if (c
> encoding
->max_char
)
3332 work
= Fcopy_font_spec (spec
);
3333 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3334 XSETFRAME (frame
, f
);
3335 size
= AREF (spec
, FONT_SIZE_INDEX
);
3336 pixel_size
= font_pixel_size (f
, spec
);
3337 if (pixel_size
== 0)
3339 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3341 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3343 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3344 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3345 if (! NILP (foundry
[0]))
3346 foundry
[1] = null_vector
;
3347 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3349 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3350 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3352 foundry
[2] = null_vector
;
3355 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3357 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3358 if (! NILP (adstyle
[0]))
3359 adstyle
[1] = null_vector
;
3360 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3362 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3364 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3366 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3368 adstyle
[2] = null_vector
;
3371 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3374 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3377 val
= AREF (work
, FONT_FAMILY_INDEX
);
3378 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3380 val
= attrs
[LFACE_FAMILY_INDEX
];
3381 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3385 family
= alloca ((sizeof family
[0]) * 2);
3387 family
[1] = null_vector
; /* terminator. */
3392 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3400 if (! NILP (alters
))
3402 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3403 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3404 family
[i
] = XCAR (alters
);
3405 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3407 family
[i
] = null_vector
;
3411 family
= alloca ((sizeof family
[0]) * 3);
3414 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3416 family
[i
] = null_vector
;
3420 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3422 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3423 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3425 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3426 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3428 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3429 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3431 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3432 entities
= font_list_entities (frame
, work
);
3433 if (! NILP (entities
))
3435 val
= font_select_entity (frame
, entities
,
3436 attrs
, pixel_size
, c
);
3449 font_open_for_lface (f
, entity
, attrs
, spec
)
3457 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3458 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3459 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3460 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3461 size
= font_pixel_size (f
, spec
);
3465 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3466 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3469 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3470 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3471 if (INTEGERP (height
))
3474 abort(); /* We should never end up here. */
3478 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3482 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3483 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3487 return font_open_entity (f
, entity
, size
);
3491 /* Find a font satisfying SPEC and best matching with face's
3492 attributes in ATTRS on FRAME, and return the opened
3496 font_load_for_lface (f
, attrs
, spec
)
3498 Lisp_Object
*attrs
, spec
;
3502 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3505 /* No font is listed for SPEC, but each font-backend may have
3506 the different criteria about "font matching". So, try
3508 entity
= font_matching_entity (f
, attrs
, spec
);
3512 return font_open_for_lface (f
, entity
, attrs
, spec
);
3516 /* Make FACE on frame F ready to use the font opened for FACE. */
3519 font_prepare_for_face (f
, face
)
3523 if (face
->font
->driver
->prepare_face
)
3524 face
->font
->driver
->prepare_face (f
, face
);
3528 /* Make FACE on frame F stop using the font opened for FACE. */
3531 font_done_for_face (f
, face
)
3535 if (face
->font
->driver
->done_face
)
3536 face
->font
->driver
->done_face (f
, face
);
3541 /* Open a font matching with font-spec SPEC on frame F. If no proper
3542 font is found, return Qnil. */
3545 font_open_by_spec (f
, spec
)
3549 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3551 /* We set up the default font-related attributes of a face to prefer
3553 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3554 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3555 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3557 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3559 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3561 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3563 return font_load_for_lface (f
, attrs
, spec
);
3567 /* Open a font matching with NAME on frame F. If no proper font is
3568 found, return Qnil. */
3571 font_open_by_name (f
, name
)
3575 Lisp_Object args
[2];
3579 args
[1] = make_unibyte_string (name
, strlen (name
));
3580 spec
= Ffont_spec (2, args
);
3581 return font_open_by_spec (f
, spec
);
3585 /* Register font-driver DRIVER. This function is used in two ways.
3587 The first is with frame F non-NULL. In this case, make DRIVER
3588 available (but not yet activated) on F. All frame creaters
3589 (e.g. Fx_create_frame) must call this function at least once with
3590 an available font-driver.
3592 The second is with frame F NULL. In this case, DRIVER is globally
3593 registered in the variable `font_driver_list'. All font-driver
3594 implementations must call this function in its syms_of_XXXX
3595 (e.g. syms_of_xfont). */
3598 register_font_driver (driver
, f
)
3599 struct font_driver
*driver
;
3602 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3603 struct font_driver_list
*prev
, *list
;
3605 if (f
&& ! driver
->draw
)
3606 error ("Unusable font driver for a frame: %s",
3607 SDATA (SYMBOL_NAME (driver
->type
)));
3609 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3610 if (EQ (list
->driver
->type
, driver
->type
))
3611 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3613 list
= xmalloc (sizeof (struct font_driver_list
));
3615 list
->driver
= driver
;
3620 f
->font_driver_list
= list
;
3622 font_driver_list
= list
;
3628 free_font_driver_list (f
)
3631 struct font_driver_list
*list
, *next
;
3633 for (list
= f
->font_driver_list
; list
; list
= next
)
3638 f
->font_driver_list
= NULL
;
3642 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3643 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3644 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3646 A caller must free all realized faces if any in advance. The
3647 return value is a list of font backends actually made used on
3651 font_update_drivers (f
, new_drivers
)
3653 Lisp_Object new_drivers
;
3655 Lisp_Object active_drivers
= Qnil
;
3656 struct font_driver
*driver
;
3657 struct font_driver_list
*list
;
3659 /* At first, turn off non-requested drivers, and turn on requested
3661 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3663 driver
= list
->driver
;
3664 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3669 if (driver
->end_for_frame
)
3670 driver
->end_for_frame (f
);
3671 font_finish_cache (f
, driver
);
3676 if (! driver
->start_for_frame
3677 || driver
->start_for_frame (f
) == 0)
3679 font_prepare_cache (f
, driver
);
3686 if (NILP (new_drivers
))
3689 if (! EQ (new_drivers
, Qt
))
3691 /* Re-order the driver list according to new_drivers. */
3692 struct font_driver_list
**list_table
, **next
;
3696 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3697 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3699 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3700 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3703 list_table
[i
++] = list
;
3705 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3707 list_table
[i
++] = list
;
3708 list_table
[i
] = NULL
;
3710 next
= &f
->font_driver_list
;
3711 for (i
= 0; list_table
[i
]; i
++)
3713 *next
= list_table
[i
];
3714 next
= &(*next
)->next
;
3718 if (! f
->font_driver_list
->on
)
3719 { /* None of the drivers is enabled: enable them all.
3720 Happens if you set the list of drivers to (xft x) in your .emacs
3721 and then use it under w32 or ns. */
3722 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3724 struct font_driver
*driver
= list
->driver
;
3725 eassert (! list
->on
);
3726 if (! driver
->start_for_frame
3727 || driver
->start_for_frame (f
) == 0)
3729 font_prepare_cache (f
, driver
);
3736 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3738 active_drivers
= nconc2 (active_drivers
,
3739 Fcons (list
->driver
->type
, Qnil
));
3740 return active_drivers
;
3744 font_put_frame_data (f
, driver
, data
)
3746 struct font_driver
*driver
;
3749 struct font_data_list
*list
, *prev
;
3751 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3752 prev
= list
, list
= list
->next
)
3753 if (list
->driver
== driver
)
3760 prev
->next
= list
->next
;
3762 f
->font_data_list
= list
->next
;
3770 list
= xmalloc (sizeof (struct font_data_list
));
3771 list
->driver
= driver
;
3772 list
->next
= f
->font_data_list
;
3773 f
->font_data_list
= list
;
3781 font_get_frame_data (f
, driver
)
3783 struct font_driver
*driver
;
3785 struct font_data_list
*list
;
3787 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3788 if (list
->driver
== driver
)
3796 /* Return the font used to draw character C by FACE at buffer position
3797 POS in window W. If STRING is non-nil, it is a string containing C
3798 at index POS. If C is negative, get C from the current buffer or
3802 font_at (c
, pos
, face
, w
, string
)
3811 Lisp_Object font_object
;
3813 multibyte
= (NILP (string
)
3814 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3815 : STRING_MULTIBYTE (string
));
3822 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3824 c
= FETCH_CHAR (pos_byte
);
3827 c
= FETCH_BYTE (pos
);
3833 multibyte
= STRING_MULTIBYTE (string
);
3836 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3838 str
= SDATA (string
) + pos_byte
;
3839 c
= STRING_CHAR (str
, 0);
3842 c
= SDATA (string
)[pos
];
3846 f
= XFRAME (w
->frame
);
3847 if (! FRAME_WINDOW_P (f
))
3854 if (STRINGP (string
))
3855 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3856 DEFAULT_FACE_ID
, 0);
3858 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3860 face
= FACE_FROM_ID (f
, face_id
);
3864 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3865 face
= FACE_FROM_ID (f
, face_id
);
3870 XSETFONT (font_object
, face
->font
);
3875 #ifdef HAVE_WINDOW_SYSTEM
3877 /* Check how many characters after POS (at most to *LIMIT) can be
3878 displayed by the same font on the window W. FACE, if non-NULL, is
3879 the face selected for the character at POS. If STRING is not nil,
3880 it is the string to check instead of the current buffer. In that
3881 case, FACE must be not NULL.
3883 The return value is the font-object for the character at POS.
3884 *LIMIT is set to the position where that font can't be used.
3886 It is assured that the current buffer (or STRING) is multibyte. */
3889 font_range (pos
, limit
, w
, face
, string
)
3890 EMACS_INT pos
, *limit
;
3895 EMACS_INT pos_byte
, ignore
, start
, start_byte
;
3897 Lisp_Object font_object
= Qnil
;
3901 pos_byte
= CHAR_TO_BYTE (pos
);
3906 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3908 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3914 pos_byte
= string_char_to_byte (string
, pos
);
3917 start
= pos
, start_byte
= pos_byte
;
3918 while (pos
< *limit
)
3920 Lisp_Object category
;
3923 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3925 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3926 if (NILP (font_object
))
3928 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3929 if (NILP (font_object
))
3934 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3935 if (! EQ (category
, QCf
)
3936 && ! CHAR_VARIATION_SELECTOR_P (c
)
3937 && font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3939 Lisp_Object f
= font_for_char (face
, c
, pos
- 1, string
);
3940 EMACS_INT i
, i_byte
;
3948 i
= start
, i_byte
= start_byte
;
3953 FETCH_CHAR_ADVANCE_NO_CHECK (c
, i
, i_byte
);
3955 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, i
, i_byte
);
3956 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3957 if (! EQ (category
, QCf
)
3958 && ! CHAR_VARIATION_SELECTOR_P (c
)
3959 && font_encode_char (f
, c
) == FONT_INVALID_CODE
)
3975 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3976 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3977 Return nil otherwise.
3978 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3979 which kind of font it is. It must be one of `font-spec', `font-entity',
3981 (object
, extra_type
)
3982 Lisp_Object object
, extra_type
;
3984 if (NILP (extra_type
))
3985 return (FONTP (object
) ? Qt
: Qnil
);
3986 if (EQ (extra_type
, Qfont_spec
))
3987 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3988 if (EQ (extra_type
, Qfont_entity
))
3989 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3990 if (EQ (extra_type
, Qfont_object
))
3991 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3992 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3995 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3996 doc
: /* Return a newly created font-spec with arguments as properties.
3998 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3999 valid font property name listed below:
4001 `:family', `:weight', `:slant', `:width'
4003 They are the same as face attributes of the same name. See
4004 `set-face-attribute'.
4008 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
4012 VALUE must be a string or a symbol specifying the additional
4013 typographic style information of a font, e.g. ``sans''.
4017 VALUE must be a string or a symbol specifying the charset registry and
4018 encoding of a font, e.g. ``iso8859-1''.
4022 VALUE must be a non-negative integer or a floating point number
4023 specifying the font size. It specifies the font size in pixels (if
4024 VALUE is an integer), or in points (if VALUE is a float).
4028 VALUE must be a string of XLFD-style or fontconfig-style font name.
4032 VALUE must be a symbol representing a script that the font must
4033 support. It may be a symbol representing a subgroup of a script
4034 listed in the variable `script-representative-chars'.
4038 VALUE must be a symbol of two-letter ISO-639 language names,
4043 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
4044 required OpenType features.
4046 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
4047 LANGSYS-TAG: OpenType language system tag symbol,
4048 or nil for the default language system.
4049 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
4050 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
4052 GSUB and GPOS may contain `nil' element. In such a case, the font
4053 must not have any of the remaining elements.
4055 For instance, if the VALUE is `(thai nil nil (mark))', the font must
4056 be an OpenType font, and whose GPOS table of `thai' script's default
4057 language system must contain `mark' feature.
4059 usage: (font-spec ARGS...) */)
4064 Lisp_Object spec
= font_make_spec ();
4067 for (i
= 0; i
< nargs
; i
+= 2)
4069 Lisp_Object key
= args
[i
], val
;
4073 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
4076 if (EQ (key
, QCname
))
4079 font_parse_name ((char *) SDATA (val
), spec
);
4080 font_put_extra (spec
, key
, val
);
4084 int idx
= get_font_prop_index (key
);
4088 val
= font_prop_validate (idx
, Qnil
, val
);
4089 if (idx
< FONT_EXTRA_INDEX
)
4090 ASET (spec
, idx
, val
);
4092 font_put_extra (spec
, key
, val
);
4095 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
4101 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
4102 doc
: /* Return a copy of FONT as a font-spec. */)
4106 Lisp_Object new_spec
, tail
, prev
, extra
;
4110 new_spec
= font_make_spec ();
4111 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
4112 ASET (new_spec
, i
, AREF (font
, i
));
4113 extra
= Fcopy_sequence (AREF (font
, FONT_EXTRA_INDEX
));
4114 /* We must remove :font-entity property. */
4115 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
4116 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
4119 extra
= XCDR (extra
);
4121 XSETCDR (prev
, XCDR (tail
));
4124 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
4128 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
4129 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
4130 Every specified properties in FROM override the corresponding
4131 properties in TO. */)
4133 Lisp_Object from
, to
;
4135 Lisp_Object extra
, tail
;
4140 to
= Fcopy_font_spec (to
);
4141 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
4142 ASET (to
, i
, AREF (from
, i
));
4143 extra
= AREF (to
, FONT_EXTRA_INDEX
);
4144 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
4145 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
4147 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
4150 XSETCDR (slot
, XCDR (XCAR (tail
)));
4152 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
4154 ASET (to
, FONT_EXTRA_INDEX
, extra
);
4158 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
4159 doc
: /* Return the value of FONT's property KEY.
4160 FONT is a font-spec, a font-entity, or a font-object.
4161 KEY must be one of these symbols:
4162 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4163 :size, :name, :script
4164 See the documentation of `font-spec' for their meanings.
4165 If FONT is a font-entity or font-object, the value of :script may be
4166 a list of scripts that are supported by the font. */)
4168 Lisp_Object font
, key
;
4175 idx
= get_font_prop_index (key
);
4176 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4177 return font_style_symbolic (font
, idx
, 0);
4178 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4179 return AREF (font
, idx
);
4180 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
4183 #ifdef HAVE_WINDOW_SYSTEM
4185 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4186 doc
: /* Return a plist of face attributes generated by FONT.
4187 FONT is a font name, a font-spec, a font-entity, or a font-object.
4188 The return value is a list of the form
4190 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4192 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4193 compatible with `set-face-attribute'. Some of these key-attribute pairs
4194 may be omitted from the list if they are not specified by FONT.
4196 The optional argument FRAME specifies the frame that the face attributes
4197 are to be displayed on. If omitted, the selected frame is used. */)
4199 Lisp_Object font
, frame
;
4202 Lisp_Object plist
[10];
4207 frame
= selected_frame
;
4208 CHECK_LIVE_FRAME (frame
);
4213 int fontset
= fs_query_fontset (font
, 0);
4214 Lisp_Object name
= font
;
4216 font
= fontset_ascii (fontset
);
4217 font
= font_spec_from_name (name
);
4219 signal_error ("Invalid font name", name
);
4221 else if (! FONTP (font
))
4222 signal_error ("Invalid font object", font
);
4224 val
= AREF (font
, FONT_FAMILY_INDEX
);
4227 plist
[n
++] = QCfamily
;
4228 plist
[n
++] = SYMBOL_NAME (val
);
4231 val
= AREF (font
, FONT_SIZE_INDEX
);
4234 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4235 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4236 plist
[n
++] = QCheight
;
4237 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4239 else if (FLOATP (val
))
4241 plist
[n
++] = QCheight
;
4242 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4245 val
= FONT_WEIGHT_FOR_FACE (font
);
4248 plist
[n
++] = QCweight
;
4252 val
= FONT_SLANT_FOR_FACE (font
);
4255 plist
[n
++] = QCslant
;
4259 val
= FONT_WIDTH_FOR_FACE (font
);
4262 plist
[n
++] = QCwidth
;
4266 return Flist (n
, plist
);
4271 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4272 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
4273 (font_spec
, prop
, val
)
4274 Lisp_Object font_spec
, prop
, val
;
4278 CHECK_FONT_SPEC (font_spec
);
4279 idx
= get_font_prop_index (prop
);
4280 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4281 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
4283 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
4287 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4288 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4289 Optional 2nd argument FRAME specifies the target frame.
4290 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4291 Optional 4th argument PREFER, if non-nil, is a font-spec to
4292 control the order of the returned list. Fonts are sorted by
4293 how close they are to PREFER. */)
4294 (font_spec
, frame
, num
, prefer
)
4295 Lisp_Object font_spec
, frame
, num
, prefer
;
4297 Lisp_Object vec
, list
;
4301 frame
= selected_frame
;
4302 CHECK_LIVE_FRAME (frame
);
4303 CHECK_FONT_SPEC (font_spec
);
4311 if (! NILP (prefer
))
4312 CHECK_FONT_SPEC (prefer
);
4314 list
= font_list_entities (frame
, font_spec
);
4317 if (NILP (XCDR (list
))
4318 && ASIZE (XCAR (list
)) == 1)
4319 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4321 if (! NILP (prefer
))
4322 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4324 vec
= font_vconcat_entity_vectors (list
);
4325 if (n
== 0 || n
>= ASIZE (vec
))
4327 Lisp_Object args
[2];
4331 list
= Fappend (2, args
);
4335 for (list
= Qnil
, n
--; n
>= 0; n
--)
4336 list
= Fcons (AREF (vec
, n
), list
);
4341 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4342 doc
: /* List available font families on the current frame.
4343 Optional argument FRAME, if non-nil, specifies the target frame. */)
4348 struct font_driver_list
*driver_list
;
4352 frame
= selected_frame
;
4353 CHECK_LIVE_FRAME (frame
);
4356 for (driver_list
= f
->font_driver_list
; driver_list
;
4357 driver_list
= driver_list
->next
)
4358 if (driver_list
->driver
->list_family
)
4360 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4361 Lisp_Object tail
= list
;
4363 for (; CONSP (val
); val
= XCDR (val
))
4364 if (NILP (Fmemq (XCAR (val
), tail
))
4365 && SYMBOLP (XCAR (val
)))
4366 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4371 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4372 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4373 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4375 Lisp_Object font_spec
, frame
;
4377 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4384 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4385 doc
: /* Return XLFD name of FONT.
4386 FONT is a font-spec, font-entity, or font-object.
4387 If the name is too long for XLFD (maximum 255 chars), return nil.
4388 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4389 the consecutive wildcards are folded to one. */)
4390 (font
, fold_wildcards
)
4391 Lisp_Object font
, fold_wildcards
;
4398 if (FONT_OBJECT_P (font
))
4400 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4402 if (STRINGP (font_name
)
4403 && SDATA (font_name
)[0] == '-')
4405 if (NILP (fold_wildcards
))
4407 strcpy (name
, (char *) SDATA (font_name
));
4410 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4412 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4415 if (! NILP (fold_wildcards
))
4417 char *p0
= name
, *p1
;
4419 while ((p1
= strstr (p0
, "-*-*")))
4421 strcpy (p1
, p1
+ 2);
4426 return build_string (name
);
4429 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4430 doc
: /* Clear font cache. */)
4433 Lisp_Object list
, frame
;
4435 FOR_EACH_FRAME (list
, frame
)
4437 FRAME_PTR f
= XFRAME (frame
);
4438 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4440 for (; driver_list
; driver_list
= driver_list
->next
)
4441 if (driver_list
->on
)
4443 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4448 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4450 font_assert (! NILP (val
));
4451 val
= XCDR (XCAR (val
));
4452 if (XINT (XCAR (val
)) == 0)
4454 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4455 XSETCDR (cache
, XCDR (val
));
4465 font_fill_lglyph_metrics (glyph
, font_object
)
4466 Lisp_Object glyph
, font_object
;
4468 struct font
*font
= XFONT_OBJECT (font_object
);
4470 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4471 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4472 struct font_metrics metrics
;
4474 LGLYPH_SET_CODE (glyph
, ecode
);
4476 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4477 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4478 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4479 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4480 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4481 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4485 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4486 doc
: /* Shape the glyph-string GSTRING.
4487 Shaping means substituting glyphs and/or adjusting positions of glyphs
4488 to get the correct visual image of character sequences set in the
4489 header of the glyph-string.
4491 If the shaping was successful, the value is GSTRING itself or a newly
4492 created glyph-string. Otherwise, the value is nil. */)
4494 Lisp_Object gstring
;
4497 Lisp_Object font_object
, n
, glyph
;
4500 if (! composition_gstring_p (gstring
))
4501 signal_error ("Invalid glyph-string: ", gstring
);
4502 if (! NILP (LGSTRING_ID (gstring
)))
4504 font_object
= LGSTRING_FONT (gstring
);
4505 CHECK_FONT_OBJECT (font_object
);
4506 font
= XFONT_OBJECT (font_object
);
4507 if (! font
->driver
->shape
)
4510 /* Try at most three times with larger gstring each time. */
4511 for (i
= 0; i
< 3; i
++)
4513 n
= font
->driver
->shape (gstring
);
4516 gstring
= larger_vector (gstring
,
4517 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4520 if (i
== 3 || XINT (n
) == 0)
4523 glyph
= LGSTRING_GLYPH (gstring
, 0);
4524 from
= LGLYPH_FROM (glyph
);
4525 to
= LGLYPH_TO (glyph
);
4526 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4528 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4532 if (NILP (LGLYPH_ADJUSTMENT (this)))
4537 glyph
= LGSTRING_GLYPH (gstring
, j
);
4538 LGLYPH_SET_FROM (glyph
, from
);
4539 LGLYPH_SET_TO (glyph
, to
);
4541 from
= LGLYPH_FROM (this);
4542 to
= LGLYPH_TO (this);
4547 if (from
> LGLYPH_FROM (this))
4548 from
= LGLYPH_FROM (this);
4549 if (to
< LGLYPH_TO (this))
4550 to
= LGLYPH_TO (this);
4556 glyph
= LGSTRING_GLYPH (gstring
, j
);
4557 LGLYPH_SET_FROM (glyph
, from
);
4558 LGLYPH_SET_TO (glyph
, to
);
4560 return composition_gstring_put_cache (gstring
, XINT (n
));
4563 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4565 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4566 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4568 VARIATION-SELECTOR is a chracter code of variation selection
4569 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4570 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4571 (font_object
, character
)
4572 Lisp_Object font_object
, character
;
4574 unsigned variations
[256];
4579 CHECK_FONT_OBJECT (font_object
);
4580 CHECK_CHARACTER (character
);
4581 font
= XFONT_OBJECT (font_object
);
4582 if (! font
->driver
->get_variation_glyphs
)
4584 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4588 for (i
= 0; i
< 255; i
++)
4592 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4593 /* Stops GCC whining about limited range of data type. */
4594 EMACS_INT var
= variations
[i
];
4596 if (var
> MOST_POSITIVE_FIXNUM
)
4597 code
= Fcons (make_number ((variations
[i
]) >> 16),
4598 make_number ((variations
[i
]) & 0xFFFF));
4600 code
= make_number (variations
[i
]);
4601 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4608 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4609 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4610 OTF-FEATURES specifies which features to apply in this format:
4611 (SCRIPT LANGSYS GSUB GPOS)
4613 SCRIPT is a symbol specifying a script tag of OpenType,
4614 LANGSYS is a symbol specifying a langsys tag of OpenType,
4615 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4617 If LANGYS is nil, the default langsys is selected.
4619 The features are applied in the order they appear in the list. The
4620 symbol `*' means to apply all available features not present in this
4621 list, and the remaining features are ignored. For instance, (vatu
4622 pstf * haln) is to apply vatu and pstf in this order, then to apply
4623 all available features other than vatu, pstf, and haln.
4625 The features are applied to the glyphs in the range FROM and TO of
4626 the glyph-string GSTRING-IN.
4628 If some feature is actually applicable, the resulting glyphs are
4629 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4630 this case, the value is the number of produced glyphs.
4632 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4635 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4636 produced in GSTRING-OUT, and the value is nil.
4638 See the documentation of `font-make-gstring' for the format of
4640 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4641 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4643 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4648 check_otf_features (otf_features
);
4649 CHECK_FONT_OBJECT (font_object
);
4650 font
= XFONT_OBJECT (font_object
);
4651 if (! font
->driver
->otf_drive
)
4652 error ("Font backend %s can't drive OpenType GSUB table",
4653 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4654 CHECK_CONS (otf_features
);
4655 CHECK_SYMBOL (XCAR (otf_features
));
4656 val
= XCDR (otf_features
);
4657 CHECK_SYMBOL (XCAR (val
));
4658 val
= XCDR (otf_features
);
4661 len
= check_gstring (gstring_in
);
4662 CHECK_VECTOR (gstring_out
);
4663 CHECK_NATNUM (from
);
4665 CHECK_NATNUM (index
);
4667 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4668 args_out_of_range_3 (from
, to
, make_number (len
));
4669 if (XINT (index
) >= ASIZE (gstring_out
))
4670 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4671 num
= font
->driver
->otf_drive (font
, otf_features
,
4672 gstring_in
, XINT (from
), XINT (to
),
4673 gstring_out
, XINT (index
), 0);
4676 return make_number (num
);
4679 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4681 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4682 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4684 (SCRIPT LANGSYS FEATURE ...)
4685 See the documentation of `font-drive-otf' for more detail.
4687 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4688 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4689 character code corresponding to the glyph or nil if there's no
4690 corresponding character. */)
4691 (font_object
, character
, otf_features
)
4692 Lisp_Object font_object
, character
, otf_features
;
4695 Lisp_Object gstring_in
, gstring_out
, g
;
4696 Lisp_Object alternates
;
4699 CHECK_FONT_GET_OBJECT (font_object
, font
);
4700 if (! font
->driver
->otf_drive
)
4701 error ("Font backend %s can't drive OpenType GSUB table",
4702 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4703 CHECK_CHARACTER (character
);
4704 CHECK_CONS (otf_features
);
4706 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4707 g
= LGSTRING_GLYPH (gstring_in
, 0);
4708 LGLYPH_SET_CHAR (g
, XINT (character
));
4709 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4710 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4711 gstring_out
, 0, 1)) < 0)
4712 gstring_out
= Ffont_make_gstring (font_object
,
4713 make_number (ASIZE (gstring_out
) * 2));
4715 for (i
= 0; i
< num
; i
++)
4717 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4718 int c
= LGLYPH_CHAR (g
);
4719 unsigned code
= LGLYPH_CODE (g
);
4721 alternates
= Fcons (Fcons (make_number (code
),
4722 c
> 0 ? make_number (c
) : Qnil
),
4725 return Fnreverse (alternates
);
4731 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4732 doc
: /* Open FONT-ENTITY. */)
4733 (font_entity
, size
, frame
)
4734 Lisp_Object font_entity
;
4740 CHECK_FONT_ENTITY (font_entity
);
4742 frame
= selected_frame
;
4743 CHECK_LIVE_FRAME (frame
);
4746 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4749 CHECK_NUMBER_OR_FLOAT (size
);
4751 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4753 isize
= XINT (size
);
4757 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4760 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4761 doc
: /* Close FONT-OBJECT. */)
4762 (font_object
, frame
)
4763 Lisp_Object font_object
, frame
;
4765 CHECK_FONT_OBJECT (font_object
);
4767 frame
= selected_frame
;
4768 CHECK_LIVE_FRAME (frame
);
4769 font_close_object (XFRAME (frame
), font_object
);
4773 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4774 doc
: /* Return information about FONT-OBJECT.
4775 The value is a vector:
4776 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4779 NAME is a string of the font name (or nil if the font backend doesn't
4782 FILENAME is a string of the font file (or nil if the font backend
4783 doesn't provide a file name).
4785 PIXEL-SIZE is a pixel size by which the font is opened.
4787 SIZE is a maximum advance width of the font in pixels.
4789 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4792 CAPABILITY is a list whose first element is a symbol representing the
4793 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4794 remaining elements describe the details of the font capability.
4796 If the font is OpenType font, the form of the list is
4797 \(opentype GSUB GPOS)
4798 where GSUB shows which "GSUB" features the font supports, and GPOS
4799 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4800 lists of the format:
4801 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4803 If the font is not OpenType font, currently the length of the form is
4806 SCRIPT is a symbol representing OpenType script tag.
4808 LANGSYS is a symbol representing OpenType langsys tag, or nil
4809 representing the default langsys.
4811 FEATURE is a symbol representing OpenType feature tag.
4813 If the font is not OpenType font, CAPABILITY is nil. */)
4815 Lisp_Object font_object
;
4820 CHECK_FONT_GET_OBJECT (font_object
, font
);
4822 val
= Fmake_vector (make_number (9), Qnil
);
4823 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4824 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4825 ASET (val
, 2, make_number (font
->pixel_size
));
4826 ASET (val
, 3, make_number (font
->max_width
));
4827 ASET (val
, 4, make_number (font
->ascent
));
4828 ASET (val
, 5, make_number (font
->descent
));
4829 ASET (val
, 6, make_number (font
->space_width
));
4830 ASET (val
, 7, make_number (font
->average_width
));
4831 if (font
->driver
->otf_capability
)
4832 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4836 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4837 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4838 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4839 (font_object
, string
)
4840 Lisp_Object font_object
, string
;
4846 CHECK_FONT_GET_OBJECT (font_object
, font
);
4847 CHECK_STRING (string
);
4848 len
= SCHARS (string
);
4849 vec
= Fmake_vector (make_number (len
), Qnil
);
4850 for (i
= 0; i
< len
; i
++)
4852 Lisp_Object ch
= Faref (string
, make_number (i
));
4857 struct font_metrics metrics
;
4859 cod
= code
= font
->driver
->encode_char (font
, c
);
4860 if (code
== FONT_INVALID_CODE
)
4862 val
= Fmake_vector (make_number (6), Qnil
);
4863 if (cod
<= MOST_POSITIVE_FIXNUM
)
4864 ASET (val
, 0, make_number (code
));
4866 ASET (val
, 0, Fcons (make_number (code
>> 16),
4867 make_number (code
& 0xFFFF)));
4868 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4869 ASET (val
, 1, make_number (metrics
.lbearing
));
4870 ASET (val
, 2, make_number (metrics
.rbearing
));
4871 ASET (val
, 3, make_number (metrics
.width
));
4872 ASET (val
, 4, make_number (metrics
.ascent
));
4873 ASET (val
, 5, make_number (metrics
.descent
));
4879 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4880 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4881 FONT is a font-spec, font-entity, or font-object. */)
4883 Lisp_Object spec
, font
;
4885 CHECK_FONT_SPEC (spec
);
4888 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4891 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4892 doc
: /* Return a font-object for displaying a character at POSITION.
4893 Optional second arg WINDOW, if non-nil, is a window displaying
4894 the current buffer. It defaults to the currently selected window. */)
4895 (position
, window
, string
)
4896 Lisp_Object position
, window
, string
;
4903 CHECK_NUMBER_COERCE_MARKER (position
);
4904 pos
= XINT (position
);
4905 if (pos
< BEGV
|| pos
>= ZV
)
4906 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4910 CHECK_NUMBER (position
);
4911 CHECK_STRING (string
);
4912 pos
= XINT (position
);
4913 if (pos
< 0 || pos
>= SCHARS (string
))
4914 args_out_of_range (string
, position
);
4917 window
= selected_window
;
4918 CHECK_LIVE_WINDOW (window
);
4919 w
= XWINDOW (window
);
4921 return font_at (-1, pos
, NULL
, w
, string
);
4925 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4926 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4927 The value is a number of glyphs drawn.
4928 Type C-l to recover what previously shown. */)
4929 (font_object
, string
)
4930 Lisp_Object font_object
, string
;
4932 Lisp_Object frame
= selected_frame
;
4933 FRAME_PTR f
= XFRAME (frame
);
4939 CHECK_FONT_GET_OBJECT (font_object
, font
);
4940 CHECK_STRING (string
);
4941 len
= SCHARS (string
);
4942 code
= alloca (sizeof (unsigned) * len
);
4943 for (i
= 0; i
< len
; i
++)
4945 Lisp_Object ch
= Faref (string
, make_number (i
));
4949 code
[i
] = font
->driver
->encode_char (font
, c
);
4950 if (code
[i
] == FONT_INVALID_CODE
)
4953 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4955 if (font
->driver
->prepare_face
)
4956 font
->driver
->prepare_face (f
, face
);
4957 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4958 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4959 if (font
->driver
->done_face
)
4960 font
->driver
->done_face (f
, face
);
4962 return make_number (len
);
4966 #endif /* FONT_DEBUG */
4968 #ifdef HAVE_WINDOW_SYSTEM
4970 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4971 doc
: /* Return information about a font named NAME on frame FRAME.
4972 If FRAME is omitted or nil, use the selected frame.
4973 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4974 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4976 OPENED-NAME is the name used for opening the font,
4977 FULL-NAME is the full name of the font,
4978 SIZE is the pixelsize of the font,
4979 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4980 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4981 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4982 how to compose characters.
4983 If the named font is not yet loaded, return nil. */)
4985 Lisp_Object name
, frame
;
4990 Lisp_Object font_object
;
4992 (*check_window_system_func
) ();
4995 CHECK_STRING (name
);
4997 frame
= selected_frame
;
4998 CHECK_LIVE_FRAME (frame
);
5003 int fontset
= fs_query_fontset (name
, 0);
5006 name
= fontset_ascii (fontset
);
5007 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
5009 else if (FONT_OBJECT_P (name
))
5011 else if (FONT_ENTITY_P (name
))
5012 font_object
= font_open_entity (f
, name
, 0);
5015 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5016 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
5018 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
5020 if (NILP (font_object
))
5022 font
= XFONT_OBJECT (font_object
);
5024 info
= Fmake_vector (make_number (7), Qnil
);
5025 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
5026 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
5027 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
5028 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
5029 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
5030 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
5031 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
5034 /* As font_object is still in FONT_OBJLIST of the entity, we can't
5035 close it now. Perhaps, we should manage font-objects
5036 by `reference-count'. */
5037 font_close_object (f
, font_object
);
5044 #define BUILD_STYLE_TABLE(TBL) \
5045 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
5048 build_style_table (entry
, nelement
)
5049 struct table_entry
*entry
;
5053 Lisp_Object table
, elt
;
5055 table
= Fmake_vector (make_number (nelement
), Qnil
);
5056 for (i
= 0; i
< nelement
; i
++)
5058 for (j
= 0; entry
[i
].names
[j
]; j
++);
5059 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
5060 ASET (elt
, 0, make_number (entry
[i
].numeric
));
5061 for (j
= 0; entry
[i
].names
[j
]; j
++)
5062 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
5063 ASET (table
, i
, elt
);
5068 Lisp_Object Vfont_log
;
5070 /* The deferred font-log data of the form [ACTION ARG RESULT].
5071 If ACTION is not nil, that is added to the log when font_add_log is
5072 called next time. At that time, ACTION is set back to nil. */
5073 static Lisp_Object Vfont_log_deferred
;
5075 /* Prepend the font-related logging data in Vfont_log if it is not
5076 `t'. ACTION describes a kind of font-related action (e.g. listing,
5077 opening), ARG is the argument for the action, and RESULT is the
5078 result of the action. */
5080 font_add_log (action
, arg
, result
)
5082 Lisp_Object arg
, result
;
5084 Lisp_Object tail
, val
;
5087 if (EQ (Vfont_log
, Qt
))
5089 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5091 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
5093 ASET (Vfont_log_deferred
, 0, Qnil
);
5094 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5095 AREF (Vfont_log_deferred
, 2));
5100 Lisp_Object tail
, elt
;
5101 Lisp_Object equalstr
= build_string ("=");
5103 val
= Ffont_xlfd_name (arg
, Qt
);
5104 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5108 if (EQ (XCAR (elt
), QCscript
)
5109 && SYMBOLP (XCDR (elt
)))
5110 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5111 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5112 else if (EQ (XCAR (elt
), QClang
)
5113 && SYMBOLP (XCDR (elt
)))
5114 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5115 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5116 else if (EQ (XCAR (elt
), QCotf
)
5117 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5118 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5120 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5126 && VECTORP (XCAR (result
))
5127 && ASIZE (XCAR (result
)) > 0
5128 && FONTP (AREF (XCAR (result
), 0)))
5129 result
= font_vconcat_entity_vectors (result
);
5132 val
= Ffont_xlfd_name (result
, Qt
);
5133 if (! FONT_SPEC_P (result
))
5134 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5135 build_string (":"), val
);
5138 else if (CONSP (result
))
5140 result
= Fcopy_sequence (result
);
5141 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5145 val
= Ffont_xlfd_name (val
, Qt
);
5146 XSETCAR (tail
, val
);
5149 else if (VECTORP (result
))
5151 result
= Fcopy_sequence (result
);
5152 for (i
= 0; i
< ASIZE (result
); i
++)
5154 val
= AREF (result
, i
);
5156 val
= Ffont_xlfd_name (val
, Qt
);
5157 ASET (result
, i
, val
);
5160 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5163 /* Record a font-related logging data to be added to Vfont_log when
5164 font_add_log is called next time. ACTION, ARG, RESULT are the same
5168 font_deferred_log (action
, arg
, result
)
5170 Lisp_Object arg
, result
;
5172 if (EQ (Vfont_log
, Qt
))
5174 ASET (Vfont_log_deferred
, 0, build_string (action
));
5175 ASET (Vfont_log_deferred
, 1, arg
);
5176 ASET (Vfont_log_deferred
, 2, result
);
5179 extern void syms_of_ftfont
P_ (());
5180 extern void syms_of_xfont
P_ (());
5181 extern void syms_of_xftfont
P_ (());
5182 extern void syms_of_ftxfont
P_ (());
5183 extern void syms_of_bdffont
P_ (());
5184 extern void syms_of_w32font
P_ (());
5185 extern void syms_of_atmfont
P_ (());
5186 extern void syms_of_nsfont
P_ (());
5191 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5192 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5193 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5194 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5195 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5196 /* Note that the other elements in sort_shift_bits are not used. */
5198 staticpro (&font_charset_alist
);
5199 font_charset_alist
= Qnil
;
5201 DEFSYM (Qopentype
, "opentype");
5203 DEFSYM (Qascii_0
, "ascii-0");
5204 DEFSYM (Qiso8859_1
, "iso8859-1");
5205 DEFSYM (Qiso10646_1
, "iso10646-1");
5206 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5207 DEFSYM (Qunicode_sip
, "unicode-sip");
5211 DEFSYM (QCotf
, ":otf");
5212 DEFSYM (QClang
, ":lang");
5213 DEFSYM (QCscript
, ":script");
5214 DEFSYM (QCantialias
, ":antialias");
5216 DEFSYM (QCfoundry
, ":foundry");
5217 DEFSYM (QCadstyle
, ":adstyle");
5218 DEFSYM (QCregistry
, ":registry");
5219 DEFSYM (QCspacing
, ":spacing");
5220 DEFSYM (QCdpi
, ":dpi");
5221 DEFSYM (QCscalable
, ":scalable");
5222 DEFSYM (QCavgwidth
, ":avgwidth");
5223 DEFSYM (QCfont_entity
, ":font-entity");
5224 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5234 staticpro (&null_vector
);
5235 null_vector
= Fmake_vector (make_number (0), Qnil
);
5237 staticpro (&scratch_font_spec
);
5238 scratch_font_spec
= Ffont_spec (0, NULL
);
5239 staticpro (&scratch_font_prefer
);
5240 scratch_font_prefer
= Ffont_spec (0, NULL
);
5242 staticpro (&Vfont_log_deferred
);
5243 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5247 staticpro (&otf_list
);
5249 #endif /* HAVE_LIBOTF */
5253 defsubr (&Sfont_spec
);
5254 defsubr (&Sfont_get
);
5255 #ifdef HAVE_WINDOW_SYSTEM
5256 defsubr (&Sfont_face_attributes
);
5258 defsubr (&Sfont_put
);
5259 defsubr (&Slist_fonts
);
5260 defsubr (&Sfont_family_list
);
5261 defsubr (&Sfind_font
);
5262 defsubr (&Sfont_xlfd_name
);
5263 defsubr (&Sclear_font_cache
);
5264 defsubr (&Sfont_shape_gstring
);
5265 defsubr (&Sfont_variation_glyphs
);
5267 defsubr (&Sfont_drive_otf
);
5268 defsubr (&Sfont_otf_alternates
);
5272 defsubr (&Sopen_font
);
5273 defsubr (&Sclose_font
);
5274 defsubr (&Squery_font
);
5275 defsubr (&Sget_font_glyphs
);
5276 defsubr (&Sfont_match_p
);
5277 defsubr (&Sfont_at
);
5279 defsubr (&Sdraw_string
);
5281 #endif /* FONT_DEBUG */
5282 #ifdef HAVE_WINDOW_SYSTEM
5283 defsubr (&Sfont_info
);
5286 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5288 Alist of fontname patterns vs the corresponding encoding and repertory info.
5289 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5290 where ENCODING is a charset or a char-table,
5291 and REPERTORY is a charset, a char-table, or nil.
5293 If ENCODING and REPERTORY are the same, the element can have the form
5294 \(REGEXP . ENCODING).
5296 ENCODING is for converting a character to a glyph code of the font.
5297 If ENCODING is a charset, encoding a character by the charset gives
5298 the corresponding glyph code. If ENCODING is a char-table, looking up
5299 the table by a character gives the corresponding glyph code.
5301 REPERTORY specifies a repertory of characters supported by the font.
5302 If REPERTORY is a charset, all characters beloging to the charset are
5303 supported. If REPERTORY is a char-table, all characters who have a
5304 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5305 gets the repertory information by an opened font and ENCODING. */);
5306 Vfont_encoding_alist
= Qnil
;
5308 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5309 doc
: /* Vector of valid font weight values.
5310 Each element has the form:
5311 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5312 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5313 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5315 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5316 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5317 See `font-weight-table' for the format of the vector. */);
5318 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5320 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5321 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5322 See `font-weight-table' for the format of the vector. */);
5323 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5325 staticpro (&font_style_table
);
5326 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5327 ASET (font_style_table
, 0, Vfont_weight_table
);
5328 ASET (font_style_table
, 1, Vfont_slant_table
);
5329 ASET (font_style_table
, 2, Vfont_width_table
);
5331 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5332 *Logging list of font related actions and results.
5333 The value t means to suppress the logging.
5334 The initial value is set to nil if the environment variable
5335 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5338 #ifdef HAVE_WINDOW_SYSTEM
5339 #ifdef HAVE_FREETYPE
5341 #ifdef HAVE_X_WINDOWS
5346 #endif /* HAVE_XFT */
5347 #endif /* HAVE_X_WINDOWS */
5348 #else /* not HAVE_FREETYPE */
5349 #ifdef HAVE_X_WINDOWS
5351 #endif /* HAVE_X_WINDOWS */
5352 #endif /* not HAVE_FREETYPE */
5355 #endif /* HAVE_BDFFONT */
5358 #endif /* WINDOWSNT */
5361 #endif /* HAVE_NS */
5362 #endif /* HAVE_WINDOW_SYSTEM */
5368 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
5371 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5372 (do not change this comment) */