1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
3 Copyright (C) 2006, 2007, 2008, 2009
4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H13PRO009
7 This file is part of GNU Emacs.
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
32 #include "dispextern.h"
34 #include "character.h"
35 #include "composite.h"
41 #endif /* HAVE_X_WINDOWS */
45 #endif /* HAVE_NTGUI */
52 extern Lisp_Object Qfontsize
;
55 Lisp_Object Qopentype
;
57 /* Important character set strings. */
58 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
60 #define DEFAULT_ENCODING Qiso8859_1
62 /* Unicode category `Cf'. */
63 static Lisp_Object QCf
;
65 /* Special vector of zero length. This is repeatedly used by (struct
66 font_driver *)->list when a specified font is not found. */
67 static Lisp_Object null_vector
;
69 static Lisp_Object Vfont_weight_table
, Vfont_slant_table
, Vfont_width_table
;
71 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
72 static Lisp_Object font_style_table
;
74 /* Structure used for tables mapping weight, slant, and width numeric
75 values and their names. */
80 /* The first one is a valid name as a face attribute.
81 The second one (if any) is a typical name in XLFD field. */
85 /* Table of weight numeric values and their names. This table must be
86 sorted by numeric values in ascending order. */
88 static const struct table_entry weight_table
[] =
91 { 20, { "ultra-light", "ultralight" }},
92 { 40, { "extra-light", "extralight" }},
94 { 75, { "semi-light", "semilight", "demilight", "book" }},
95 { 100, { "normal", "medium", "regular", "unspecified" }},
96 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
98 { 205, { "extra-bold", "extrabold" }},
99 { 210, { "ultra-bold", "ultrabold", "black" }}
102 /* Table of slant numeric values and their names. This table must be
103 sorted by numeric values in ascending order. */
105 static const struct table_entry slant_table
[] =
107 { 0, { "reverse-oblique", "ro" }},
108 { 10, { "reverse-italic", "ri" }},
109 { 100, { "normal", "r", "unspecified" }},
110 { 200, { "italic" ,"i", "ot" }},
111 { 210, { "oblique", "o" }}
114 /* Table of width numeric values and their names. This table must be
115 sorted by numeric values in ascending order. */
117 static const struct table_entry width_table
[] =
119 { 50, { "ultra-condensed", "ultracondensed" }},
120 { 63, { "extra-condensed", "extracondensed" }},
121 { 75, { "condensed", "compressed", "narrow" }},
122 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
123 { 100, { "normal", "medium", "regular", "unspecified" }},
124 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
125 { 125, { "expanded" }},
126 { 150, { "extra-expanded", "extraexpanded" }},
127 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
130 extern Lisp_Object Qnormal
;
132 /* Symbols representing keys of normal font properties. */
133 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
;
134 extern Lisp_Object QCheight
, QCsize
, QCname
;
136 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
;
137 /* Symbols representing keys of font extra info. */
138 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
139 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
140 /* Symbols representing values of font spacing property. */
141 Lisp_Object Qc
, Qm
, Qp
, Qd
;
142 /* Special ADSTYLE properties to avoid fonts used for Latin
143 characters; used in xfont.c and ftfont.c. */
144 Lisp_Object Qja
, Qko
;
146 Lisp_Object Vfont_encoding_alist
;
148 /* Alist of font registry symbol and the corresponding charsets
149 information. The information is retrieved from
150 Vfont_encoding_alist on demand.
152 Eash element has the form:
153 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
157 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
158 encodes a character code to a glyph code of a font, and
159 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
160 character is supported by a font.
162 The latter form means that the information for REGISTRY couldn't be
164 static Lisp_Object font_charset_alist
;
166 /* List of all font drivers. Each font-backend (XXXfont.c) calls
167 register_font_driver in syms_of_XXXfont to register its font-driver
169 static struct font_driver_list
*font_driver_list
;
173 /* Creaters of font-related Lisp object. */
178 Lisp_Object font_spec
;
179 struct font_spec
*spec
180 = ((struct font_spec
*)
181 allocate_pseudovector (VECSIZE (struct font_spec
),
182 FONT_SPEC_MAX
, PVEC_FONT
));
183 XSETFONT (font_spec
, spec
);
190 Lisp_Object font_entity
;
191 struct font_entity
*entity
192 = ((struct font_entity
*)
193 allocate_pseudovector (VECSIZE (struct font_entity
),
194 FONT_ENTITY_MAX
, PVEC_FONT
));
195 XSETFONT (font_entity
, entity
);
199 /* Create a font-object whose structure size is SIZE. If ENTITY is
200 not nil, copy properties from ENTITY to the font-object. If
201 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
203 font_make_object (size
, entity
, pixelsize
)
208 Lisp_Object font_object
;
210 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
213 XSETFONT (font_object
, font
);
217 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
218 font
->props
[i
] = AREF (entity
, i
);
219 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
220 font
->props
[FONT_EXTRA_INDEX
]
221 = Fcopy_sequence (AREF (entity
, FONT_EXTRA_INDEX
));
224 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
230 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
231 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
232 static Lisp_Object font_matching_entity
P_ ((FRAME_PTR
, Lisp_Object
*,
235 /* Number of registered font drivers. */
236 static int num_font_drivers
;
239 /* Return a Lispy value of a font property value at STR and LEN bytes.
240 If STR is "*", it returns nil.
241 If FORCE_SYMBOL is zero and all characters in STR are digits, it
242 returns an integer. Otherwise, it returns a symbol interned from
246 font_intern_prop (str
, len
, force_symbol
)
256 if (len
== 1 && *str
== '*')
258 if (!force_symbol
&& len
>=1 && isdigit (*str
))
260 for (i
= 1; i
< len
; i
++)
261 if (! isdigit (str
[i
]))
264 return make_number (atoi (str
));
267 /* The following code is copied from the function intern (in
268 lread.c), and modified to suite our purpose. */
270 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
271 obarray
= check_obarray (obarray
);
272 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
273 if (len
== nchars
|| len
!= nbytes
)
274 /* CONTENTS contains no multibyte sequences or contains an invalid
275 multibyte sequence. We'll make a unibyte string. */
276 tem
= oblookup (obarray
, str
, len
, len
);
278 tem
= oblookup (obarray
, str
, nchars
, len
);
281 if (len
== nchars
|| len
!= nbytes
)
282 tem
= make_unibyte_string (str
, len
);
284 tem
= make_multibyte_string (str
, nchars
, len
);
285 return Fintern (tem
, obarray
);
288 /* Return a pixel size of font-spec SPEC on frame F. */
291 font_pixel_size (f
, spec
)
295 #ifdef HAVE_WINDOW_SYSTEM
296 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
305 font_assert (FLOATP (size
));
306 point_size
= XFLOAT_DATA (size
);
307 val
= AREF (spec
, FONT_DPI_INDEX
);
312 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
320 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
321 font vector. If VAL is not valid (i.e. not registered in
322 font_style_table), return -1 if NOERROR is zero, and return a
323 proper index if NOERROR is nonzero. In that case, register VAL in
324 font_style_table if VAL is a symbol, and return a closest index if
325 VAL is an integer. */
328 font_style_to_value (prop
, val
, noerror
)
329 enum font_property_index prop
;
333 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
334 int len
= ASIZE (table
);
340 Lisp_Object args
[2], elt
;
342 /* At first try exact match. */
343 for (i
= 0; i
< len
; i
++)
344 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
345 if (EQ (val
, AREF (AREF (table
, i
), j
)))
346 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
347 | (i
<< 4) | (j
- 1));
348 /* Try also with case-folding match. */
349 s
= SDATA (SYMBOL_NAME (val
));
350 for (i
= 0; i
< len
; i
++)
351 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
353 elt
= AREF (AREF (table
, i
), j
);
354 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
355 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
356 | (i
<< 4) | (j
- 1));
362 elt
= Fmake_vector (make_number (2), make_number (100));
365 args
[1] = Fmake_vector (make_number (1), elt
);
366 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
367 return (100 << 8) | (i
<< 4);
372 int numeric
= XINT (val
);
374 for (i
= 0, last_n
= -1; i
< len
; i
++)
376 int n
= XINT (AREF (AREF (table
, i
), 0));
379 return (n
<< 8) | (i
<< 4);
384 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
385 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
391 return ((last_n
<< 8) | ((i
- 1) << 4));
396 font_style_symbolic (font
, prop
, for_face
)
398 enum font_property_index prop
;
401 Lisp_Object val
= AREF (font
, prop
);
402 Lisp_Object table
, elt
;
407 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
408 i
= XINT (val
) & 0xFF;
409 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
410 elt
= AREF (table
, ((i
>> 4) & 0xF));
411 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
412 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
415 extern Lisp_Object Vface_alternative_font_family_alist
;
417 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
420 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
421 FONTNAME. ENCODING is a charset symbol that specifies the encoding
422 of the font. REPERTORY is a charset symbol or nil. */
425 find_font_encoding (fontname
)
426 Lisp_Object fontname
;
428 Lisp_Object tail
, elt
;
430 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
434 && STRINGP (XCAR (elt
))
435 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
436 && (SYMBOLP (XCDR (elt
))
437 ? CHARSETP (XCDR (elt
))
438 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
444 /* Return encoding charset and repertory charset for REGISTRY in
445 ENCODING and REPERTORY correspondingly. If correct information for
446 REGISTRY is available, return 0. Otherwise return -1. */
449 font_registry_charsets (registry
, encoding
, repertory
)
450 Lisp_Object registry
;
451 struct charset
**encoding
, **repertory
;
454 int encoding_id
, repertory_id
;
456 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
462 encoding_id
= XINT (XCAR (val
));
463 repertory_id
= XINT (XCDR (val
));
467 val
= find_font_encoding (SYMBOL_NAME (registry
));
468 if (SYMBOLP (val
) && CHARSETP (val
))
470 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
472 else if (CONSP (val
))
474 if (! CHARSETP (XCAR (val
)))
476 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
477 if (NILP (XCDR (val
)))
481 if (! CHARSETP (XCDR (val
)))
483 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
488 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
490 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
494 *encoding
= CHARSET_FROM_ID (encoding_id
);
496 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
501 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
506 /* Font property value validaters. See the comment of
507 font_property_table for the meaning of the arguments. */
509 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
510 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
511 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
512 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
513 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
514 static int get_font_prop_index
P_ ((Lisp_Object
));
517 font_prop_validate_symbol (prop
, val
)
518 Lisp_Object prop
, val
;
521 val
= Fintern (val
, Qnil
);
524 else if (EQ (prop
, QCregistry
))
525 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
531 font_prop_validate_style (style
, val
)
532 Lisp_Object style
, val
;
534 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
535 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
542 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
546 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
548 if ((n
& 0xF) + 1 >= ASIZE (elt
))
550 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
554 else if (SYMBOLP (val
))
556 int n
= font_style_to_value (prop
, val
, 0);
558 val
= n
>= 0 ? make_number (n
) : Qerror
;
566 font_prop_validate_non_neg (prop
, val
)
567 Lisp_Object prop
, val
;
569 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
574 font_prop_validate_spacing (prop
, val
)
575 Lisp_Object prop
, val
;
577 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
579 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
581 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
583 if (spacing
== 'c' || spacing
== 'C')
584 return make_number (FONT_SPACING_CHARCELL
);
585 if (spacing
== 'm' || spacing
== 'M')
586 return make_number (FONT_SPACING_MONO
);
587 if (spacing
== 'p' || spacing
== 'P')
588 return make_number (FONT_SPACING_PROPORTIONAL
);
589 if (spacing
== 'd' || spacing
== 'D')
590 return make_number (FONT_SPACING_DUAL
);
596 font_prop_validate_otf (prop
, val
)
597 Lisp_Object prop
, val
;
599 Lisp_Object tail
, tmp
;
602 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
603 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
604 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
607 if (! SYMBOLP (XCAR (val
)))
612 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
614 for (i
= 0; i
< 2; i
++)
621 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
622 if (! SYMBOLP (XCAR (tmp
)))
630 /* Structure of known font property keys and validater of the
634 /* Pointer to the key symbol. */
636 /* Function to validate PROP's value VAL, or NULL if any value is
637 ok. The value is VAL or its regularized value if VAL is valid,
638 and Qerror if not. */
639 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
640 } font_property_table
[] =
641 { { &QCtype
, font_prop_validate_symbol
},
642 { &QCfoundry
, font_prop_validate_symbol
},
643 { &QCfamily
, font_prop_validate_symbol
},
644 { &QCadstyle
, font_prop_validate_symbol
},
645 { &QCregistry
, font_prop_validate_symbol
},
646 { &QCweight
, font_prop_validate_style
},
647 { &QCslant
, font_prop_validate_style
},
648 { &QCwidth
, font_prop_validate_style
},
649 { &QCsize
, font_prop_validate_non_neg
},
650 { &QCdpi
, font_prop_validate_non_neg
},
651 { &QCspacing
, font_prop_validate_spacing
},
652 { &QCavgwidth
, font_prop_validate_non_neg
},
653 /* The order of the above entries must match with enum
654 font_property_index. */
655 { &QClang
, font_prop_validate_symbol
},
656 { &QCscript
, font_prop_validate_symbol
},
657 { &QCotf
, font_prop_validate_otf
}
660 /* Size (number of elements) of the above table. */
661 #define FONT_PROPERTY_TABLE_SIZE \
662 ((sizeof font_property_table) / (sizeof *font_property_table))
664 /* Return an index number of font property KEY or -1 if KEY is not an
665 already known property. */
668 get_font_prop_index (key
)
673 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
674 if (EQ (key
, *font_property_table
[i
].key
))
679 /* Validate the font property. The property key is specified by the
680 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
681 signal an error. The value is VAL or the regularized one. */
684 font_prop_validate (idx
, prop
, val
)
686 Lisp_Object prop
, val
;
688 Lisp_Object validated
;
693 prop
= *font_property_table
[idx
].key
;
696 idx
= get_font_prop_index (prop
);
700 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
701 if (EQ (validated
, Qerror
))
702 signal_error ("invalid font property", Fcons (prop
, val
));
707 /* Store VAL as a value of extra font property PROP in FONT while
708 keeping the sorting order. Don't check the validity of VAL. */
711 font_put_extra (font
, prop
, val
)
712 Lisp_Object font
, prop
, val
;
714 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
715 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
719 Lisp_Object prev
= Qnil
;
722 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
723 prev
= extra
, extra
= XCDR (extra
);
725 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
727 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
732 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
737 /* Font name parser and unparser */
739 static int parse_matrix
P_ ((char *));
740 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
741 static int font_parse_name
P_ ((char *, Lisp_Object
));
743 /* An enumerator for each field of an XLFD font name. */
744 enum xlfd_field_index
763 /* An enumerator for mask bit corresponding to each XLFD field. */
766 XLFD_FOUNDRY_MASK
= 0x0001,
767 XLFD_FAMILY_MASK
= 0x0002,
768 XLFD_WEIGHT_MASK
= 0x0004,
769 XLFD_SLANT_MASK
= 0x0008,
770 XLFD_SWIDTH_MASK
= 0x0010,
771 XLFD_ADSTYLE_MASK
= 0x0020,
772 XLFD_PIXEL_MASK
= 0x0040,
773 XLFD_POINT_MASK
= 0x0080,
774 XLFD_RESX_MASK
= 0x0100,
775 XLFD_RESY_MASK
= 0x0200,
776 XLFD_SPACING_MASK
= 0x0400,
777 XLFD_AVGWIDTH_MASK
= 0x0800,
778 XLFD_REGISTRY_MASK
= 0x1000,
779 XLFD_ENCODING_MASK
= 0x2000
783 /* Parse P pointing the pixel/point size field of the form
784 `[A B C D]' which specifies a transformation matrix:
790 by which all glyphs of the font are transformed. The spec says
791 that scalar value N for the pixel/point size is equivalent to:
792 A = N * resx/resy, B = C = 0, D = N.
794 Return the scalar value N if the form is valid. Otherwise return
805 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
808 matrix
[i
] = - strtod (p
+ 1, &end
);
810 matrix
[i
] = strtod (p
, &end
);
813 return (i
== 4 ? (int) matrix
[3] : -1);
816 /* Expand a wildcard field in FIELD (the first N fields are filled) to
817 multiple fields to fill in all 14 XLFD fields while restring a
818 field position by its contents. */
821 font_expand_wildcards (field
, n
)
822 Lisp_Object field
[XLFD_LAST_INDEX
];
826 Lisp_Object tmp
[XLFD_LAST_INDEX
];
827 /* Array of information about where this element can go. Nth
828 element is for Nth element of FIELD. */
830 /* Minimum possible field. */
832 /* Maxinum possible field. */
834 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
836 } range
[XLFD_LAST_INDEX
];
838 int range_from
, range_to
;
841 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
842 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
843 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
844 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
845 | XLFD_AVGWIDTH_MASK)
846 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
848 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
849 field. The value is shifted to left one bit by one in the
851 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
852 range_mask
= (range_mask
<< 1) | 1;
854 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
855 position-based retriction for FIELD[I]. */
856 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
857 i
++, range_from
++, range_to
++, range_mask
<<= 1)
859 Lisp_Object val
= field
[i
];
865 range
[i
].from
= range_from
;
866 range
[i
].to
= range_to
;
867 range
[i
].mask
= range_mask
;
871 /* The triplet FROM, TO, and MASK is a value-based
872 retriction for FIELD[I]. */
878 int numeric
= XINT (val
);
881 from
= to
= XLFD_ENCODING_INDEX
,
882 mask
= XLFD_ENCODING_MASK
;
883 else if (numeric
== 0)
884 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
885 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
886 else if (numeric
<= 48)
887 from
= to
= XLFD_PIXEL_INDEX
,
888 mask
= XLFD_PIXEL_MASK
;
890 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
891 mask
= XLFD_LARGENUM_MASK
;
893 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
894 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
895 mask
= XLFD_NULL_MASK
;
897 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
900 Lisp_Object name
= SYMBOL_NAME (val
);
902 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
903 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
904 mask
= XLFD_REGENC_MASK
;
906 from
= to
= XLFD_ENCODING_INDEX
,
907 mask
= XLFD_ENCODING_MASK
;
909 else if (range_from
<= XLFD_WEIGHT_INDEX
910 && range_to
>= XLFD_WEIGHT_INDEX
911 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
912 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
913 else if (range_from
<= XLFD_SLANT_INDEX
914 && range_to
>= XLFD_SLANT_INDEX
915 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
916 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
917 else if (range_from
<= XLFD_SWIDTH_INDEX
918 && range_to
>= XLFD_SWIDTH_INDEX
919 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
920 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
923 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
924 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
926 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
927 mask
= XLFD_SYMBOL_MASK
;
930 /* Merge position-based and value-based restrictions. */
932 while (from
< range_from
)
933 mask
&= ~(1 << from
++);
934 while (from
< 14 && ! (mask
& (1 << from
)))
936 while (to
> range_to
)
937 mask
&= ~(1 << to
--);
938 while (to
>= 0 && ! (mask
& (1 << to
)))
942 range
[i
].from
= from
;
944 range
[i
].mask
= mask
;
946 if (from
> range_from
|| to
< range_to
)
948 /* The range is narrowed by value-based restrictions.
949 Reflect it to the other fields. */
951 /* Following fields should be after FROM. */
953 /* Preceding fields should be before TO. */
954 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
956 /* Check FROM for non-wildcard field. */
957 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
959 while (range
[j
].from
< from
)
960 range
[j
].mask
&= ~(1 << range
[j
].from
++);
961 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
963 range
[j
].from
= from
;
966 from
= range
[j
].from
;
967 if (range
[j
].to
> to
)
969 while (range
[j
].to
> to
)
970 range
[j
].mask
&= ~(1 << range
[j
].to
--);
971 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
984 /* Decide all fileds from restrictions in RANGE. */
985 for (i
= j
= 0; i
< n
; i
++)
987 if (j
< range
[i
].from
)
989 if (i
== 0 || ! NILP (tmp
[i
- 1]))
990 /* None of TMP[X] corresponds to Jth field. */
992 for (; j
< range
[i
].from
; j
++)
997 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
999 for (; j
< XLFD_LAST_INDEX
; j
++)
1001 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
1002 field
[XLFD_ENCODING_INDEX
]
1003 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1008 #ifdef ENABLE_CHECKING
1009 /* Match a 14-field XLFD pattern against a full XLFD font name. */
1011 font_match_xlfd (char *pattern
, char *name
)
1013 while (*pattern
&& *name
)
1015 if (*pattern
== *name
)
1017 else if (*pattern
== '*')
1018 if (*name
== pattern
[1])
1029 /* Make sure the font object matches the XLFD font name. */
1031 font_check_xlfd_parse (Lisp_Object font
, char *name
)
1033 char name_check
[256];
1034 font_unparse_xlfd (font
, 0, name_check
, 255);
1035 return font_match_xlfd (name_check
, name
);
1041 /* Parse NAME (null terminated) as XLFD and store information in FONT
1042 (font-spec or font-entity). Size property of FONT is set as
1044 specified XLFD fields FONT property
1045 --------------------- -------------
1046 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1047 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1048 POINT_SIZE POINT_SIZE/10 (Lisp float)
1050 If NAME is successfully parsed, return 0. Otherwise return -1.
1052 FONT is usually a font-spec, but when this function is called from
1053 X font backend driver, it is a font-entity. In that case, NAME is
1054 a fully specified XLFD. */
1057 font_parse_xlfd (name
, font
)
1061 int len
= strlen (name
);
1063 char *f
[XLFD_LAST_INDEX
+ 1];
1067 if (len
> 255 || !len
)
1068 /* Maximum XLFD name length is 255. */
1070 /* Accept "*-.." as a fully specified XLFD. */
1071 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1072 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1075 for (p
= name
+ i
; *p
; p
++)
1079 if (i
== XLFD_LAST_INDEX
)
1084 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1085 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1087 if (i
== XLFD_LAST_INDEX
)
1089 /* Fully specified XLFD. */
1092 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1093 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1094 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1095 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1097 val
= INTERN_FIELD_SYM (i
);
1100 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1102 ASET (font
, j
, make_number (n
));
1105 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1106 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1107 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1109 ASET (font
, FONT_REGISTRY_INDEX
,
1110 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1111 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1113 p
= f
[XLFD_PIXEL_INDEX
];
1114 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1115 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1118 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1120 ASET (font
, FONT_SIZE_INDEX
, val
);
1123 double point_size
= -1;
1125 font_assert (FONT_SPEC_P (font
));
1126 p
= f
[XLFD_POINT_INDEX
];
1128 point_size
= parse_matrix (p
);
1129 else if (isdigit (*p
))
1130 point_size
= atoi (p
), point_size
/= 10;
1131 if (point_size
>= 0)
1132 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1136 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1137 if (! NILP (val
) && ! INTEGERP (val
))
1139 ASET (font
, FONT_DPI_INDEX
, val
);
1140 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1143 val
= font_prop_validate_spacing (QCspacing
, val
);
1144 if (! INTEGERP (val
))
1146 ASET (font
, FONT_SPACING_INDEX
, val
);
1148 p
= f
[XLFD_AVGWIDTH_INDEX
];
1151 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1152 if (! NILP (val
) && ! INTEGERP (val
))
1154 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1158 int wild_card_found
= 0;
1159 Lisp_Object prop
[XLFD_LAST_INDEX
];
1161 if (FONT_ENTITY_P (font
))
1163 for (j
= 0; j
< i
; j
++)
1167 if (f
[j
][1] && f
[j
][1] != '-')
1170 wild_card_found
= 1;
1173 prop
[j
] = INTERN_FIELD (j
);
1175 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1177 if (! wild_card_found
)
1179 if (font_expand_wildcards (prop
, i
) < 0)
1182 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1183 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1184 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1185 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1186 if (! NILP (prop
[i
]))
1188 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1190 ASET (font
, j
, make_number (n
));
1192 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1193 val
= prop
[XLFD_REGISTRY_INDEX
];
1196 val
= prop
[XLFD_ENCODING_INDEX
];
1198 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1200 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1201 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1203 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1204 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1206 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1208 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1209 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1210 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1212 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1214 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1217 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1218 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1219 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1221 val
= font_prop_validate_spacing (QCspacing
,
1222 prop
[XLFD_SPACING_INDEX
]);
1223 if (! INTEGERP (val
))
1225 ASET (font
, FONT_SPACING_INDEX
, val
);
1227 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1228 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1234 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1235 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1236 0, use PIXEL_SIZE instead. */
1239 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1245 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1249 font_assert (FONTP (font
));
1251 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1254 if (i
== FONT_ADSTYLE_INDEX
)
1255 j
= XLFD_ADSTYLE_INDEX
;
1256 else if (i
== FONT_REGISTRY_INDEX
)
1257 j
= XLFD_REGISTRY_INDEX
;
1258 val
= AREF (font
, i
);
1261 if (j
== XLFD_REGISTRY_INDEX
)
1262 f
[j
] = "*-*", len
+= 4;
1264 f
[j
] = "*", len
+= 2;
1269 val
= SYMBOL_NAME (val
);
1270 if (j
== XLFD_REGISTRY_INDEX
1271 && ! strchr ((char *) SDATA (val
), '-'))
1273 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1274 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1276 f
[j
] = alloca (SBYTES (val
) + 3);
1277 sprintf (f
[j
], "%s-*", SDATA (val
));
1278 len
+= SBYTES (val
) + 3;
1282 f
[j
] = alloca (SBYTES (val
) + 4);
1283 sprintf (f
[j
], "%s*-*", SDATA (val
));
1284 len
+= SBYTES (val
) + 4;
1288 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1292 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1295 val
= font_style_symbolic (font
, i
, 0);
1297 f
[j
] = "*", len
+= 2;
1300 val
= SYMBOL_NAME (val
);
1301 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1305 val
= AREF (font
, FONT_SIZE_INDEX
);
1306 font_assert (NUMBERP (val
) || NILP (val
));
1314 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1315 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1318 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1320 else if (FLOATP (val
))
1322 i
= XFLOAT_DATA (val
) * 10;
1323 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1324 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1327 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1329 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1331 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1332 f
[XLFD_RESX_INDEX
] = alloca (22);
1333 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1337 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1338 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1340 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1342 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1343 : spacing
<= FONT_SPACING_DUAL
? "d"
1344 : spacing
<= FONT_SPACING_MONO
? "m"
1349 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1350 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1352 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1353 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
], "%ld",
1354 (long) XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1357 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1358 len
++; /* for terminating '\0'. */
1361 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1362 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1363 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1364 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1365 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1366 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1367 f
[XLFD_REGISTRY_INDEX
]);
1370 /* Parse NAME (null terminated) and store information in FONT
1371 (font-spec or font-entity). NAME is supplied in either the
1372 Fontconfig or GTK font name format. If NAME is successfully
1373 parsed, return 0. Otherwise return -1.
1375 The fontconfig format is
1377 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1381 FAMILY [PROPS...] [SIZE]
1383 This function tries to guess which format it is. */
1386 font_parse_fcname (name
, font
)
1391 char *size_beg
= NULL
, *size_end
= NULL
;
1392 char *props_beg
= NULL
, *family_end
= NULL
;
1393 int len
= strlen (name
);
1398 for (p
= name
; *p
; p
++)
1400 if (*p
== '\\' && p
[1])
1404 props_beg
= family_end
= p
;
1409 int decimal
= 0, size_found
= 1;
1410 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1413 if (*q
!= '.' || decimal
)
1432 Lisp_Object extra_props
= Qnil
;
1434 /* A fontconfig name with size and/or property data. */
1435 if (family_end
> name
)
1438 family
= font_intern_prop (name
, family_end
- name
, 1);
1439 ASET (font
, FONT_FAMILY_INDEX
, family
);
1443 double point_size
= strtod (size_beg
, &size_end
);
1444 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1445 if (*size_end
== ':' && size_end
[1])
1446 props_beg
= size_end
;
1450 /* Now parse ":KEY=VAL" patterns. */
1453 for (p
= props_beg
; *p
; p
= q
)
1455 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1458 /* Must be an enumerated value. */
1462 val
= font_intern_prop (p
, q
- p
, 1);
1464 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1466 if (PROP_MATCH ("light", 5)
1467 || PROP_MATCH ("medium", 6)
1468 || PROP_MATCH ("demibold", 8)
1469 || PROP_MATCH ("bold", 4)
1470 || PROP_MATCH ("black", 5))
1471 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1472 else if (PROP_MATCH ("roman", 5)
1473 || PROP_MATCH ("italic", 6)
1474 || PROP_MATCH ("oblique", 7))
1475 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1476 else if (PROP_MATCH ("charcell", 8))
1477 ASET (font
, FONT_SPACING_INDEX
,
1478 make_number (FONT_SPACING_CHARCELL
));
1479 else if (PROP_MATCH ("mono", 4))
1480 ASET (font
, FONT_SPACING_INDEX
,
1481 make_number (FONT_SPACING_MONO
));
1482 else if (PROP_MATCH ("proportional", 12))
1483 ASET (font
, FONT_SPACING_INDEX
,
1484 make_number (FONT_SPACING_PROPORTIONAL
));
1493 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1494 prop
= FONT_SIZE_INDEX
;
1497 key
= font_intern_prop (p
, q
- p
, 1);
1498 prop
= get_font_prop_index (key
);
1502 for (q
= p
; *q
&& *q
!= ':'; q
++);
1503 val
= font_intern_prop (p
, q
- p
, 0);
1505 if (prop
>= FONT_FOUNDRY_INDEX
1506 && prop
< FONT_EXTRA_INDEX
)
1507 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1510 extra_props
= nconc2 (extra_props
,
1511 Fcons (Fcons (key
, val
), Qnil
));
1518 if (! NILP (extra_props
))
1520 struct font_driver_list
*driver_list
= font_driver_list
;
1521 for ( ; driver_list
; driver_list
= driver_list
->next
)
1522 if (driver_list
->driver
->filter_properties
)
1523 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1529 /* Either a fontconfig-style name with no size and property
1530 data, or a GTK-style name. */
1532 int word_len
, prop_found
= 0;
1534 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1540 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1548 double point_size
= strtod (p
, &q
);
1549 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1554 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1555 if (*q
== '\\' && q
[1])
1559 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1561 if (PROP_MATCH ("Ultra-Light", 11))
1564 prop
= font_intern_prop ("ultra-light", 11, 1);
1565 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1567 else if (PROP_MATCH ("Light", 5))
1570 prop
= font_intern_prop ("light", 5, 1);
1571 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1573 else if (PROP_MATCH ("Semi-Bold", 9))
1576 prop
= font_intern_prop ("semi-bold", 9, 1);
1577 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1579 else if (PROP_MATCH ("Bold", 4))
1582 prop
= font_intern_prop ("bold", 4, 1);
1583 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1585 else if (PROP_MATCH ("Italic", 6))
1588 prop
= font_intern_prop ("italic", 4, 1);
1589 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1591 else if (PROP_MATCH ("Oblique", 7))
1594 prop
= font_intern_prop ("oblique", 7, 1);
1595 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1599 return -1; /* Unknown property in GTK-style font name. */
1608 family
= font_intern_prop (name
, family_end
- name
, 1);
1609 ASET (font
, FONT_FAMILY_INDEX
, family
);
1616 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1617 NAME (NBYTES length), and return the name length. If
1618 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1621 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1627 Lisp_Object family
, foundry
;
1628 Lisp_Object tail
, val
;
1632 Lisp_Object styles
[3];
1633 char *style_names
[3] = { "weight", "slant", "width" };
1636 family
= AREF (font
, FONT_FAMILY_INDEX
);
1637 if (! NILP (family
))
1639 if (SYMBOLP (family
))
1641 family
= SYMBOL_NAME (family
);
1642 len
+= SBYTES (family
);
1648 val
= AREF (font
, FONT_SIZE_INDEX
);
1651 if (XINT (val
) != 0)
1652 pixel_size
= XINT (val
);
1654 len
+= 21; /* for ":pixelsize=NUM" */
1656 else if (FLOATP (val
))
1659 point_size
= (int) XFLOAT_DATA (val
);
1660 len
+= 11; /* for "-NUM" */
1663 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1664 if (! NILP (foundry
))
1666 if (SYMBOLP (foundry
))
1668 foundry
= SYMBOL_NAME (foundry
);
1669 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1675 for (i
= 0; i
< 3; i
++)
1677 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1678 if (! NILP (styles
[i
]))
1679 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1680 SDATA (SYMBOL_NAME (styles
[i
])));
1683 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1684 len
+= sprintf (work
, ":dpi=%ld", (long)XINT (AREF (font
, FONT_DPI_INDEX
)));
1685 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1686 len
+= strlen (":spacing=100");
1687 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1688 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1689 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1691 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1693 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1695 len
+= SBYTES (val
);
1696 else if (INTEGERP (val
))
1697 len
+= sprintf (work
, "%ld", (long) XINT (val
));
1698 else if (SYMBOLP (val
))
1699 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1705 if (! NILP (family
))
1706 p
+= sprintf (p
, "%s", SDATA (family
));
1710 p
+= sprintf (p
, "%d", point_size
);
1712 p
+= sprintf (p
, "-%d", point_size
);
1714 else if (pixel_size
> 0)
1715 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1716 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1717 p
+= sprintf (p
, ":foundry=%s",
1718 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1719 for (i
= 0; i
< 3; i
++)
1720 if (! NILP (styles
[i
]))
1721 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1722 SDATA (SYMBOL_NAME (styles
[i
])));
1723 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1724 p
+= sprintf (p
, ":dpi=%ld", (long) XINT (AREF (font
, FONT_DPI_INDEX
)));
1725 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1726 p
+= sprintf (p
, ":spacing=%ld",
1727 (long) XINT (AREF (font
, FONT_SPACING_INDEX
)));
1728 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1730 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1731 p
+= sprintf (p
, ":scalable=true");
1733 p
+= sprintf (p
, ":scalable=false");
1738 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1739 NAME (NBYTES length), and return the name length. F is the frame
1740 on which the font is displayed; it is used to calculate the point
1744 font_unparse_gtkname (font
, f
, name
, nbytes
)
1752 Lisp_Object family
, weight
, slant
, size
;
1753 int point_size
= -1;
1755 family
= AREF (font
, FONT_FAMILY_INDEX
);
1756 if (! NILP (family
))
1758 if (! SYMBOLP (family
))
1760 family
= SYMBOL_NAME (family
);
1761 len
+= SBYTES (family
);
1764 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1765 if (EQ (weight
, Qnormal
))
1767 else if (! NILP (weight
))
1769 weight
= SYMBOL_NAME (weight
);
1770 len
+= SBYTES (weight
);
1773 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1774 if (EQ (slant
, Qnormal
))
1776 else if (! NILP (slant
))
1778 slant
= SYMBOL_NAME (slant
);
1779 len
+= SBYTES (slant
);
1782 size
= AREF (font
, FONT_SIZE_INDEX
);
1783 /* Convert pixel size to point size. */
1784 if (INTEGERP (size
))
1786 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1788 if (INTEGERP (font_dpi
))
1789 dpi
= XINT (font_dpi
);
1792 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1795 else if (FLOATP (size
))
1797 point_size
= (int) XFLOAT_DATA (size
);
1804 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1806 if (! NILP (weight
))
1809 p
+= sprintf (p
, " %s", SDATA (weight
));
1810 q
[1] = toupper (q
[1]);
1816 p
+= sprintf (p
, " %s", SDATA (slant
));
1817 q
[1] = toupper (q
[1]);
1821 p
+= sprintf (p
, " %d", point_size
);
1826 /* Parse NAME (null terminated) and store information in FONT
1827 (font-spec or font-entity). If NAME is successfully parsed, return
1828 0. Otherwise return -1. */
1831 font_parse_name (name
, font
)
1835 if (name
[0] == '-' || index (name
, '*') || index (name
, '?'))
1836 return font_parse_xlfd (name
, font
);
1837 return font_parse_fcname (name
, font
);
1841 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1842 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1846 font_parse_family_registry (family
, registry
, font_spec
)
1847 Lisp_Object family
, registry
, font_spec
;
1853 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1855 CHECK_STRING (family
);
1856 len
= SBYTES (family
);
1857 p0
= (char *) SDATA (family
);
1858 p1
= index (p0
, '-');
1861 if ((*p0
!= '*' && p1
- p0
> 0)
1862 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1863 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1866 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1869 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1871 if (! NILP (registry
))
1873 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1874 CHECK_STRING (registry
);
1875 len
= SBYTES (registry
);
1876 p0
= (char *) SDATA (registry
);
1877 p1
= index (p0
, '-');
1880 if (SDATA (registry
)[len
- 1] == '*')
1881 registry
= concat2 (registry
, build_string ("-*"));
1883 registry
= concat2 (registry
, build_string ("*-*"));
1885 registry
= Fdowncase (registry
);
1886 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1891 /* This part (through the next ^L) is still experimental and not
1892 tested much. We may drastically change codes. */
1898 #define LGSTRING_HEADER_SIZE 6
1899 #define LGSTRING_GLYPH_SIZE 8
1902 check_gstring (gstring
)
1903 Lisp_Object gstring
;
1908 CHECK_VECTOR (gstring
);
1909 val
= AREF (gstring
, 0);
1911 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1913 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1914 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1915 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1916 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1917 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1918 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1919 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1920 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1921 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1922 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1923 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1925 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1927 val
= LGSTRING_GLYPH (gstring
, i
);
1929 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1931 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1933 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1934 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1935 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1936 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1937 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1938 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1939 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1940 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1942 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1944 if (ASIZE (val
) < 3)
1946 for (j
= 0; j
< 3; j
++)
1947 CHECK_NUMBER (AREF (val
, j
));
1952 error ("Invalid glyph-string format");
1957 check_otf_features (otf_features
)
1958 Lisp_Object otf_features
;
1962 CHECK_CONS (otf_features
);
1963 CHECK_SYMBOL (XCAR (otf_features
));
1964 otf_features
= XCDR (otf_features
);
1965 CHECK_CONS (otf_features
);
1966 CHECK_SYMBOL (XCAR (otf_features
));
1967 otf_features
= XCDR (otf_features
);
1968 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1970 CHECK_SYMBOL (Fcar (val
));
1971 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1972 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1974 otf_features
= XCDR (otf_features
);
1975 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1977 CHECK_SYMBOL (Fcar (val
));
1978 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1979 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1986 Lisp_Object otf_list
;
1989 otf_tag_symbol (tag
)
1994 OTF_tag_name (tag
, name
);
1995 return Fintern (make_unibyte_string (name
, 4), Qnil
);
2002 Lisp_Object val
= Fassoc (file
, otf_list
);
2006 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
2009 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
2010 val
= make_save_value (otf
, 0);
2011 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
2017 /* Return a list describing which scripts/languages FONT supports by
2018 which GSUB/GPOS features of OpenType tables. See the comment of
2019 (struct font_driver).otf_capability. */
2022 font_otf_capability (font
)
2026 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
2029 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
2032 for (i
= 0; i
< 2; i
++)
2034 OTF_GSUB_GPOS
*gsub_gpos
;
2035 Lisp_Object script_list
= Qnil
;
2038 if (OTF_get_features (otf
, i
== 0) < 0)
2040 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2041 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2043 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2044 Lisp_Object langsys_list
= Qnil
;
2045 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2048 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2050 OTF_LangSys
*langsys
;
2051 Lisp_Object feature_list
= Qnil
;
2052 Lisp_Object langsys_tag
;
2055 if (k
== script
->LangSysCount
)
2057 langsys
= &script
->DefaultLangSys
;
2062 langsys
= script
->LangSys
+ k
;
2064 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2066 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2068 OTF_Feature
*feature
2069 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2070 Lisp_Object feature_tag
2071 = otf_tag_symbol (feature
->FeatureTag
);
2073 feature_list
= Fcons (feature_tag
, feature_list
);
2075 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2078 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2083 XSETCAR (capability
, script_list
);
2085 XSETCDR (capability
, script_list
);
2091 /* Parse OTF features in SPEC and write a proper features spec string
2092 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2093 assured that the sufficient memory has already allocated for
2097 generate_otf_features (spec
, features
)
2107 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2113 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2118 else if (! asterisk
)
2120 val
= SYMBOL_NAME (val
);
2121 p
+= sprintf (p
, "%s", SDATA (val
));
2125 val
= SYMBOL_NAME (val
);
2126 p
+= sprintf (p
, "~%s", SDATA (val
));
2130 error ("OTF spec too long");
2134 font_otf_DeviceTable (device_table
)
2135 OTF_DeviceTable
*device_table
;
2137 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2139 return Fcons (make_number (len
),
2140 make_unibyte_string (device_table
->DeltaValue
, len
));
2144 font_otf_ValueRecord (value_format
, value_record
)
2146 OTF_ValueRecord
*value_record
;
2148 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2150 if (value_format
& OTF_XPlacement
)
2151 ASET (val
, 0, make_number (value_record
->XPlacement
));
2152 if (value_format
& OTF_YPlacement
)
2153 ASET (val
, 1, make_number (value_record
->YPlacement
));
2154 if (value_format
& OTF_XAdvance
)
2155 ASET (val
, 2, make_number (value_record
->XAdvance
));
2156 if (value_format
& OTF_YAdvance
)
2157 ASET (val
, 3, make_number (value_record
->YAdvance
));
2158 if (value_format
& OTF_XPlaDevice
)
2159 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2160 if (value_format
& OTF_YPlaDevice
)
2161 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2162 if (value_format
& OTF_XAdvDevice
)
2163 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2164 if (value_format
& OTF_YAdvDevice
)
2165 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2170 font_otf_Anchor (anchor
)
2175 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2176 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2177 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2178 if (anchor
->AnchorFormat
== 2)
2179 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2182 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2183 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2187 #endif /* HAVE_LIBOTF */
2193 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2194 static int font_compare
P_ ((const void *, const void *));
2195 static Lisp_Object font_sort_entities
P_ ((Lisp_Object
, Lisp_Object
,
2198 /* Return a rescaling ratio of FONT_ENTITY. */
2199 extern Lisp_Object Vface_font_rescale_alist
;
2202 font_rescale_ratio (font_entity
)
2203 Lisp_Object font_entity
;
2205 Lisp_Object tail
, elt
;
2206 Lisp_Object name
= Qnil
;
2208 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2211 if (FLOATP (XCDR (elt
)))
2213 if (STRINGP (XCAR (elt
)))
2216 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2217 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2218 return XFLOAT_DATA (XCDR (elt
));
2220 else if (FONT_SPEC_P (XCAR (elt
)))
2222 if (font_match_p (XCAR (elt
), font_entity
))
2223 return XFLOAT_DATA (XCDR (elt
));
2230 /* We sort fonts by scoring each of them against a specified
2231 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2232 the value is, the closer the font is to the font-spec.
2234 The lowest 2 bits of the score is used for driver type. The font
2235 available by the most preferred font driver is 0.
2237 Each 7-bit in the higher 28 bits are used for numeric properties
2238 WEIGHT, SLANT, WIDTH, and SIZE. */
2240 /* How many bits to shift to store the difference value of each font
2241 property in a score. Note that flots for FONT_TYPE_INDEX and
2242 FONT_REGISTRY_INDEX are not used. */
2243 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2245 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2246 The return value indicates how different ENTITY is compared with
2250 font_score (entity
, spec_prop
)
2251 Lisp_Object entity
, *spec_prop
;
2256 /* Score three style numeric fields. Maximum difference is 127. */
2257 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2258 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2260 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2265 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2268 /* Score the size. Maximum difference is 127. */
2269 i
= FONT_SIZE_INDEX
;
2270 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2271 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2273 /* We use the higher 6-bit for the actual size difference. The
2274 lowest bit is set if the DPI is different. */
2276 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2278 if (CONSP (Vface_font_rescale_alist
))
2279 pixel_size
*= font_rescale_ratio (entity
);
2280 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2284 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2285 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2287 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2288 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2290 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2297 /* Concatenate all elements of LIST into one vector. LIST is a list
2298 of font-entity vectors. */
2301 font_vconcat_entity_vectors (Lisp_Object list
)
2303 int nargs
= XINT (Flength (list
));
2304 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2307 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2308 args
[i
] = XCAR (list
);
2309 return Fvconcat (nargs
, args
);
2313 /* The structure for elements being sorted by qsort. */
2314 struct font_sort_data
2317 int font_driver_preference
;
2322 /* The comparison function for qsort. */
2325 font_compare (d1
, d2
)
2326 const void *d1
, *d2
;
2328 const struct font_sort_data
*data1
= d1
;
2329 const struct font_sort_data
*data2
= d2
;
2331 if (data1
->score
< data2
->score
)
2333 else if (data1
->score
> data2
->score
)
2335 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2339 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2340 If PREFER specifies a point-size, calculate the corresponding
2341 pixel-size from QCdpi property of PREFER or from the Y-resolution
2342 of FRAME before sorting.
2344 If BEST-ONLY is nonzero, return the best matching entity (that
2345 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2346 if BEST-ONLY is negative). Otherwise, return the sorted result as
2347 a single vector of font-entities.
2349 This function does no optimization for the case that the total
2350 number of elements is 1. The caller should avoid calling this in
2354 font_sort_entities (list
, prefer
, frame
, best_only
)
2355 Lisp_Object list
, prefer
, frame
;
2358 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2360 struct font_sort_data
*data
;
2361 unsigned best_score
;
2362 Lisp_Object best_entity
;
2363 struct frame
*f
= XFRAME (frame
);
2364 Lisp_Object tail
, vec
;
2367 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2368 prefer_prop
[i
] = AREF (prefer
, i
);
2369 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2370 prefer_prop
[FONT_SIZE_INDEX
]
2371 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2373 if (NILP (XCDR (list
)))
2375 /* What we have to take care of is this single vector. */
2377 maxlen
= ASIZE (vec
);
2381 /* We don't have to perform sort, so there's no need of creating
2382 a single vector. But, we must find the length of the longest
2385 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2386 if (maxlen
< ASIZE (XCAR (tail
)))
2387 maxlen
= ASIZE (XCAR (tail
));
2391 /* We have to create a single vector to sort it. */
2392 vec
= font_vconcat_entity_vectors (list
);
2393 maxlen
= ASIZE (vec
);
2396 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2397 best_score
= 0xFFFFFFFF;
2400 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2402 int font_driver_preference
= 0;
2403 Lisp_Object current_font_driver
;
2409 /* We are sure that the length of VEC > 0. */
2410 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2411 /* Score the elements. */
2412 for (i
= 0; i
< len
; i
++)
2414 data
[i
].entity
= AREF (vec
, i
);
2416 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2418 ? font_score (data
[i
].entity
, prefer_prop
)
2420 if (best_only
&& best_score
> data
[i
].score
)
2422 best_score
= data
[i
].score
;
2423 best_entity
= data
[i
].entity
;
2424 if (best_score
== 0)
2427 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2429 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2430 font_driver_preference
++;
2432 data
[i
].font_driver_preference
= font_driver_preference
;
2435 /* Sort if necessary. */
2438 qsort (data
, len
, sizeof *data
, font_compare
);
2439 for (i
= 0; i
< len
; i
++)
2440 ASET (vec
, i
, data
[i
].entity
);
2449 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2454 /* API of Font Service Layer. */
2456 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2457 sort_shift_bits. Finternal_set_font_selection_order calls this
2458 function with font_sort_order after setting up it. */
2461 font_update_sort_order (order
)
2466 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2468 int xlfd_idx
= order
[i
];
2470 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2471 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2472 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2473 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2474 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2475 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2477 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2482 font_check_otf_features (script
, langsys
, features
, table
)
2483 Lisp_Object script
, langsys
, features
, table
;
2488 table
= assq_no_quit (script
, table
);
2491 table
= XCDR (table
);
2492 if (! NILP (langsys
))
2494 table
= assq_no_quit (langsys
, table
);
2500 val
= assq_no_quit (Qnil
, table
);
2502 table
= XCAR (table
);
2506 table
= XCDR (table
);
2507 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2509 if (NILP (XCAR (features
)))
2514 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2520 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2523 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2525 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2527 script
= XCAR (spec
);
2531 langsys
= XCAR (spec
);
2542 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2543 XCAR (otf_capability
)))
2545 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2546 XCDR (otf_capability
)))
2553 /* Check if FONT (font-entity or font-object) matches with the font
2554 specification SPEC. */
2557 font_match_p (spec
, font
)
2558 Lisp_Object spec
, font
;
2560 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2561 Lisp_Object extra
, font_extra
;
2564 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2565 if (! NILP (AREF (spec
, i
))
2566 && ! NILP (AREF (font
, i
))
2567 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2569 props
= XFONT_SPEC (spec
)->props
;
2570 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2572 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2573 prop
[i
] = AREF (spec
, i
);
2574 prop
[FONT_SIZE_INDEX
]
2575 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2579 if (font_score (font
, props
) > 0)
2581 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2582 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2583 for (; CONSP (extra
); extra
= XCDR (extra
))
2585 Lisp_Object key
= XCAR (XCAR (extra
));
2586 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2588 if (EQ (key
, QClang
))
2590 val2
= assq_no_quit (key
, font_extra
);
2599 if (NILP (Fmemq (val
, val2
)))
2604 ? NILP (Fmemq (val
, XCDR (val2
)))
2608 else if (EQ (key
, QCscript
))
2610 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2616 /* All characters in the list must be supported. */
2617 for (; CONSP (val2
); val2
= XCDR (val2
))
2619 if (! NATNUMP (XCAR (val2
)))
2621 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2622 == FONT_INVALID_CODE
)
2626 else if (VECTORP (val2
))
2628 /* At most one character in the vector must be supported. */
2629 for (i
= 0; i
< ASIZE (val2
); i
++)
2631 if (! NATNUMP (AREF (val2
, i
)))
2633 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2634 != FONT_INVALID_CODE
)
2637 if (i
== ASIZE (val2
))
2642 else if (EQ (key
, QCotf
))
2646 if (! FONT_OBJECT_P (font
))
2648 fontp
= XFONT_OBJECT (font
);
2649 if (! fontp
->driver
->otf_capability
)
2651 val2
= fontp
->driver
->otf_capability (fontp
);
2652 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2663 Each font backend has the callback function get_cache, and it
2664 returns a cons cell of which cdr part can be freely used for
2665 caching fonts. The cons cell may be shared by multiple frames
2666 and/or multiple font drivers. So, we arrange the cdr part as this:
2668 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2670 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2671 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2672 cons (FONT-SPEC FONT-ENTITY ...). */
2674 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2675 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2676 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2677 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2678 struct font_driver
*));
2681 font_prepare_cache (f
, driver
)
2683 struct font_driver
*driver
;
2685 Lisp_Object cache
, val
;
2687 cache
= driver
->get_cache (f
);
2689 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2693 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2694 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2698 val
= XCDR (XCAR (val
));
2699 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2705 font_finish_cache (f
, driver
)
2707 struct font_driver
*driver
;
2709 Lisp_Object cache
, val
, tmp
;
2712 cache
= driver
->get_cache (f
);
2714 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2715 cache
= val
, val
= XCDR (val
);
2716 font_assert (! NILP (val
));
2717 tmp
= XCDR (XCAR (val
));
2718 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2719 if (XINT (XCAR (tmp
)) == 0)
2721 font_clear_cache (f
, XCAR (val
), driver
);
2722 XSETCDR (cache
, XCDR (val
));
2728 font_get_cache (f
, driver
)
2730 struct font_driver
*driver
;
2732 Lisp_Object val
= driver
->get_cache (f
);
2733 Lisp_Object type
= driver
->type
;
2735 font_assert (CONSP (val
));
2736 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2737 font_assert (CONSP (val
));
2738 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2739 val
= XCDR (XCAR (val
));
2743 static int num_fonts
;
2746 font_clear_cache (f
, cache
, driver
)
2749 struct font_driver
*driver
;
2751 Lisp_Object tail
, elt
;
2752 Lisp_Object tail2
, entity
;
2754 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2755 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2758 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2759 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2761 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2763 entity
= XCAR (tail2
);
2765 if (FONT_ENTITY_P (entity
)
2766 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2768 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2770 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2772 Lisp_Object val
= XCAR (objlist
);
2773 struct font
*font
= XFONT_OBJECT (val
);
2775 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2777 font_assert (font
&& driver
== font
->driver
);
2778 driver
->close (f
, font
);
2782 if (driver
->free_entity
)
2783 driver
->free_entity (entity
);
2788 XSETCDR (cache
, Qnil
);
2792 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2795 font_delete_unmatched (vec
, spec
, size
)
2796 Lisp_Object vec
, spec
;
2799 Lisp_Object entity
, val
;
2800 enum font_property_index prop
;
2803 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2805 entity
= AREF (vec
, i
);
2806 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2807 if (INTEGERP (AREF (spec
, prop
))
2808 && ((XINT (AREF (spec
, prop
)) >> 8)
2809 != (XINT (AREF (entity
, prop
)) >> 8)))
2810 prop
= FONT_SPEC_MAX
;
2811 if (prop
< FONT_SPEC_MAX
2813 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2815 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2818 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2819 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2820 prop
= FONT_SPEC_MAX
;
2822 if (prop
< FONT_SPEC_MAX
2823 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2824 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2825 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2826 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2827 prop
= FONT_SPEC_MAX
;
2828 if (prop
< FONT_SPEC_MAX
2829 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2830 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2831 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2832 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2833 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2834 prop
= FONT_SPEC_MAX
;
2835 if (prop
< FONT_SPEC_MAX
)
2836 val
= Fcons (entity
, val
);
2838 return (Fvconcat (1, &val
));
2842 /* Return a list of vectors of font-entities matching with SPEC on
2843 FRAME. The elements of the list are in the same of order of
2847 font_list_entities (frame
, spec
)
2848 Lisp_Object frame
, spec
;
2850 FRAME_PTR f
= XFRAME (frame
);
2851 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2852 Lisp_Object ftype
, val
;
2853 Lisp_Object list
= Qnil
;
2855 int need_filtering
= 0;
2858 font_assert (FONT_SPEC_P (spec
));
2860 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2861 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2862 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2863 size
= font_pixel_size (f
, spec
);
2867 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2868 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2869 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2870 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2872 ASET (scratch_font_spec
, i
, Qnil
);
2873 if (! NILP (AREF (spec
, i
)))
2875 if (i
== FONT_DPI_INDEX
)
2876 /* Skip FONT_SPACING_INDEX */
2879 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2880 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2882 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2884 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2886 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2888 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2889 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2896 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2900 val
= Fvconcat (1, &val
);
2901 copy
= Fcopy_font_spec (scratch_font_spec
);
2902 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2903 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2905 if (ASIZE (val
) > 0 && need_filtering
)
2906 val
= font_delete_unmatched (val
, spec
, size
);
2907 if (ASIZE (val
) > 0)
2908 list
= Fcons (val
, list
);
2911 list
= Fnreverse (list
);
2912 FONT_ADD_LOG ("list", spec
, list
);
2917 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2918 nil, is an array of face's attributes, which specifies preferred
2919 font-related attributes. */
2922 font_matching_entity (f
, attrs
, spec
)
2924 Lisp_Object
*attrs
, spec
;
2926 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2927 Lisp_Object ftype
, size
, entity
;
2929 Lisp_Object work
= Fcopy_font_spec (spec
);
2931 XSETFRAME (frame
, f
);
2932 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2933 size
= AREF (spec
, FONT_SIZE_INDEX
);
2936 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2937 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2938 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2939 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2942 for (; driver_list
; driver_list
= driver_list
->next
)
2944 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2946 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2949 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2950 entity
= assoc_no_quit (work
, XCDR (cache
));
2952 entity
= XCDR (entity
);
2955 entity
= driver_list
->driver
->match (frame
, work
);
2956 copy
= Fcopy_font_spec (work
);
2957 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2958 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2960 if (! NILP (entity
))
2963 FONT_ADD_LOG ("match", work
, entity
);
2968 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2969 opened font object. */
2972 font_open_entity (f
, entity
, pixel_size
)
2977 struct font_driver_list
*driver_list
;
2978 Lisp_Object objlist
, size
, val
, font_object
;
2980 int min_width
, height
;
2981 int scaled_pixel_size
;
2983 font_assert (FONT_ENTITY_P (entity
));
2984 size
= AREF (entity
, FONT_SIZE_INDEX
);
2985 if (XINT (size
) != 0)
2986 scaled_pixel_size
= pixel_size
= XINT (size
);
2987 else if (CONSP (Vface_font_rescale_alist
))
2988 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2991 /* This doesn't work if you have changed hinting or any other parameter.
2992 We need to make a new object in every case to be sure. */
2993 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2994 objlist
= XCDR (objlist
))
2995 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2996 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2997 return XCAR (objlist
);
3000 val
= AREF (entity
, FONT_TYPE_INDEX
);
3001 for (driver_list
= f
->font_driver_list
;
3002 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
3003 driver_list
= driver_list
->next
);
3007 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
3008 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3009 FONT_ADD_LOG ("open", entity
, font_object
);
3010 if (NILP (font_object
))
3012 ASET (entity
, FONT_OBJLIST_INDEX
,
3013 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
3014 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
3017 font
= XFONT_OBJECT (font_object
);
3018 min_width
= (font
->min_width
? font
->min_width
3019 : font
->average_width
? font
->average_width
3020 : font
->space_width
? font
->space_width
3022 height
= (font
->height
? font
->height
: 1);
3023 #ifdef HAVE_WINDOW_SYSTEM
3024 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
3025 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
3027 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
3028 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
3029 fonts_changed_p
= 1;
3033 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
3034 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
3035 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
3036 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
3044 /* Close FONT_OBJECT that is opened on frame F. */
3047 font_close_object (f
, font_object
)
3049 Lisp_Object font_object
;
3051 struct font
*font
= XFONT_OBJECT (font_object
);
3053 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
3054 /* Already closed. */
3056 FONT_ADD_LOG ("close", font_object
, Qnil
);
3057 font
->driver
->close (f
, font
);
3058 #ifdef HAVE_WINDOW_SYSTEM
3059 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
3060 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
3066 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
3067 FONT is a font-entity and it must be opened to check. */
3070 font_has_char (f
, font
, c
)
3077 if (FONT_ENTITY_P (font
))
3079 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
3080 struct font_driver_list
*driver_list
;
3082 for (driver_list
= f
->font_driver_list
;
3083 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
3084 driver_list
= driver_list
->next
);
3087 if (! driver_list
->driver
->has_char
)
3089 return driver_list
->driver
->has_char (font
, c
);
3092 font_assert (FONT_OBJECT_P (font
));
3093 fontp
= XFONT_OBJECT (font
);
3094 if (fontp
->driver
->has_char
)
3096 int result
= fontp
->driver
->has_char (font
, c
);
3101 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
3105 /* Return the glyph ID of FONT_OBJECT for character C. */
3108 font_encode_char (font_object
, c
)
3109 Lisp_Object font_object
;
3114 font_assert (FONT_OBJECT_P (font_object
));
3115 font
= XFONT_OBJECT (font_object
);
3116 return font
->driver
->encode_char (font
, c
);
3120 /* Return the name of FONT_OBJECT. */
3123 font_get_name (font_object
)
3124 Lisp_Object font_object
;
3126 font_assert (FONT_OBJECT_P (font_object
));
3127 return AREF (font_object
, FONT_NAME_INDEX
);
3131 /* Return the specification of FONT_OBJECT. */
3134 font_get_spec (font_object
)
3135 Lisp_Object font_object
;
3137 Lisp_Object spec
= font_make_spec ();
3140 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
3141 ASET (spec
, i
, AREF (font_object
, i
));
3142 ASET (spec
, FONT_SIZE_INDEX
,
3143 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
3148 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3149 could not be parsed by font_parse_name, return Qnil. */
3152 font_spec_from_name (font_name
)
3153 Lisp_Object font_name
;
3155 Lisp_Object spec
= Ffont_spec (0, NULL
);
3157 CHECK_STRING (font_name
);
3158 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3160 font_put_extra (spec
, QCname
, font_name
);
3166 font_clear_prop (attrs
, prop
)
3168 enum font_property_index prop
;
3170 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3175 if (! NILP (Ffont_get (font
, QCname
)))
3177 font
= Fcopy_font_spec (font
);
3178 font_put_extra (font
, QCname
, Qnil
);
3182 if (NILP (AREF (font
, prop
))
3183 && prop
!= FONT_FAMILY_INDEX
3184 && prop
!= FONT_FOUNDRY_INDEX
3185 && prop
!= FONT_WIDTH_INDEX
3186 && prop
!= FONT_SIZE_INDEX
)
3188 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3189 font
= Fcopy_font_spec (font
);
3190 ASET (font
, prop
, Qnil
);
3191 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3193 if (prop
== FONT_FAMILY_INDEX
)
3195 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3196 /* If we are setting the font family, we must also clear
3197 FONT_WIDTH_INDEX to avoid rejecting families that lack
3198 support for some widths. */
3199 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3201 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3202 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3203 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3204 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3205 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3206 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3208 else if (prop
== FONT_SIZE_INDEX
)
3210 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3211 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3212 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3214 else if (prop
== FONT_WIDTH_INDEX
)
3215 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3216 attrs
[LFACE_FONT_INDEX
] = font
;
3220 font_update_lface (f
, attrs
)
3226 spec
= attrs
[LFACE_FONT_INDEX
];
3227 if (! FONT_SPEC_P (spec
))
3230 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3231 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3232 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3233 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3234 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3235 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3236 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3237 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);
3238 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3239 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3240 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3244 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3249 val
= Ffont_get (spec
, QCdpi
);
3252 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3254 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3256 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3258 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3259 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3265 /* Selecte a font from ENTITIES (list of font-entity vectors) that
3266 supports C and matches best with ATTRS and PIXEL_SIZE. */
3269 font_select_entity (frame
, entities
, attrs
, pixel_size
, c
)
3270 Lisp_Object frame
, entities
, *attrs
;
3273 Lisp_Object font_entity
;
3276 FRAME_PTR f
= XFRAME (frame
);
3278 if (NILP (XCDR (entities
))
3279 && ASIZE (XCAR (entities
)) == 1)
3281 font_entity
= AREF (XCAR (entities
), 0);
3283 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3288 /* Sort fonts by properties specified in ATTRS. */
3289 prefer
= scratch_font_prefer
;
3291 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3292 ASET (prefer
, i
, Qnil
);
3293 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3295 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3297 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3298 ASET (prefer
, i
, AREF (face_font
, i
));
3300 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3301 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3302 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3303 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3304 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3305 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3306 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3308 return font_sort_entities (entities
, prefer
, frame
, c
);
3311 /* Return a font-entity satisfying SPEC and best matching with face's
3312 font related attributes in ATTRS. C, if not negative, is a
3313 character that the entity must support. */
3316 font_find_for_lface (f
, attrs
, spec
, c
)
3323 Lisp_Object frame
, entities
, val
;
3324 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3328 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3329 if (NILP (registry
[0]))
3331 registry
[0] = DEFAULT_ENCODING
;
3332 registry
[1] = Qascii_0
;
3333 registry
[2] = null_vector
;
3336 registry
[1] = null_vector
;
3338 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3340 struct charset
*encoding
, *repertory
;
3342 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3343 &encoding
, &repertory
) < 0)
3346 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3348 else if (c
> encoding
->max_char
)
3352 work
= Fcopy_font_spec (spec
);
3353 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3354 XSETFRAME (frame
, f
);
3355 size
= AREF (spec
, FONT_SIZE_INDEX
);
3356 pixel_size
= font_pixel_size (f
, spec
);
3357 if (pixel_size
== 0)
3359 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3361 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3363 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3364 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3365 if (! NILP (foundry
[0]))
3366 foundry
[1] = null_vector
;
3367 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3369 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3370 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3372 foundry
[2] = null_vector
;
3375 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3377 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3378 if (! NILP (adstyle
[0]))
3379 adstyle
[1] = null_vector
;
3380 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3382 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3384 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3386 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3388 adstyle
[2] = null_vector
;
3391 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3394 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3397 val
= AREF (work
, FONT_FAMILY_INDEX
);
3398 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3400 val
= attrs
[LFACE_FAMILY_INDEX
];
3401 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3405 family
= alloca ((sizeof family
[0]) * 2);
3407 family
[1] = null_vector
; /* terminator. */
3412 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3413 /* Font family names are case-sensitive under NS. */
3421 if (! NILP (alters
))
3423 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3424 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3425 family
[i
] = XCAR (alters
);
3426 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3428 family
[i
] = null_vector
;
3432 family
= alloca ((sizeof family
[0]) * 3);
3435 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3437 family
[i
] = null_vector
;
3441 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3443 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3444 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3446 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3447 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3449 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3450 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3452 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3453 entities
= font_list_entities (frame
, work
);
3454 if (! NILP (entities
))
3456 val
= font_select_entity (frame
, entities
,
3457 attrs
, pixel_size
, c
);
3470 font_open_for_lface (f
, entity
, attrs
, spec
)
3478 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3479 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3480 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3481 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3482 size
= font_pixel_size (f
, spec
);
3486 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3487 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3490 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3491 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3492 if (INTEGERP (height
))
3495 abort(); /* We should never end up here. */
3499 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3503 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3504 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3508 return font_open_entity (f
, entity
, size
);
3512 /* Find a font satisfying SPEC and best matching with face's
3513 attributes in ATTRS on FRAME, and return the opened
3517 font_load_for_lface (f
, attrs
, spec
)
3519 Lisp_Object
*attrs
, spec
;
3521 Lisp_Object entity
, name
;
3523 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3526 /* No font is listed for SPEC, but each font-backend may have
3527 the different criteria about "font matching". So, try
3529 entity
= font_matching_entity (f
, attrs
, spec
);
3533 /* Don't loose the original name that was put in initially. We need
3534 it to re-apply the font when font parameters (like hinting or dpi) have
3536 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3537 name
= Ffont_get (spec
, QCname
);
3538 if (STRINGP (name
)) font_put_extra (entity
, QCname
, name
);
3543 /* Make FACE on frame F ready to use the font opened for FACE. */
3546 font_prepare_for_face (f
, face
)
3550 if (face
->font
->driver
->prepare_face
)
3551 face
->font
->driver
->prepare_face (f
, face
);
3555 /* Make FACE on frame F stop using the font opened for FACE. */
3558 font_done_for_face (f
, face
)
3562 if (face
->font
->driver
->done_face
)
3563 face
->font
->driver
->done_face (f
, face
);
3568 /* Open a font matching with font-spec SPEC on frame F. If no proper
3569 font is found, return Qnil. */
3572 font_open_by_spec (f
, spec
)
3576 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3578 /* We set up the default font-related attributes of a face to prefer
3580 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3581 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3582 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3584 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3586 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3588 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3590 return font_load_for_lface (f
, attrs
, spec
);
3594 /* Open a font matching with NAME on frame F. If no proper font is
3595 found, return Qnil. */
3598 font_open_by_name (f
, name
)
3602 Lisp_Object args
[2];
3606 args
[1] = make_unibyte_string (name
, strlen (name
));
3607 spec
= Ffont_spec (2, args
);
3608 return font_open_by_spec (f
, spec
);
3612 /* Register font-driver DRIVER. This function is used in two ways.
3614 The first is with frame F non-NULL. In this case, make DRIVER
3615 available (but not yet activated) on F. All frame creaters
3616 (e.g. Fx_create_frame) must call this function at least once with
3617 an available font-driver.
3619 The second is with frame F NULL. In this case, DRIVER is globally
3620 registered in the variable `font_driver_list'. All font-driver
3621 implementations must call this function in its syms_of_XXXX
3622 (e.g. syms_of_xfont). */
3625 register_font_driver (driver
, f
)
3626 struct font_driver
*driver
;
3629 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3630 struct font_driver_list
*prev
, *list
;
3632 if (f
&& ! driver
->draw
)
3633 error ("Unusable font driver for a frame: %s",
3634 SDATA (SYMBOL_NAME (driver
->type
)));
3636 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3637 if (EQ (list
->driver
->type
, driver
->type
))
3638 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3640 list
= xmalloc (sizeof (struct font_driver_list
));
3642 list
->driver
= driver
;
3647 f
->font_driver_list
= list
;
3649 font_driver_list
= list
;
3655 free_font_driver_list (f
)
3658 struct font_driver_list
*list
, *next
;
3660 for (list
= f
->font_driver_list
; list
; list
= next
)
3665 f
->font_driver_list
= NULL
;
3669 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3670 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3671 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3673 A caller must free all realized faces if any in advance. The
3674 return value is a list of font backends actually made used on
3678 font_update_drivers (f
, new_drivers
)
3680 Lisp_Object new_drivers
;
3682 Lisp_Object active_drivers
= Qnil
;
3683 struct font_driver
*driver
;
3684 struct font_driver_list
*list
;
3686 /* At first, turn off non-requested drivers, and turn on requested
3688 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3690 driver
= list
->driver
;
3691 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3696 if (driver
->end_for_frame
)
3697 driver
->end_for_frame (f
);
3698 font_finish_cache (f
, driver
);
3703 if (! driver
->start_for_frame
3704 || driver
->start_for_frame (f
) == 0)
3706 font_prepare_cache (f
, driver
);
3713 if (NILP (new_drivers
))
3716 if (! EQ (new_drivers
, Qt
))
3718 /* Re-order the driver list according to new_drivers. */
3719 struct font_driver_list
**list_table
, **next
;
3723 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3724 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3726 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3727 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3730 list_table
[i
++] = list
;
3732 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3734 list_table
[i
++] = list
;
3735 list_table
[i
] = NULL
;
3737 next
= &f
->font_driver_list
;
3738 for (i
= 0; list_table
[i
]; i
++)
3740 *next
= list_table
[i
];
3741 next
= &(*next
)->next
;
3745 if (! f
->font_driver_list
->on
)
3746 { /* None of the drivers is enabled: enable them all.
3747 Happens if you set the list of drivers to (xft x) in your .emacs
3748 and then use it under w32 or ns. */
3749 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3751 struct font_driver
*driver
= list
->driver
;
3752 eassert (! list
->on
);
3753 if (! driver
->start_for_frame
3754 || driver
->start_for_frame (f
) == 0)
3756 font_prepare_cache (f
, driver
);
3763 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3765 active_drivers
= nconc2 (active_drivers
,
3766 Fcons (list
->driver
->type
, Qnil
));
3767 return active_drivers
;
3771 font_put_frame_data (f
, driver
, data
)
3773 struct font_driver
*driver
;
3776 struct font_data_list
*list
, *prev
;
3778 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3779 prev
= list
, list
= list
->next
)
3780 if (list
->driver
== driver
)
3787 prev
->next
= list
->next
;
3789 f
->font_data_list
= list
->next
;
3797 list
= xmalloc (sizeof (struct font_data_list
));
3798 list
->driver
= driver
;
3799 list
->next
= f
->font_data_list
;
3800 f
->font_data_list
= list
;
3808 font_get_frame_data (f
, driver
)
3810 struct font_driver
*driver
;
3812 struct font_data_list
*list
;
3814 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3815 if (list
->driver
== driver
)
3823 /* Return the font used to draw character C by FACE at buffer position
3824 POS in window W. If STRING is non-nil, it is a string containing C
3825 at index POS. If C is negative, get C from the current buffer or
3829 font_at (c
, pos
, face
, w
, string
)
3838 Lisp_Object font_object
;
3840 multibyte
= (NILP (string
)
3841 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3842 : STRING_MULTIBYTE (string
));
3849 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3851 c
= FETCH_CHAR (pos_byte
);
3854 c
= FETCH_BYTE (pos
);
3860 multibyte
= STRING_MULTIBYTE (string
);
3863 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3865 str
= SDATA (string
) + pos_byte
;
3866 c
= STRING_CHAR (str
, 0);
3869 c
= SDATA (string
)[pos
];
3873 f
= XFRAME (w
->frame
);
3874 if (! FRAME_WINDOW_P (f
))
3881 if (STRINGP (string
))
3882 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3883 DEFAULT_FACE_ID
, 0);
3885 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3887 face
= FACE_FROM_ID (f
, face_id
);
3891 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3892 face
= FACE_FROM_ID (f
, face_id
);
3897 XSETFONT (font_object
, face
->font
);
3902 #ifdef HAVE_WINDOW_SYSTEM
3904 /* Check how many characters after POS (at most to *LIMIT) can be
3905 displayed by the same font on the window W. FACE, if non-NULL, is
3906 the face selected for the character at POS. If STRING is not nil,
3907 it is the string to check instead of the current buffer. In that
3908 case, FACE must be not NULL.
3910 The return value is the font-object for the character at POS.
3911 *LIMIT is set to the position where that font can't be used.
3913 It is assured that the current buffer (or STRING) is multibyte. */
3916 font_range (pos
, limit
, w
, face
, string
)
3917 EMACS_INT pos
, *limit
;
3922 EMACS_INT pos_byte
, ignore
, start
, start_byte
;
3924 Lisp_Object font_object
= Qnil
;
3928 pos_byte
= CHAR_TO_BYTE (pos
);
3933 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3935 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3941 pos_byte
= string_char_to_byte (string
, pos
);
3944 start
= pos
, start_byte
= pos_byte
;
3945 while (pos
< *limit
)
3947 Lisp_Object category
;
3950 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3952 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3953 if (NILP (font_object
))
3955 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3956 if (NILP (font_object
))
3961 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3962 if (! EQ (category
, QCf
)
3963 && ! CHAR_VARIATION_SELECTOR_P (c
)
3964 && font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3966 Lisp_Object f
= font_for_char (face
, c
, pos
- 1, string
);
3967 EMACS_INT i
, i_byte
;
3975 i
= start
, i_byte
= start_byte
;
3980 FETCH_CHAR_ADVANCE_NO_CHECK (c
, i
, i_byte
);
3982 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, i
, i_byte
);
3983 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3984 if (! EQ (category
, QCf
)
3985 && ! CHAR_VARIATION_SELECTOR_P (c
)
3986 && font_encode_char (f
, c
) == FONT_INVALID_CODE
)
4002 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
4003 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
4004 Return nil otherwise.
4005 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
4006 which kind of font it is. It must be one of `font-spec', `font-entity',
4008 (object
, extra_type
)
4009 Lisp_Object object
, extra_type
;
4011 if (NILP (extra_type
))
4012 return (FONTP (object
) ? Qt
: Qnil
);
4013 if (EQ (extra_type
, Qfont_spec
))
4014 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
4015 if (EQ (extra_type
, Qfont_entity
))
4016 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
4017 if (EQ (extra_type
, Qfont_object
))
4018 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
4019 wrong_type_argument (intern ("font-extra-type"), extra_type
);
4022 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
4023 doc
: /* Return a newly created font-spec with arguments as properties.
4025 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
4026 valid font property name listed below:
4028 `:family', `:weight', `:slant', `:width'
4030 They are the same as face attributes of the same name. See
4031 `set-face-attribute'.
4035 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
4039 VALUE must be a string or a symbol specifying the additional
4040 typographic style information of a font, e.g. ``sans''.
4044 VALUE must be a string or a symbol specifying the charset registry and
4045 encoding of a font, e.g. ``iso8859-1''.
4049 VALUE must be a non-negative integer or a floating point number
4050 specifying the font size. It specifies the font size in pixels (if
4051 VALUE is an integer), or in points (if VALUE is a float).
4055 VALUE must be a string of XLFD-style or fontconfig-style font name.
4059 VALUE must be a symbol representing a script that the font must
4060 support. It may be a symbol representing a subgroup of a script
4061 listed in the variable `script-representative-chars'.
4065 VALUE must be a symbol of two-letter ISO-639 language names,
4070 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
4071 required OpenType features.
4073 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
4074 LANGSYS-TAG: OpenType language system tag symbol,
4075 or nil for the default language system.
4076 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
4077 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
4079 GSUB and GPOS may contain `nil' element. In such a case, the font
4080 must not have any of the remaining elements.
4082 For instance, if the VALUE is `(thai nil nil (mark))', the font must
4083 be an OpenType font, and whose GPOS table of `thai' script's default
4084 language system must contain `mark' feature.
4086 usage: (font-spec ARGS...) */)
4091 Lisp_Object spec
= font_make_spec ();
4094 for (i
= 0; i
< nargs
; i
+= 2)
4096 Lisp_Object key
= args
[i
], val
;
4100 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
4103 if (EQ (key
, QCname
))
4106 font_parse_name ((char *) SDATA (val
), spec
);
4107 font_put_extra (spec
, key
, val
);
4111 int idx
= get_font_prop_index (key
);
4115 val
= font_prop_validate (idx
, Qnil
, val
);
4116 if (idx
< FONT_EXTRA_INDEX
)
4117 ASET (spec
, idx
, val
);
4119 font_put_extra (spec
, key
, val
);
4122 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
4128 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
4129 doc
: /* Return a copy of FONT as a font-spec. */)
4133 Lisp_Object new_spec
, tail
, prev
, extra
;
4137 new_spec
= font_make_spec ();
4138 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
4139 ASET (new_spec
, i
, AREF (font
, i
));
4140 extra
= Fcopy_sequence (AREF (font
, FONT_EXTRA_INDEX
));
4141 /* We must remove :font-entity property. */
4142 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
4143 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
4146 extra
= XCDR (extra
);
4148 XSETCDR (prev
, XCDR (tail
));
4151 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
4155 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
4156 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
4157 Every specified properties in FROM override the corresponding
4158 properties in TO. */)
4160 Lisp_Object from
, to
;
4162 Lisp_Object extra
, tail
;
4167 to
= Fcopy_font_spec (to
);
4168 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
4169 ASET (to
, i
, AREF (from
, i
));
4170 extra
= AREF (to
, FONT_EXTRA_INDEX
);
4171 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
4172 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
4174 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
4177 XSETCDR (slot
, XCDR (XCAR (tail
)));
4179 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
4181 ASET (to
, FONT_EXTRA_INDEX
, extra
);
4185 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
4186 doc
: /* Return the value of FONT's property KEY.
4187 FONT is a font-spec, a font-entity, or a font-object.
4188 KEY must be one of these symbols:
4189 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4190 :size, :name, :script
4191 See the documentation of `font-spec' for their meanings.
4192 If FONT is a font-entity or font-object, the value of :script may be
4193 a list of scripts that are supported by the font. */)
4195 Lisp_Object font
, key
;
4202 idx
= get_font_prop_index (key
);
4203 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4204 return font_style_symbolic (font
, idx
, 0);
4205 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4206 return AREF (font
, idx
);
4207 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
4210 #ifdef HAVE_WINDOW_SYSTEM
4212 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4213 doc
: /* Return a plist of face attributes generated by FONT.
4214 FONT is a font name, a font-spec, a font-entity, or a font-object.
4215 The return value is a list of the form
4217 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4219 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4220 compatible with `set-face-attribute'. Some of these key-attribute pairs
4221 may be omitted from the list if they are not specified by FONT.
4223 The optional argument FRAME specifies the frame that the face attributes
4224 are to be displayed on. If omitted, the selected frame is used. */)
4226 Lisp_Object font
, frame
;
4229 Lisp_Object plist
[10];
4234 frame
= selected_frame
;
4235 CHECK_LIVE_FRAME (frame
);
4240 int fontset
= fs_query_fontset (font
, 0);
4241 Lisp_Object name
= font
;
4243 font
= fontset_ascii (fontset
);
4244 font
= font_spec_from_name (name
);
4246 signal_error ("Invalid font name", name
);
4248 else if (! FONTP (font
))
4249 signal_error ("Invalid font object", font
);
4251 val
= AREF (font
, FONT_FAMILY_INDEX
);
4254 plist
[n
++] = QCfamily
;
4255 plist
[n
++] = SYMBOL_NAME (val
);
4258 val
= AREF (font
, FONT_SIZE_INDEX
);
4261 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4262 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4263 plist
[n
++] = QCheight
;
4264 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4266 else if (FLOATP (val
))
4268 plist
[n
++] = QCheight
;
4269 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4272 val
= FONT_WEIGHT_FOR_FACE (font
);
4275 plist
[n
++] = QCweight
;
4279 val
= FONT_SLANT_FOR_FACE (font
);
4282 plist
[n
++] = QCslant
;
4286 val
= FONT_WIDTH_FOR_FACE (font
);
4289 plist
[n
++] = QCwidth
;
4293 return Flist (n
, plist
);
4298 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4299 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
4300 (font_spec
, prop
, val
)
4301 Lisp_Object font_spec
, prop
, val
;
4305 CHECK_FONT_SPEC (font_spec
);
4306 idx
= get_font_prop_index (prop
);
4307 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4308 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
4310 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
4314 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4315 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4316 Optional 2nd argument FRAME specifies the target frame.
4317 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4318 Optional 4th argument PREFER, if non-nil, is a font-spec to
4319 control the order of the returned list. Fonts are sorted by
4320 how close they are to PREFER. */)
4321 (font_spec
, frame
, num
, prefer
)
4322 Lisp_Object font_spec
, frame
, num
, prefer
;
4324 Lisp_Object vec
, list
;
4328 frame
= selected_frame
;
4329 CHECK_LIVE_FRAME (frame
);
4330 CHECK_FONT_SPEC (font_spec
);
4338 if (! NILP (prefer
))
4339 CHECK_FONT_SPEC (prefer
);
4341 list
= font_list_entities (frame
, font_spec
);
4344 if (NILP (XCDR (list
))
4345 && ASIZE (XCAR (list
)) == 1)
4346 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4348 if (! NILP (prefer
))
4349 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4351 vec
= font_vconcat_entity_vectors (list
);
4352 if (n
== 0 || n
>= ASIZE (vec
))
4354 Lisp_Object args
[2];
4358 list
= Fappend (2, args
);
4362 for (list
= Qnil
, n
--; n
>= 0; n
--)
4363 list
= Fcons (AREF (vec
, n
), list
);
4368 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4369 doc
: /* List available font families on the current frame.
4370 Optional argument FRAME, if non-nil, specifies the target frame. */)
4375 struct font_driver_list
*driver_list
;
4379 frame
= selected_frame
;
4380 CHECK_LIVE_FRAME (frame
);
4383 for (driver_list
= f
->font_driver_list
; driver_list
;
4384 driver_list
= driver_list
->next
)
4385 if (driver_list
->driver
->list_family
)
4387 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4388 Lisp_Object tail
= list
;
4390 for (; CONSP (val
); val
= XCDR (val
))
4391 if (NILP (Fmemq (XCAR (val
), tail
))
4392 && SYMBOLP (XCAR (val
)))
4393 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4398 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4399 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4400 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4402 Lisp_Object font_spec
, frame
;
4404 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4411 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4412 doc
: /* Return XLFD name of FONT.
4413 FONT is a font-spec, font-entity, or font-object.
4414 If the name is too long for XLFD (maximum 255 chars), return nil.
4415 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4416 the consecutive wildcards are folded to one. */)
4417 (font
, fold_wildcards
)
4418 Lisp_Object font
, fold_wildcards
;
4425 if (FONT_OBJECT_P (font
))
4427 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4429 if (STRINGP (font_name
)
4430 && SDATA (font_name
)[0] == '-')
4432 if (NILP (fold_wildcards
))
4434 strcpy (name
, (char *) SDATA (font_name
));
4437 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4439 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4442 if (! NILP (fold_wildcards
))
4444 char *p0
= name
, *p1
;
4446 while ((p1
= strstr (p0
, "-*-*")))
4448 strcpy (p1
, p1
+ 2);
4453 return build_string (name
);
4456 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4457 doc
: /* Clear font cache. */)
4460 Lisp_Object list
, frame
;
4462 FOR_EACH_FRAME (list
, frame
)
4464 FRAME_PTR f
= XFRAME (frame
);
4465 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4467 for (; driver_list
; driver_list
= driver_list
->next
)
4468 if (driver_list
->on
)
4470 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4475 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4477 font_assert (! NILP (val
));
4478 val
= XCDR (XCAR (val
));
4479 if (XINT (XCAR (val
)) == 0)
4481 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4482 XSETCDR (cache
, XCDR (val
));
4492 font_fill_lglyph_metrics (glyph
, font_object
)
4493 Lisp_Object glyph
, font_object
;
4495 struct font
*font
= XFONT_OBJECT (font_object
);
4497 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4498 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4499 struct font_metrics metrics
;
4501 LGLYPH_SET_CODE (glyph
, ecode
);
4503 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4504 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4505 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4506 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4507 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4508 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4512 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4513 doc
: /* Shape the glyph-string GSTRING.
4514 Shaping means substituting glyphs and/or adjusting positions of glyphs
4515 to get the correct visual image of character sequences set in the
4516 header of the glyph-string.
4518 If the shaping was successful, the value is GSTRING itself or a newly
4519 created glyph-string. Otherwise, the value is nil. */)
4521 Lisp_Object gstring
;
4524 Lisp_Object font_object
, n
, glyph
;
4527 if (! composition_gstring_p (gstring
))
4528 signal_error ("Invalid glyph-string: ", gstring
);
4529 if (! NILP (LGSTRING_ID (gstring
)))
4531 font_object
= LGSTRING_FONT (gstring
);
4532 CHECK_FONT_OBJECT (font_object
);
4533 font
= XFONT_OBJECT (font_object
);
4534 if (! font
->driver
->shape
)
4537 /* Try at most three times with larger gstring each time. */
4538 for (i
= 0; i
< 3; i
++)
4540 n
= font
->driver
->shape (gstring
);
4543 gstring
= larger_vector (gstring
,
4544 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4547 if (i
== 3 || XINT (n
) == 0)
4550 glyph
= LGSTRING_GLYPH (gstring
, 0);
4551 from
= LGLYPH_FROM (glyph
);
4552 to
= LGLYPH_TO (glyph
);
4553 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4555 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4559 if (NILP (LGLYPH_ADJUSTMENT (this)))
4564 glyph
= LGSTRING_GLYPH (gstring
, j
);
4565 LGLYPH_SET_FROM (glyph
, from
);
4566 LGLYPH_SET_TO (glyph
, to
);
4568 from
= LGLYPH_FROM (this);
4569 to
= LGLYPH_TO (this);
4574 if (from
> LGLYPH_FROM (this))
4575 from
= LGLYPH_FROM (this);
4576 if (to
< LGLYPH_TO (this))
4577 to
= LGLYPH_TO (this);
4583 glyph
= LGSTRING_GLYPH (gstring
, j
);
4584 LGLYPH_SET_FROM (glyph
, from
);
4585 LGLYPH_SET_TO (glyph
, to
);
4587 return composition_gstring_put_cache (gstring
, XINT (n
));
4590 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4592 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4593 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4595 VARIATION-SELECTOR is a chracter code of variation selection
4596 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4597 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4598 (font_object
, character
)
4599 Lisp_Object font_object
, character
;
4601 unsigned variations
[256];
4606 CHECK_FONT_OBJECT (font_object
);
4607 CHECK_CHARACTER (character
);
4608 font
= XFONT_OBJECT (font_object
);
4609 if (! font
->driver
->get_variation_glyphs
)
4611 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4615 for (i
= 0; i
< 255; i
++)
4619 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4620 /* Stops GCC whining about limited range of data type. */
4621 EMACS_INT var
= variations
[i
];
4623 if (var
> MOST_POSITIVE_FIXNUM
)
4624 code
= Fcons (make_number ((variations
[i
]) >> 16),
4625 make_number ((variations
[i
]) & 0xFFFF));
4627 code
= make_number (variations
[i
]);
4628 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4635 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4636 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4637 OTF-FEATURES specifies which features to apply in this format:
4638 (SCRIPT LANGSYS GSUB GPOS)
4640 SCRIPT is a symbol specifying a script tag of OpenType,
4641 LANGSYS is a symbol specifying a langsys tag of OpenType,
4642 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4644 If LANGYS is nil, the default langsys is selected.
4646 The features are applied in the order they appear in the list. The
4647 symbol `*' means to apply all available features not present in this
4648 list, and the remaining features are ignored. For instance, (vatu
4649 pstf * haln) is to apply vatu and pstf in this order, then to apply
4650 all available features other than vatu, pstf, and haln.
4652 The features are applied to the glyphs in the range FROM and TO of
4653 the glyph-string GSTRING-IN.
4655 If some feature is actually applicable, the resulting glyphs are
4656 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4657 this case, the value is the number of produced glyphs.
4659 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4662 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4663 produced in GSTRING-OUT, and the value is nil.
4665 See the documentation of `font-make-gstring' for the format of
4667 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4668 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4670 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4675 check_otf_features (otf_features
);
4676 CHECK_FONT_OBJECT (font_object
);
4677 font
= XFONT_OBJECT (font_object
);
4678 if (! font
->driver
->otf_drive
)
4679 error ("Font backend %s can't drive OpenType GSUB table",
4680 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4681 CHECK_CONS (otf_features
);
4682 CHECK_SYMBOL (XCAR (otf_features
));
4683 val
= XCDR (otf_features
);
4684 CHECK_SYMBOL (XCAR (val
));
4685 val
= XCDR (otf_features
);
4688 len
= check_gstring (gstring_in
);
4689 CHECK_VECTOR (gstring_out
);
4690 CHECK_NATNUM (from
);
4692 CHECK_NATNUM (index
);
4694 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4695 args_out_of_range_3 (from
, to
, make_number (len
));
4696 if (XINT (index
) >= ASIZE (gstring_out
))
4697 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4698 num
= font
->driver
->otf_drive (font
, otf_features
,
4699 gstring_in
, XINT (from
), XINT (to
),
4700 gstring_out
, XINT (index
), 0);
4703 return make_number (num
);
4706 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4708 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4709 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4711 (SCRIPT LANGSYS FEATURE ...)
4712 See the documentation of `font-drive-otf' for more detail.
4714 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4715 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4716 character code corresponding to the glyph or nil if there's no
4717 corresponding character. */)
4718 (font_object
, character
, otf_features
)
4719 Lisp_Object font_object
, character
, otf_features
;
4722 Lisp_Object gstring_in
, gstring_out
, g
;
4723 Lisp_Object alternates
;
4726 CHECK_FONT_GET_OBJECT (font_object
, font
);
4727 if (! font
->driver
->otf_drive
)
4728 error ("Font backend %s can't drive OpenType GSUB table",
4729 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4730 CHECK_CHARACTER (character
);
4731 CHECK_CONS (otf_features
);
4733 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4734 g
= LGSTRING_GLYPH (gstring_in
, 0);
4735 LGLYPH_SET_CHAR (g
, XINT (character
));
4736 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4737 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4738 gstring_out
, 0, 1)) < 0)
4739 gstring_out
= Ffont_make_gstring (font_object
,
4740 make_number (ASIZE (gstring_out
) * 2));
4742 for (i
= 0; i
< num
; i
++)
4744 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4745 int c
= LGLYPH_CHAR (g
);
4746 unsigned code
= LGLYPH_CODE (g
);
4748 alternates
= Fcons (Fcons (make_number (code
),
4749 c
> 0 ? make_number (c
) : Qnil
),
4752 return Fnreverse (alternates
);
4758 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4759 doc
: /* Open FONT-ENTITY. */)
4760 (font_entity
, size
, frame
)
4761 Lisp_Object font_entity
;
4767 CHECK_FONT_ENTITY (font_entity
);
4769 frame
= selected_frame
;
4770 CHECK_LIVE_FRAME (frame
);
4773 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4776 CHECK_NUMBER_OR_FLOAT (size
);
4778 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4780 isize
= XINT (size
);
4784 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4787 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4788 doc
: /* Close FONT-OBJECT. */)
4789 (font_object
, frame
)
4790 Lisp_Object font_object
, frame
;
4792 CHECK_FONT_OBJECT (font_object
);
4794 frame
= selected_frame
;
4795 CHECK_LIVE_FRAME (frame
);
4796 font_close_object (XFRAME (frame
), font_object
);
4800 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4801 doc
: /* Return information about FONT-OBJECT.
4802 The value is a vector:
4803 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4806 NAME is a string of the font name (or nil if the font backend doesn't
4809 FILENAME is a string of the font file (or nil if the font backend
4810 doesn't provide a file name).
4812 PIXEL-SIZE is a pixel size by which the font is opened.
4814 SIZE is a maximum advance width of the font in pixels.
4816 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4819 CAPABILITY is a list whose first element is a symbol representing the
4820 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4821 remaining elements describe the details of the font capability.
4823 If the font is OpenType font, the form of the list is
4824 \(opentype GSUB GPOS)
4825 where GSUB shows which "GSUB" features the font supports, and GPOS
4826 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4827 lists of the format:
4828 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4830 If the font is not OpenType font, currently the length of the form is
4833 SCRIPT is a symbol representing OpenType script tag.
4835 LANGSYS is a symbol representing OpenType langsys tag, or nil
4836 representing the default langsys.
4838 FEATURE is a symbol representing OpenType feature tag.
4840 If the font is not OpenType font, CAPABILITY is nil. */)
4842 Lisp_Object font_object
;
4847 CHECK_FONT_GET_OBJECT (font_object
, font
);
4849 val
= Fmake_vector (make_number (9), Qnil
);
4850 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4851 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4852 ASET (val
, 2, make_number (font
->pixel_size
));
4853 ASET (val
, 3, make_number (font
->max_width
));
4854 ASET (val
, 4, make_number (font
->ascent
));
4855 ASET (val
, 5, make_number (font
->descent
));
4856 ASET (val
, 6, make_number (font
->space_width
));
4857 ASET (val
, 7, make_number (font
->average_width
));
4858 if (font
->driver
->otf_capability
)
4859 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4863 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4864 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4865 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4866 (font_object
, string
)
4867 Lisp_Object font_object
, string
;
4873 CHECK_FONT_GET_OBJECT (font_object
, font
);
4874 CHECK_STRING (string
);
4875 len
= SCHARS (string
);
4876 vec
= Fmake_vector (make_number (len
), Qnil
);
4877 for (i
= 0; i
< len
; i
++)
4879 Lisp_Object ch
= Faref (string
, make_number (i
));
4884 struct font_metrics metrics
;
4886 cod
= code
= font
->driver
->encode_char (font
, c
);
4887 if (code
== FONT_INVALID_CODE
)
4889 val
= Fmake_vector (make_number (6), Qnil
);
4890 if (cod
<= MOST_POSITIVE_FIXNUM
)
4891 ASET (val
, 0, make_number (code
));
4893 ASET (val
, 0, Fcons (make_number (code
>> 16),
4894 make_number (code
& 0xFFFF)));
4895 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4896 ASET (val
, 1, make_number (metrics
.lbearing
));
4897 ASET (val
, 2, make_number (metrics
.rbearing
));
4898 ASET (val
, 3, make_number (metrics
.width
));
4899 ASET (val
, 4, make_number (metrics
.ascent
));
4900 ASET (val
, 5, make_number (metrics
.descent
));
4906 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4907 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4908 FONT is a font-spec, font-entity, or font-object. */)
4910 Lisp_Object spec
, font
;
4912 CHECK_FONT_SPEC (spec
);
4915 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4918 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4919 doc
: /* Return a font-object for displaying a character at POSITION.
4920 Optional second arg WINDOW, if non-nil, is a window displaying
4921 the current buffer. It defaults to the currently selected window. */)
4922 (position
, window
, string
)
4923 Lisp_Object position
, window
, string
;
4930 CHECK_NUMBER_COERCE_MARKER (position
);
4931 pos
= XINT (position
);
4932 if (pos
< BEGV
|| pos
>= ZV
)
4933 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4937 CHECK_NUMBER (position
);
4938 CHECK_STRING (string
);
4939 pos
= XINT (position
);
4940 if (pos
< 0 || pos
>= SCHARS (string
))
4941 args_out_of_range (string
, position
);
4944 window
= selected_window
;
4945 CHECK_LIVE_WINDOW (window
);
4946 w
= XWINDOW (window
);
4948 return font_at (-1, pos
, NULL
, w
, string
);
4952 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4953 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4954 The value is a number of glyphs drawn.
4955 Type C-l to recover what previously shown. */)
4956 (font_object
, string
)
4957 Lisp_Object font_object
, string
;
4959 Lisp_Object frame
= selected_frame
;
4960 FRAME_PTR f
= XFRAME (frame
);
4966 CHECK_FONT_GET_OBJECT (font_object
, font
);
4967 CHECK_STRING (string
);
4968 len
= SCHARS (string
);
4969 code
= alloca (sizeof (unsigned) * len
);
4970 for (i
= 0; i
< len
; i
++)
4972 Lisp_Object ch
= Faref (string
, make_number (i
));
4976 code
[i
] = font
->driver
->encode_char (font
, c
);
4977 if (code
[i
] == FONT_INVALID_CODE
)
4980 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4982 if (font
->driver
->prepare_face
)
4983 font
->driver
->prepare_face (f
, face
);
4984 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4985 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4986 if (font
->driver
->done_face
)
4987 font
->driver
->done_face (f
, face
);
4989 return make_number (len
);
4993 #endif /* FONT_DEBUG */
4995 #ifdef HAVE_WINDOW_SYSTEM
4997 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4998 doc
: /* Return information about a font named NAME on frame FRAME.
4999 If FRAME is omitted or nil, use the selected frame.
5000 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
5001 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
5003 OPENED-NAME is the name used for opening the font,
5004 FULL-NAME is the full name of the font,
5005 SIZE is the pixelsize of the font,
5006 HEIGHT is the pixel-height of the font (i.e ascent + descent),
5007 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
5008 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
5009 how to compose characters.
5010 If the named font is not yet loaded, return nil. */)
5012 Lisp_Object name
, frame
;
5017 Lisp_Object font_object
;
5019 (*check_window_system_func
) ();
5022 CHECK_STRING (name
);
5024 frame
= selected_frame
;
5025 CHECK_LIVE_FRAME (frame
);
5030 int fontset
= fs_query_fontset (name
, 0);
5033 name
= fontset_ascii (fontset
);
5034 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
5036 else if (FONT_OBJECT_P (name
))
5038 else if (FONT_ENTITY_P (name
))
5039 font_object
= font_open_entity (f
, name
, 0);
5042 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5043 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
5045 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
5047 if (NILP (font_object
))
5049 font
= XFONT_OBJECT (font_object
);
5051 info
= Fmake_vector (make_number (7), Qnil
);
5052 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
5053 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
5054 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
5055 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
5056 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
5057 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
5058 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
5061 /* As font_object is still in FONT_OBJLIST of the entity, we can't
5062 close it now. Perhaps, we should manage font-objects
5063 by `reference-count'. */
5064 font_close_object (f
, font_object
);
5071 #define BUILD_STYLE_TABLE(TBL) \
5072 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
5075 build_style_table (entry
, nelement
)
5076 struct table_entry
*entry
;
5080 Lisp_Object table
, elt
;
5082 table
= Fmake_vector (make_number (nelement
), Qnil
);
5083 for (i
= 0; i
< nelement
; i
++)
5085 for (j
= 0; entry
[i
].names
[j
]; j
++);
5086 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
5087 ASET (elt
, 0, make_number (entry
[i
].numeric
));
5088 for (j
= 0; entry
[i
].names
[j
]; j
++)
5089 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
5090 ASET (table
, i
, elt
);
5095 Lisp_Object Vfont_log
;
5097 /* The deferred font-log data of the form [ACTION ARG RESULT].
5098 If ACTION is not nil, that is added to the log when font_add_log is
5099 called next time. At that time, ACTION is set back to nil. */
5100 static Lisp_Object Vfont_log_deferred
;
5102 /* Prepend the font-related logging data in Vfont_log if it is not
5103 `t'. ACTION describes a kind of font-related action (e.g. listing,
5104 opening), ARG is the argument for the action, and RESULT is the
5105 result of the action. */
5107 font_add_log (action
, arg
, result
)
5109 Lisp_Object arg
, result
;
5111 Lisp_Object tail
, val
;
5114 if (EQ (Vfont_log
, Qt
))
5116 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5118 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
5120 ASET (Vfont_log_deferred
, 0, Qnil
);
5121 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5122 AREF (Vfont_log_deferred
, 2));
5127 Lisp_Object tail
, elt
;
5128 Lisp_Object equalstr
= build_string ("=");
5130 val
= Ffont_xlfd_name (arg
, Qt
);
5131 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5135 if (EQ (XCAR (elt
), QCscript
)
5136 && SYMBOLP (XCDR (elt
)))
5137 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5138 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5139 else if (EQ (XCAR (elt
), QClang
)
5140 && SYMBOLP (XCDR (elt
)))
5141 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5142 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5143 else if (EQ (XCAR (elt
), QCotf
)
5144 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5145 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5147 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5153 && VECTORP (XCAR (result
))
5154 && ASIZE (XCAR (result
)) > 0
5155 && FONTP (AREF (XCAR (result
), 0)))
5156 result
= font_vconcat_entity_vectors (result
);
5159 val
= Ffont_xlfd_name (result
, Qt
);
5160 if (! FONT_SPEC_P (result
))
5161 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5162 build_string (":"), val
);
5165 else if (CONSP (result
))
5167 result
= Fcopy_sequence (result
);
5168 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5172 val
= Ffont_xlfd_name (val
, Qt
);
5173 XSETCAR (tail
, val
);
5176 else if (VECTORP (result
))
5178 result
= Fcopy_sequence (result
);
5179 for (i
= 0; i
< ASIZE (result
); i
++)
5181 val
= AREF (result
, i
);
5183 val
= Ffont_xlfd_name (val
, Qt
);
5184 ASET (result
, i
, val
);
5187 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5190 /* Record a font-related logging data to be added to Vfont_log when
5191 font_add_log is called next time. ACTION, ARG, RESULT are the same
5195 font_deferred_log (action
, arg
, result
)
5197 Lisp_Object arg
, result
;
5199 if (EQ (Vfont_log
, Qt
))
5201 ASET (Vfont_log_deferred
, 0, build_string (action
));
5202 ASET (Vfont_log_deferred
, 1, arg
);
5203 ASET (Vfont_log_deferred
, 2, result
);
5206 extern void syms_of_ftfont
P_ (());
5207 extern void syms_of_xfont
P_ (());
5208 extern void syms_of_xftfont
P_ (());
5209 extern void syms_of_ftxfont
P_ (());
5210 extern void syms_of_bdffont
P_ (());
5211 extern void syms_of_w32font
P_ (());
5212 extern void syms_of_atmfont
P_ (());
5213 extern void syms_of_nsfont
P_ (());
5218 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5219 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5220 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5221 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5222 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5223 /* Note that the other elements in sort_shift_bits are not used. */
5225 staticpro (&font_charset_alist
);
5226 font_charset_alist
= Qnil
;
5228 DEFSYM (Qopentype
, "opentype");
5230 DEFSYM (Qascii_0
, "ascii-0");
5231 DEFSYM (Qiso8859_1
, "iso8859-1");
5232 DEFSYM (Qiso10646_1
, "iso10646-1");
5233 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5234 DEFSYM (Qunicode_sip
, "unicode-sip");
5238 DEFSYM (QCotf
, ":otf");
5239 DEFSYM (QClang
, ":lang");
5240 DEFSYM (QCscript
, ":script");
5241 DEFSYM (QCantialias
, ":antialias");
5243 DEFSYM (QCfoundry
, ":foundry");
5244 DEFSYM (QCadstyle
, ":adstyle");
5245 DEFSYM (QCregistry
, ":registry");
5246 DEFSYM (QCspacing
, ":spacing");
5247 DEFSYM (QCdpi
, ":dpi");
5248 DEFSYM (QCscalable
, ":scalable");
5249 DEFSYM (QCavgwidth
, ":avgwidth");
5250 DEFSYM (QCfont_entity
, ":font-entity");
5251 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5261 staticpro (&null_vector
);
5262 null_vector
= Fmake_vector (make_number (0), Qnil
);
5264 staticpro (&scratch_font_spec
);
5265 scratch_font_spec
= Ffont_spec (0, NULL
);
5266 staticpro (&scratch_font_prefer
);
5267 scratch_font_prefer
= Ffont_spec (0, NULL
);
5269 staticpro (&Vfont_log_deferred
);
5270 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5274 staticpro (&otf_list
);
5276 #endif /* HAVE_LIBOTF */
5280 defsubr (&Sfont_spec
);
5281 defsubr (&Sfont_get
);
5282 #ifdef HAVE_WINDOW_SYSTEM
5283 defsubr (&Sfont_face_attributes
);
5285 defsubr (&Sfont_put
);
5286 defsubr (&Slist_fonts
);
5287 defsubr (&Sfont_family_list
);
5288 defsubr (&Sfind_font
);
5289 defsubr (&Sfont_xlfd_name
);
5290 defsubr (&Sclear_font_cache
);
5291 defsubr (&Sfont_shape_gstring
);
5292 defsubr (&Sfont_variation_glyphs
);
5294 defsubr (&Sfont_drive_otf
);
5295 defsubr (&Sfont_otf_alternates
);
5299 defsubr (&Sopen_font
);
5300 defsubr (&Sclose_font
);
5301 defsubr (&Squery_font
);
5302 defsubr (&Sget_font_glyphs
);
5303 defsubr (&Sfont_match_p
);
5304 defsubr (&Sfont_at
);
5306 defsubr (&Sdraw_string
);
5308 #endif /* FONT_DEBUG */
5309 #ifdef HAVE_WINDOW_SYSTEM
5310 defsubr (&Sfont_info
);
5313 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5315 Alist of fontname patterns vs the corresponding encoding and repertory info.
5316 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5317 where ENCODING is a charset or a char-table,
5318 and REPERTORY is a charset, a char-table, or nil.
5320 If ENCODING and REPERTORY are the same, the element can have the form
5321 \(REGEXP . ENCODING).
5323 ENCODING is for converting a character to a glyph code of the font.
5324 If ENCODING is a charset, encoding a character by the charset gives
5325 the corresponding glyph code. If ENCODING is a char-table, looking up
5326 the table by a character gives the corresponding glyph code.
5328 REPERTORY specifies a repertory of characters supported by the font.
5329 If REPERTORY is a charset, all characters beloging to the charset are
5330 supported. If REPERTORY is a char-table, all characters who have a
5331 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5332 gets the repertory information by an opened font and ENCODING. */);
5333 Vfont_encoding_alist
= Qnil
;
5335 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5336 doc
: /* Vector of valid font weight values.
5337 Each element has the form:
5338 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5339 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5340 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5342 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5343 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5344 See `font-weight-table' for the format of the vector. */);
5345 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5347 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5348 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5349 See `font-weight-table' for the format of the vector. */);
5350 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5352 staticpro (&font_style_table
);
5353 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5354 ASET (font_style_table
, 0, Vfont_weight_table
);
5355 ASET (font_style_table
, 1, Vfont_slant_table
);
5356 ASET (font_style_table
, 2, Vfont_width_table
);
5358 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5359 *Logging list of font related actions and results.
5360 The value t means to suppress the logging.
5361 The initial value is set to nil if the environment variable
5362 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5365 #ifdef HAVE_WINDOW_SYSTEM
5366 #ifdef HAVE_FREETYPE
5368 #ifdef HAVE_X_WINDOWS
5373 #endif /* HAVE_XFT */
5374 #endif /* HAVE_X_WINDOWS */
5375 #else /* not HAVE_FREETYPE */
5376 #ifdef HAVE_X_WINDOWS
5378 #endif /* HAVE_X_WINDOWS */
5379 #endif /* not HAVE_FREETYPE */
5382 #endif /* HAVE_BDFFONT */
5385 #endif /* WINDOWSNT */
5388 #endif /* HAVE_NS */
5389 #endif /* HAVE_WINDOW_SYSTEM */
5395 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
5398 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5399 (do not change this comment) */