1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
3 Copyright (C) 2006, 2007, 2008, 2009, 2010
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 QCuser_spec
;
148 Lisp_Object Vfont_encoding_alist
;
150 /* Alist of font registry symbol and the corresponding charsets
151 information. The information is retrieved from
152 Vfont_encoding_alist on demand.
154 Eash element has the form:
155 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
159 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
160 encodes a character code to a glyph code of a font, and
161 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
162 character is supported by a font.
164 The latter form means that the information for REGISTRY couldn't be
166 static Lisp_Object font_charset_alist
;
168 /* List of all font drivers. Each font-backend (XXXfont.c) calls
169 register_font_driver in syms_of_XXXfont to register its font-driver
171 static struct font_driver_list
*font_driver_list
;
175 /* Creaters of font-related Lisp object. */
178 font_make_spec (void)
180 Lisp_Object font_spec
;
181 struct font_spec
*spec
182 = ((struct font_spec
*)
183 allocate_pseudovector (VECSIZE (struct font_spec
),
184 FONT_SPEC_MAX
, PVEC_FONT
));
185 XSETFONT (font_spec
, spec
);
190 font_make_entity (void)
192 Lisp_Object font_entity
;
193 struct font_entity
*entity
194 = ((struct font_entity
*)
195 allocate_pseudovector (VECSIZE (struct font_entity
),
196 FONT_ENTITY_MAX
, PVEC_FONT
));
197 XSETFONT (font_entity
, entity
);
201 /* Create a font-object whose structure size is SIZE. If ENTITY is
202 not nil, copy properties from ENTITY to the font-object. If
203 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
205 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
207 Lisp_Object font_object
;
209 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
212 XSETFONT (font_object
, font
);
216 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
217 font
->props
[i
] = AREF (entity
, i
);
218 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
219 font
->props
[FONT_EXTRA_INDEX
]
220 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
223 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
229 static int font_pixel_size (FRAME_PTR f
, Lisp_Object
);
230 static Lisp_Object
font_open_entity (FRAME_PTR
, Lisp_Object
, int);
231 static Lisp_Object
font_matching_entity (FRAME_PTR
, Lisp_Object
*,
234 /* Number of registered font drivers. */
235 static int num_font_drivers
;
238 /* Return a Lispy value of a font property value at STR and LEN bytes.
239 If STR is "*", it returns nil.
240 If FORCE_SYMBOL is zero and all characters in STR are digits, it
241 returns an integer. Otherwise, it returns a symbol interned from
245 font_intern_prop (char *str
, int len
, int force_symbol
)
252 if (len
== 1 && *str
== '*')
254 if (!force_symbol
&& len
>=1 && isdigit (*str
))
256 for (i
= 1; i
< len
; i
++)
257 if (! isdigit (str
[i
]))
260 return make_number (atoi (str
));
263 /* The following code is copied from the function intern (in
264 lread.c), and modified to suite our purpose. */
266 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
267 obarray
= check_obarray (obarray
);
268 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
269 if (len
== nchars
|| len
!= nbytes
)
270 /* CONTENTS contains no multibyte sequences or contains an invalid
271 multibyte sequence. We'll make a unibyte string. */
272 tem
= oblookup (obarray
, str
, len
, len
);
274 tem
= oblookup (obarray
, str
, nchars
, len
);
277 if (len
== nchars
|| len
!= nbytes
)
278 tem
= make_unibyte_string (str
, len
);
280 tem
= make_multibyte_string (str
, nchars
, len
);
281 return Fintern (tem
, obarray
);
284 /* Return a pixel size of font-spec SPEC on frame F. */
287 font_pixel_size (FRAME_PTR f
, Lisp_Object spec
)
289 #ifdef HAVE_WINDOW_SYSTEM
290 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
299 font_assert (FLOATP (size
));
300 point_size
= XFLOAT_DATA (size
);
301 val
= AREF (spec
, FONT_DPI_INDEX
);
306 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
314 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
315 font vector. If VAL is not valid (i.e. not registered in
316 font_style_table), return -1 if NOERROR is zero, and return a
317 proper index if NOERROR is nonzero. In that case, register VAL in
318 font_style_table if VAL is a symbol, and return a closest index if
319 VAL is an integer. */
322 font_style_to_value (enum font_property_index prop
, Lisp_Object val
, int noerror
)
324 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
325 int len
= ASIZE (table
);
331 Lisp_Object args
[2], elt
;
333 /* At first try exact match. */
334 for (i
= 0; i
< len
; i
++)
335 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
336 if (EQ (val
, AREF (AREF (table
, i
), j
)))
337 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
338 | (i
<< 4) | (j
- 1));
339 /* Try also with case-folding match. */
340 s
= SDATA (SYMBOL_NAME (val
));
341 for (i
= 0; i
< len
; i
++)
342 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
344 elt
= AREF (AREF (table
, i
), j
);
345 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
346 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
347 | (i
<< 4) | (j
- 1));
353 elt
= Fmake_vector (make_number (2), make_number (100));
356 args
[1] = Fmake_vector (make_number (1), elt
);
357 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
358 return (100 << 8) | (i
<< 4);
363 int numeric
= XINT (val
);
365 for (i
= 0, last_n
= -1; i
< len
; i
++)
367 int n
= XINT (AREF (AREF (table
, i
), 0));
370 return (n
<< 8) | (i
<< 4);
375 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
376 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
382 return ((last_n
<< 8) | ((i
- 1) << 4));
387 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
, int for_face
)
389 Lisp_Object val
= AREF (font
, prop
);
390 Lisp_Object table
, elt
;
395 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
396 i
= XINT (val
) & 0xFF;
397 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
398 elt
= AREF (table
, ((i
>> 4) & 0xF));
399 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
400 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
403 extern Lisp_Object Vface_alternative_font_family_alist
;
405 extern Lisp_Object
find_font_encoding (Lisp_Object
);
408 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
409 FONTNAME. ENCODING is a charset symbol that specifies the encoding
410 of the font. REPERTORY is a charset symbol or nil. */
413 find_font_encoding (Lisp_Object fontname
)
415 Lisp_Object tail
, elt
;
417 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
421 && STRINGP (XCAR (elt
))
422 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
423 && (SYMBOLP (XCDR (elt
))
424 ? CHARSETP (XCDR (elt
))
425 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
431 /* Return encoding charset and repertory charset for REGISTRY in
432 ENCODING and REPERTORY correspondingly. If correct information for
433 REGISTRY is available, return 0. Otherwise return -1. */
436 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
439 int encoding_id
, repertory_id
;
441 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
447 encoding_id
= XINT (XCAR (val
));
448 repertory_id
= XINT (XCDR (val
));
452 val
= find_font_encoding (SYMBOL_NAME (registry
));
453 if (SYMBOLP (val
) && CHARSETP (val
))
455 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
457 else if (CONSP (val
))
459 if (! CHARSETP (XCAR (val
)))
461 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
462 if (NILP (XCDR (val
)))
466 if (! CHARSETP (XCDR (val
)))
468 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
473 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
475 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
479 *encoding
= CHARSET_FROM_ID (encoding_id
);
481 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
486 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
491 /* Font property value validaters. See the comment of
492 font_property_table for the meaning of the arguments. */
494 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
495 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
496 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
497 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
498 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
499 static int get_font_prop_index (Lisp_Object
);
502 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
505 val
= Fintern (val
, Qnil
);
508 else if (EQ (prop
, QCregistry
))
509 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
515 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
517 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
518 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
525 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
529 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
531 if ((n
& 0xF) + 1 >= ASIZE (elt
))
533 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
537 else if (SYMBOLP (val
))
539 int n
= font_style_to_value (prop
, val
, 0);
541 val
= n
>= 0 ? make_number (n
) : Qerror
;
549 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
551 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
556 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
558 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
560 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
562 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
564 if (spacing
== 'c' || spacing
== 'C')
565 return make_number (FONT_SPACING_CHARCELL
);
566 if (spacing
== 'm' || spacing
== 'M')
567 return make_number (FONT_SPACING_MONO
);
568 if (spacing
== 'p' || spacing
== 'P')
569 return make_number (FONT_SPACING_PROPORTIONAL
);
570 if (spacing
== 'd' || spacing
== 'D')
571 return make_number (FONT_SPACING_DUAL
);
577 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
579 Lisp_Object tail
, tmp
;
582 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
583 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
584 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
587 if (! SYMBOLP (XCAR (val
)))
592 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
594 for (i
= 0; i
< 2; i
++)
601 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
602 if (! SYMBOLP (XCAR (tmp
)))
610 /* Structure of known font property keys and validater of the
614 /* Pointer to the key symbol. */
616 /* Function to validate PROP's value VAL, or NULL if any value is
617 ok. The value is VAL or its regularized value if VAL is valid,
618 and Qerror if not. */
619 Lisp_Object (*validater
) (Lisp_Object prop
, Lisp_Object val
);
620 } font_property_table
[] =
621 { { &QCtype
, font_prop_validate_symbol
},
622 { &QCfoundry
, font_prop_validate_symbol
},
623 { &QCfamily
, font_prop_validate_symbol
},
624 { &QCadstyle
, font_prop_validate_symbol
},
625 { &QCregistry
, font_prop_validate_symbol
},
626 { &QCweight
, font_prop_validate_style
},
627 { &QCslant
, font_prop_validate_style
},
628 { &QCwidth
, font_prop_validate_style
},
629 { &QCsize
, font_prop_validate_non_neg
},
630 { &QCdpi
, font_prop_validate_non_neg
},
631 { &QCspacing
, font_prop_validate_spacing
},
632 { &QCavgwidth
, font_prop_validate_non_neg
},
633 /* The order of the above entries must match with enum
634 font_property_index. */
635 { &QClang
, font_prop_validate_symbol
},
636 { &QCscript
, font_prop_validate_symbol
},
637 { &QCotf
, font_prop_validate_otf
}
640 /* Size (number of elements) of the above table. */
641 #define FONT_PROPERTY_TABLE_SIZE \
642 ((sizeof font_property_table) / (sizeof *font_property_table))
644 /* Return an index number of font property KEY or -1 if KEY is not an
645 already known property. */
648 get_font_prop_index (Lisp_Object key
)
652 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
653 if (EQ (key
, *font_property_table
[i
].key
))
658 /* Validate the font property. The property key is specified by the
659 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
660 signal an error. The value is VAL or the regularized one. */
663 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
665 Lisp_Object validated
;
670 prop
= *font_property_table
[idx
].key
;
673 idx
= get_font_prop_index (prop
);
677 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
678 if (EQ (validated
, Qerror
))
679 signal_error ("invalid font property", Fcons (prop
, val
));
684 /* Store VAL as a value of extra font property PROP in FONT while
685 keeping the sorting order. Don't check the validity of VAL. */
688 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
690 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
691 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
695 Lisp_Object prev
= Qnil
;
698 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
699 prev
= extra
, extra
= XCDR (extra
);
702 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
704 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
710 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
715 /* Font name parser and unparser */
717 static int parse_matrix (char *);
718 static int font_expand_wildcards (Lisp_Object
*, int);
719 static int font_parse_name (char *, Lisp_Object
);
721 /* An enumerator for each field of an XLFD font name. */
722 enum xlfd_field_index
741 /* An enumerator for mask bit corresponding to each XLFD field. */
744 XLFD_FOUNDRY_MASK
= 0x0001,
745 XLFD_FAMILY_MASK
= 0x0002,
746 XLFD_WEIGHT_MASK
= 0x0004,
747 XLFD_SLANT_MASK
= 0x0008,
748 XLFD_SWIDTH_MASK
= 0x0010,
749 XLFD_ADSTYLE_MASK
= 0x0020,
750 XLFD_PIXEL_MASK
= 0x0040,
751 XLFD_POINT_MASK
= 0x0080,
752 XLFD_RESX_MASK
= 0x0100,
753 XLFD_RESY_MASK
= 0x0200,
754 XLFD_SPACING_MASK
= 0x0400,
755 XLFD_AVGWIDTH_MASK
= 0x0800,
756 XLFD_REGISTRY_MASK
= 0x1000,
757 XLFD_ENCODING_MASK
= 0x2000
761 /* Parse P pointing the pixel/point size field of the form
762 `[A B C D]' which specifies a transformation matrix:
768 by which all glyphs of the font are transformed. The spec says
769 that scalar value N for the pixel/point size is equivalent to:
770 A = N * resx/resy, B = C = 0, D = N.
772 Return the scalar value N if the form is valid. Otherwise return
776 parse_matrix (char *p
)
782 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
785 matrix
[i
] = - strtod (p
+ 1, &end
);
787 matrix
[i
] = strtod (p
, &end
);
790 return (i
== 4 ? (int) matrix
[3] : -1);
793 /* Expand a wildcard field in FIELD (the first N fields are filled) to
794 multiple fields to fill in all 14 XLFD fields while restring a
795 field position by its contents. */
798 font_expand_wildcards (Lisp_Object
*field
, int n
)
801 Lisp_Object tmp
[XLFD_LAST_INDEX
];
802 /* Array of information about where this element can go. Nth
803 element is for Nth element of FIELD. */
805 /* Minimum possible field. */
807 /* Maxinum possible field. */
809 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
811 } range
[XLFD_LAST_INDEX
];
813 int range_from
, range_to
;
816 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
817 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
818 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
819 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
820 | XLFD_AVGWIDTH_MASK)
821 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
823 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
824 field. The value is shifted to left one bit by one in the
826 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
827 range_mask
= (range_mask
<< 1) | 1;
829 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
830 position-based retriction for FIELD[I]. */
831 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
832 i
++, range_from
++, range_to
++, range_mask
<<= 1)
834 Lisp_Object val
= field
[i
];
840 range
[i
].from
= range_from
;
841 range
[i
].to
= range_to
;
842 range
[i
].mask
= range_mask
;
846 /* The triplet FROM, TO, and MASK is a value-based
847 retriction for FIELD[I]. */
853 int numeric
= XINT (val
);
856 from
= to
= XLFD_ENCODING_INDEX
,
857 mask
= XLFD_ENCODING_MASK
;
858 else if (numeric
== 0)
859 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
860 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
861 else if (numeric
<= 48)
862 from
= to
= XLFD_PIXEL_INDEX
,
863 mask
= XLFD_PIXEL_MASK
;
865 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
866 mask
= XLFD_LARGENUM_MASK
;
868 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
869 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
870 mask
= XLFD_NULL_MASK
;
872 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
875 Lisp_Object name
= SYMBOL_NAME (val
);
877 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
878 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
879 mask
= XLFD_REGENC_MASK
;
881 from
= to
= XLFD_ENCODING_INDEX
,
882 mask
= XLFD_ENCODING_MASK
;
884 else if (range_from
<= XLFD_WEIGHT_INDEX
885 && range_to
>= XLFD_WEIGHT_INDEX
886 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
887 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
888 else if (range_from
<= XLFD_SLANT_INDEX
889 && range_to
>= XLFD_SLANT_INDEX
890 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
891 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
892 else if (range_from
<= XLFD_SWIDTH_INDEX
893 && range_to
>= XLFD_SWIDTH_INDEX
894 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
895 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
898 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
899 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
901 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
902 mask
= XLFD_SYMBOL_MASK
;
905 /* Merge position-based and value-based restrictions. */
907 while (from
< range_from
)
908 mask
&= ~(1 << from
++);
909 while (from
< 14 && ! (mask
& (1 << from
)))
911 while (to
> range_to
)
912 mask
&= ~(1 << to
--);
913 while (to
>= 0 && ! (mask
& (1 << to
)))
917 range
[i
].from
= from
;
919 range
[i
].mask
= mask
;
921 if (from
> range_from
|| to
< range_to
)
923 /* The range is narrowed by value-based restrictions.
924 Reflect it to the other fields. */
926 /* Following fields should be after FROM. */
928 /* Preceding fields should be before TO. */
929 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
931 /* Check FROM for non-wildcard field. */
932 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
934 while (range
[j
].from
< from
)
935 range
[j
].mask
&= ~(1 << range
[j
].from
++);
936 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
938 range
[j
].from
= from
;
941 from
= range
[j
].from
;
942 if (range
[j
].to
> to
)
944 while (range
[j
].to
> to
)
945 range
[j
].mask
&= ~(1 << range
[j
].to
--);
946 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
959 /* Decide all fileds from restrictions in RANGE. */
960 for (i
= j
= 0; i
< n
; i
++)
962 if (j
< range
[i
].from
)
964 if (i
== 0 || ! NILP (tmp
[i
- 1]))
965 /* None of TMP[X] corresponds to Jth field. */
967 for (; j
< range
[i
].from
; j
++)
972 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
974 for (; j
< XLFD_LAST_INDEX
; j
++)
976 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
977 field
[XLFD_ENCODING_INDEX
]
978 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
983 #ifdef ENABLE_CHECKING
984 /* Match a 14-field XLFD pattern against a full XLFD font name. */
986 font_match_xlfd (char *pattern
, char *name
)
988 while (*pattern
&& *name
)
990 if (*pattern
== *name
)
992 else if (*pattern
== '*')
993 if (*name
== pattern
[1])
1004 /* Make sure the font object matches the XLFD font name. */
1006 font_check_xlfd_parse (Lisp_Object font
, char *name
)
1008 char name_check
[256];
1009 font_unparse_xlfd (font
, 0, name_check
, 255);
1010 return font_match_xlfd (name_check
, name
);
1016 /* Parse NAME (null terminated) as XLFD and store information in FONT
1017 (font-spec or font-entity). Size property of FONT is set as
1019 specified XLFD fields FONT property
1020 --------------------- -------------
1021 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1022 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1023 POINT_SIZE POINT_SIZE/10 (Lisp float)
1025 If NAME is successfully parsed, return 0. Otherwise return -1.
1027 FONT is usually a font-spec, but when this function is called from
1028 X font backend driver, it is a font-entity. In that case, NAME is
1029 a fully specified XLFD. */
1032 font_parse_xlfd (char *name
, Lisp_Object font
)
1034 int len
= strlen (name
);
1036 char *f
[XLFD_LAST_INDEX
+ 1];
1040 if (len
> 255 || !len
)
1041 /* Maximum XLFD name length is 255. */
1043 /* Accept "*-.." as a fully specified XLFD. */
1044 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1045 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1048 for (p
= name
+ i
; *p
; p
++)
1052 if (i
== XLFD_LAST_INDEX
)
1057 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1058 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1060 if (i
== XLFD_LAST_INDEX
)
1062 /* Fully specified XLFD. */
1065 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1066 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1067 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1068 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1070 val
= INTERN_FIELD_SYM (i
);
1073 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1075 ASET (font
, j
, make_number (n
));
1078 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1079 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1080 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1082 ASET (font
, FONT_REGISTRY_INDEX
,
1083 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1084 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1086 p
= f
[XLFD_PIXEL_INDEX
];
1087 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1088 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1091 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1093 ASET (font
, FONT_SIZE_INDEX
, val
);
1094 else if (FONT_ENTITY_P (font
))
1098 double point_size
= -1;
1100 font_assert (FONT_SPEC_P (font
));
1101 p
= f
[XLFD_POINT_INDEX
];
1103 point_size
= parse_matrix (p
);
1104 else if (isdigit (*p
))
1105 point_size
= atoi (p
), point_size
/= 10;
1106 if (point_size
>= 0)
1107 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1111 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1112 if (! NILP (val
) && ! INTEGERP (val
))
1114 ASET (font
, FONT_DPI_INDEX
, val
);
1115 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1118 val
= font_prop_validate_spacing (QCspacing
, val
);
1119 if (! INTEGERP (val
))
1121 ASET (font
, FONT_SPACING_INDEX
, val
);
1123 p
= f
[XLFD_AVGWIDTH_INDEX
];
1126 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1127 if (! NILP (val
) && ! INTEGERP (val
))
1129 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1133 int wild_card_found
= 0;
1134 Lisp_Object prop
[XLFD_LAST_INDEX
];
1136 if (FONT_ENTITY_P (font
))
1138 for (j
= 0; j
< i
; j
++)
1142 if (f
[j
][1] && f
[j
][1] != '-')
1145 wild_card_found
= 1;
1148 prop
[j
] = INTERN_FIELD (j
);
1150 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1152 if (! wild_card_found
)
1154 if (font_expand_wildcards (prop
, i
) < 0)
1157 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1158 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1159 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1160 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1161 if (! NILP (prop
[i
]))
1163 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1165 ASET (font
, j
, make_number (n
));
1167 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1168 val
= prop
[XLFD_REGISTRY_INDEX
];
1171 val
= prop
[XLFD_ENCODING_INDEX
];
1173 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1175 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1176 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1178 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1179 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1181 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1183 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1184 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1185 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1187 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1189 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1192 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1193 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1194 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1196 val
= font_prop_validate_spacing (QCspacing
,
1197 prop
[XLFD_SPACING_INDEX
]);
1198 if (! INTEGERP (val
))
1200 ASET (font
, FONT_SPACING_INDEX
, val
);
1202 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1203 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1209 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1210 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1211 0, use PIXEL_SIZE instead. */
1214 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1216 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1220 font_assert (FONTP (font
));
1222 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1225 if (i
== FONT_ADSTYLE_INDEX
)
1226 j
= XLFD_ADSTYLE_INDEX
;
1227 else if (i
== FONT_REGISTRY_INDEX
)
1228 j
= XLFD_REGISTRY_INDEX
;
1229 val
= AREF (font
, i
);
1232 if (j
== XLFD_REGISTRY_INDEX
)
1233 f
[j
] = "*-*", len
+= 4;
1235 f
[j
] = "*", len
+= 2;
1240 val
= SYMBOL_NAME (val
);
1241 if (j
== XLFD_REGISTRY_INDEX
1242 && ! strchr ((char *) SDATA (val
), '-'))
1244 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1245 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1247 f
[j
] = alloca (SBYTES (val
) + 3);
1248 sprintf (f
[j
], "%s-*", SDATA (val
));
1249 len
+= SBYTES (val
) + 3;
1253 f
[j
] = alloca (SBYTES (val
) + 4);
1254 sprintf (f
[j
], "%s*-*", SDATA (val
));
1255 len
+= SBYTES (val
) + 4;
1259 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1263 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1266 val
= font_style_symbolic (font
, i
, 0);
1268 f
[j
] = "*", len
+= 2;
1271 val
= SYMBOL_NAME (val
);
1272 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1276 val
= AREF (font
, FONT_SIZE_INDEX
);
1277 font_assert (NUMBERP (val
) || NILP (val
));
1285 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1286 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1289 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1291 else if (FLOATP (val
))
1293 i
= XFLOAT_DATA (val
) * 10;
1294 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1295 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1298 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1300 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1302 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1303 f
[XLFD_RESX_INDEX
] = alloca (22);
1304 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1308 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1309 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1311 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1313 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1314 : spacing
<= FONT_SPACING_DUAL
? "d"
1315 : spacing
<= FONT_SPACING_MONO
? "m"
1320 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1321 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1323 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1324 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
], "%ld",
1325 (long) XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1328 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1329 len
++; /* for terminating '\0'. */
1332 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1333 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1334 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1335 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1336 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1337 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1338 f
[XLFD_REGISTRY_INDEX
]);
1341 /* Parse NAME (null terminated) and store information in FONT
1342 (font-spec or font-entity). NAME is supplied in either the
1343 Fontconfig or GTK font name format. If NAME is successfully
1344 parsed, return 0. Otherwise return -1.
1346 The fontconfig format is
1348 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1352 FAMILY [PROPS...] [SIZE]
1354 This function tries to guess which format it is. */
1357 font_parse_fcname (char *name
, Lisp_Object font
)
1360 char *size_beg
= NULL
, *size_end
= NULL
;
1361 char *props_beg
= NULL
, *family_end
= NULL
;
1362 int len
= strlen (name
);
1367 for (p
= name
; *p
; p
++)
1369 if (*p
== '\\' && p
[1])
1373 props_beg
= family_end
= p
;
1378 int decimal
= 0, size_found
= 1;
1379 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1382 if (*q
!= '.' || decimal
)
1401 Lisp_Object extra_props
= Qnil
;
1403 /* A fontconfig name with size and/or property data. */
1404 if (family_end
> name
)
1407 family
= font_intern_prop (name
, family_end
- name
, 1);
1408 ASET (font
, FONT_FAMILY_INDEX
, family
);
1412 double point_size
= strtod (size_beg
, &size_end
);
1413 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1414 if (*size_end
== ':' && size_end
[1])
1415 props_beg
= size_end
;
1419 /* Now parse ":KEY=VAL" patterns. */
1422 for (p
= props_beg
; *p
; p
= q
)
1424 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1427 /* Must be an enumerated value. */
1431 val
= font_intern_prop (p
, q
- p
, 1);
1433 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1435 if (PROP_MATCH ("light", 5)
1436 || PROP_MATCH ("medium", 6)
1437 || PROP_MATCH ("demibold", 8)
1438 || PROP_MATCH ("bold", 4)
1439 || PROP_MATCH ("black", 5))
1440 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1441 else if (PROP_MATCH ("roman", 5)
1442 || PROP_MATCH ("italic", 6)
1443 || PROP_MATCH ("oblique", 7))
1444 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1445 else if (PROP_MATCH ("charcell", 8))
1446 ASET (font
, FONT_SPACING_INDEX
,
1447 make_number (FONT_SPACING_CHARCELL
));
1448 else if (PROP_MATCH ("mono", 4))
1449 ASET (font
, FONT_SPACING_INDEX
,
1450 make_number (FONT_SPACING_MONO
));
1451 else if (PROP_MATCH ("proportional", 12))
1452 ASET (font
, FONT_SPACING_INDEX
,
1453 make_number (FONT_SPACING_PROPORTIONAL
));
1462 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1463 prop
= FONT_SIZE_INDEX
;
1466 key
= font_intern_prop (p
, q
- p
, 1);
1467 prop
= get_font_prop_index (key
);
1471 for (q
= p
; *q
&& *q
!= ':'; q
++);
1472 val
= font_intern_prop (p
, q
- p
, 0);
1474 if (prop
>= FONT_FOUNDRY_INDEX
1475 && prop
< FONT_EXTRA_INDEX
)
1476 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1479 extra_props
= nconc2 (extra_props
,
1480 Fcons (Fcons (key
, val
), Qnil
));
1487 if (! NILP (extra_props
))
1489 struct font_driver_list
*driver_list
= font_driver_list
;
1490 for ( ; driver_list
; driver_list
= driver_list
->next
)
1491 if (driver_list
->driver
->filter_properties
)
1492 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1498 /* Either a fontconfig-style name with no size and property
1499 data, or a GTK-style name. */
1501 int word_len
, prop_found
= 0;
1503 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1509 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1510 if (! isdigit (*q
) && *q
!= '.')
1517 double point_size
= strtod (p
, &q
);
1518 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1523 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1524 if (*q
== '\\' && q
[1])
1528 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1530 if (PROP_MATCH ("Ultra-Light", 11))
1533 prop
= font_intern_prop ("ultra-light", 11, 1);
1534 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1536 else if (PROP_MATCH ("Light", 5))
1539 prop
= font_intern_prop ("light", 5, 1);
1540 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1542 else if (PROP_MATCH ("Book", 4))
1545 prop
= font_intern_prop ("book", 4, 1);
1546 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1548 else if (PROP_MATCH ("Medium", 6))
1551 prop
= font_intern_prop ("medium", 6, 1);
1552 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1554 else if (PROP_MATCH ("Semi-Bold", 9))
1557 prop
= font_intern_prop ("semi-bold", 9, 1);
1558 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1560 else if (PROP_MATCH ("Bold", 4))
1563 prop
= font_intern_prop ("bold", 4, 1);
1564 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1566 else if (PROP_MATCH ("Italic", 6))
1569 prop
= font_intern_prop ("italic", 4, 1);
1570 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1572 else if (PROP_MATCH ("Oblique", 7))
1575 prop
= font_intern_prop ("oblique", 7, 1);
1576 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1578 else if (PROP_MATCH ("Semi-Condensed", 14))
1581 prop
= font_intern_prop ("semi-condensed", 14, 1);
1582 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, prop
);
1584 else if (PROP_MATCH ("Condensed", 9))
1587 prop
= font_intern_prop ("condensed", 9, 1);
1588 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, prop
);
1592 return -1; /* Unknown property in GTK-style font name. */
1601 family
= font_intern_prop (name
, family_end
- name
, 1);
1602 ASET (font
, FONT_FAMILY_INDEX
, family
);
1609 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1610 NAME (NBYTES length), and return the name length. If
1611 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1614 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1616 Lisp_Object family
, foundry
;
1617 Lisp_Object tail
, val
;
1621 Lisp_Object styles
[3];
1622 char *style_names
[3] = { "weight", "slant", "width" };
1625 family
= AREF (font
, FONT_FAMILY_INDEX
);
1626 if (! NILP (family
))
1628 if (SYMBOLP (family
))
1630 family
= SYMBOL_NAME (family
);
1631 len
+= SBYTES (family
);
1637 val
= AREF (font
, FONT_SIZE_INDEX
);
1640 if (XINT (val
) != 0)
1641 pixel_size
= XINT (val
);
1643 len
+= 21; /* for ":pixelsize=NUM" */
1645 else if (FLOATP (val
))
1648 point_size
= (int) XFLOAT_DATA (val
);
1649 len
+= 11; /* for "-NUM" */
1652 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1653 if (! NILP (foundry
))
1655 if (SYMBOLP (foundry
))
1657 foundry
= SYMBOL_NAME (foundry
);
1658 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1664 for (i
= 0; i
< 3; i
++)
1666 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1667 if (! NILP (styles
[i
]))
1668 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1669 SDATA (SYMBOL_NAME (styles
[i
])));
1672 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1673 len
+= sprintf (work
, ":dpi=%ld", (long)XINT (AREF (font
, FONT_DPI_INDEX
)));
1674 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1675 len
+= strlen (":spacing=100");
1676 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1677 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1678 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1680 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1682 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1684 len
+= SBYTES (val
);
1685 else if (INTEGERP (val
))
1686 len
+= sprintf (work
, "%ld", (long) XINT (val
));
1687 else if (SYMBOLP (val
))
1688 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1694 if (! NILP (family
))
1695 p
+= sprintf (p
, "%s", SDATA (family
));
1699 p
+= sprintf (p
, "%d", point_size
);
1701 p
+= sprintf (p
, "-%d", point_size
);
1703 else if (pixel_size
> 0)
1704 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1705 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1706 p
+= sprintf (p
, ":foundry=%s",
1707 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1708 for (i
= 0; i
< 3; i
++)
1709 if (! NILP (styles
[i
]))
1710 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1711 SDATA (SYMBOL_NAME (styles
[i
])));
1712 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1713 p
+= sprintf (p
, ":dpi=%ld", (long) XINT (AREF (font
, FONT_DPI_INDEX
)));
1714 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1715 p
+= sprintf (p
, ":spacing=%ld",
1716 (long) XINT (AREF (font
, FONT_SPACING_INDEX
)));
1717 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1719 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1720 p
+= sprintf (p
, ":scalable=true");
1722 p
+= sprintf (p
, ":scalable=false");
1727 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1728 NAME (NBYTES length), and return the name length. F is the frame
1729 on which the font is displayed; it is used to calculate the point
1733 font_unparse_gtkname (Lisp_Object font
, struct frame
*f
, char *name
, int nbytes
)
1737 Lisp_Object family
, weight
, slant
, size
;
1738 int point_size
= -1;
1740 family
= AREF (font
, FONT_FAMILY_INDEX
);
1741 if (! NILP (family
))
1743 if (! SYMBOLP (family
))
1745 family
= SYMBOL_NAME (family
);
1746 len
+= SBYTES (family
);
1749 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1750 if (EQ (weight
, Qnormal
))
1752 else if (! NILP (weight
))
1754 weight
= SYMBOL_NAME (weight
);
1755 len
+= SBYTES (weight
);
1758 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1759 if (EQ (slant
, Qnormal
))
1761 else if (! NILP (slant
))
1763 slant
= SYMBOL_NAME (slant
);
1764 len
+= SBYTES (slant
);
1767 size
= AREF (font
, FONT_SIZE_INDEX
);
1768 /* Convert pixel size to point size. */
1769 if (INTEGERP (size
))
1771 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1773 if (INTEGERP (font_dpi
))
1774 dpi
= XINT (font_dpi
);
1777 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1780 else if (FLOATP (size
))
1782 point_size
= (int) XFLOAT_DATA (size
);
1789 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1791 if (! NILP (weight
))
1794 p
+= sprintf (p
, " %s", SDATA (weight
));
1795 q
[1] = toupper (q
[1]);
1801 p
+= sprintf (p
, " %s", SDATA (slant
));
1802 q
[1] = toupper (q
[1]);
1806 p
+= sprintf (p
, " %d", point_size
);
1811 /* Parse NAME (null terminated) and store information in FONT
1812 (font-spec or font-entity). If NAME is successfully parsed, return
1813 0. Otherwise return -1. */
1816 font_parse_name (char *name
, Lisp_Object font
)
1818 if (name
[0] == '-' || index (name
, '*') || index (name
, '?'))
1819 return font_parse_xlfd (name
, font
);
1820 return font_parse_fcname (name
, font
);
1824 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1825 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1829 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1835 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1837 CHECK_STRING (family
);
1838 len
= SBYTES (family
);
1839 p0
= (char *) SDATA (family
);
1840 p1
= index (p0
, '-');
1843 if ((*p0
!= '*' && p1
- p0
> 0)
1844 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1845 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1848 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1851 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1853 if (! NILP (registry
))
1855 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1856 CHECK_STRING (registry
);
1857 len
= SBYTES (registry
);
1858 p0
= (char *) SDATA (registry
);
1859 p1
= index (p0
, '-');
1862 if (SDATA (registry
)[len
- 1] == '*')
1863 registry
= concat2 (registry
, build_string ("-*"));
1865 registry
= concat2 (registry
, build_string ("*-*"));
1867 registry
= Fdowncase (registry
);
1868 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1873 /* This part (through the next ^L) is still experimental and not
1874 tested much. We may drastically change codes. */
1880 #define LGSTRING_HEADER_SIZE 6
1881 #define LGSTRING_GLYPH_SIZE 8
1884 check_gstring (gstring
)
1885 Lisp_Object gstring
;
1890 CHECK_VECTOR (gstring
);
1891 val
= AREF (gstring
, 0);
1893 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1895 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1896 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1897 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1898 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1899 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1900 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1901 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1902 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1903 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1904 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1905 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1907 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1909 val
= LGSTRING_GLYPH (gstring
, i
);
1911 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1913 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1915 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1916 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1917 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1918 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1919 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1920 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1921 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1922 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1924 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1926 if (ASIZE (val
) < 3)
1928 for (j
= 0; j
< 3; j
++)
1929 CHECK_NUMBER (AREF (val
, j
));
1934 error ("Invalid glyph-string format");
1939 check_otf_features (otf_features
)
1940 Lisp_Object otf_features
;
1944 CHECK_CONS (otf_features
);
1945 CHECK_SYMBOL (XCAR (otf_features
));
1946 otf_features
= XCDR (otf_features
);
1947 CHECK_CONS (otf_features
);
1948 CHECK_SYMBOL (XCAR (otf_features
));
1949 otf_features
= XCDR (otf_features
);
1950 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1952 CHECK_SYMBOL (Fcar (val
));
1953 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1954 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1956 otf_features
= XCDR (otf_features
);
1957 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1959 CHECK_SYMBOL (Fcar (val
));
1960 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1961 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1968 Lisp_Object otf_list
;
1971 otf_tag_symbol (tag
)
1976 OTF_tag_name (tag
, name
);
1977 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1984 Lisp_Object val
= Fassoc (file
, otf_list
);
1988 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1991 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1992 val
= make_save_value (otf
, 0);
1993 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1999 /* Return a list describing which scripts/languages FONT supports by
2000 which GSUB/GPOS features of OpenType tables. See the comment of
2001 (struct font_driver).otf_capability. */
2004 font_otf_capability (font
)
2008 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
2011 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
2014 for (i
= 0; i
< 2; i
++)
2016 OTF_GSUB_GPOS
*gsub_gpos
;
2017 Lisp_Object script_list
= Qnil
;
2020 if (OTF_get_features (otf
, i
== 0) < 0)
2022 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2023 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2025 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2026 Lisp_Object langsys_list
= Qnil
;
2027 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2030 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2032 OTF_LangSys
*langsys
;
2033 Lisp_Object feature_list
= Qnil
;
2034 Lisp_Object langsys_tag
;
2037 if (k
== script
->LangSysCount
)
2039 langsys
= &script
->DefaultLangSys
;
2044 langsys
= script
->LangSys
+ k
;
2046 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2048 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2050 OTF_Feature
*feature
2051 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2052 Lisp_Object feature_tag
2053 = otf_tag_symbol (feature
->FeatureTag
);
2055 feature_list
= Fcons (feature_tag
, feature_list
);
2057 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2060 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2065 XSETCAR (capability
, script_list
);
2067 XSETCDR (capability
, script_list
);
2073 /* Parse OTF features in SPEC and write a proper features spec string
2074 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2075 assured that the sufficient memory has already allocated for
2079 generate_otf_features (spec
, features
)
2089 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2095 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2100 else if (! asterisk
)
2102 val
= SYMBOL_NAME (val
);
2103 p
+= sprintf (p
, "%s", SDATA (val
));
2107 val
= SYMBOL_NAME (val
);
2108 p
+= sprintf (p
, "~%s", SDATA (val
));
2112 error ("OTF spec too long");
2116 font_otf_DeviceTable (device_table
)
2117 OTF_DeviceTable
*device_table
;
2119 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2121 return Fcons (make_number (len
),
2122 make_unibyte_string (device_table
->DeltaValue
, len
));
2126 font_otf_ValueRecord (value_format
, value_record
)
2128 OTF_ValueRecord
*value_record
;
2130 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2132 if (value_format
& OTF_XPlacement
)
2133 ASET (val
, 0, make_number (value_record
->XPlacement
));
2134 if (value_format
& OTF_YPlacement
)
2135 ASET (val
, 1, make_number (value_record
->YPlacement
));
2136 if (value_format
& OTF_XAdvance
)
2137 ASET (val
, 2, make_number (value_record
->XAdvance
));
2138 if (value_format
& OTF_YAdvance
)
2139 ASET (val
, 3, make_number (value_record
->YAdvance
));
2140 if (value_format
& OTF_XPlaDevice
)
2141 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2142 if (value_format
& OTF_YPlaDevice
)
2143 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2144 if (value_format
& OTF_XAdvDevice
)
2145 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2146 if (value_format
& OTF_YAdvDevice
)
2147 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2152 font_otf_Anchor (anchor
)
2157 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2158 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2159 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2160 if (anchor
->AnchorFormat
== 2)
2161 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2164 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2165 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2169 #endif /* HAVE_LIBOTF */
2175 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
2176 static int font_compare (const void *, const void *);
2177 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
2180 /* Return a rescaling ratio of FONT_ENTITY. */
2181 extern Lisp_Object Vface_font_rescale_alist
;
2184 font_rescale_ratio (Lisp_Object font_entity
)
2186 Lisp_Object tail
, elt
;
2187 Lisp_Object name
= Qnil
;
2189 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2192 if (FLOATP (XCDR (elt
)))
2194 if (STRINGP (XCAR (elt
)))
2197 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2198 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2199 return XFLOAT_DATA (XCDR (elt
));
2201 else if (FONT_SPEC_P (XCAR (elt
)))
2203 if (font_match_p (XCAR (elt
), font_entity
))
2204 return XFLOAT_DATA (XCDR (elt
));
2211 /* We sort fonts by scoring each of them against a specified
2212 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2213 the value is, the closer the font is to the font-spec.
2215 The lowest 2 bits of the score is used for driver type. The font
2216 available by the most preferred font driver is 0.
2218 Each 7-bit in the higher 28 bits are used for numeric properties
2219 WEIGHT, SLANT, WIDTH, and SIZE. */
2221 /* How many bits to shift to store the difference value of each font
2222 property in a score. Note that flots for FONT_TYPE_INDEX and
2223 FONT_REGISTRY_INDEX are not used. */
2224 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2226 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2227 The return value indicates how different ENTITY is compared with
2231 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2236 /* Score three style numeric fields. Maximum difference is 127. */
2237 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2238 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2240 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2245 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2248 /* Score the size. Maximum difference is 127. */
2249 i
= FONT_SIZE_INDEX
;
2250 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2251 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2253 /* We use the higher 6-bit for the actual size difference. The
2254 lowest bit is set if the DPI is different. */
2256 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2258 if (CONSP (Vface_font_rescale_alist
))
2259 pixel_size
*= font_rescale_ratio (entity
);
2260 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2264 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2265 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2267 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2268 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2270 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2277 /* Concatenate all elements of LIST into one vector. LIST is a list
2278 of font-entity vectors. */
2281 font_vconcat_entity_vectors (Lisp_Object list
)
2283 int nargs
= XINT (Flength (list
));
2284 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2287 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2288 args
[i
] = XCAR (list
);
2289 return Fvconcat (nargs
, args
);
2293 /* The structure for elements being sorted by qsort. */
2294 struct font_sort_data
2297 int font_driver_preference
;
2302 /* The comparison function for qsort. */
2305 font_compare (const void *d1
, const void *d2
)
2307 const struct font_sort_data
*data1
= d1
;
2308 const struct font_sort_data
*data2
= d2
;
2310 if (data1
->score
< data2
->score
)
2312 else if (data1
->score
> data2
->score
)
2314 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2318 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2319 If PREFER specifies a point-size, calculate the corresponding
2320 pixel-size from QCdpi property of PREFER or from the Y-resolution
2321 of FRAME before sorting.
2323 If BEST-ONLY is nonzero, return the best matching entity (that
2324 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2325 if BEST-ONLY is negative). Otherwise, return the sorted result as
2326 a single vector of font-entities.
2328 This function does no optimization for the case that the total
2329 number of elements is 1. The caller should avoid calling this in
2333 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2335 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2337 struct font_sort_data
*data
;
2338 unsigned best_score
;
2339 Lisp_Object best_entity
;
2340 struct frame
*f
= XFRAME (frame
);
2341 Lisp_Object tail
, vec
;
2344 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2345 prefer_prop
[i
] = AREF (prefer
, i
);
2346 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2347 prefer_prop
[FONT_SIZE_INDEX
]
2348 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2350 if (NILP (XCDR (list
)))
2352 /* What we have to take care of is this single vector. */
2354 maxlen
= ASIZE (vec
);
2358 /* We don't have to perform sort, so there's no need of creating
2359 a single vector. But, we must find the length of the longest
2362 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2363 if (maxlen
< ASIZE (XCAR (tail
)))
2364 maxlen
= ASIZE (XCAR (tail
));
2368 /* We have to create a single vector to sort it. */
2369 vec
= font_vconcat_entity_vectors (list
);
2370 maxlen
= ASIZE (vec
);
2373 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2374 best_score
= 0xFFFFFFFF;
2377 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2379 int font_driver_preference
= 0;
2380 Lisp_Object current_font_driver
;
2386 /* We are sure that the length of VEC > 0. */
2387 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2388 /* Score the elements. */
2389 for (i
= 0; i
< len
; i
++)
2391 data
[i
].entity
= AREF (vec
, i
);
2393 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2395 ? font_score (data
[i
].entity
, prefer_prop
)
2397 if (best_only
&& best_score
> data
[i
].score
)
2399 best_score
= data
[i
].score
;
2400 best_entity
= data
[i
].entity
;
2401 if (best_score
== 0)
2404 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2406 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2407 font_driver_preference
++;
2409 data
[i
].font_driver_preference
= font_driver_preference
;
2412 /* Sort if necessary. */
2415 qsort (data
, len
, sizeof *data
, font_compare
);
2416 for (i
= 0; i
< len
; i
++)
2417 ASET (vec
, i
, data
[i
].entity
);
2426 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2431 /* API of Font Service Layer. */
2433 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2434 sort_shift_bits. Finternal_set_font_selection_order calls this
2435 function with font_sort_order after setting up it. */
2438 font_update_sort_order (int *order
)
2442 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2444 int xlfd_idx
= order
[i
];
2446 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2447 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2448 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2449 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2450 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2451 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2453 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2458 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
, Lisp_Object features
, Lisp_Object table
)
2463 table
= assq_no_quit (script
, table
);
2466 table
= XCDR (table
);
2467 if (! NILP (langsys
))
2469 table
= assq_no_quit (langsys
, table
);
2475 val
= assq_no_quit (Qnil
, table
);
2477 table
= XCAR (table
);
2481 table
= XCDR (table
);
2482 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2484 if (NILP (XCAR (features
)))
2489 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2495 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2498 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2500 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2502 script
= XCAR (spec
);
2506 langsys
= XCAR (spec
);
2517 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2518 XCAR (otf_capability
)))
2520 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2521 XCDR (otf_capability
)))
2528 /* Check if FONT (font-entity or font-object) matches with the font
2529 specification SPEC. */
2532 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2534 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2535 Lisp_Object extra
, font_extra
;
2538 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2539 if (! NILP (AREF (spec
, i
))
2540 && ! NILP (AREF (font
, i
))
2541 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2543 props
= XFONT_SPEC (spec
)->props
;
2544 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2546 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2547 prop
[i
] = AREF (spec
, i
);
2548 prop
[FONT_SIZE_INDEX
]
2549 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2553 if (font_score (font
, props
) > 0)
2555 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2556 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2557 for (; CONSP (extra
); extra
= XCDR (extra
))
2559 Lisp_Object key
= XCAR (XCAR (extra
));
2560 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2562 if (EQ (key
, QClang
))
2564 val2
= assq_no_quit (key
, font_extra
);
2573 if (NILP (Fmemq (val
, val2
)))
2578 ? NILP (Fmemq (val
, XCDR (val2
)))
2582 else if (EQ (key
, QCscript
))
2584 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2590 /* All characters in the list must be supported. */
2591 for (; CONSP (val2
); val2
= XCDR (val2
))
2593 if (! NATNUMP (XCAR (val2
)))
2595 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2596 == FONT_INVALID_CODE
)
2600 else if (VECTORP (val2
))
2602 /* At most one character in the vector must be supported. */
2603 for (i
= 0; i
< ASIZE (val2
); i
++)
2605 if (! NATNUMP (AREF (val2
, i
)))
2607 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2608 != FONT_INVALID_CODE
)
2611 if (i
== ASIZE (val2
))
2616 else if (EQ (key
, QCotf
))
2620 if (! FONT_OBJECT_P (font
))
2622 fontp
= XFONT_OBJECT (font
);
2623 if (! fontp
->driver
->otf_capability
)
2625 val2
= fontp
->driver
->otf_capability (fontp
);
2626 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2637 Each font backend has the callback function get_cache, and it
2638 returns a cons cell of which cdr part can be freely used for
2639 caching fonts. The cons cell may be shared by multiple frames
2640 and/or multiple font drivers. So, we arrange the cdr part as this:
2642 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2644 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2645 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2646 cons (FONT-SPEC FONT-ENTITY ...). */
2648 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2649 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2650 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2651 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2652 struct font_driver
*);
2655 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2657 Lisp_Object cache
, val
;
2659 cache
= driver
->get_cache (f
);
2661 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2665 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2666 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2670 val
= XCDR (XCAR (val
));
2671 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2677 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2679 Lisp_Object cache
, val
, tmp
;
2682 cache
= driver
->get_cache (f
);
2684 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2685 cache
= val
, val
= XCDR (val
);
2686 font_assert (! NILP (val
));
2687 tmp
= XCDR (XCAR (val
));
2688 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2689 if (XINT (XCAR (tmp
)) == 0)
2691 font_clear_cache (f
, XCAR (val
), driver
);
2692 XSETCDR (cache
, XCDR (val
));
2698 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2700 Lisp_Object val
= driver
->get_cache (f
);
2701 Lisp_Object type
= driver
->type
;
2703 font_assert (CONSP (val
));
2704 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2705 font_assert (CONSP (val
));
2706 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2707 val
= XCDR (XCAR (val
));
2711 static int num_fonts
;
2714 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2716 Lisp_Object tail
, elt
;
2717 Lisp_Object tail2
, entity
;
2719 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2720 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2723 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2724 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2726 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2728 entity
= XCAR (tail2
);
2730 if (FONT_ENTITY_P (entity
)
2731 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2733 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2735 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2737 Lisp_Object val
= XCAR (objlist
);
2738 struct font
*font
= XFONT_OBJECT (val
);
2740 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2742 font_assert (font
&& driver
== font
->driver
);
2743 driver
->close (f
, font
);
2747 if (driver
->free_entity
)
2748 driver
->free_entity (entity
);
2753 XSETCDR (cache
, Qnil
);
2757 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2759 /* Check each font-entity in VEC, and return a list of font-entities
2760 that satisfy this condition:
2761 (1) matches with SPEC and SIZE if SPEC is not nil, and
2762 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2765 extern Lisp_Object Vface_ignored_fonts
;
2768 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2770 Lisp_Object entity
, val
;
2771 enum font_property_index prop
;
2774 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2776 entity
= AREF (vec
, i
);
2777 if (! NILP (Vface_ignored_fonts
))
2780 Lisp_Object tail
, regexp
;
2782 if (font_unparse_xlfd (entity
, 0, name
, 256) >= 0)
2784 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2786 regexp
= XCAR (tail
);
2787 if (STRINGP (regexp
)
2788 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
2797 val
= Fcons (entity
, val
);
2800 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2801 if (INTEGERP (AREF (spec
, prop
))
2802 && ((XINT (AREF (spec
, prop
)) >> 8)
2803 != (XINT (AREF (entity
, prop
)) >> 8)))
2804 prop
= FONT_SPEC_MAX
;
2805 if (prop
< FONT_SPEC_MAX
2807 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2809 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2812 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2813 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2814 prop
= FONT_SPEC_MAX
;
2816 if (prop
< FONT_SPEC_MAX
2817 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2818 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2819 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2820 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2821 prop
= FONT_SPEC_MAX
;
2822 if (prop
< FONT_SPEC_MAX
2823 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2824 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2825 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2826 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2827 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2828 prop
= FONT_SPEC_MAX
;
2829 if (prop
< FONT_SPEC_MAX
)
2830 val
= Fcons (entity
, val
);
2832 return (Fvconcat (1, &val
));
2836 /* Return a list of vectors of font-entities matching with SPEC on
2837 FRAME. Each elements in the list is a vector of entities from the
2838 same font-driver. */
2841 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2843 FRAME_PTR f
= XFRAME (frame
);
2844 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2845 Lisp_Object ftype
, val
;
2846 Lisp_Object list
= Qnil
;
2848 int need_filtering
= 0;
2851 font_assert (FONT_SPEC_P (spec
));
2853 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2854 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2855 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2856 size
= font_pixel_size (f
, spec
);
2860 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2861 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2862 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2863 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2865 ASET (scratch_font_spec
, i
, Qnil
);
2866 if (! NILP (AREF (spec
, i
)))
2868 if (i
== FONT_DPI_INDEX
)
2869 /* Skip FONT_SPACING_INDEX */
2872 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2873 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2875 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2877 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2879 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2881 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2882 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2889 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2893 val
= Fvconcat (1, &val
);
2894 copy
= Fcopy_font_spec (scratch_font_spec
);
2895 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2896 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2900 || ! NILP (Vface_ignored_fonts
)))
2901 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2902 if (ASIZE (val
) > 0)
2903 list
= Fcons (val
, list
);
2906 list
= Fnreverse (list
);
2907 FONT_ADD_LOG ("list", spec
, list
);
2912 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2913 nil, is an array of face's attributes, which specifies preferred
2914 font-related attributes. */
2917 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2919 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2920 Lisp_Object ftype
, size
, entity
;
2922 Lisp_Object work
= Fcopy_font_spec (spec
);
2924 XSETFRAME (frame
, f
);
2925 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2926 size
= AREF (spec
, FONT_SIZE_INDEX
);
2929 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2930 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2931 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2932 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2935 for (; driver_list
; driver_list
= driver_list
->next
)
2937 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2939 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2942 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2943 entity
= assoc_no_quit (work
, XCDR (cache
));
2945 entity
= XCDR (entity
);
2948 entity
= driver_list
->driver
->match (frame
, work
);
2949 copy
= Fcopy_font_spec (work
);
2950 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2951 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2953 if (! NILP (entity
))
2956 FONT_ADD_LOG ("match", work
, entity
);
2961 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2962 opened font object. */
2965 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2967 struct font_driver_list
*driver_list
;
2968 Lisp_Object objlist
, size
, val
, font_object
;
2970 int min_width
, height
;
2971 int scaled_pixel_size
;
2973 font_assert (FONT_ENTITY_P (entity
));
2974 size
= AREF (entity
, FONT_SIZE_INDEX
);
2975 if (XINT (size
) != 0)
2976 scaled_pixel_size
= pixel_size
= XINT (size
);
2977 else if (CONSP (Vface_font_rescale_alist
))
2978 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2980 val
= AREF (entity
, FONT_TYPE_INDEX
);
2981 for (driver_list
= f
->font_driver_list
;
2982 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2983 driver_list
= driver_list
->next
);
2987 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2988 objlist
= XCDR (objlist
))
2990 Lisp_Object fn
= XCAR (objlist
);
2991 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2992 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2994 if (driver_list
->driver
->cached_font_ok
== NULL
2995 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
3000 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
3001 if (!NILP (font_object
))
3002 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3003 FONT_ADD_LOG ("open", entity
, font_object
);
3004 if (NILP (font_object
))
3006 ASET (entity
, FONT_OBJLIST_INDEX
,
3007 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
3008 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
3011 font
= XFONT_OBJECT (font_object
);
3012 min_width
= (font
->min_width
? font
->min_width
3013 : font
->average_width
? font
->average_width
3014 : font
->space_width
? font
->space_width
3016 height
= (font
->height
? font
->height
: 1);
3017 #ifdef HAVE_WINDOW_SYSTEM
3018 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
3019 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
3021 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
3022 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
3023 fonts_changed_p
= 1;
3027 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
3028 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
3029 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
3030 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
3038 /* Close FONT_OBJECT that is opened on frame F. */
3041 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
3043 struct font
*font
= XFONT_OBJECT (font_object
);
3045 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
3046 /* Already closed. */
3048 FONT_ADD_LOG ("close", font_object
, Qnil
);
3049 font
->driver
->close (f
, font
);
3050 #ifdef HAVE_WINDOW_SYSTEM
3051 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
3052 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
3058 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
3059 FONT is a font-entity and it must be opened to check. */
3062 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
3066 if (FONT_ENTITY_P (font
))
3068 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
3069 struct font_driver_list
*driver_list
;
3071 for (driver_list
= f
->font_driver_list
;
3072 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
3073 driver_list
= driver_list
->next
);
3076 if (! driver_list
->driver
->has_char
)
3078 return driver_list
->driver
->has_char (font
, c
);
3081 font_assert (FONT_OBJECT_P (font
));
3082 fontp
= XFONT_OBJECT (font
);
3083 if (fontp
->driver
->has_char
)
3085 int result
= fontp
->driver
->has_char (font
, c
);
3090 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
3094 /* Return the glyph ID of FONT_OBJECT for character C. */
3097 font_encode_char (Lisp_Object font_object
, int c
)
3101 font_assert (FONT_OBJECT_P (font_object
));
3102 font
= XFONT_OBJECT (font_object
);
3103 return font
->driver
->encode_char (font
, c
);
3107 /* Return the name of FONT_OBJECT. */
3110 font_get_name (Lisp_Object font_object
)
3112 font_assert (FONT_OBJECT_P (font_object
));
3113 return AREF (font_object
, FONT_NAME_INDEX
);
3117 /* Return the specification of FONT_OBJECT. */
3120 font_get_spec (Lisp_Object font_object
)
3122 Lisp_Object spec
= font_make_spec ();
3125 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
3126 ASET (spec
, i
, AREF (font_object
, i
));
3127 ASET (spec
, FONT_SIZE_INDEX
,
3128 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
3133 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3134 could not be parsed by font_parse_name, return Qnil. */
3137 font_spec_from_name (Lisp_Object font_name
)
3139 Lisp_Object spec
= Ffont_spec (0, NULL
);
3141 CHECK_STRING (font_name
);
3142 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3144 font_put_extra (spec
, QCname
, font_name
);
3145 font_put_extra (spec
, QCuser_spec
, font_name
);
3151 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
3153 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3158 if (! NILP (Ffont_get (font
, QCname
)))
3160 font
= Fcopy_font_spec (font
);
3161 font_put_extra (font
, QCname
, Qnil
);
3164 if (NILP (AREF (font
, prop
))
3165 && prop
!= FONT_FAMILY_INDEX
3166 && prop
!= FONT_FOUNDRY_INDEX
3167 && prop
!= FONT_WIDTH_INDEX
3168 && prop
!= FONT_SIZE_INDEX
)
3170 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3171 font
= Fcopy_font_spec (font
);
3172 ASET (font
, prop
, Qnil
);
3173 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3175 if (prop
== FONT_FAMILY_INDEX
)
3177 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3178 /* If we are setting the font family, we must also clear
3179 FONT_WIDTH_INDEX to avoid rejecting families that lack
3180 support for some widths. */
3181 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3183 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3184 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3185 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3186 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3187 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3188 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3190 else if (prop
== FONT_SIZE_INDEX
)
3192 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3193 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3194 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3196 else if (prop
== FONT_WIDTH_INDEX
)
3197 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3198 attrs
[LFACE_FONT_INDEX
] = font
;
3202 font_update_lface (FRAME_PTR f
, Lisp_Object
*attrs
)
3206 spec
= attrs
[LFACE_FONT_INDEX
];
3207 if (! FONT_SPEC_P (spec
))
3210 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3211 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3212 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3213 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3214 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3215 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3216 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3217 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);
3218 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3219 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3220 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3224 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3229 val
= Ffont_get (spec
, QCdpi
);
3232 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3234 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3236 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3238 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3239 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3245 /* Selecte a font from ENTITIES (list of font-entity vectors) that
3246 supports C and matches best with ATTRS and PIXEL_SIZE. */
3249 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
3251 Lisp_Object font_entity
;
3254 FRAME_PTR f
= XFRAME (frame
);
3256 if (NILP (XCDR (entities
))
3257 && ASIZE (XCAR (entities
)) == 1)
3259 font_entity
= AREF (XCAR (entities
), 0);
3261 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3266 /* Sort fonts by properties specified in ATTRS. */
3267 prefer
= scratch_font_prefer
;
3269 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3270 ASET (prefer
, i
, Qnil
);
3271 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3273 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3275 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3276 ASET (prefer
, i
, AREF (face_font
, i
));
3278 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3279 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3280 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3281 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3282 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3283 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3284 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3286 return font_sort_entities (entities
, prefer
, frame
, c
);
3289 /* Return a font-entity satisfying SPEC and best matching with face's
3290 font related attributes in ATTRS. C, if not negative, is a
3291 character that the entity must support. */
3294 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3297 Lisp_Object frame
, entities
, val
;
3298 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3302 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3303 if (NILP (registry
[0]))
3305 registry
[0] = DEFAULT_ENCODING
;
3306 registry
[1] = Qascii_0
;
3307 registry
[2] = null_vector
;
3310 registry
[1] = null_vector
;
3312 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3314 struct charset
*encoding
, *repertory
;
3316 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3317 &encoding
, &repertory
) < 0)
3320 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3322 else if (c
> encoding
->max_char
)
3326 work
= Fcopy_font_spec (spec
);
3327 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3328 XSETFRAME (frame
, f
);
3329 size
= AREF (spec
, FONT_SIZE_INDEX
);
3330 pixel_size
= font_pixel_size (f
, spec
);
3331 if (pixel_size
== 0)
3333 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3335 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3337 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3338 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3339 if (! NILP (foundry
[0]))
3340 foundry
[1] = null_vector
;
3341 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3343 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3344 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3346 foundry
[2] = null_vector
;
3349 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3351 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3352 if (! NILP (adstyle
[0]))
3353 adstyle
[1] = null_vector
;
3354 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3356 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3358 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3360 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3362 adstyle
[2] = null_vector
;
3365 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3368 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3371 val
= AREF (work
, FONT_FAMILY_INDEX
);
3372 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3374 val
= attrs
[LFACE_FAMILY_INDEX
];
3375 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3379 family
= alloca ((sizeof family
[0]) * 2);
3381 family
[1] = null_vector
; /* terminator. */
3386 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3387 /* Font family names are case-sensitive under NS. */
3395 if (! NILP (alters
))
3397 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3398 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3399 family
[i
] = XCAR (alters
);
3400 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3402 family
[i
] = null_vector
;
3406 family
= alloca ((sizeof family
[0]) * 3);
3409 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3411 family
[i
] = null_vector
;
3415 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3417 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3418 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3420 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3421 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3423 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3424 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3426 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3427 entities
= font_list_entities (frame
, work
);
3428 if (! NILP (entities
))
3430 val
= font_select_entity (frame
, entities
,
3431 attrs
, pixel_size
, c
);
3444 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3448 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3449 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3450 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3451 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3452 size
= font_pixel_size (f
, spec
);
3456 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3457 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3460 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3461 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3462 if (INTEGERP (height
))
3465 abort(); /* We should never end up here. */
3469 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3473 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3474 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3478 return font_open_entity (f
, entity
, size
);
3482 /* Find a font satisfying SPEC and best matching with face's
3483 attributes in ATTRS on FRAME, and return the opened
3487 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3489 Lisp_Object entity
, name
;
3491 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3494 /* No font is listed for SPEC, but each font-backend may have
3495 the different criteria about "font matching". So, try
3497 entity
= font_matching_entity (f
, attrs
, spec
);
3501 /* Don't loose the original name that was put in initially. We need
3502 it to re-apply the font when font parameters (like hinting or dpi) have
3504 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3507 name
= Ffont_get (spec
, QCuser_spec
);
3508 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3514 /* Make FACE on frame F ready to use the font opened for FACE. */
3517 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3519 if (face
->font
->driver
->prepare_face
)
3520 face
->font
->driver
->prepare_face (f
, face
);
3524 /* Make FACE on frame F stop using the font opened for FACE. */
3527 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3529 if (face
->font
->driver
->done_face
)
3530 face
->font
->driver
->done_face (f
, face
);
3535 /* Open a font matching with font-spec SPEC on frame F. If no proper
3536 font is found, return Qnil. */
3539 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3541 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3543 /* We set up the default font-related attributes of a face to prefer
3545 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3546 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3547 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3549 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3551 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3553 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3555 return font_load_for_lface (f
, attrs
, spec
);
3559 /* Open a font matching with NAME on frame F. If no proper font is
3560 found, return Qnil. */
3563 font_open_by_name (FRAME_PTR f
, char *name
)
3565 Lisp_Object args
[2];
3566 Lisp_Object spec
, ret
;
3569 args
[1] = make_unibyte_string (name
, strlen (name
));
3570 spec
= Ffont_spec (2, args
);
3571 ret
= font_open_by_spec (f
, spec
);
3572 /* Do not loose name originally put in. */
3574 font_put_extra (ret
, QCuser_spec
, args
[1]);
3580 /* Register font-driver DRIVER. This function is used in two ways.
3582 The first is with frame F non-NULL. In this case, make DRIVER
3583 available (but not yet activated) on F. All frame creaters
3584 (e.g. Fx_create_frame) must call this function at least once with
3585 an available font-driver.
3587 The second is with frame F NULL. In this case, DRIVER is globally
3588 registered in the variable `font_driver_list'. All font-driver
3589 implementations must call this function in its syms_of_XXXX
3590 (e.g. syms_of_xfont). */
3593 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3595 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3596 struct font_driver_list
*prev
, *list
;
3598 if (f
&& ! driver
->draw
)
3599 error ("Unusable font driver for a frame: %s",
3600 SDATA (SYMBOL_NAME (driver
->type
)));
3602 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3603 if (EQ (list
->driver
->type
, driver
->type
))
3604 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3606 list
= xmalloc (sizeof (struct font_driver_list
));
3608 list
->driver
= driver
;
3613 f
->font_driver_list
= list
;
3615 font_driver_list
= list
;
3621 free_font_driver_list (FRAME_PTR f
)
3623 struct font_driver_list
*list
, *next
;
3625 for (list
= f
->font_driver_list
; list
; list
= next
)
3630 f
->font_driver_list
= NULL
;
3634 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3635 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3636 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3638 A caller must free all realized faces if any in advance. The
3639 return value is a list of font backends actually made used on
3643 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3645 Lisp_Object active_drivers
= Qnil
;
3646 struct font_driver
*driver
;
3647 struct font_driver_list
*list
;
3649 /* At first, turn off non-requested drivers, and turn on requested
3651 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3653 driver
= list
->driver
;
3654 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3659 if (driver
->end_for_frame
)
3660 driver
->end_for_frame (f
);
3661 font_finish_cache (f
, driver
);
3666 if (! driver
->start_for_frame
3667 || driver
->start_for_frame (f
) == 0)
3669 font_prepare_cache (f
, driver
);
3676 if (NILP (new_drivers
))
3679 if (! EQ (new_drivers
, Qt
))
3681 /* Re-order the driver list according to new_drivers. */
3682 struct font_driver_list
**list_table
, **next
;
3686 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3687 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3689 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3690 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3693 list_table
[i
++] = list
;
3695 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3697 list_table
[i
++] = list
;
3698 list_table
[i
] = NULL
;
3700 next
= &f
->font_driver_list
;
3701 for (i
= 0; list_table
[i
]; i
++)
3703 *next
= list_table
[i
];
3704 next
= &(*next
)->next
;
3708 if (! f
->font_driver_list
->on
)
3709 { /* None of the drivers is enabled: enable them all.
3710 Happens if you set the list of drivers to (xft x) in your .emacs
3711 and then use it under w32 or ns. */
3712 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3714 struct font_driver
*driver
= list
->driver
;
3715 eassert (! list
->on
);
3716 if (! driver
->start_for_frame
3717 || driver
->start_for_frame (f
) == 0)
3719 font_prepare_cache (f
, driver
);
3726 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3728 active_drivers
= nconc2 (active_drivers
,
3729 Fcons (list
->driver
->type
, Qnil
));
3730 return active_drivers
;
3734 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3736 struct font_data_list
*list
, *prev
;
3738 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3739 prev
= list
, list
= list
->next
)
3740 if (list
->driver
== driver
)
3747 prev
->next
= list
->next
;
3749 f
->font_data_list
= list
->next
;
3757 list
= xmalloc (sizeof (struct font_data_list
));
3758 list
->driver
= driver
;
3759 list
->next
= f
->font_data_list
;
3760 f
->font_data_list
= list
;
3768 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3770 struct font_data_list
*list
;
3772 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3773 if (list
->driver
== driver
)
3781 /* Return the font used to draw character C by FACE at buffer position
3782 POS in window W. If STRING is non-nil, it is a string containing C
3783 at index POS. If C is negative, get C from the current buffer or
3787 font_at (int c
, EMACS_INT pos
, struct face
*face
, struct window
*w
, Lisp_Object string
)
3791 Lisp_Object font_object
;
3793 multibyte
= (NILP (string
)
3794 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3795 : STRING_MULTIBYTE (string
));
3802 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3804 c
= FETCH_CHAR (pos_byte
);
3807 c
= FETCH_BYTE (pos
);
3813 multibyte
= STRING_MULTIBYTE (string
);
3816 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3818 str
= SDATA (string
) + pos_byte
;
3819 c
= STRING_CHAR (str
);
3822 c
= SDATA (string
)[pos
];
3826 f
= XFRAME (w
->frame
);
3827 if (! FRAME_WINDOW_P (f
))
3834 if (STRINGP (string
))
3835 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3836 DEFAULT_FACE_ID
, 0);
3838 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3840 face
= FACE_FROM_ID (f
, face_id
);
3844 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3845 face
= FACE_FROM_ID (f
, face_id
);
3850 XSETFONT (font_object
, face
->font
);
3855 #ifdef HAVE_WINDOW_SYSTEM
3857 /* Check how many characters after POS (at most to *LIMIT) can be
3858 displayed by the same font on the window W. FACE, if non-NULL, is
3859 the face selected for the character at POS. If STRING is not nil,
3860 it is the string to check instead of the current buffer. In that
3861 case, FACE must be not NULL.
3863 The return value is the font-object for the character at POS.
3864 *LIMIT is set to the position where that font can't be used.
3866 It is assured that the current buffer (or STRING) is multibyte. */
3869 font_range (EMACS_INT pos
, EMACS_INT
*limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3871 EMACS_INT pos_byte
, ignore
;
3873 Lisp_Object font_object
= Qnil
;
3877 pos_byte
= CHAR_TO_BYTE (pos
);
3882 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3884 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3890 pos_byte
= string_char_to_byte (string
, pos
);
3893 while (pos
< *limit
)
3895 Lisp_Object category
;
3898 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3900 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3901 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3902 if (EQ (category
, QCf
)
3903 || CHAR_VARIATION_SELECTOR_P (c
))
3905 if (NILP (font_object
))
3907 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3908 if (NILP (font_object
))
3912 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3922 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3923 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3924 Return nil otherwise.
3925 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3926 which kind of font it is. It must be one of `font-spec', `font-entity',
3928 (object
, extra_type
)
3929 Lisp_Object object
, extra_type
;
3931 if (NILP (extra_type
))
3932 return (FONTP (object
) ? Qt
: Qnil
);
3933 if (EQ (extra_type
, Qfont_spec
))
3934 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3935 if (EQ (extra_type
, Qfont_entity
))
3936 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3937 if (EQ (extra_type
, Qfont_object
))
3938 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3939 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3942 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3943 doc
: /* Return a newly created font-spec with arguments as properties.
3945 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3946 valid font property name listed below:
3948 `:family', `:weight', `:slant', `:width'
3950 They are the same as face attributes of the same name. See
3951 `set-face-attribute'.
3955 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3959 VALUE must be a string or a symbol specifying the additional
3960 typographic style information of a font, e.g. ``sans''.
3964 VALUE must be a string or a symbol specifying the charset registry and
3965 encoding of a font, e.g. ``iso8859-1''.
3969 VALUE must be a non-negative integer or a floating point number
3970 specifying the font size. It specifies the font size in pixels (if
3971 VALUE is an integer), or in points (if VALUE is a float).
3975 VALUE must be a string of XLFD-style or fontconfig-style font name.
3979 VALUE must be a symbol representing a script that the font must
3980 support. It may be a symbol representing a subgroup of a script
3981 listed in the variable `script-representative-chars'.
3985 VALUE must be a symbol of two-letter ISO-639 language names,
3990 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3991 required OpenType features.
3993 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3994 LANGSYS-TAG: OpenType language system tag symbol,
3995 or nil for the default language system.
3996 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3997 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3999 GSUB and GPOS may contain `nil' element. In such a case, the font
4000 must not have any of the remaining elements.
4002 For instance, if the VALUE is `(thai nil nil (mark))', the font must
4003 be an OpenType font, and whose GPOS table of `thai' script's default
4004 language system must contain `mark' feature.
4006 usage: (font-spec ARGS...) */)
4011 Lisp_Object spec
= font_make_spec ();
4014 for (i
= 0; i
< nargs
; i
+= 2)
4016 Lisp_Object key
= args
[i
], val
;
4020 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
4023 if (EQ (key
, QCname
))
4026 font_parse_name ((char *) SDATA (val
), spec
);
4027 font_put_extra (spec
, key
, val
);
4031 int idx
= get_font_prop_index (key
);
4035 val
= font_prop_validate (idx
, Qnil
, val
);
4036 if (idx
< FONT_EXTRA_INDEX
)
4037 ASET (spec
, idx
, val
);
4039 font_put_extra (spec
, key
, val
);
4042 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
4048 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
4049 doc
: /* Return a copy of FONT as a font-spec. */)
4053 Lisp_Object new_spec
, tail
, prev
, extra
;
4057 new_spec
= font_make_spec ();
4058 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
4059 ASET (new_spec
, i
, AREF (font
, i
));
4060 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
4061 /* We must remove :font-entity property. */
4062 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
4063 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
4066 extra
= XCDR (extra
);
4068 XSETCDR (prev
, XCDR (tail
));
4071 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
4075 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
4076 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
4077 Every specified properties in FROM override the corresponding
4078 properties in TO. */)
4080 Lisp_Object from
, to
;
4082 Lisp_Object extra
, tail
;
4087 to
= Fcopy_font_spec (to
);
4088 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
4089 ASET (to
, i
, AREF (from
, i
));
4090 extra
= AREF (to
, FONT_EXTRA_INDEX
);
4091 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
4092 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
4094 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
4097 XSETCDR (slot
, XCDR (XCAR (tail
)));
4099 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
4101 ASET (to
, FONT_EXTRA_INDEX
, extra
);
4105 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
4106 doc
: /* Return the value of FONT's property KEY.
4107 FONT is a font-spec, a font-entity, or a font-object.
4108 KEY must be one of these symbols:
4109 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4110 :size, :name, :script
4111 See the documentation of `font-spec' for their meanings.
4112 If FONT is a font-entity or font-object, the value of :script may be
4113 a list of scripts that are supported by the font. */)
4115 Lisp_Object font
, key
;
4122 idx
= get_font_prop_index (key
);
4123 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4124 return font_style_symbolic (font
, idx
, 0);
4125 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4126 return AREF (font
, idx
);
4127 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
4130 #ifdef HAVE_WINDOW_SYSTEM
4132 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4133 doc
: /* Return a plist of face attributes generated by FONT.
4134 FONT is a font name, a font-spec, a font-entity, or a font-object.
4135 The return value is a list of the form
4137 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4139 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4140 compatible with `set-face-attribute'. Some of these key-attribute pairs
4141 may be omitted from the list if they are not specified by FONT.
4143 The optional argument FRAME specifies the frame that the face attributes
4144 are to be displayed on. If omitted, the selected frame is used. */)
4146 Lisp_Object font
, frame
;
4149 Lisp_Object plist
[10];
4154 frame
= selected_frame
;
4155 CHECK_LIVE_FRAME (frame
);
4160 int fontset
= fs_query_fontset (font
, 0);
4161 Lisp_Object name
= font
;
4163 font
= fontset_ascii (fontset
);
4164 font
= font_spec_from_name (name
);
4166 signal_error ("Invalid font name", name
);
4168 else if (! FONTP (font
))
4169 signal_error ("Invalid font object", font
);
4171 val
= AREF (font
, FONT_FAMILY_INDEX
);
4174 plist
[n
++] = QCfamily
;
4175 plist
[n
++] = SYMBOL_NAME (val
);
4178 val
= AREF (font
, FONT_SIZE_INDEX
);
4181 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4182 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4183 plist
[n
++] = QCheight
;
4184 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4186 else if (FLOATP (val
))
4188 plist
[n
++] = QCheight
;
4189 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4192 val
= FONT_WEIGHT_FOR_FACE (font
);
4195 plist
[n
++] = QCweight
;
4199 val
= FONT_SLANT_FOR_FACE (font
);
4202 plist
[n
++] = QCslant
;
4206 val
= FONT_WIDTH_FOR_FACE (font
);
4209 plist
[n
++] = QCwidth
;
4213 return Flist (n
, plist
);
4218 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4219 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
4220 (font_spec
, prop
, val
)
4221 Lisp_Object font_spec
, prop
, val
;
4225 CHECK_FONT_SPEC (font_spec
);
4226 idx
= get_font_prop_index (prop
);
4227 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4228 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
4230 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
4234 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4235 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4236 Optional 2nd argument FRAME specifies the target frame.
4237 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4238 Optional 4th argument PREFER, if non-nil, is a font-spec to
4239 control the order of the returned list. Fonts are sorted by
4240 how close they are to PREFER. */)
4241 (font_spec
, frame
, num
, prefer
)
4242 Lisp_Object font_spec
, frame
, num
, prefer
;
4244 Lisp_Object vec
, list
;
4248 frame
= selected_frame
;
4249 CHECK_LIVE_FRAME (frame
);
4250 CHECK_FONT_SPEC (font_spec
);
4258 if (! NILP (prefer
))
4259 CHECK_FONT_SPEC (prefer
);
4261 list
= font_list_entities (frame
, font_spec
);
4264 if (NILP (XCDR (list
))
4265 && ASIZE (XCAR (list
)) == 1)
4266 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4268 if (! NILP (prefer
))
4269 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4271 vec
= font_vconcat_entity_vectors (list
);
4272 if (n
== 0 || n
>= ASIZE (vec
))
4274 Lisp_Object args
[2];
4278 list
= Fappend (2, args
);
4282 for (list
= Qnil
, n
--; n
>= 0; n
--)
4283 list
= Fcons (AREF (vec
, n
), list
);
4288 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4289 doc
: /* List available font families on the current frame.
4290 Optional argument FRAME, if non-nil, specifies the target frame. */)
4295 struct font_driver_list
*driver_list
;
4299 frame
= selected_frame
;
4300 CHECK_LIVE_FRAME (frame
);
4303 for (driver_list
= f
->font_driver_list
; driver_list
;
4304 driver_list
= driver_list
->next
)
4305 if (driver_list
->driver
->list_family
)
4307 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4308 Lisp_Object tail
= list
;
4310 for (; CONSP (val
); val
= XCDR (val
))
4311 if (NILP (Fmemq (XCAR (val
), tail
))
4312 && SYMBOLP (XCAR (val
)))
4313 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4318 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4319 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4320 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4322 Lisp_Object font_spec
, frame
;
4324 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4331 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4332 doc
: /* Return XLFD name of FONT.
4333 FONT is a font-spec, font-entity, or font-object.
4334 If the name is too long for XLFD (maximum 255 chars), return nil.
4335 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4336 the consecutive wildcards are folded to one. */)
4337 (font
, fold_wildcards
)
4338 Lisp_Object font
, fold_wildcards
;
4345 if (FONT_OBJECT_P (font
))
4347 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4349 if (STRINGP (font_name
)
4350 && SDATA (font_name
)[0] == '-')
4352 if (NILP (fold_wildcards
))
4354 strcpy (name
, (char *) SDATA (font_name
));
4357 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4359 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4362 if (! NILP (fold_wildcards
))
4364 char *p0
= name
, *p1
;
4366 while ((p1
= strstr (p0
, "-*-*")))
4368 strcpy (p1
, p1
+ 2);
4373 return build_string (name
);
4376 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4377 doc
: /* Clear font cache. */)
4380 Lisp_Object list
, frame
;
4382 FOR_EACH_FRAME (list
, frame
)
4384 FRAME_PTR f
= XFRAME (frame
);
4385 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4387 for (; driver_list
; driver_list
= driver_list
->next
)
4388 if (driver_list
->on
)
4390 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4391 Lisp_Object val
, tmp
;
4395 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4397 font_assert (! NILP (val
));
4398 tmp
= XCDR (XCAR (val
));
4399 if (XINT (XCAR (tmp
)) == 0)
4401 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4402 XSETCDR (cache
, XCDR (val
));
4412 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4414 struct font
*font
= XFONT_OBJECT (font_object
);
4416 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4417 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4418 struct font_metrics metrics
;
4420 LGLYPH_SET_CODE (glyph
, ecode
);
4422 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4423 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4424 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4425 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4426 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4427 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4431 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4432 doc
: /* Shape the glyph-string GSTRING.
4433 Shaping means substituting glyphs and/or adjusting positions of glyphs
4434 to get the correct visual image of character sequences set in the
4435 header of the glyph-string.
4437 If the shaping was successful, the value is GSTRING itself or a newly
4438 created glyph-string. Otherwise, the value is nil. */)
4440 Lisp_Object gstring
;
4443 Lisp_Object font_object
, n
, glyph
;
4446 if (! composition_gstring_p (gstring
))
4447 signal_error ("Invalid glyph-string: ", gstring
);
4448 if (! NILP (LGSTRING_ID (gstring
)))
4450 font_object
= LGSTRING_FONT (gstring
);
4451 CHECK_FONT_OBJECT (font_object
);
4452 font
= XFONT_OBJECT (font_object
);
4453 if (! font
->driver
->shape
)
4456 /* Try at most three times with larger gstring each time. */
4457 for (i
= 0; i
< 3; i
++)
4459 n
= font
->driver
->shape (gstring
);
4462 gstring
= larger_vector (gstring
,
4463 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4466 if (i
== 3 || XINT (n
) == 0)
4469 glyph
= LGSTRING_GLYPH (gstring
, 0);
4470 from
= LGLYPH_FROM (glyph
);
4471 to
= LGLYPH_TO (glyph
);
4472 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4474 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4478 if (NILP (LGLYPH_ADJUSTMENT (this)))
4483 glyph
= LGSTRING_GLYPH (gstring
, j
);
4484 LGLYPH_SET_FROM (glyph
, from
);
4485 LGLYPH_SET_TO (glyph
, to
);
4487 from
= LGLYPH_FROM (this);
4488 to
= LGLYPH_TO (this);
4493 if (from
> LGLYPH_FROM (this))
4494 from
= LGLYPH_FROM (this);
4495 if (to
< LGLYPH_TO (this))
4496 to
= LGLYPH_TO (this);
4502 glyph
= LGSTRING_GLYPH (gstring
, j
);
4503 LGLYPH_SET_FROM (glyph
, from
);
4504 LGLYPH_SET_TO (glyph
, to
);
4506 return composition_gstring_put_cache (gstring
, XINT (n
));
4509 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4511 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4512 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4514 VARIATION-SELECTOR is a chracter code of variation selection
4515 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4516 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4517 (font_object
, character
)
4518 Lisp_Object font_object
, character
;
4520 unsigned variations
[256];
4525 CHECK_FONT_OBJECT (font_object
);
4526 CHECK_CHARACTER (character
);
4527 font
= XFONT_OBJECT (font_object
);
4528 if (! font
->driver
->get_variation_glyphs
)
4530 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4534 for (i
= 0; i
< 255; i
++)
4538 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4539 /* Stops GCC whining about limited range of data type. */
4540 EMACS_INT var
= variations
[i
];
4542 if (var
> MOST_POSITIVE_FIXNUM
)
4543 code
= Fcons (make_number ((variations
[i
]) >> 16),
4544 make_number ((variations
[i
]) & 0xFFFF));
4546 code
= make_number (variations
[i
]);
4547 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4554 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4555 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4556 OTF-FEATURES specifies which features to apply in this format:
4557 (SCRIPT LANGSYS GSUB GPOS)
4559 SCRIPT is a symbol specifying a script tag of OpenType,
4560 LANGSYS is a symbol specifying a langsys tag of OpenType,
4561 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4563 If LANGYS is nil, the default langsys is selected.
4565 The features are applied in the order they appear in the list. The
4566 symbol `*' means to apply all available features not present in this
4567 list, and the remaining features are ignored. For instance, (vatu
4568 pstf * haln) is to apply vatu and pstf in this order, then to apply
4569 all available features other than vatu, pstf, and haln.
4571 The features are applied to the glyphs in the range FROM and TO of
4572 the glyph-string GSTRING-IN.
4574 If some feature is actually applicable, the resulting glyphs are
4575 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4576 this case, the value is the number of produced glyphs.
4578 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4581 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4582 produced in GSTRING-OUT, and the value is nil.
4584 See the documentation of `font-make-gstring' for the format of
4586 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4587 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4589 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4594 check_otf_features (otf_features
);
4595 CHECK_FONT_OBJECT (font_object
);
4596 font
= XFONT_OBJECT (font_object
);
4597 if (! font
->driver
->otf_drive
)
4598 error ("Font backend %s can't drive OpenType GSUB table",
4599 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4600 CHECK_CONS (otf_features
);
4601 CHECK_SYMBOL (XCAR (otf_features
));
4602 val
= XCDR (otf_features
);
4603 CHECK_SYMBOL (XCAR (val
));
4604 val
= XCDR (otf_features
);
4607 len
= check_gstring (gstring_in
);
4608 CHECK_VECTOR (gstring_out
);
4609 CHECK_NATNUM (from
);
4611 CHECK_NATNUM (index
);
4613 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4614 args_out_of_range_3 (from
, to
, make_number (len
));
4615 if (XINT (index
) >= ASIZE (gstring_out
))
4616 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4617 num
= font
->driver
->otf_drive (font
, otf_features
,
4618 gstring_in
, XINT (from
), XINT (to
),
4619 gstring_out
, XINT (index
), 0);
4622 return make_number (num
);
4625 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4627 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4628 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4630 (SCRIPT LANGSYS FEATURE ...)
4631 See the documentation of `font-drive-otf' for more detail.
4633 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4634 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4635 character code corresponding to the glyph or nil if there's no
4636 corresponding character. */)
4637 (font_object
, character
, otf_features
)
4638 Lisp_Object font_object
, character
, otf_features
;
4641 Lisp_Object gstring_in
, gstring_out
, g
;
4642 Lisp_Object alternates
;
4645 CHECK_FONT_GET_OBJECT (font_object
, font
);
4646 if (! font
->driver
->otf_drive
)
4647 error ("Font backend %s can't drive OpenType GSUB table",
4648 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4649 CHECK_CHARACTER (character
);
4650 CHECK_CONS (otf_features
);
4652 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4653 g
= LGSTRING_GLYPH (gstring_in
, 0);
4654 LGLYPH_SET_CHAR (g
, XINT (character
));
4655 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4656 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4657 gstring_out
, 0, 1)) < 0)
4658 gstring_out
= Ffont_make_gstring (font_object
,
4659 make_number (ASIZE (gstring_out
) * 2));
4661 for (i
= 0; i
< num
; i
++)
4663 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4664 int c
= LGLYPH_CHAR (g
);
4665 unsigned code
= LGLYPH_CODE (g
);
4667 alternates
= Fcons (Fcons (make_number (code
),
4668 c
> 0 ? make_number (c
) : Qnil
),
4671 return Fnreverse (alternates
);
4677 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4678 doc
: /* Open FONT-ENTITY. */)
4679 (font_entity
, size
, frame
)
4680 Lisp_Object font_entity
;
4686 CHECK_FONT_ENTITY (font_entity
);
4688 frame
= selected_frame
;
4689 CHECK_LIVE_FRAME (frame
);
4692 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4695 CHECK_NUMBER_OR_FLOAT (size
);
4697 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4699 isize
= XINT (size
);
4703 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4706 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4707 doc
: /* Close FONT-OBJECT. */)
4708 (font_object
, frame
)
4709 Lisp_Object font_object
, frame
;
4711 CHECK_FONT_OBJECT (font_object
);
4713 frame
= selected_frame
;
4714 CHECK_LIVE_FRAME (frame
);
4715 font_close_object (XFRAME (frame
), font_object
);
4719 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4720 doc
: /* Return information about FONT-OBJECT.
4721 The value is a vector:
4722 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4725 NAME is a string of the font name (or nil if the font backend doesn't
4728 FILENAME is a string of the font file (or nil if the font backend
4729 doesn't provide a file name).
4731 PIXEL-SIZE is a pixel size by which the font is opened.
4733 SIZE is a maximum advance width of the font in pixels.
4735 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4738 CAPABILITY is a list whose first element is a symbol representing the
4739 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4740 remaining elements describe the details of the font capability.
4742 If the font is OpenType font, the form of the list is
4743 \(opentype GSUB GPOS)
4744 where GSUB shows which "GSUB" features the font supports, and GPOS
4745 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4746 lists of the format:
4747 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4749 If the font is not OpenType font, currently the length of the form is
4752 SCRIPT is a symbol representing OpenType script tag.
4754 LANGSYS is a symbol representing OpenType langsys tag, or nil
4755 representing the default langsys.
4757 FEATURE is a symbol representing OpenType feature tag.
4759 If the font is not OpenType font, CAPABILITY is nil. */)
4761 Lisp_Object font_object
;
4766 CHECK_FONT_GET_OBJECT (font_object
, font
);
4768 val
= Fmake_vector (make_number (9), Qnil
);
4769 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4770 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4771 ASET (val
, 2, make_number (font
->pixel_size
));
4772 ASET (val
, 3, make_number (font
->max_width
));
4773 ASET (val
, 4, make_number (font
->ascent
));
4774 ASET (val
, 5, make_number (font
->descent
));
4775 ASET (val
, 6, make_number (font
->space_width
));
4776 ASET (val
, 7, make_number (font
->average_width
));
4777 if (font
->driver
->otf_capability
)
4778 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4782 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4783 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4784 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4785 (font_object
, string
)
4786 Lisp_Object font_object
, string
;
4792 CHECK_FONT_GET_OBJECT (font_object
, font
);
4793 CHECK_STRING (string
);
4794 len
= SCHARS (string
);
4795 vec
= Fmake_vector (make_number (len
), Qnil
);
4796 for (i
= 0; i
< len
; i
++)
4798 Lisp_Object ch
= Faref (string
, make_number (i
));
4803 struct font_metrics metrics
;
4805 cod
= code
= font
->driver
->encode_char (font
, c
);
4806 if (code
== FONT_INVALID_CODE
)
4808 val
= Fmake_vector (make_number (6), Qnil
);
4809 if (cod
<= MOST_POSITIVE_FIXNUM
)
4810 ASET (val
, 0, make_number (code
));
4812 ASET (val
, 0, Fcons (make_number (code
>> 16),
4813 make_number (code
& 0xFFFF)));
4814 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4815 ASET (val
, 1, make_number (metrics
.lbearing
));
4816 ASET (val
, 2, make_number (metrics
.rbearing
));
4817 ASET (val
, 3, make_number (metrics
.width
));
4818 ASET (val
, 4, make_number (metrics
.ascent
));
4819 ASET (val
, 5, make_number (metrics
.descent
));
4825 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4826 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4827 FONT is a font-spec, font-entity, or font-object. */)
4829 Lisp_Object spec
, font
;
4831 CHECK_FONT_SPEC (spec
);
4834 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4837 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4838 doc
: /* Return a font-object for displaying a character at POSITION.
4839 Optional second arg WINDOW, if non-nil, is a window displaying
4840 the current buffer. It defaults to the currently selected window. */)
4841 (position
, window
, string
)
4842 Lisp_Object position
, window
, string
;
4849 CHECK_NUMBER_COERCE_MARKER (position
);
4850 pos
= XINT (position
);
4851 if (pos
< BEGV
|| pos
>= ZV
)
4852 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4856 CHECK_NUMBER (position
);
4857 CHECK_STRING (string
);
4858 pos
= XINT (position
);
4859 if (pos
< 0 || pos
>= SCHARS (string
))
4860 args_out_of_range (string
, position
);
4863 window
= selected_window
;
4864 CHECK_LIVE_WINDOW (window
);
4865 w
= XWINDOW (window
);
4867 return font_at (-1, pos
, NULL
, w
, string
);
4871 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4872 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4873 The value is a number of glyphs drawn.
4874 Type C-l to recover what previously shown. */)
4875 (font_object
, string
)
4876 Lisp_Object font_object
, string
;
4878 Lisp_Object frame
= selected_frame
;
4879 FRAME_PTR f
= XFRAME (frame
);
4885 CHECK_FONT_GET_OBJECT (font_object
, font
);
4886 CHECK_STRING (string
);
4887 len
= SCHARS (string
);
4888 code
= alloca (sizeof (unsigned) * len
);
4889 for (i
= 0; i
< len
; i
++)
4891 Lisp_Object ch
= Faref (string
, make_number (i
));
4895 code
[i
] = font
->driver
->encode_char (font
, c
);
4896 if (code
[i
] == FONT_INVALID_CODE
)
4899 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4901 if (font
->driver
->prepare_face
)
4902 font
->driver
->prepare_face (f
, face
);
4903 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4904 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4905 if (font
->driver
->done_face
)
4906 font
->driver
->done_face (f
, face
);
4908 return make_number (len
);
4912 #endif /* FONT_DEBUG */
4914 #ifdef HAVE_WINDOW_SYSTEM
4916 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4917 doc
: /* Return information about a font named NAME on frame FRAME.
4918 If FRAME is omitted or nil, use the selected frame.
4919 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4920 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4922 OPENED-NAME is the name used for opening the font,
4923 FULL-NAME is the full name of the font,
4924 SIZE is the pixelsize of the font,
4925 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4926 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4927 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4928 how to compose characters.
4929 If the named font is not yet loaded, return nil. */)
4931 Lisp_Object name
, frame
;
4936 Lisp_Object font_object
;
4938 (*check_window_system_func
) ();
4941 CHECK_STRING (name
);
4943 frame
= selected_frame
;
4944 CHECK_LIVE_FRAME (frame
);
4949 int fontset
= fs_query_fontset (name
, 0);
4952 name
= fontset_ascii (fontset
);
4953 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4955 else if (FONT_OBJECT_P (name
))
4957 else if (FONT_ENTITY_P (name
))
4958 font_object
= font_open_entity (f
, name
, 0);
4961 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4962 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4964 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4966 if (NILP (font_object
))
4968 font
= XFONT_OBJECT (font_object
);
4970 info
= Fmake_vector (make_number (7), Qnil
);
4971 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4972 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
4973 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4974 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4975 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4976 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4977 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4980 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4981 close it now. Perhaps, we should manage font-objects
4982 by `reference-count'. */
4983 font_close_object (f
, font_object
);
4990 #define BUILD_STYLE_TABLE(TBL) \
4991 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4994 build_style_table (const struct table_entry
*entry
, int nelement
)
4997 Lisp_Object table
, elt
;
4999 table
= Fmake_vector (make_number (nelement
), Qnil
);
5000 for (i
= 0; i
< nelement
; i
++)
5002 for (j
= 0; entry
[i
].names
[j
]; j
++);
5003 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
5004 ASET (elt
, 0, make_number (entry
[i
].numeric
));
5005 for (j
= 0; entry
[i
].names
[j
]; j
++)
5006 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
5007 ASET (table
, i
, elt
);
5012 Lisp_Object Vfont_log
;
5014 /* The deferred font-log data of the form [ACTION ARG RESULT].
5015 If ACTION is not nil, that is added to the log when font_add_log is
5016 called next time. At that time, ACTION is set back to nil. */
5017 static Lisp_Object Vfont_log_deferred
;
5019 /* Prepend the font-related logging data in Vfont_log if it is not
5020 `t'. ACTION describes a kind of font-related action (e.g. listing,
5021 opening), ARG is the argument for the action, and RESULT is the
5022 result of the action. */
5024 font_add_log (char *action
, Lisp_Object arg
, Lisp_Object result
)
5026 Lisp_Object tail
, val
;
5029 if (EQ (Vfont_log
, Qt
))
5031 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5033 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
5035 ASET (Vfont_log_deferred
, 0, Qnil
);
5036 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5037 AREF (Vfont_log_deferred
, 2));
5042 Lisp_Object tail
, elt
;
5043 Lisp_Object equalstr
= build_string ("=");
5045 val
= Ffont_xlfd_name (arg
, Qt
);
5046 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5050 if (EQ (XCAR (elt
), QCscript
)
5051 && SYMBOLP (XCDR (elt
)))
5052 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5053 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5054 else if (EQ (XCAR (elt
), QClang
)
5055 && SYMBOLP (XCDR (elt
)))
5056 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5057 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5058 else if (EQ (XCAR (elt
), QCotf
)
5059 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5060 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5062 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5068 && VECTORP (XCAR (result
))
5069 && ASIZE (XCAR (result
)) > 0
5070 && FONTP (AREF (XCAR (result
), 0)))
5071 result
= font_vconcat_entity_vectors (result
);
5074 val
= Ffont_xlfd_name (result
, Qt
);
5075 if (! FONT_SPEC_P (result
))
5076 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5077 build_string (":"), val
);
5080 else if (CONSP (result
))
5082 result
= Fcopy_sequence (result
);
5083 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5087 val
= Ffont_xlfd_name (val
, Qt
);
5088 XSETCAR (tail
, val
);
5091 else if (VECTORP (result
))
5093 result
= Fcopy_sequence (result
);
5094 for (i
= 0; i
< ASIZE (result
); i
++)
5096 val
= AREF (result
, i
);
5098 val
= Ffont_xlfd_name (val
, Qt
);
5099 ASET (result
, i
, val
);
5102 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5105 /* Record a font-related logging data to be added to Vfont_log when
5106 font_add_log is called next time. ACTION, ARG, RESULT are the same
5110 font_deferred_log (char *action
, Lisp_Object arg
, Lisp_Object result
)
5112 if (EQ (Vfont_log
, Qt
))
5114 ASET (Vfont_log_deferred
, 0, build_string (action
));
5115 ASET (Vfont_log_deferred
, 1, arg
);
5116 ASET (Vfont_log_deferred
, 2, result
);
5119 extern void syms_of_ftfont (void);
5120 extern void syms_of_xfont (void);
5121 extern void syms_of_xftfont (void);
5122 extern void syms_of_ftxfont (void);
5123 extern void syms_of_bdffont (void);
5124 extern void syms_of_w32font (void);
5125 extern void syms_of_atmfont (void);
5126 extern void syms_of_nsfont (void);
5131 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5132 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5133 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5134 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5135 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5136 /* Note that the other elements in sort_shift_bits are not used. */
5138 staticpro (&font_charset_alist
);
5139 font_charset_alist
= Qnil
;
5141 DEFSYM (Qopentype
, "opentype");
5143 DEFSYM (Qascii_0
, "ascii-0");
5144 DEFSYM (Qiso8859_1
, "iso8859-1");
5145 DEFSYM (Qiso10646_1
, "iso10646-1");
5146 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5147 DEFSYM (Qunicode_sip
, "unicode-sip");
5151 DEFSYM (QCotf
, ":otf");
5152 DEFSYM (QClang
, ":lang");
5153 DEFSYM (QCscript
, ":script");
5154 DEFSYM (QCantialias
, ":antialias");
5156 DEFSYM (QCfoundry
, ":foundry");
5157 DEFSYM (QCadstyle
, ":adstyle");
5158 DEFSYM (QCregistry
, ":registry");
5159 DEFSYM (QCspacing
, ":spacing");
5160 DEFSYM (QCdpi
, ":dpi");
5161 DEFSYM (QCscalable
, ":scalable");
5162 DEFSYM (QCavgwidth
, ":avgwidth");
5163 DEFSYM (QCfont_entity
, ":font-entity");
5164 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5174 DEFSYM (QCuser_spec
, "user-spec");
5176 staticpro (&null_vector
);
5177 null_vector
= Fmake_vector (make_number (0), Qnil
);
5179 staticpro (&scratch_font_spec
);
5180 scratch_font_spec
= Ffont_spec (0, NULL
);
5181 staticpro (&scratch_font_prefer
);
5182 scratch_font_prefer
= Ffont_spec (0, NULL
);
5184 staticpro (&Vfont_log_deferred
);
5185 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5189 staticpro (&otf_list
);
5191 #endif /* HAVE_LIBOTF */
5195 defsubr (&Sfont_spec
);
5196 defsubr (&Sfont_get
);
5197 #ifdef HAVE_WINDOW_SYSTEM
5198 defsubr (&Sfont_face_attributes
);
5200 defsubr (&Sfont_put
);
5201 defsubr (&Slist_fonts
);
5202 defsubr (&Sfont_family_list
);
5203 defsubr (&Sfind_font
);
5204 defsubr (&Sfont_xlfd_name
);
5205 defsubr (&Sclear_font_cache
);
5206 defsubr (&Sfont_shape_gstring
);
5207 defsubr (&Sfont_variation_glyphs
);
5209 defsubr (&Sfont_drive_otf
);
5210 defsubr (&Sfont_otf_alternates
);
5214 defsubr (&Sopen_font
);
5215 defsubr (&Sclose_font
);
5216 defsubr (&Squery_font
);
5217 defsubr (&Sget_font_glyphs
);
5218 defsubr (&Sfont_match_p
);
5219 defsubr (&Sfont_at
);
5221 defsubr (&Sdraw_string
);
5223 #endif /* FONT_DEBUG */
5224 #ifdef HAVE_WINDOW_SYSTEM
5225 defsubr (&Sfont_info
);
5228 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5230 Alist of fontname patterns vs the corresponding encoding and repertory info.
5231 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5232 where ENCODING is a charset or a char-table,
5233 and REPERTORY is a charset, a char-table, or nil.
5235 If ENCODING and REPERTORY are the same, the element can have the form
5236 \(REGEXP . ENCODING).
5238 ENCODING is for converting a character to a glyph code of the font.
5239 If ENCODING is a charset, encoding a character by the charset gives
5240 the corresponding glyph code. If ENCODING is a char-table, looking up
5241 the table by a character gives the corresponding glyph code.
5243 REPERTORY specifies a repertory of characters supported by the font.
5244 If REPERTORY is a charset, all characters beloging to the charset are
5245 supported. If REPERTORY is a char-table, all characters who have a
5246 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5247 gets the repertory information by an opened font and ENCODING. */);
5248 Vfont_encoding_alist
= Qnil
;
5250 /* FIXME: These 3 vars are not quite what they appear: setq on them
5251 won't have any effect other than disconnect them from the style
5252 table used by the font display code. So we make them read-only,
5253 to avoid this confusing situation. */
5255 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5256 doc
: /* Vector of valid font weight values.
5257 Each element has the form:
5258 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5259 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5260 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5261 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5263 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5264 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5265 See `font-weight-table' for the format of the vector. */);
5266 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5267 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5269 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5270 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5271 See `font-weight-table' for the format of the vector. */);
5272 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5273 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5275 staticpro (&font_style_table
);
5276 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5277 ASET (font_style_table
, 0, Vfont_weight_table
);
5278 ASET (font_style_table
, 1, Vfont_slant_table
);
5279 ASET (font_style_table
, 2, Vfont_width_table
);
5281 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5282 *Logging list of font related actions and results.
5283 The value t means to suppress the logging.
5284 The initial value is set to nil if the environment variable
5285 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5288 #ifdef HAVE_WINDOW_SYSTEM
5289 #ifdef HAVE_FREETYPE
5291 #ifdef HAVE_X_WINDOWS
5296 #endif /* HAVE_XFT */
5297 #endif /* HAVE_X_WINDOWS */
5298 #else /* not HAVE_FREETYPE */
5299 #ifdef HAVE_X_WINDOWS
5301 #endif /* HAVE_X_WINDOWS */
5302 #endif /* not HAVE_FREETYPE */
5305 #endif /* HAVE_BDFFONT */
5308 #endif /* WINDOWSNT */
5311 #endif /* HAVE_NS */
5312 #endif /* HAVE_WINDOW_SYSTEM */
5318 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
5321 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5322 (do not change this comment) */