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_alist (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
);
726 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
728 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
734 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
739 /* Font name parser and unparser */
741 static int parse_matrix
P_ ((char *));
742 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
743 static int font_parse_name
P_ ((char *, Lisp_Object
));
745 /* An enumerator for each field of an XLFD font name. */
746 enum xlfd_field_index
765 /* An enumerator for mask bit corresponding to each XLFD field. */
768 XLFD_FOUNDRY_MASK
= 0x0001,
769 XLFD_FAMILY_MASK
= 0x0002,
770 XLFD_WEIGHT_MASK
= 0x0004,
771 XLFD_SLANT_MASK
= 0x0008,
772 XLFD_SWIDTH_MASK
= 0x0010,
773 XLFD_ADSTYLE_MASK
= 0x0020,
774 XLFD_PIXEL_MASK
= 0x0040,
775 XLFD_POINT_MASK
= 0x0080,
776 XLFD_RESX_MASK
= 0x0100,
777 XLFD_RESY_MASK
= 0x0200,
778 XLFD_SPACING_MASK
= 0x0400,
779 XLFD_AVGWIDTH_MASK
= 0x0800,
780 XLFD_REGISTRY_MASK
= 0x1000,
781 XLFD_ENCODING_MASK
= 0x2000
785 /* Parse P pointing the pixel/point size field of the form
786 `[A B C D]' which specifies a transformation matrix:
792 by which all glyphs of the font are transformed. The spec says
793 that scalar value N for the pixel/point size is equivalent to:
794 A = N * resx/resy, B = C = 0, D = N.
796 Return the scalar value N if the form is valid. Otherwise return
807 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
810 matrix
[i
] = - strtod (p
+ 1, &end
);
812 matrix
[i
] = strtod (p
, &end
);
815 return (i
== 4 ? (int) matrix
[3] : -1);
818 /* Expand a wildcard field in FIELD (the first N fields are filled) to
819 multiple fields to fill in all 14 XLFD fields while restring a
820 field position by its contents. */
823 font_expand_wildcards (field
, n
)
824 Lisp_Object field
[XLFD_LAST_INDEX
];
828 Lisp_Object tmp
[XLFD_LAST_INDEX
];
829 /* Array of information about where this element can go. Nth
830 element is for Nth element of FIELD. */
832 /* Minimum possible field. */
834 /* Maxinum possible field. */
836 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
838 } range
[XLFD_LAST_INDEX
];
840 int range_from
, range_to
;
843 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
844 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
845 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
846 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
847 | XLFD_AVGWIDTH_MASK)
848 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
850 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
851 field. The value is shifted to left one bit by one in the
853 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
854 range_mask
= (range_mask
<< 1) | 1;
856 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
857 position-based retriction for FIELD[I]. */
858 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
859 i
++, range_from
++, range_to
++, range_mask
<<= 1)
861 Lisp_Object val
= field
[i
];
867 range
[i
].from
= range_from
;
868 range
[i
].to
= range_to
;
869 range
[i
].mask
= range_mask
;
873 /* The triplet FROM, TO, and MASK is a value-based
874 retriction for FIELD[I]. */
880 int numeric
= XINT (val
);
883 from
= to
= XLFD_ENCODING_INDEX
,
884 mask
= XLFD_ENCODING_MASK
;
885 else if (numeric
== 0)
886 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
887 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
888 else if (numeric
<= 48)
889 from
= to
= XLFD_PIXEL_INDEX
,
890 mask
= XLFD_PIXEL_MASK
;
892 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
893 mask
= XLFD_LARGENUM_MASK
;
895 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
896 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
897 mask
= XLFD_NULL_MASK
;
899 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
902 Lisp_Object name
= SYMBOL_NAME (val
);
904 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
905 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
906 mask
= XLFD_REGENC_MASK
;
908 from
= to
= XLFD_ENCODING_INDEX
,
909 mask
= XLFD_ENCODING_MASK
;
911 else if (range_from
<= XLFD_WEIGHT_INDEX
912 && range_to
>= XLFD_WEIGHT_INDEX
913 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
914 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
915 else if (range_from
<= XLFD_SLANT_INDEX
916 && range_to
>= XLFD_SLANT_INDEX
917 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
918 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
919 else if (range_from
<= XLFD_SWIDTH_INDEX
920 && range_to
>= XLFD_SWIDTH_INDEX
921 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
922 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
925 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
926 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
928 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
929 mask
= XLFD_SYMBOL_MASK
;
932 /* Merge position-based and value-based restrictions. */
934 while (from
< range_from
)
935 mask
&= ~(1 << from
++);
936 while (from
< 14 && ! (mask
& (1 << from
)))
938 while (to
> range_to
)
939 mask
&= ~(1 << to
--);
940 while (to
>= 0 && ! (mask
& (1 << to
)))
944 range
[i
].from
= from
;
946 range
[i
].mask
= mask
;
948 if (from
> range_from
|| to
< range_to
)
950 /* The range is narrowed by value-based restrictions.
951 Reflect it to the other fields. */
953 /* Following fields should be after FROM. */
955 /* Preceding fields should be before TO. */
956 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
958 /* Check FROM for non-wildcard field. */
959 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
961 while (range
[j
].from
< from
)
962 range
[j
].mask
&= ~(1 << range
[j
].from
++);
963 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
965 range
[j
].from
= from
;
968 from
= range
[j
].from
;
969 if (range
[j
].to
> to
)
971 while (range
[j
].to
> to
)
972 range
[j
].mask
&= ~(1 << range
[j
].to
--);
973 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
986 /* Decide all fileds from restrictions in RANGE. */
987 for (i
= j
= 0; i
< n
; i
++)
989 if (j
< range
[i
].from
)
991 if (i
== 0 || ! NILP (tmp
[i
- 1]))
992 /* None of TMP[X] corresponds to Jth field. */
994 for (; j
< range
[i
].from
; j
++)
999 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
1001 for (; j
< XLFD_LAST_INDEX
; j
++)
1003 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
1004 field
[XLFD_ENCODING_INDEX
]
1005 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1010 #ifdef ENABLE_CHECKING
1011 /* Match a 14-field XLFD pattern against a full XLFD font name. */
1013 font_match_xlfd (char *pattern
, char *name
)
1015 while (*pattern
&& *name
)
1017 if (*pattern
== *name
)
1019 else if (*pattern
== '*')
1020 if (*name
== pattern
[1])
1031 /* Make sure the font object matches the XLFD font name. */
1033 font_check_xlfd_parse (Lisp_Object font
, char *name
)
1035 char name_check
[256];
1036 font_unparse_xlfd (font
, 0, name_check
, 255);
1037 return font_match_xlfd (name_check
, name
);
1043 /* Parse NAME (null terminated) as XLFD and store information in FONT
1044 (font-spec or font-entity). Size property of FONT is set as
1046 specified XLFD fields FONT property
1047 --------------------- -------------
1048 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1049 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1050 POINT_SIZE POINT_SIZE/10 (Lisp float)
1052 If NAME is successfully parsed, return 0. Otherwise return -1.
1054 FONT is usually a font-spec, but when this function is called from
1055 X font backend driver, it is a font-entity. In that case, NAME is
1056 a fully specified XLFD. */
1059 font_parse_xlfd (name
, font
)
1063 int len
= strlen (name
);
1065 char *f
[XLFD_LAST_INDEX
+ 1];
1069 if (len
> 255 || !len
)
1070 /* Maximum XLFD name length is 255. */
1072 /* Accept "*-.." as a fully specified XLFD. */
1073 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1074 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1077 for (p
= name
+ i
; *p
; p
++)
1081 if (i
== XLFD_LAST_INDEX
)
1086 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1087 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1089 if (i
== XLFD_LAST_INDEX
)
1091 /* Fully specified XLFD. */
1094 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1095 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1096 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1097 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1099 val
= INTERN_FIELD_SYM (i
);
1102 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1104 ASET (font
, j
, make_number (n
));
1107 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1108 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1109 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1111 ASET (font
, FONT_REGISTRY_INDEX
,
1112 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1113 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1115 p
= f
[XLFD_PIXEL_INDEX
];
1116 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1117 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1120 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1122 ASET (font
, FONT_SIZE_INDEX
, val
);
1125 double point_size
= -1;
1127 font_assert (FONT_SPEC_P (font
));
1128 p
= f
[XLFD_POINT_INDEX
];
1130 point_size
= parse_matrix (p
);
1131 else if (isdigit (*p
))
1132 point_size
= atoi (p
), point_size
/= 10;
1133 if (point_size
>= 0)
1134 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1138 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1139 if (! NILP (val
) && ! INTEGERP (val
))
1141 ASET (font
, FONT_DPI_INDEX
, val
);
1142 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1145 val
= font_prop_validate_spacing (QCspacing
, val
);
1146 if (! INTEGERP (val
))
1148 ASET (font
, FONT_SPACING_INDEX
, val
);
1150 p
= f
[XLFD_AVGWIDTH_INDEX
];
1153 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1154 if (! NILP (val
) && ! INTEGERP (val
))
1156 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1160 int wild_card_found
= 0;
1161 Lisp_Object prop
[XLFD_LAST_INDEX
];
1163 if (FONT_ENTITY_P (font
))
1165 for (j
= 0; j
< i
; j
++)
1169 if (f
[j
][1] && f
[j
][1] != '-')
1172 wild_card_found
= 1;
1175 prop
[j
] = INTERN_FIELD (j
);
1177 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1179 if (! wild_card_found
)
1181 if (font_expand_wildcards (prop
, i
) < 0)
1184 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1185 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1186 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1187 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1188 if (! NILP (prop
[i
]))
1190 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1192 ASET (font
, j
, make_number (n
));
1194 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1195 val
= prop
[XLFD_REGISTRY_INDEX
];
1198 val
= prop
[XLFD_ENCODING_INDEX
];
1200 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1202 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1203 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1205 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1206 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1208 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1210 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1211 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1212 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1214 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1216 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1219 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1220 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1221 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1223 val
= font_prop_validate_spacing (QCspacing
,
1224 prop
[XLFD_SPACING_INDEX
]);
1225 if (! INTEGERP (val
))
1227 ASET (font
, FONT_SPACING_INDEX
, val
);
1229 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1230 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1236 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1237 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1238 0, use PIXEL_SIZE instead. */
1241 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1247 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1251 font_assert (FONTP (font
));
1253 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1256 if (i
== FONT_ADSTYLE_INDEX
)
1257 j
= XLFD_ADSTYLE_INDEX
;
1258 else if (i
== FONT_REGISTRY_INDEX
)
1259 j
= XLFD_REGISTRY_INDEX
;
1260 val
= AREF (font
, i
);
1263 if (j
== XLFD_REGISTRY_INDEX
)
1264 f
[j
] = "*-*", len
+= 4;
1266 f
[j
] = "*", len
+= 2;
1271 val
= SYMBOL_NAME (val
);
1272 if (j
== XLFD_REGISTRY_INDEX
1273 && ! strchr ((char *) SDATA (val
), '-'))
1275 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1276 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1278 f
[j
] = alloca (SBYTES (val
) + 3);
1279 sprintf (f
[j
], "%s-*", SDATA (val
));
1280 len
+= SBYTES (val
) + 3;
1284 f
[j
] = alloca (SBYTES (val
) + 4);
1285 sprintf (f
[j
], "%s*-*", SDATA (val
));
1286 len
+= SBYTES (val
) + 4;
1290 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1294 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1297 val
= font_style_symbolic (font
, i
, 0);
1299 f
[j
] = "*", len
+= 2;
1302 val
= SYMBOL_NAME (val
);
1303 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1307 val
= AREF (font
, FONT_SIZE_INDEX
);
1308 font_assert (NUMBERP (val
) || NILP (val
));
1316 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1317 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1320 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1322 else if (FLOATP (val
))
1324 i
= XFLOAT_DATA (val
) * 10;
1325 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1326 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1329 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1331 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1333 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1334 f
[XLFD_RESX_INDEX
] = alloca (22);
1335 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1339 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1340 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1342 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1344 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1345 : spacing
<= FONT_SPACING_DUAL
? "d"
1346 : spacing
<= FONT_SPACING_MONO
? "m"
1351 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1352 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1354 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1355 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
], "%ld",
1356 (long) XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1359 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1360 len
++; /* for terminating '\0'. */
1363 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1364 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1365 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1366 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1367 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1368 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1369 f
[XLFD_REGISTRY_INDEX
]);
1372 /* Parse NAME (null terminated) and store information in FONT
1373 (font-spec or font-entity). NAME is supplied in either the
1374 Fontconfig or GTK font name format. If NAME is successfully
1375 parsed, return 0. Otherwise return -1.
1377 The fontconfig format is
1379 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1383 FAMILY [PROPS...] [SIZE]
1385 This function tries to guess which format it is. */
1388 font_parse_fcname (name
, font
)
1393 char *size_beg
= NULL
, *size_end
= NULL
;
1394 char *props_beg
= NULL
, *family_end
= NULL
;
1395 int len
= strlen (name
);
1400 for (p
= name
; *p
; p
++)
1402 if (*p
== '\\' && p
[1])
1406 props_beg
= family_end
= p
;
1411 int decimal
= 0, size_found
= 1;
1412 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1415 if (*q
!= '.' || decimal
)
1434 Lisp_Object extra_props
= Qnil
;
1436 /* A fontconfig name with size and/or property data. */
1437 if (family_end
> name
)
1440 family
= font_intern_prop (name
, family_end
- name
, 1);
1441 ASET (font
, FONT_FAMILY_INDEX
, family
);
1445 double point_size
= strtod (size_beg
, &size_end
);
1446 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1447 if (*size_end
== ':' && size_end
[1])
1448 props_beg
= size_end
;
1452 /* Now parse ":KEY=VAL" patterns. */
1455 for (p
= props_beg
; *p
; p
= q
)
1457 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1460 /* Must be an enumerated value. */
1464 val
= font_intern_prop (p
, q
- p
, 1);
1466 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1468 if (PROP_MATCH ("light", 5)
1469 || PROP_MATCH ("medium", 6)
1470 || PROP_MATCH ("demibold", 8)
1471 || PROP_MATCH ("bold", 4)
1472 || PROP_MATCH ("black", 5))
1473 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1474 else if (PROP_MATCH ("roman", 5)
1475 || PROP_MATCH ("italic", 6)
1476 || PROP_MATCH ("oblique", 7))
1477 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1478 else if (PROP_MATCH ("charcell", 8))
1479 ASET (font
, FONT_SPACING_INDEX
,
1480 make_number (FONT_SPACING_CHARCELL
));
1481 else if (PROP_MATCH ("mono", 4))
1482 ASET (font
, FONT_SPACING_INDEX
,
1483 make_number (FONT_SPACING_MONO
));
1484 else if (PROP_MATCH ("proportional", 12))
1485 ASET (font
, FONT_SPACING_INDEX
,
1486 make_number (FONT_SPACING_PROPORTIONAL
));
1495 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1496 prop
= FONT_SIZE_INDEX
;
1499 key
= font_intern_prop (p
, q
- p
, 1);
1500 prop
= get_font_prop_index (key
);
1504 for (q
= p
; *q
&& *q
!= ':'; q
++);
1505 val
= font_intern_prop (p
, q
- p
, 0);
1507 if (prop
>= FONT_FOUNDRY_INDEX
1508 && prop
< FONT_EXTRA_INDEX
)
1509 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1512 extra_props
= nconc2 (extra_props
,
1513 Fcons (Fcons (key
, val
), Qnil
));
1520 if (! NILP (extra_props
))
1522 struct font_driver_list
*driver_list
= font_driver_list
;
1523 for ( ; driver_list
; driver_list
= driver_list
->next
)
1524 if (driver_list
->driver
->filter_properties
)
1525 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1531 /* Either a fontconfig-style name with no size and property
1532 data, or a GTK-style name. */
1534 int word_len
, prop_found
= 0;
1536 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1542 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1550 double point_size
= strtod (p
, &q
);
1551 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1556 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1557 if (*q
== '\\' && q
[1])
1561 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1563 if (PROP_MATCH ("Ultra-Light", 11))
1566 prop
= font_intern_prop ("ultra-light", 11, 1);
1567 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1569 else if (PROP_MATCH ("Light", 5))
1572 prop
= font_intern_prop ("light", 5, 1);
1573 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1575 else if (PROP_MATCH ("Semi-Bold", 9))
1578 prop
= font_intern_prop ("semi-bold", 9, 1);
1579 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1581 else if (PROP_MATCH ("Bold", 4))
1584 prop
= font_intern_prop ("bold", 4, 1);
1585 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1587 else if (PROP_MATCH ("Italic", 6))
1590 prop
= font_intern_prop ("italic", 4, 1);
1591 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1593 else if (PROP_MATCH ("Oblique", 7))
1596 prop
= font_intern_prop ("oblique", 7, 1);
1597 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1601 return -1; /* Unknown property in GTK-style font name. */
1610 family
= font_intern_prop (name
, family_end
- name
, 1);
1611 ASET (font
, FONT_FAMILY_INDEX
, family
);
1618 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1619 NAME (NBYTES length), and return the name length. If
1620 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1623 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1629 Lisp_Object family
, foundry
;
1630 Lisp_Object tail
, val
;
1634 Lisp_Object styles
[3];
1635 char *style_names
[3] = { "weight", "slant", "width" };
1638 family
= AREF (font
, FONT_FAMILY_INDEX
);
1639 if (! NILP (family
))
1641 if (SYMBOLP (family
))
1643 family
= SYMBOL_NAME (family
);
1644 len
+= SBYTES (family
);
1650 val
= AREF (font
, FONT_SIZE_INDEX
);
1653 if (XINT (val
) != 0)
1654 pixel_size
= XINT (val
);
1656 len
+= 21; /* for ":pixelsize=NUM" */
1658 else if (FLOATP (val
))
1661 point_size
= (int) XFLOAT_DATA (val
);
1662 len
+= 11; /* for "-NUM" */
1665 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1666 if (! NILP (foundry
))
1668 if (SYMBOLP (foundry
))
1670 foundry
= SYMBOL_NAME (foundry
);
1671 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1677 for (i
= 0; i
< 3; i
++)
1679 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1680 if (! NILP (styles
[i
]))
1681 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1682 SDATA (SYMBOL_NAME (styles
[i
])));
1685 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1686 len
+= sprintf (work
, ":dpi=%ld", (long)XINT (AREF (font
, FONT_DPI_INDEX
)));
1687 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1688 len
+= strlen (":spacing=100");
1689 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1690 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1691 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1693 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1695 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1697 len
+= SBYTES (val
);
1698 else if (INTEGERP (val
))
1699 len
+= sprintf (work
, "%ld", (long) XINT (val
));
1700 else if (SYMBOLP (val
))
1701 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1707 if (! NILP (family
))
1708 p
+= sprintf (p
, "%s", SDATA (family
));
1712 p
+= sprintf (p
, "%d", point_size
);
1714 p
+= sprintf (p
, "-%d", point_size
);
1716 else if (pixel_size
> 0)
1717 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1718 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1719 p
+= sprintf (p
, ":foundry=%s",
1720 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1721 for (i
= 0; i
< 3; i
++)
1722 if (! NILP (styles
[i
]))
1723 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1724 SDATA (SYMBOL_NAME (styles
[i
])));
1725 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1726 p
+= sprintf (p
, ":dpi=%ld", (long) XINT (AREF (font
, FONT_DPI_INDEX
)));
1727 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1728 p
+= sprintf (p
, ":spacing=%ld",
1729 (long) XINT (AREF (font
, FONT_SPACING_INDEX
)));
1730 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1732 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1733 p
+= sprintf (p
, ":scalable=true");
1735 p
+= sprintf (p
, ":scalable=false");
1740 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1741 NAME (NBYTES length), and return the name length. F is the frame
1742 on which the font is displayed; it is used to calculate the point
1746 font_unparse_gtkname (font
, f
, name
, nbytes
)
1754 Lisp_Object family
, weight
, slant
, size
;
1755 int point_size
= -1;
1757 family
= AREF (font
, FONT_FAMILY_INDEX
);
1758 if (! NILP (family
))
1760 if (! SYMBOLP (family
))
1762 family
= SYMBOL_NAME (family
);
1763 len
+= SBYTES (family
);
1766 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1767 if (EQ (weight
, Qnormal
))
1769 else if (! NILP (weight
))
1771 weight
= SYMBOL_NAME (weight
);
1772 len
+= SBYTES (weight
);
1775 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1776 if (EQ (slant
, Qnormal
))
1778 else if (! NILP (slant
))
1780 slant
= SYMBOL_NAME (slant
);
1781 len
+= SBYTES (slant
);
1784 size
= AREF (font
, FONT_SIZE_INDEX
);
1785 /* Convert pixel size to point size. */
1786 if (INTEGERP (size
))
1788 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1790 if (INTEGERP (font_dpi
))
1791 dpi
= XINT (font_dpi
);
1794 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1797 else if (FLOATP (size
))
1799 point_size
= (int) XFLOAT_DATA (size
);
1806 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1808 if (! NILP (weight
))
1811 p
+= sprintf (p
, " %s", SDATA (weight
));
1812 q
[1] = toupper (q
[1]);
1818 p
+= sprintf (p
, " %s", SDATA (slant
));
1819 q
[1] = toupper (q
[1]);
1823 p
+= sprintf (p
, " %d", point_size
);
1828 /* Parse NAME (null terminated) and store information in FONT
1829 (font-spec or font-entity). If NAME is successfully parsed, return
1830 0. Otherwise return -1. */
1833 font_parse_name (name
, font
)
1837 if (name
[0] == '-' || index (name
, '*') || index (name
, '?'))
1838 return font_parse_xlfd (name
, font
);
1839 return font_parse_fcname (name
, font
);
1843 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1844 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1848 font_parse_family_registry (family
, registry
, font_spec
)
1849 Lisp_Object family
, registry
, font_spec
;
1855 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1857 CHECK_STRING (family
);
1858 len
= SBYTES (family
);
1859 p0
= (char *) SDATA (family
);
1860 p1
= index (p0
, '-');
1863 if ((*p0
!= '*' && p1
- p0
> 0)
1864 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1865 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1868 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1871 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1873 if (! NILP (registry
))
1875 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1876 CHECK_STRING (registry
);
1877 len
= SBYTES (registry
);
1878 p0
= (char *) SDATA (registry
);
1879 p1
= index (p0
, '-');
1882 if (SDATA (registry
)[len
- 1] == '*')
1883 registry
= concat2 (registry
, build_string ("-*"));
1885 registry
= concat2 (registry
, build_string ("*-*"));
1887 registry
= Fdowncase (registry
);
1888 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1893 /* This part (through the next ^L) is still experimental and not
1894 tested much. We may drastically change codes. */
1900 #define LGSTRING_HEADER_SIZE 6
1901 #define LGSTRING_GLYPH_SIZE 8
1904 check_gstring (gstring
)
1905 Lisp_Object gstring
;
1910 CHECK_VECTOR (gstring
);
1911 val
= AREF (gstring
, 0);
1913 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1915 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1916 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1917 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1918 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1919 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1920 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1921 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1922 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1923 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1924 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1925 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1927 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1929 val
= LGSTRING_GLYPH (gstring
, i
);
1931 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1933 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1935 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1936 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1937 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1938 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1939 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1940 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1941 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1942 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1944 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1946 if (ASIZE (val
) < 3)
1948 for (j
= 0; j
< 3; j
++)
1949 CHECK_NUMBER (AREF (val
, j
));
1954 error ("Invalid glyph-string format");
1959 check_otf_features (otf_features
)
1960 Lisp_Object otf_features
;
1964 CHECK_CONS (otf_features
);
1965 CHECK_SYMBOL (XCAR (otf_features
));
1966 otf_features
= XCDR (otf_features
);
1967 CHECK_CONS (otf_features
);
1968 CHECK_SYMBOL (XCAR (otf_features
));
1969 otf_features
= XCDR (otf_features
);
1970 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1972 CHECK_SYMBOL (Fcar (val
));
1973 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1974 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1976 otf_features
= XCDR (otf_features
);
1977 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1979 CHECK_SYMBOL (Fcar (val
));
1980 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1981 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1988 Lisp_Object otf_list
;
1991 otf_tag_symbol (tag
)
1996 OTF_tag_name (tag
, name
);
1997 return Fintern (make_unibyte_string (name
, 4), Qnil
);
2004 Lisp_Object val
= Fassoc (file
, otf_list
);
2008 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
2011 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
2012 val
= make_save_value (otf
, 0);
2013 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
2019 /* Return a list describing which scripts/languages FONT supports by
2020 which GSUB/GPOS features of OpenType tables. See the comment of
2021 (struct font_driver).otf_capability. */
2024 font_otf_capability (font
)
2028 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
2031 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
2034 for (i
= 0; i
< 2; i
++)
2036 OTF_GSUB_GPOS
*gsub_gpos
;
2037 Lisp_Object script_list
= Qnil
;
2040 if (OTF_get_features (otf
, i
== 0) < 0)
2042 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2043 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2045 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2046 Lisp_Object langsys_list
= Qnil
;
2047 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2050 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2052 OTF_LangSys
*langsys
;
2053 Lisp_Object feature_list
= Qnil
;
2054 Lisp_Object langsys_tag
;
2057 if (k
== script
->LangSysCount
)
2059 langsys
= &script
->DefaultLangSys
;
2064 langsys
= script
->LangSys
+ k
;
2066 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2068 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2070 OTF_Feature
*feature
2071 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2072 Lisp_Object feature_tag
2073 = otf_tag_symbol (feature
->FeatureTag
);
2075 feature_list
= Fcons (feature_tag
, feature_list
);
2077 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2080 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2085 XSETCAR (capability
, script_list
);
2087 XSETCDR (capability
, script_list
);
2093 /* Parse OTF features in SPEC and write a proper features spec string
2094 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2095 assured that the sufficient memory has already allocated for
2099 generate_otf_features (spec
, features
)
2109 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2115 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2120 else if (! asterisk
)
2122 val
= SYMBOL_NAME (val
);
2123 p
+= sprintf (p
, "%s", SDATA (val
));
2127 val
= SYMBOL_NAME (val
);
2128 p
+= sprintf (p
, "~%s", SDATA (val
));
2132 error ("OTF spec too long");
2136 font_otf_DeviceTable (device_table
)
2137 OTF_DeviceTable
*device_table
;
2139 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2141 return Fcons (make_number (len
),
2142 make_unibyte_string (device_table
->DeltaValue
, len
));
2146 font_otf_ValueRecord (value_format
, value_record
)
2148 OTF_ValueRecord
*value_record
;
2150 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2152 if (value_format
& OTF_XPlacement
)
2153 ASET (val
, 0, make_number (value_record
->XPlacement
));
2154 if (value_format
& OTF_YPlacement
)
2155 ASET (val
, 1, make_number (value_record
->YPlacement
));
2156 if (value_format
& OTF_XAdvance
)
2157 ASET (val
, 2, make_number (value_record
->XAdvance
));
2158 if (value_format
& OTF_YAdvance
)
2159 ASET (val
, 3, make_number (value_record
->YAdvance
));
2160 if (value_format
& OTF_XPlaDevice
)
2161 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2162 if (value_format
& OTF_YPlaDevice
)
2163 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2164 if (value_format
& OTF_XAdvDevice
)
2165 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2166 if (value_format
& OTF_YAdvDevice
)
2167 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2172 font_otf_Anchor (anchor
)
2177 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2178 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2179 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2180 if (anchor
->AnchorFormat
== 2)
2181 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2184 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2185 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2189 #endif /* HAVE_LIBOTF */
2195 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2196 static int font_compare
P_ ((const void *, const void *));
2197 static Lisp_Object font_sort_entities
P_ ((Lisp_Object
, Lisp_Object
,
2200 /* Return a rescaling ratio of FONT_ENTITY. */
2201 extern Lisp_Object Vface_font_rescale_alist
;
2204 font_rescale_ratio (font_entity
)
2205 Lisp_Object font_entity
;
2207 Lisp_Object tail
, elt
;
2208 Lisp_Object name
= Qnil
;
2210 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2213 if (FLOATP (XCDR (elt
)))
2215 if (STRINGP (XCAR (elt
)))
2218 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2219 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2220 return XFLOAT_DATA (XCDR (elt
));
2222 else if (FONT_SPEC_P (XCAR (elt
)))
2224 if (font_match_p (XCAR (elt
), font_entity
))
2225 return XFLOAT_DATA (XCDR (elt
));
2232 /* We sort fonts by scoring each of them against a specified
2233 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2234 the value is, the closer the font is to the font-spec.
2236 The lowest 2 bits of the score is used for driver type. The font
2237 available by the most preferred font driver is 0.
2239 Each 7-bit in the higher 28 bits are used for numeric properties
2240 WEIGHT, SLANT, WIDTH, and SIZE. */
2242 /* How many bits to shift to store the difference value of each font
2243 property in a score. Note that flots for FONT_TYPE_INDEX and
2244 FONT_REGISTRY_INDEX are not used. */
2245 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2247 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2248 The return value indicates how different ENTITY is compared with
2252 font_score (entity
, spec_prop
)
2253 Lisp_Object entity
, *spec_prop
;
2258 /* Score three style numeric fields. Maximum difference is 127. */
2259 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2260 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2262 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2267 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2270 /* Score the size. Maximum difference is 127. */
2271 i
= FONT_SIZE_INDEX
;
2272 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2273 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2275 /* We use the higher 6-bit for the actual size difference. The
2276 lowest bit is set if the DPI is different. */
2278 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2280 if (CONSP (Vface_font_rescale_alist
))
2281 pixel_size
*= font_rescale_ratio (entity
);
2282 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2286 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2287 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2289 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2290 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2292 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2299 /* Concatenate all elements of LIST into one vector. LIST is a list
2300 of font-entity vectors. */
2303 font_vconcat_entity_vectors (Lisp_Object list
)
2305 int nargs
= XINT (Flength (list
));
2306 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2309 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2310 args
[i
] = XCAR (list
);
2311 return Fvconcat (nargs
, args
);
2315 /* The structure for elements being sorted by qsort. */
2316 struct font_sort_data
2319 int font_driver_preference
;
2324 /* The comparison function for qsort. */
2327 font_compare (d1
, d2
)
2328 const void *d1
, *d2
;
2330 const struct font_sort_data
*data1
= d1
;
2331 const struct font_sort_data
*data2
= d2
;
2333 if (data1
->score
< data2
->score
)
2335 else if (data1
->score
> data2
->score
)
2337 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2341 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2342 If PREFER specifies a point-size, calculate the corresponding
2343 pixel-size from QCdpi property of PREFER or from the Y-resolution
2344 of FRAME before sorting.
2346 If BEST-ONLY is nonzero, return the best matching entity (that
2347 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2348 if BEST-ONLY is negative). Otherwise, return the sorted result as
2349 a single vector of font-entities.
2351 This function does no optimization for the case that the total
2352 number of elements is 1. The caller should avoid calling this in
2356 font_sort_entities (list
, prefer
, frame
, best_only
)
2357 Lisp_Object list
, prefer
, frame
;
2360 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2362 struct font_sort_data
*data
;
2363 unsigned best_score
;
2364 Lisp_Object best_entity
;
2365 struct frame
*f
= XFRAME (frame
);
2366 Lisp_Object tail
, vec
;
2369 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2370 prefer_prop
[i
] = AREF (prefer
, i
);
2371 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2372 prefer_prop
[FONT_SIZE_INDEX
]
2373 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2375 if (NILP (XCDR (list
)))
2377 /* What we have to take care of is this single vector. */
2379 maxlen
= ASIZE (vec
);
2383 /* We don't have to perform sort, so there's no need of creating
2384 a single vector. But, we must find the length of the longest
2387 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2388 if (maxlen
< ASIZE (XCAR (tail
)))
2389 maxlen
= ASIZE (XCAR (tail
));
2393 /* We have to create a single vector to sort it. */
2394 vec
= font_vconcat_entity_vectors (list
);
2395 maxlen
= ASIZE (vec
);
2398 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2399 best_score
= 0xFFFFFFFF;
2402 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2404 int font_driver_preference
= 0;
2405 Lisp_Object current_font_driver
;
2411 /* We are sure that the length of VEC > 0. */
2412 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2413 /* Score the elements. */
2414 for (i
= 0; i
< len
; i
++)
2416 data
[i
].entity
= AREF (vec
, i
);
2418 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2420 ? font_score (data
[i
].entity
, prefer_prop
)
2422 if (best_only
&& best_score
> data
[i
].score
)
2424 best_score
= data
[i
].score
;
2425 best_entity
= data
[i
].entity
;
2426 if (best_score
== 0)
2429 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2431 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2432 font_driver_preference
++;
2434 data
[i
].font_driver_preference
= font_driver_preference
;
2437 /* Sort if necessary. */
2440 qsort (data
, len
, sizeof *data
, font_compare
);
2441 for (i
= 0; i
< len
; i
++)
2442 ASET (vec
, i
, data
[i
].entity
);
2451 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2456 /* API of Font Service Layer. */
2458 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2459 sort_shift_bits. Finternal_set_font_selection_order calls this
2460 function with font_sort_order after setting up it. */
2463 font_update_sort_order (order
)
2468 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2470 int xlfd_idx
= order
[i
];
2472 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2473 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2474 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2475 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2476 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2477 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2479 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2484 font_check_otf_features (script
, langsys
, features
, table
)
2485 Lisp_Object script
, langsys
, features
, table
;
2490 table
= assq_no_quit (script
, table
);
2493 table
= XCDR (table
);
2494 if (! NILP (langsys
))
2496 table
= assq_no_quit (langsys
, table
);
2502 val
= assq_no_quit (Qnil
, table
);
2504 table
= XCAR (table
);
2508 table
= XCDR (table
);
2509 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2511 if (NILP (XCAR (features
)))
2516 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2522 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2525 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2527 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2529 script
= XCAR (spec
);
2533 langsys
= XCAR (spec
);
2544 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2545 XCAR (otf_capability
)))
2547 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2548 XCDR (otf_capability
)))
2555 /* Check if FONT (font-entity or font-object) matches with the font
2556 specification SPEC. */
2559 font_match_p (spec
, font
)
2560 Lisp_Object spec
, font
;
2562 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2563 Lisp_Object extra
, font_extra
;
2566 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2567 if (! NILP (AREF (spec
, i
))
2568 && ! NILP (AREF (font
, i
))
2569 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2571 props
= XFONT_SPEC (spec
)->props
;
2572 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2574 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2575 prop
[i
] = AREF (spec
, i
);
2576 prop
[FONT_SIZE_INDEX
]
2577 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2581 if (font_score (font
, props
) > 0)
2583 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2584 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2585 for (; CONSP (extra
); extra
= XCDR (extra
))
2587 Lisp_Object key
= XCAR (XCAR (extra
));
2588 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2590 if (EQ (key
, QClang
))
2592 val2
= assq_no_quit (key
, font_extra
);
2601 if (NILP (Fmemq (val
, val2
)))
2606 ? NILP (Fmemq (val
, XCDR (val2
)))
2610 else if (EQ (key
, QCscript
))
2612 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2618 /* All characters in the list must be supported. */
2619 for (; CONSP (val2
); val2
= XCDR (val2
))
2621 if (! NATNUMP (XCAR (val2
)))
2623 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2624 == FONT_INVALID_CODE
)
2628 else if (VECTORP (val2
))
2630 /* At most one character in the vector must be supported. */
2631 for (i
= 0; i
< ASIZE (val2
); i
++)
2633 if (! NATNUMP (AREF (val2
, i
)))
2635 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2636 != FONT_INVALID_CODE
)
2639 if (i
== ASIZE (val2
))
2644 else if (EQ (key
, QCotf
))
2648 if (! FONT_OBJECT_P (font
))
2650 fontp
= XFONT_OBJECT (font
);
2651 if (! fontp
->driver
->otf_capability
)
2653 val2
= fontp
->driver
->otf_capability (fontp
);
2654 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2665 Each font backend has the callback function get_cache, and it
2666 returns a cons cell of which cdr part can be freely used for
2667 caching fonts. The cons cell may be shared by multiple frames
2668 and/or multiple font drivers. So, we arrange the cdr part as this:
2670 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2672 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2673 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2674 cons (FONT-SPEC FONT-ENTITY ...). */
2676 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2677 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2678 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2679 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2680 struct font_driver
*));
2683 font_prepare_cache (f
, driver
)
2685 struct font_driver
*driver
;
2687 Lisp_Object cache
, val
;
2689 cache
= driver
->get_cache (f
);
2691 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2695 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2696 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2700 val
= XCDR (XCAR (val
));
2701 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2707 font_finish_cache (f
, driver
)
2709 struct font_driver
*driver
;
2711 Lisp_Object cache
, val
, tmp
;
2714 cache
= driver
->get_cache (f
);
2716 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2717 cache
= val
, val
= XCDR (val
);
2718 font_assert (! NILP (val
));
2719 tmp
= XCDR (XCAR (val
));
2720 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2721 if (XINT (XCAR (tmp
)) == 0)
2723 font_clear_cache (f
, XCAR (val
), driver
);
2724 XSETCDR (cache
, XCDR (val
));
2730 font_get_cache (f
, driver
)
2732 struct font_driver
*driver
;
2734 Lisp_Object val
= driver
->get_cache (f
);
2735 Lisp_Object type
= driver
->type
;
2737 font_assert (CONSP (val
));
2738 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2739 font_assert (CONSP (val
));
2740 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2741 val
= XCDR (XCAR (val
));
2745 static int num_fonts
;
2748 font_clear_cache (f
, cache
, driver
)
2751 struct font_driver
*driver
;
2753 Lisp_Object tail
, elt
;
2754 Lisp_Object tail2
, entity
;
2756 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2757 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2760 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2761 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2763 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2765 entity
= XCAR (tail2
);
2767 if (FONT_ENTITY_P (entity
)
2768 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2770 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2772 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2774 Lisp_Object val
= XCAR (objlist
);
2775 struct font
*font
= XFONT_OBJECT (val
);
2777 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2779 font_assert (font
&& driver
== font
->driver
);
2780 driver
->close (f
, font
);
2784 if (driver
->free_entity
)
2785 driver
->free_entity (entity
);
2790 XSETCDR (cache
, Qnil
);
2794 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2797 font_delete_unmatched (vec
, spec
, size
)
2798 Lisp_Object vec
, spec
;
2801 Lisp_Object entity
, val
;
2802 enum font_property_index prop
;
2805 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2807 entity
= AREF (vec
, i
);
2808 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2809 if (INTEGERP (AREF (spec
, prop
))
2810 && ((XINT (AREF (spec
, prop
)) >> 8)
2811 != (XINT (AREF (entity
, prop
)) >> 8)))
2812 prop
= FONT_SPEC_MAX
;
2813 if (prop
< FONT_SPEC_MAX
2815 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2817 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2820 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2821 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2822 prop
= FONT_SPEC_MAX
;
2824 if (prop
< FONT_SPEC_MAX
2825 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2826 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2827 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2828 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2829 prop
= FONT_SPEC_MAX
;
2830 if (prop
< FONT_SPEC_MAX
2831 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2832 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2833 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2834 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2835 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2836 prop
= FONT_SPEC_MAX
;
2837 if (prop
< FONT_SPEC_MAX
)
2838 val
= Fcons (entity
, val
);
2840 return (Fvconcat (1, &val
));
2844 /* Return a list of vectors of font-entities matching with SPEC on
2845 FRAME. The elements of the list are in the same of order of
2849 font_list_entities (frame
, spec
)
2850 Lisp_Object frame
, spec
;
2852 FRAME_PTR f
= XFRAME (frame
);
2853 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2854 Lisp_Object ftype
, val
;
2855 Lisp_Object list
= Qnil
;
2857 int need_filtering
= 0;
2860 font_assert (FONT_SPEC_P (spec
));
2862 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2863 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2864 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2865 size
= font_pixel_size (f
, spec
);
2869 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2870 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2871 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2872 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2874 ASET (scratch_font_spec
, i
, Qnil
);
2875 if (! NILP (AREF (spec
, i
)))
2877 if (i
== FONT_DPI_INDEX
)
2878 /* Skip FONT_SPACING_INDEX */
2881 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2882 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2884 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2886 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2888 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2890 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2891 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2898 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2902 val
= Fvconcat (1, &val
);
2903 copy
= Fcopy_font_spec (scratch_font_spec
);
2904 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2905 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2907 if (ASIZE (val
) > 0 && need_filtering
)
2908 val
= font_delete_unmatched (val
, spec
, size
);
2909 if (ASIZE (val
) > 0)
2910 list
= Fcons (val
, list
);
2913 list
= Fnreverse (list
);
2914 FONT_ADD_LOG ("list", spec
, list
);
2919 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2920 nil, is an array of face's attributes, which specifies preferred
2921 font-related attributes. */
2924 font_matching_entity (f
, attrs
, spec
)
2926 Lisp_Object
*attrs
, spec
;
2928 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2929 Lisp_Object ftype
, size
, entity
;
2931 Lisp_Object work
= Fcopy_font_spec (spec
);
2933 XSETFRAME (frame
, f
);
2934 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2935 size
= AREF (spec
, FONT_SIZE_INDEX
);
2938 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2939 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2940 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2941 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2944 for (; driver_list
; driver_list
= driver_list
->next
)
2946 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2948 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2951 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2952 entity
= assoc_no_quit (work
, XCDR (cache
));
2954 entity
= XCDR (entity
);
2957 entity
= driver_list
->driver
->match (frame
, work
);
2958 copy
= Fcopy_font_spec (work
);
2959 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2960 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2962 if (! NILP (entity
))
2965 FONT_ADD_LOG ("match", work
, entity
);
2970 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2971 opened font object. */
2974 font_open_entity (f
, entity
, pixel_size
)
2979 struct font_driver_list
*driver_list
;
2980 Lisp_Object objlist
, size
, val
, font_object
;
2982 int min_width
, height
;
2983 int scaled_pixel_size
;
2985 font_assert (FONT_ENTITY_P (entity
));
2986 size
= AREF (entity
, FONT_SIZE_INDEX
);
2987 if (XINT (size
) != 0)
2988 scaled_pixel_size
= pixel_size
= XINT (size
);
2989 else if (CONSP (Vface_font_rescale_alist
))
2990 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2993 /* This doesn't work if you have changed hinting or any other parameter.
2994 We need to make a new object in every case to be sure. */
2995 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2996 objlist
= XCDR (objlist
))
2997 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2998 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2999 return XCAR (objlist
);
3002 val
= AREF (entity
, FONT_TYPE_INDEX
);
3003 for (driver_list
= f
->font_driver_list
;
3004 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
3005 driver_list
= driver_list
->next
);
3009 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
3010 if (!NILP (font_object
))
3011 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3012 FONT_ADD_LOG ("open", entity
, font_object
);
3013 if (NILP (font_object
))
3015 ASET (entity
, FONT_OBJLIST_INDEX
,
3016 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
3017 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
3020 font
= XFONT_OBJECT (font_object
);
3021 min_width
= (font
->min_width
? font
->min_width
3022 : font
->average_width
? font
->average_width
3023 : font
->space_width
? font
->space_width
3025 height
= (font
->height
? font
->height
: 1);
3026 #ifdef HAVE_WINDOW_SYSTEM
3027 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
3028 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
3030 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
3031 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
3032 fonts_changed_p
= 1;
3036 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
3037 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
3038 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
3039 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
3047 /* Close FONT_OBJECT that is opened on frame F. */
3050 font_close_object (f
, font_object
)
3052 Lisp_Object font_object
;
3054 struct font
*font
= XFONT_OBJECT (font_object
);
3056 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
3057 /* Already closed. */
3059 FONT_ADD_LOG ("close", font_object
, Qnil
);
3060 font
->driver
->close (f
, font
);
3061 #ifdef HAVE_WINDOW_SYSTEM
3062 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
3063 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
3069 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
3070 FONT is a font-entity and it must be opened to check. */
3073 font_has_char (f
, font
, c
)
3080 if (FONT_ENTITY_P (font
))
3082 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
3083 struct font_driver_list
*driver_list
;
3085 for (driver_list
= f
->font_driver_list
;
3086 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
3087 driver_list
= driver_list
->next
);
3090 if (! driver_list
->driver
->has_char
)
3092 return driver_list
->driver
->has_char (font
, c
);
3095 font_assert (FONT_OBJECT_P (font
));
3096 fontp
= XFONT_OBJECT (font
);
3097 if (fontp
->driver
->has_char
)
3099 int result
= fontp
->driver
->has_char (font
, c
);
3104 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
3108 /* Return the glyph ID of FONT_OBJECT for character C. */
3111 font_encode_char (font_object
, c
)
3112 Lisp_Object font_object
;
3117 font_assert (FONT_OBJECT_P (font_object
));
3118 font
= XFONT_OBJECT (font_object
);
3119 return font
->driver
->encode_char (font
, c
);
3123 /* Return the name of FONT_OBJECT. */
3126 font_get_name (font_object
)
3127 Lisp_Object font_object
;
3129 font_assert (FONT_OBJECT_P (font_object
));
3130 return AREF (font_object
, FONT_NAME_INDEX
);
3134 /* Return the specification of FONT_OBJECT. */
3137 font_get_spec (font_object
)
3138 Lisp_Object font_object
;
3140 Lisp_Object spec
= font_make_spec ();
3143 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
3144 ASET (spec
, i
, AREF (font_object
, i
));
3145 ASET (spec
, FONT_SIZE_INDEX
,
3146 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
3151 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3152 could not be parsed by font_parse_name, return Qnil. */
3155 font_spec_from_name (font_name
)
3156 Lisp_Object font_name
;
3158 Lisp_Object spec
= Ffont_spec (0, NULL
);
3160 CHECK_STRING (font_name
);
3161 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3163 font_put_extra (spec
, QCname
, font_name
);
3169 font_clear_prop (attrs
, prop
)
3171 enum font_property_index prop
;
3173 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3178 if (! NILP (Ffont_get (font
, QCname
)))
3180 font
= Fcopy_font_spec (font
);
3181 font_put_extra (font
, QCname
, Qnil
);
3185 if (NILP (AREF (font
, prop
))
3186 && prop
!= FONT_FAMILY_INDEX
3187 && prop
!= FONT_FOUNDRY_INDEX
3188 && prop
!= FONT_WIDTH_INDEX
3189 && prop
!= FONT_SIZE_INDEX
)
3191 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3192 font
= Fcopy_font_spec (font
);
3193 ASET (font
, prop
, Qnil
);
3194 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3196 if (prop
== FONT_FAMILY_INDEX
)
3198 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3199 /* If we are setting the font family, we must also clear
3200 FONT_WIDTH_INDEX to avoid rejecting families that lack
3201 support for some widths. */
3202 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3204 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3205 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3206 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3207 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3208 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3209 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3211 else if (prop
== FONT_SIZE_INDEX
)
3213 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3214 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3215 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3217 else if (prop
== FONT_WIDTH_INDEX
)
3218 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3219 attrs
[LFACE_FONT_INDEX
] = font
;
3223 font_update_lface (f
, attrs
)
3229 spec
= attrs
[LFACE_FONT_INDEX
];
3230 if (! FONT_SPEC_P (spec
))
3233 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3234 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3235 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3236 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3237 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3238 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3239 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3240 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);
3241 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3242 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3243 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3247 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3252 val
= Ffont_get (spec
, QCdpi
);
3255 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3257 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3259 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3261 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3262 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3268 /* Selecte a font from ENTITIES (list of font-entity vectors) that
3269 supports C and matches best with ATTRS and PIXEL_SIZE. */
3272 font_select_entity (frame
, entities
, attrs
, pixel_size
, c
)
3273 Lisp_Object frame
, entities
, *attrs
;
3276 Lisp_Object font_entity
;
3279 FRAME_PTR f
= XFRAME (frame
);
3281 if (NILP (XCDR (entities
))
3282 && ASIZE (XCAR (entities
)) == 1)
3284 font_entity
= AREF (XCAR (entities
), 0);
3286 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3291 /* Sort fonts by properties specified in ATTRS. */
3292 prefer
= scratch_font_prefer
;
3294 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3295 ASET (prefer
, i
, Qnil
);
3296 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3298 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3300 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3301 ASET (prefer
, i
, AREF (face_font
, i
));
3303 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3304 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3305 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3306 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3307 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3308 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3309 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3311 return font_sort_entities (entities
, prefer
, frame
, c
);
3314 /* Return a font-entity satisfying SPEC and best matching with face's
3315 font related attributes in ATTRS. C, if not negative, is a
3316 character that the entity must support. */
3319 font_find_for_lface (f
, attrs
, spec
, c
)
3326 Lisp_Object frame
, entities
, val
;
3327 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3331 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3332 if (NILP (registry
[0]))
3334 registry
[0] = DEFAULT_ENCODING
;
3335 registry
[1] = Qascii_0
;
3336 registry
[2] = null_vector
;
3339 registry
[1] = null_vector
;
3341 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3343 struct charset
*encoding
, *repertory
;
3345 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3346 &encoding
, &repertory
) < 0)
3349 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3351 else if (c
> encoding
->max_char
)
3355 work
= Fcopy_font_spec (spec
);
3356 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3357 XSETFRAME (frame
, f
);
3358 size
= AREF (spec
, FONT_SIZE_INDEX
);
3359 pixel_size
= font_pixel_size (f
, spec
);
3360 if (pixel_size
== 0)
3362 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3364 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3366 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3367 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3368 if (! NILP (foundry
[0]))
3369 foundry
[1] = null_vector
;
3370 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3372 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3373 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3375 foundry
[2] = null_vector
;
3378 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3380 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3381 if (! NILP (adstyle
[0]))
3382 adstyle
[1] = null_vector
;
3383 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3385 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3387 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3389 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3391 adstyle
[2] = null_vector
;
3394 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3397 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3400 val
= AREF (work
, FONT_FAMILY_INDEX
);
3401 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3403 val
= attrs
[LFACE_FAMILY_INDEX
];
3404 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3408 family
= alloca ((sizeof family
[0]) * 2);
3410 family
[1] = null_vector
; /* terminator. */
3415 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3416 /* Font family names are case-sensitive under NS. */
3424 if (! NILP (alters
))
3426 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3427 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3428 family
[i
] = XCAR (alters
);
3429 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3431 family
[i
] = null_vector
;
3435 family
= alloca ((sizeof family
[0]) * 3);
3438 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3440 family
[i
] = null_vector
;
3444 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3446 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3447 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3449 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3450 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3452 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3453 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3455 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3456 entities
= font_list_entities (frame
, work
);
3457 if (! NILP (entities
))
3459 val
= font_select_entity (frame
, entities
,
3460 attrs
, pixel_size
, c
);
3473 font_open_for_lface (f
, entity
, attrs
, spec
)
3481 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3482 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3483 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3484 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3485 size
= font_pixel_size (f
, spec
);
3489 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3490 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3493 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3494 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3495 if (INTEGERP (height
))
3498 abort(); /* We should never end up here. */
3502 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3506 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3507 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3511 return font_open_entity (f
, entity
, size
);
3515 /* Find a font satisfying SPEC and best matching with face's
3516 attributes in ATTRS on FRAME, and return the opened
3520 font_load_for_lface (f
, attrs
, spec
)
3522 Lisp_Object
*attrs
, spec
;
3524 Lisp_Object entity
, name
;
3526 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3529 /* No font is listed for SPEC, but each font-backend may have
3530 the different criteria about "font matching". So, try
3532 entity
= font_matching_entity (f
, attrs
, spec
);
3536 /* Don't loose the original name that was put in initially. We need
3537 it to re-apply the font when font parameters (like hinting or dpi) have
3539 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3542 name
= Ffont_get (spec
, QCname
);
3543 if (STRINGP (name
)) font_put_extra (entity
, QCname
, name
);
3549 /* Make FACE on frame F ready to use the font opened for FACE. */
3552 font_prepare_for_face (f
, face
)
3556 if (face
->font
->driver
->prepare_face
)
3557 face
->font
->driver
->prepare_face (f
, face
);
3561 /* Make FACE on frame F stop using the font opened for FACE. */
3564 font_done_for_face (f
, face
)
3568 if (face
->font
->driver
->done_face
)
3569 face
->font
->driver
->done_face (f
, face
);
3574 /* Open a font matching with font-spec SPEC on frame F. If no proper
3575 font is found, return Qnil. */
3578 font_open_by_spec (f
, spec
)
3582 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3584 /* We set up the default font-related attributes of a face to prefer
3586 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3587 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3588 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3590 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3592 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3594 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3596 return font_load_for_lface (f
, attrs
, spec
);
3600 /* Open a font matching with NAME on frame F. If no proper font is
3601 found, return Qnil. */
3604 font_open_by_name (f
, name
)
3608 Lisp_Object args
[2];
3609 Lisp_Object spec
, ret
;
3612 args
[1] = make_unibyte_string (name
, strlen (name
));
3613 spec
= Ffont_spec (2, args
);
3614 ret
= font_open_by_spec (f
, spec
);
3615 /* Do not loose name originally put in. */
3617 font_put_extra (ret
, QCname
, args
[1]);
3623 /* Register font-driver DRIVER. This function is used in two ways.
3625 The first is with frame F non-NULL. In this case, make DRIVER
3626 available (but not yet activated) on F. All frame creaters
3627 (e.g. Fx_create_frame) must call this function at least once with
3628 an available font-driver.
3630 The second is with frame F NULL. In this case, DRIVER is globally
3631 registered in the variable `font_driver_list'. All font-driver
3632 implementations must call this function in its syms_of_XXXX
3633 (e.g. syms_of_xfont). */
3636 register_font_driver (driver
, f
)
3637 struct font_driver
*driver
;
3640 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3641 struct font_driver_list
*prev
, *list
;
3643 if (f
&& ! driver
->draw
)
3644 error ("Unusable font driver for a frame: %s",
3645 SDATA (SYMBOL_NAME (driver
->type
)));
3647 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3648 if (EQ (list
->driver
->type
, driver
->type
))
3649 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3651 list
= xmalloc (sizeof (struct font_driver_list
));
3653 list
->driver
= driver
;
3658 f
->font_driver_list
= list
;
3660 font_driver_list
= list
;
3666 free_font_driver_list (f
)
3669 struct font_driver_list
*list
, *next
;
3671 for (list
= f
->font_driver_list
; list
; list
= next
)
3676 f
->font_driver_list
= NULL
;
3680 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3681 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3682 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3684 A caller must free all realized faces if any in advance. The
3685 return value is a list of font backends actually made used on
3689 font_update_drivers (f
, new_drivers
)
3691 Lisp_Object new_drivers
;
3693 Lisp_Object active_drivers
= Qnil
;
3694 struct font_driver
*driver
;
3695 struct font_driver_list
*list
;
3697 /* At first, turn off non-requested drivers, and turn on requested
3699 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3701 driver
= list
->driver
;
3702 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3707 if (driver
->end_for_frame
)
3708 driver
->end_for_frame (f
);
3709 font_finish_cache (f
, driver
);
3714 if (! driver
->start_for_frame
3715 || driver
->start_for_frame (f
) == 0)
3717 font_prepare_cache (f
, driver
);
3724 if (NILP (new_drivers
))
3727 if (! EQ (new_drivers
, Qt
))
3729 /* Re-order the driver list according to new_drivers. */
3730 struct font_driver_list
**list_table
, **next
;
3734 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3735 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3737 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3738 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3741 list_table
[i
++] = list
;
3743 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3745 list_table
[i
++] = list
;
3746 list_table
[i
] = NULL
;
3748 next
= &f
->font_driver_list
;
3749 for (i
= 0; list_table
[i
]; i
++)
3751 *next
= list_table
[i
];
3752 next
= &(*next
)->next
;
3756 if (! f
->font_driver_list
->on
)
3757 { /* None of the drivers is enabled: enable them all.
3758 Happens if you set the list of drivers to (xft x) in your .emacs
3759 and then use it under w32 or ns. */
3760 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3762 struct font_driver
*driver
= list
->driver
;
3763 eassert (! list
->on
);
3764 if (! driver
->start_for_frame
3765 || driver
->start_for_frame (f
) == 0)
3767 font_prepare_cache (f
, driver
);
3774 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3776 active_drivers
= nconc2 (active_drivers
,
3777 Fcons (list
->driver
->type
, Qnil
));
3778 return active_drivers
;
3782 font_put_frame_data (f
, driver
, data
)
3784 struct font_driver
*driver
;
3787 struct font_data_list
*list
, *prev
;
3789 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3790 prev
= list
, list
= list
->next
)
3791 if (list
->driver
== driver
)
3798 prev
->next
= list
->next
;
3800 f
->font_data_list
= list
->next
;
3808 list
= xmalloc (sizeof (struct font_data_list
));
3809 list
->driver
= driver
;
3810 list
->next
= f
->font_data_list
;
3811 f
->font_data_list
= list
;
3819 font_get_frame_data (f
, driver
)
3821 struct font_driver
*driver
;
3823 struct font_data_list
*list
;
3825 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3826 if (list
->driver
== driver
)
3834 /* Return the font used to draw character C by FACE at buffer position
3835 POS in window W. If STRING is non-nil, it is a string containing C
3836 at index POS. If C is negative, get C from the current buffer or
3840 font_at (c
, pos
, face
, w
, string
)
3849 Lisp_Object font_object
;
3851 multibyte
= (NILP (string
)
3852 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3853 : STRING_MULTIBYTE (string
));
3860 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3862 c
= FETCH_CHAR (pos_byte
);
3865 c
= FETCH_BYTE (pos
);
3871 multibyte
= STRING_MULTIBYTE (string
);
3874 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3876 str
= SDATA (string
) + pos_byte
;
3877 c
= STRING_CHAR (str
);
3880 c
= SDATA (string
)[pos
];
3884 f
= XFRAME (w
->frame
);
3885 if (! FRAME_WINDOW_P (f
))
3892 if (STRINGP (string
))
3893 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3894 DEFAULT_FACE_ID
, 0);
3896 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3898 face
= FACE_FROM_ID (f
, face_id
);
3902 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3903 face
= FACE_FROM_ID (f
, face_id
);
3908 XSETFONT (font_object
, face
->font
);
3913 #ifdef HAVE_WINDOW_SYSTEM
3915 /* Check how many characters after POS (at most to *LIMIT) can be
3916 displayed by the same font on the window W. FACE, if non-NULL, is
3917 the face selected for the character at POS. If STRING is not nil,
3918 it is the string to check instead of the current buffer. In that
3919 case, FACE must be not NULL.
3921 The return value is the font-object for the character at POS.
3922 *LIMIT is set to the position where that font can't be used.
3924 It is assured that the current buffer (or STRING) is multibyte. */
3927 font_range (pos
, limit
, w
, face
, string
)
3928 EMACS_INT pos
, *limit
;
3933 EMACS_INT pos_byte
, ignore
, start
, start_byte
;
3935 Lisp_Object font_object
= Qnil
;
3939 pos_byte
= CHAR_TO_BYTE (pos
);
3944 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3946 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3952 pos_byte
= string_char_to_byte (string
, pos
);
3955 start
= pos
, start_byte
= pos_byte
;
3956 while (pos
< *limit
)
3958 Lisp_Object category
;
3961 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3963 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3964 if (NILP (font_object
))
3966 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3967 if (NILP (font_object
))
3972 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3973 if (! EQ (category
, QCf
)
3974 && ! CHAR_VARIATION_SELECTOR_P (c
)
3975 && font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3977 Lisp_Object f
= font_for_char (face
, c
, pos
- 1, string
);
3978 EMACS_INT i
, i_byte
;
3986 i
= start
, i_byte
= start_byte
;
3991 FETCH_CHAR_ADVANCE_NO_CHECK (c
, i
, i_byte
);
3993 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, i
, i_byte
);
3994 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3995 if (! EQ (category
, QCf
)
3996 && ! CHAR_VARIATION_SELECTOR_P (c
)
3997 && font_encode_char (f
, c
) == FONT_INVALID_CODE
)
4013 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
4014 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
4015 Return nil otherwise.
4016 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
4017 which kind of font it is. It must be one of `font-spec', `font-entity',
4019 (object
, extra_type
)
4020 Lisp_Object object
, extra_type
;
4022 if (NILP (extra_type
))
4023 return (FONTP (object
) ? Qt
: Qnil
);
4024 if (EQ (extra_type
, Qfont_spec
))
4025 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
4026 if (EQ (extra_type
, Qfont_entity
))
4027 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
4028 if (EQ (extra_type
, Qfont_object
))
4029 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
4030 wrong_type_argument (intern ("font-extra-type"), extra_type
);
4033 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
4034 doc
: /* Return a newly created font-spec with arguments as properties.
4036 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
4037 valid font property name listed below:
4039 `:family', `:weight', `:slant', `:width'
4041 They are the same as face attributes of the same name. See
4042 `set-face-attribute'.
4046 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
4050 VALUE must be a string or a symbol specifying the additional
4051 typographic style information of a font, e.g. ``sans''.
4055 VALUE must be a string or a symbol specifying the charset registry and
4056 encoding of a font, e.g. ``iso8859-1''.
4060 VALUE must be a non-negative integer or a floating point number
4061 specifying the font size. It specifies the font size in pixels (if
4062 VALUE is an integer), or in points (if VALUE is a float).
4066 VALUE must be a string of XLFD-style or fontconfig-style font name.
4070 VALUE must be a symbol representing a script that the font must
4071 support. It may be a symbol representing a subgroup of a script
4072 listed in the variable `script-representative-chars'.
4076 VALUE must be a symbol of two-letter ISO-639 language names,
4081 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
4082 required OpenType features.
4084 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
4085 LANGSYS-TAG: OpenType language system tag symbol,
4086 or nil for the default language system.
4087 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
4088 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
4090 GSUB and GPOS may contain `nil' element. In such a case, the font
4091 must not have any of the remaining elements.
4093 For instance, if the VALUE is `(thai nil nil (mark))', the font must
4094 be an OpenType font, and whose GPOS table of `thai' script's default
4095 language system must contain `mark' feature.
4097 usage: (font-spec ARGS...) */)
4102 Lisp_Object spec
= font_make_spec ();
4105 for (i
= 0; i
< nargs
; i
+= 2)
4107 Lisp_Object key
= args
[i
], val
;
4111 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
4114 if (EQ (key
, QCname
))
4117 font_parse_name ((char *) SDATA (val
), spec
);
4118 font_put_extra (spec
, key
, val
);
4122 int idx
= get_font_prop_index (key
);
4126 val
= font_prop_validate (idx
, Qnil
, val
);
4127 if (idx
< FONT_EXTRA_INDEX
)
4128 ASET (spec
, idx
, val
);
4130 font_put_extra (spec
, key
, val
);
4133 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
4139 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
4140 doc
: /* Return a copy of FONT as a font-spec. */)
4144 Lisp_Object new_spec
, tail
, prev
, extra
;
4148 new_spec
= font_make_spec ();
4149 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
4150 ASET (new_spec
, i
, AREF (font
, i
));
4151 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
4152 /* We must remove :font-entity property. */
4153 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
4154 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
4157 extra
= XCDR (extra
);
4159 XSETCDR (prev
, XCDR (tail
));
4162 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
4166 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
4167 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
4168 Every specified properties in FROM override the corresponding
4169 properties in TO. */)
4171 Lisp_Object from
, to
;
4173 Lisp_Object extra
, tail
;
4178 to
= Fcopy_font_spec (to
);
4179 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
4180 ASET (to
, i
, AREF (from
, i
));
4181 extra
= AREF (to
, FONT_EXTRA_INDEX
);
4182 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
4183 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
4185 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
4188 XSETCDR (slot
, XCDR (XCAR (tail
)));
4190 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
4192 ASET (to
, FONT_EXTRA_INDEX
, extra
);
4196 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
4197 doc
: /* Return the value of FONT's property KEY.
4198 FONT is a font-spec, a font-entity, or a font-object.
4199 KEY must be one of these symbols:
4200 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4201 :size, :name, :script
4202 See the documentation of `font-spec' for their meanings.
4203 If FONT is a font-entity or font-object, the value of :script may be
4204 a list of scripts that are supported by the font. */)
4206 Lisp_Object font
, key
;
4213 idx
= get_font_prop_index (key
);
4214 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4215 return font_style_symbolic (font
, idx
, 0);
4216 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4217 return AREF (font
, idx
);
4218 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
4221 #ifdef HAVE_WINDOW_SYSTEM
4223 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4224 doc
: /* Return a plist of face attributes generated by FONT.
4225 FONT is a font name, a font-spec, a font-entity, or a font-object.
4226 The return value is a list of the form
4228 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4230 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4231 compatible with `set-face-attribute'. Some of these key-attribute pairs
4232 may be omitted from the list if they are not specified by FONT.
4234 The optional argument FRAME specifies the frame that the face attributes
4235 are to be displayed on. If omitted, the selected frame is used. */)
4237 Lisp_Object font
, frame
;
4240 Lisp_Object plist
[10];
4245 frame
= selected_frame
;
4246 CHECK_LIVE_FRAME (frame
);
4251 int fontset
= fs_query_fontset (font
, 0);
4252 Lisp_Object name
= font
;
4254 font
= fontset_ascii (fontset
);
4255 font
= font_spec_from_name (name
);
4257 signal_error ("Invalid font name", name
);
4259 else if (! FONTP (font
))
4260 signal_error ("Invalid font object", font
);
4262 val
= AREF (font
, FONT_FAMILY_INDEX
);
4265 plist
[n
++] = QCfamily
;
4266 plist
[n
++] = SYMBOL_NAME (val
);
4269 val
= AREF (font
, FONT_SIZE_INDEX
);
4272 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4273 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4274 plist
[n
++] = QCheight
;
4275 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4277 else if (FLOATP (val
))
4279 plist
[n
++] = QCheight
;
4280 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4283 val
= FONT_WEIGHT_FOR_FACE (font
);
4286 plist
[n
++] = QCweight
;
4290 val
= FONT_SLANT_FOR_FACE (font
);
4293 plist
[n
++] = QCslant
;
4297 val
= FONT_WIDTH_FOR_FACE (font
);
4300 plist
[n
++] = QCwidth
;
4304 return Flist (n
, plist
);
4309 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4310 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
4311 (font_spec
, prop
, val
)
4312 Lisp_Object font_spec
, prop
, val
;
4316 CHECK_FONT_SPEC (font_spec
);
4317 idx
= get_font_prop_index (prop
);
4318 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4319 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
4321 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
4325 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4326 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4327 Optional 2nd argument FRAME specifies the target frame.
4328 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4329 Optional 4th argument PREFER, if non-nil, is a font-spec to
4330 control the order of the returned list. Fonts are sorted by
4331 how close they are to PREFER. */)
4332 (font_spec
, frame
, num
, prefer
)
4333 Lisp_Object font_spec
, frame
, num
, prefer
;
4335 Lisp_Object vec
, list
;
4339 frame
= selected_frame
;
4340 CHECK_LIVE_FRAME (frame
);
4341 CHECK_FONT_SPEC (font_spec
);
4349 if (! NILP (prefer
))
4350 CHECK_FONT_SPEC (prefer
);
4352 list
= font_list_entities (frame
, font_spec
);
4355 if (NILP (XCDR (list
))
4356 && ASIZE (XCAR (list
)) == 1)
4357 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4359 if (! NILP (prefer
))
4360 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4362 vec
= font_vconcat_entity_vectors (list
);
4363 if (n
== 0 || n
>= ASIZE (vec
))
4365 Lisp_Object args
[2];
4369 list
= Fappend (2, args
);
4373 for (list
= Qnil
, n
--; n
>= 0; n
--)
4374 list
= Fcons (AREF (vec
, n
), list
);
4379 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4380 doc
: /* List available font families on the current frame.
4381 Optional argument FRAME, if non-nil, specifies the target frame. */)
4386 struct font_driver_list
*driver_list
;
4390 frame
= selected_frame
;
4391 CHECK_LIVE_FRAME (frame
);
4394 for (driver_list
= f
->font_driver_list
; driver_list
;
4395 driver_list
= driver_list
->next
)
4396 if (driver_list
->driver
->list_family
)
4398 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4399 Lisp_Object tail
= list
;
4401 for (; CONSP (val
); val
= XCDR (val
))
4402 if (NILP (Fmemq (XCAR (val
), tail
))
4403 && SYMBOLP (XCAR (val
)))
4404 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4409 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4410 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4411 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4413 Lisp_Object font_spec
, frame
;
4415 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4422 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4423 doc
: /* Return XLFD name of FONT.
4424 FONT is a font-spec, font-entity, or font-object.
4425 If the name is too long for XLFD (maximum 255 chars), return nil.
4426 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4427 the consecutive wildcards are folded to one. */)
4428 (font
, fold_wildcards
)
4429 Lisp_Object font
, fold_wildcards
;
4436 if (FONT_OBJECT_P (font
))
4438 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4440 if (STRINGP (font_name
)
4441 && SDATA (font_name
)[0] == '-')
4443 if (NILP (fold_wildcards
))
4445 strcpy (name
, (char *) SDATA (font_name
));
4448 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4450 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4453 if (! NILP (fold_wildcards
))
4455 char *p0
= name
, *p1
;
4457 while ((p1
= strstr (p0
, "-*-*")))
4459 strcpy (p1
, p1
+ 2);
4464 return build_string (name
);
4467 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4468 doc
: /* Clear font cache. */)
4471 Lisp_Object list
, frame
;
4473 FOR_EACH_FRAME (list
, frame
)
4475 FRAME_PTR f
= XFRAME (frame
);
4476 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4478 for (; driver_list
; driver_list
= driver_list
->next
)
4479 if (driver_list
->on
)
4481 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4486 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4488 font_assert (! NILP (val
));
4489 val
= XCDR (XCAR (val
));
4490 if (XINT (XCAR (val
)) == 0)
4492 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4493 XSETCDR (cache
, XCDR (val
));
4503 font_fill_lglyph_metrics (glyph
, font_object
)
4504 Lisp_Object glyph
, font_object
;
4506 struct font
*font
= XFONT_OBJECT (font_object
);
4508 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4509 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4510 struct font_metrics metrics
;
4512 LGLYPH_SET_CODE (glyph
, ecode
);
4514 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4515 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4516 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4517 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4518 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4519 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4523 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4524 doc
: /* Shape the glyph-string GSTRING.
4525 Shaping means substituting glyphs and/or adjusting positions of glyphs
4526 to get the correct visual image of character sequences set in the
4527 header of the glyph-string.
4529 If the shaping was successful, the value is GSTRING itself or a newly
4530 created glyph-string. Otherwise, the value is nil. */)
4532 Lisp_Object gstring
;
4535 Lisp_Object font_object
, n
, glyph
;
4538 if (! composition_gstring_p (gstring
))
4539 signal_error ("Invalid glyph-string: ", gstring
);
4540 if (! NILP (LGSTRING_ID (gstring
)))
4542 font_object
= LGSTRING_FONT (gstring
);
4543 CHECK_FONT_OBJECT (font_object
);
4544 font
= XFONT_OBJECT (font_object
);
4545 if (! font
->driver
->shape
)
4548 /* Try at most three times with larger gstring each time. */
4549 for (i
= 0; i
< 3; i
++)
4551 n
= font
->driver
->shape (gstring
);
4554 gstring
= larger_vector (gstring
,
4555 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4558 if (i
== 3 || XINT (n
) == 0)
4561 glyph
= LGSTRING_GLYPH (gstring
, 0);
4562 from
= LGLYPH_FROM (glyph
);
4563 to
= LGLYPH_TO (glyph
);
4564 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4566 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4570 if (NILP (LGLYPH_ADJUSTMENT (this)))
4575 glyph
= LGSTRING_GLYPH (gstring
, j
);
4576 LGLYPH_SET_FROM (glyph
, from
);
4577 LGLYPH_SET_TO (glyph
, to
);
4579 from
= LGLYPH_FROM (this);
4580 to
= LGLYPH_TO (this);
4585 if (from
> LGLYPH_FROM (this))
4586 from
= LGLYPH_FROM (this);
4587 if (to
< LGLYPH_TO (this))
4588 to
= LGLYPH_TO (this);
4594 glyph
= LGSTRING_GLYPH (gstring
, j
);
4595 LGLYPH_SET_FROM (glyph
, from
);
4596 LGLYPH_SET_TO (glyph
, to
);
4598 return composition_gstring_put_cache (gstring
, XINT (n
));
4601 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4603 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4604 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4606 VARIATION-SELECTOR is a chracter code of variation selection
4607 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4608 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4609 (font_object
, character
)
4610 Lisp_Object font_object
, character
;
4612 unsigned variations
[256];
4617 CHECK_FONT_OBJECT (font_object
);
4618 CHECK_CHARACTER (character
);
4619 font
= XFONT_OBJECT (font_object
);
4620 if (! font
->driver
->get_variation_glyphs
)
4622 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4626 for (i
= 0; i
< 255; i
++)
4630 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4631 /* Stops GCC whining about limited range of data type. */
4632 EMACS_INT var
= variations
[i
];
4634 if (var
> MOST_POSITIVE_FIXNUM
)
4635 code
= Fcons (make_number ((variations
[i
]) >> 16),
4636 make_number ((variations
[i
]) & 0xFFFF));
4638 code
= make_number (variations
[i
]);
4639 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4646 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4647 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4648 OTF-FEATURES specifies which features to apply in this format:
4649 (SCRIPT LANGSYS GSUB GPOS)
4651 SCRIPT is a symbol specifying a script tag of OpenType,
4652 LANGSYS is a symbol specifying a langsys tag of OpenType,
4653 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4655 If LANGYS is nil, the default langsys is selected.
4657 The features are applied in the order they appear in the list. The
4658 symbol `*' means to apply all available features not present in this
4659 list, and the remaining features are ignored. For instance, (vatu
4660 pstf * haln) is to apply vatu and pstf in this order, then to apply
4661 all available features other than vatu, pstf, and haln.
4663 The features are applied to the glyphs in the range FROM and TO of
4664 the glyph-string GSTRING-IN.
4666 If some feature is actually applicable, the resulting glyphs are
4667 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4668 this case, the value is the number of produced glyphs.
4670 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4673 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4674 produced in GSTRING-OUT, and the value is nil.
4676 See the documentation of `font-make-gstring' for the format of
4678 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4679 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4681 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4686 check_otf_features (otf_features
);
4687 CHECK_FONT_OBJECT (font_object
);
4688 font
= XFONT_OBJECT (font_object
);
4689 if (! font
->driver
->otf_drive
)
4690 error ("Font backend %s can't drive OpenType GSUB table",
4691 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4692 CHECK_CONS (otf_features
);
4693 CHECK_SYMBOL (XCAR (otf_features
));
4694 val
= XCDR (otf_features
);
4695 CHECK_SYMBOL (XCAR (val
));
4696 val
= XCDR (otf_features
);
4699 len
= check_gstring (gstring_in
);
4700 CHECK_VECTOR (gstring_out
);
4701 CHECK_NATNUM (from
);
4703 CHECK_NATNUM (index
);
4705 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4706 args_out_of_range_3 (from
, to
, make_number (len
));
4707 if (XINT (index
) >= ASIZE (gstring_out
))
4708 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4709 num
= font
->driver
->otf_drive (font
, otf_features
,
4710 gstring_in
, XINT (from
), XINT (to
),
4711 gstring_out
, XINT (index
), 0);
4714 return make_number (num
);
4717 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4719 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4720 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4722 (SCRIPT LANGSYS FEATURE ...)
4723 See the documentation of `font-drive-otf' for more detail.
4725 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4726 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4727 character code corresponding to the glyph or nil if there's no
4728 corresponding character. */)
4729 (font_object
, character
, otf_features
)
4730 Lisp_Object font_object
, character
, otf_features
;
4733 Lisp_Object gstring_in
, gstring_out
, g
;
4734 Lisp_Object alternates
;
4737 CHECK_FONT_GET_OBJECT (font_object
, font
);
4738 if (! font
->driver
->otf_drive
)
4739 error ("Font backend %s can't drive OpenType GSUB table",
4740 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4741 CHECK_CHARACTER (character
);
4742 CHECK_CONS (otf_features
);
4744 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4745 g
= LGSTRING_GLYPH (gstring_in
, 0);
4746 LGLYPH_SET_CHAR (g
, XINT (character
));
4747 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4748 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4749 gstring_out
, 0, 1)) < 0)
4750 gstring_out
= Ffont_make_gstring (font_object
,
4751 make_number (ASIZE (gstring_out
) * 2));
4753 for (i
= 0; i
< num
; i
++)
4755 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4756 int c
= LGLYPH_CHAR (g
);
4757 unsigned code
= LGLYPH_CODE (g
);
4759 alternates
= Fcons (Fcons (make_number (code
),
4760 c
> 0 ? make_number (c
) : Qnil
),
4763 return Fnreverse (alternates
);
4769 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4770 doc
: /* Open FONT-ENTITY. */)
4771 (font_entity
, size
, frame
)
4772 Lisp_Object font_entity
;
4778 CHECK_FONT_ENTITY (font_entity
);
4780 frame
= selected_frame
;
4781 CHECK_LIVE_FRAME (frame
);
4784 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4787 CHECK_NUMBER_OR_FLOAT (size
);
4789 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4791 isize
= XINT (size
);
4795 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4798 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4799 doc
: /* Close FONT-OBJECT. */)
4800 (font_object
, frame
)
4801 Lisp_Object font_object
, frame
;
4803 CHECK_FONT_OBJECT (font_object
);
4805 frame
= selected_frame
;
4806 CHECK_LIVE_FRAME (frame
);
4807 font_close_object (XFRAME (frame
), font_object
);
4811 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4812 doc
: /* Return information about FONT-OBJECT.
4813 The value is a vector:
4814 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4817 NAME is a string of the font name (or nil if the font backend doesn't
4820 FILENAME is a string of the font file (or nil if the font backend
4821 doesn't provide a file name).
4823 PIXEL-SIZE is a pixel size by which the font is opened.
4825 SIZE is a maximum advance width of the font in pixels.
4827 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4830 CAPABILITY is a list whose first element is a symbol representing the
4831 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4832 remaining elements describe the details of the font capability.
4834 If the font is OpenType font, the form of the list is
4835 \(opentype GSUB GPOS)
4836 where GSUB shows which "GSUB" features the font supports, and GPOS
4837 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4838 lists of the format:
4839 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4841 If the font is not OpenType font, currently the length of the form is
4844 SCRIPT is a symbol representing OpenType script tag.
4846 LANGSYS is a symbol representing OpenType langsys tag, or nil
4847 representing the default langsys.
4849 FEATURE is a symbol representing OpenType feature tag.
4851 If the font is not OpenType font, CAPABILITY is nil. */)
4853 Lisp_Object font_object
;
4858 CHECK_FONT_GET_OBJECT (font_object
, font
);
4860 val
= Fmake_vector (make_number (9), Qnil
);
4861 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4862 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4863 ASET (val
, 2, make_number (font
->pixel_size
));
4864 ASET (val
, 3, make_number (font
->max_width
));
4865 ASET (val
, 4, make_number (font
->ascent
));
4866 ASET (val
, 5, make_number (font
->descent
));
4867 ASET (val
, 6, make_number (font
->space_width
));
4868 ASET (val
, 7, make_number (font
->average_width
));
4869 if (font
->driver
->otf_capability
)
4870 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4874 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4875 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4876 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4877 (font_object
, string
)
4878 Lisp_Object font_object
, string
;
4884 CHECK_FONT_GET_OBJECT (font_object
, font
);
4885 CHECK_STRING (string
);
4886 len
= SCHARS (string
);
4887 vec
= Fmake_vector (make_number (len
), Qnil
);
4888 for (i
= 0; i
< len
; i
++)
4890 Lisp_Object ch
= Faref (string
, make_number (i
));
4895 struct font_metrics metrics
;
4897 cod
= code
= font
->driver
->encode_char (font
, c
);
4898 if (code
== FONT_INVALID_CODE
)
4900 val
= Fmake_vector (make_number (6), Qnil
);
4901 if (cod
<= MOST_POSITIVE_FIXNUM
)
4902 ASET (val
, 0, make_number (code
));
4904 ASET (val
, 0, Fcons (make_number (code
>> 16),
4905 make_number (code
& 0xFFFF)));
4906 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4907 ASET (val
, 1, make_number (metrics
.lbearing
));
4908 ASET (val
, 2, make_number (metrics
.rbearing
));
4909 ASET (val
, 3, make_number (metrics
.width
));
4910 ASET (val
, 4, make_number (metrics
.ascent
));
4911 ASET (val
, 5, make_number (metrics
.descent
));
4917 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4918 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4919 FONT is a font-spec, font-entity, or font-object. */)
4921 Lisp_Object spec
, font
;
4923 CHECK_FONT_SPEC (spec
);
4926 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4929 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4930 doc
: /* Return a font-object for displaying a character at POSITION.
4931 Optional second arg WINDOW, if non-nil, is a window displaying
4932 the current buffer. It defaults to the currently selected window. */)
4933 (position
, window
, string
)
4934 Lisp_Object position
, window
, string
;
4941 CHECK_NUMBER_COERCE_MARKER (position
);
4942 pos
= XINT (position
);
4943 if (pos
< BEGV
|| pos
>= ZV
)
4944 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4948 CHECK_NUMBER (position
);
4949 CHECK_STRING (string
);
4950 pos
= XINT (position
);
4951 if (pos
< 0 || pos
>= SCHARS (string
))
4952 args_out_of_range (string
, position
);
4955 window
= selected_window
;
4956 CHECK_LIVE_WINDOW (window
);
4957 w
= XWINDOW (window
);
4959 return font_at (-1, pos
, NULL
, w
, string
);
4963 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4964 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4965 The value is a number of glyphs drawn.
4966 Type C-l to recover what previously shown. */)
4967 (font_object
, string
)
4968 Lisp_Object font_object
, string
;
4970 Lisp_Object frame
= selected_frame
;
4971 FRAME_PTR f
= XFRAME (frame
);
4977 CHECK_FONT_GET_OBJECT (font_object
, font
);
4978 CHECK_STRING (string
);
4979 len
= SCHARS (string
);
4980 code
= alloca (sizeof (unsigned) * len
);
4981 for (i
= 0; i
< len
; i
++)
4983 Lisp_Object ch
= Faref (string
, make_number (i
));
4987 code
[i
] = font
->driver
->encode_char (font
, c
);
4988 if (code
[i
] == FONT_INVALID_CODE
)
4991 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4993 if (font
->driver
->prepare_face
)
4994 font
->driver
->prepare_face (f
, face
);
4995 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4996 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4997 if (font
->driver
->done_face
)
4998 font
->driver
->done_face (f
, face
);
5000 return make_number (len
);
5004 #endif /* FONT_DEBUG */
5006 #ifdef HAVE_WINDOW_SYSTEM
5008 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
5009 doc
: /* Return information about a font named NAME on frame FRAME.
5010 If FRAME is omitted or nil, use the selected frame.
5011 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
5012 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
5014 OPENED-NAME is the name used for opening the font,
5015 FULL-NAME is the full name of the font,
5016 SIZE is the pixelsize of the font,
5017 HEIGHT is the pixel-height of the font (i.e ascent + descent),
5018 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
5019 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
5020 how to compose characters.
5021 If the named font is not yet loaded, return nil. */)
5023 Lisp_Object name
, frame
;
5028 Lisp_Object font_object
;
5030 (*check_window_system_func
) ();
5033 CHECK_STRING (name
);
5035 frame
= selected_frame
;
5036 CHECK_LIVE_FRAME (frame
);
5041 int fontset
= fs_query_fontset (name
, 0);
5044 name
= fontset_ascii (fontset
);
5045 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
5047 else if (FONT_OBJECT_P (name
))
5049 else if (FONT_ENTITY_P (name
))
5050 font_object
= font_open_entity (f
, name
, 0);
5053 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5054 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
5056 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
5058 if (NILP (font_object
))
5060 font
= XFONT_OBJECT (font_object
);
5062 info
= Fmake_vector (make_number (7), Qnil
);
5063 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
5064 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
5065 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
5066 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
5067 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
5068 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
5069 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
5072 /* As font_object is still in FONT_OBJLIST of the entity, we can't
5073 close it now. Perhaps, we should manage font-objects
5074 by `reference-count'. */
5075 font_close_object (f
, font_object
);
5082 #define BUILD_STYLE_TABLE(TBL) \
5083 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
5086 build_style_table (entry
, nelement
)
5087 struct table_entry
*entry
;
5091 Lisp_Object table
, elt
;
5093 table
= Fmake_vector (make_number (nelement
), Qnil
);
5094 for (i
= 0; i
< nelement
; i
++)
5096 for (j
= 0; entry
[i
].names
[j
]; j
++);
5097 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
5098 ASET (elt
, 0, make_number (entry
[i
].numeric
));
5099 for (j
= 0; entry
[i
].names
[j
]; j
++)
5100 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
5101 ASET (table
, i
, elt
);
5106 Lisp_Object Vfont_log
;
5108 /* The deferred font-log data of the form [ACTION ARG RESULT].
5109 If ACTION is not nil, that is added to the log when font_add_log is
5110 called next time. At that time, ACTION is set back to nil. */
5111 static Lisp_Object Vfont_log_deferred
;
5113 /* Prepend the font-related logging data in Vfont_log if it is not
5114 `t'. ACTION describes a kind of font-related action (e.g. listing,
5115 opening), ARG is the argument for the action, and RESULT is the
5116 result of the action. */
5118 font_add_log (action
, arg
, result
)
5120 Lisp_Object arg
, result
;
5122 Lisp_Object tail
, val
;
5125 if (EQ (Vfont_log
, Qt
))
5127 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5129 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
5131 ASET (Vfont_log_deferred
, 0, Qnil
);
5132 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5133 AREF (Vfont_log_deferred
, 2));
5138 Lisp_Object tail
, elt
;
5139 Lisp_Object equalstr
= build_string ("=");
5141 val
= Ffont_xlfd_name (arg
, Qt
);
5142 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5146 if (EQ (XCAR (elt
), QCscript
)
5147 && SYMBOLP (XCDR (elt
)))
5148 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5149 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5150 else if (EQ (XCAR (elt
), QClang
)
5151 && SYMBOLP (XCDR (elt
)))
5152 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5153 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5154 else if (EQ (XCAR (elt
), QCotf
)
5155 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5156 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5158 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5164 && VECTORP (XCAR (result
))
5165 && ASIZE (XCAR (result
)) > 0
5166 && FONTP (AREF (XCAR (result
), 0)))
5167 result
= font_vconcat_entity_vectors (result
);
5170 val
= Ffont_xlfd_name (result
, Qt
);
5171 if (! FONT_SPEC_P (result
))
5172 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5173 build_string (":"), val
);
5176 else if (CONSP (result
))
5178 result
= Fcopy_sequence (result
);
5179 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5183 val
= Ffont_xlfd_name (val
, Qt
);
5184 XSETCAR (tail
, val
);
5187 else if (VECTORP (result
))
5189 result
= Fcopy_sequence (result
);
5190 for (i
= 0; i
< ASIZE (result
); i
++)
5192 val
= AREF (result
, i
);
5194 val
= Ffont_xlfd_name (val
, Qt
);
5195 ASET (result
, i
, val
);
5198 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5201 /* Record a font-related logging data to be added to Vfont_log when
5202 font_add_log is called next time. ACTION, ARG, RESULT are the same
5206 font_deferred_log (action
, arg
, result
)
5208 Lisp_Object arg
, result
;
5210 if (EQ (Vfont_log
, Qt
))
5212 ASET (Vfont_log_deferred
, 0, build_string (action
));
5213 ASET (Vfont_log_deferred
, 1, arg
);
5214 ASET (Vfont_log_deferred
, 2, result
);
5217 extern void syms_of_ftfont
P_ (());
5218 extern void syms_of_xfont
P_ (());
5219 extern void syms_of_xftfont
P_ (());
5220 extern void syms_of_ftxfont
P_ (());
5221 extern void syms_of_bdffont
P_ (());
5222 extern void syms_of_w32font
P_ (());
5223 extern void syms_of_atmfont
P_ (());
5224 extern void syms_of_nsfont
P_ (());
5229 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5230 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5231 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5232 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5233 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5234 /* Note that the other elements in sort_shift_bits are not used. */
5236 staticpro (&font_charset_alist
);
5237 font_charset_alist
= Qnil
;
5239 DEFSYM (Qopentype
, "opentype");
5241 DEFSYM (Qascii_0
, "ascii-0");
5242 DEFSYM (Qiso8859_1
, "iso8859-1");
5243 DEFSYM (Qiso10646_1
, "iso10646-1");
5244 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5245 DEFSYM (Qunicode_sip
, "unicode-sip");
5249 DEFSYM (QCotf
, ":otf");
5250 DEFSYM (QClang
, ":lang");
5251 DEFSYM (QCscript
, ":script");
5252 DEFSYM (QCantialias
, ":antialias");
5254 DEFSYM (QCfoundry
, ":foundry");
5255 DEFSYM (QCadstyle
, ":adstyle");
5256 DEFSYM (QCregistry
, ":registry");
5257 DEFSYM (QCspacing
, ":spacing");
5258 DEFSYM (QCdpi
, ":dpi");
5259 DEFSYM (QCscalable
, ":scalable");
5260 DEFSYM (QCavgwidth
, ":avgwidth");
5261 DEFSYM (QCfont_entity
, ":font-entity");
5262 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5272 staticpro (&null_vector
);
5273 null_vector
= Fmake_vector (make_number (0), Qnil
);
5275 staticpro (&scratch_font_spec
);
5276 scratch_font_spec
= Ffont_spec (0, NULL
);
5277 staticpro (&scratch_font_prefer
);
5278 scratch_font_prefer
= Ffont_spec (0, NULL
);
5280 staticpro (&Vfont_log_deferred
);
5281 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5285 staticpro (&otf_list
);
5287 #endif /* HAVE_LIBOTF */
5291 defsubr (&Sfont_spec
);
5292 defsubr (&Sfont_get
);
5293 #ifdef HAVE_WINDOW_SYSTEM
5294 defsubr (&Sfont_face_attributes
);
5296 defsubr (&Sfont_put
);
5297 defsubr (&Slist_fonts
);
5298 defsubr (&Sfont_family_list
);
5299 defsubr (&Sfind_font
);
5300 defsubr (&Sfont_xlfd_name
);
5301 defsubr (&Sclear_font_cache
);
5302 defsubr (&Sfont_shape_gstring
);
5303 defsubr (&Sfont_variation_glyphs
);
5305 defsubr (&Sfont_drive_otf
);
5306 defsubr (&Sfont_otf_alternates
);
5310 defsubr (&Sopen_font
);
5311 defsubr (&Sclose_font
);
5312 defsubr (&Squery_font
);
5313 defsubr (&Sget_font_glyphs
);
5314 defsubr (&Sfont_match_p
);
5315 defsubr (&Sfont_at
);
5317 defsubr (&Sdraw_string
);
5319 #endif /* FONT_DEBUG */
5320 #ifdef HAVE_WINDOW_SYSTEM
5321 defsubr (&Sfont_info
);
5324 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5326 Alist of fontname patterns vs the corresponding encoding and repertory info.
5327 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5328 where ENCODING is a charset or a char-table,
5329 and REPERTORY is a charset, a char-table, or nil.
5331 If ENCODING and REPERTORY are the same, the element can have the form
5332 \(REGEXP . ENCODING).
5334 ENCODING is for converting a character to a glyph code of the font.
5335 If ENCODING is a charset, encoding a character by the charset gives
5336 the corresponding glyph code. If ENCODING is a char-table, looking up
5337 the table by a character gives the corresponding glyph code.
5339 REPERTORY specifies a repertory of characters supported by the font.
5340 If REPERTORY is a charset, all characters beloging to the charset are
5341 supported. If REPERTORY is a char-table, all characters who have a
5342 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5343 gets the repertory information by an opened font and ENCODING. */);
5344 Vfont_encoding_alist
= Qnil
;
5346 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5347 doc
: /* Vector of valid font weight values.
5348 Each element has the form:
5349 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5350 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5351 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5353 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5354 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5355 See `font-weight-table' for the format of the vector. */);
5356 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5358 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5359 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5360 See `font-weight-table' for the format of the vector. */);
5361 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5363 staticpro (&font_style_table
);
5364 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5365 ASET (font_style_table
, 0, Vfont_weight_table
);
5366 ASET (font_style_table
, 1, Vfont_slant_table
);
5367 ASET (font_style_table
, 2, Vfont_width_table
);
5369 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5370 *Logging list of font related actions and results.
5371 The value t means to suppress the logging.
5372 The initial value is set to nil if the environment variable
5373 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5376 #ifdef HAVE_WINDOW_SYSTEM
5377 #ifdef HAVE_FREETYPE
5379 #ifdef HAVE_X_WINDOWS
5384 #endif /* HAVE_XFT */
5385 #endif /* HAVE_X_WINDOWS */
5386 #else /* not HAVE_FREETYPE */
5387 #ifdef HAVE_X_WINDOWS
5389 #endif /* HAVE_X_WINDOWS */
5390 #endif /* not HAVE_FREETYPE */
5393 #endif /* HAVE_BDFFONT */
5396 #endif /* WINDOWSNT */
5399 #endif /* HAVE_NS */
5400 #endif /* HAVE_WINDOW_SYSTEM */
5406 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
5409 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5410 (do not change this comment) */