1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
3 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H13PRO009
7 This file is part of GNU Emacs.
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
31 #include "dispextern.h"
33 #include "character.h"
34 #include "composite.h"
40 #endif /* HAVE_X_WINDOWS */
44 #endif /* HAVE_NTGUI */
50 Lisp_Object Qopentype
;
52 /* Important character set strings. */
53 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
55 #define DEFAULT_ENCODING Qiso8859_1
57 /* Unicode category `Cf'. */
58 static Lisp_Object QCf
;
60 /* Special vector of zero length. This is repeatedly used by (struct
61 font_driver *)->list when a specified font is not found. */
62 static Lisp_Object null_vector
;
64 static Lisp_Object Vfont_weight_table
, Vfont_slant_table
, Vfont_width_table
;
66 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
67 static Lisp_Object font_style_table
;
69 /* Structure used for tables mapping weight, slant, and width numeric
70 values and their names. */
75 /* The first one is a valid name as a face attribute.
76 The second one (if any) is a typical name in XLFD field. */
80 /* Table of weight numeric values and their names. This table must be
81 sorted by numeric values in ascending order. */
83 static const struct table_entry weight_table
[] =
86 { 20, { "ultra-light", "ultralight" }},
87 { 40, { "extra-light", "extralight" }},
89 { 75, { "semi-light", "semilight", "demilight", "book" }},
90 { 100, { "normal", "medium", "regular", "unspecified" }},
91 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
93 { 205, { "extra-bold", "extrabold" }},
94 { 210, { "ultra-bold", "ultrabold", "black" }}
97 /* Table of slant numeric values and their names. This table must be
98 sorted by numeric values in ascending order. */
100 static const struct table_entry slant_table
[] =
102 { 0, { "reverse-oblique", "ro" }},
103 { 10, { "reverse-italic", "ri" }},
104 { 100, { "normal", "r", "unspecified" }},
105 { 200, { "italic" ,"i", "ot" }},
106 { 210, { "oblique", "o" }}
109 /* Table of width numeric values and their names. This table must be
110 sorted by numeric values in ascending order. */
112 static const struct table_entry width_table
[] =
114 { 50, { "ultra-condensed", "ultracondensed" }},
115 { 63, { "extra-condensed", "extracondensed" }},
116 { 75, { "condensed", "compressed", "narrow" }},
117 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
118 { 100, { "normal", "medium", "regular", "unspecified" }},
119 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
120 { 125, { "expanded" }},
121 { 150, { "extra-expanded", "extraexpanded" }},
122 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
125 Lisp_Object QCfoundry
;
126 static Lisp_Object QCadstyle
, QCregistry
;
127 /* Symbols representing keys of font extra info. */
128 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
129 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
130 /* Symbols representing values of font spacing property. */
131 Lisp_Object Qc
, Qm
, Qp
, Qd
;
132 /* Special ADSTYLE properties to avoid fonts used for Latin
133 characters; used in xfont.c and ftfont.c. */
134 Lisp_Object Qja
, Qko
;
136 Lisp_Object QCuser_spec
;
138 Lisp_Object Vfont_encoding_alist
;
140 /* Alist of font registry symbol and the corresponding charsets
141 information. The information is retrieved from
142 Vfont_encoding_alist on demand.
144 Eash element has the form:
145 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
149 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
150 encodes a character code to a glyph code of a font, and
151 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
152 character is supported by a font.
154 The latter form means that the information for REGISTRY couldn't be
156 static Lisp_Object font_charset_alist
;
158 /* List of all font drivers. Each font-backend (XXXfont.c) calls
159 register_font_driver in syms_of_XXXfont to register its font-driver
161 static struct font_driver_list
*font_driver_list
;
165 /* Creaters of font-related Lisp object. */
168 font_make_spec (void)
170 Lisp_Object font_spec
;
171 struct font_spec
*spec
172 = ((struct font_spec
*)
173 allocate_pseudovector (VECSIZE (struct font_spec
),
174 FONT_SPEC_MAX
, PVEC_FONT
));
175 XSETFONT (font_spec
, spec
);
180 font_make_entity (void)
182 Lisp_Object font_entity
;
183 struct font_entity
*entity
184 = ((struct font_entity
*)
185 allocate_pseudovector (VECSIZE (struct font_entity
),
186 FONT_ENTITY_MAX
, PVEC_FONT
));
187 XSETFONT (font_entity
, entity
);
191 /* Create a font-object whose structure size is SIZE. If ENTITY is
192 not nil, copy properties from ENTITY to the font-object. If
193 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
195 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
197 Lisp_Object font_object
;
199 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
202 XSETFONT (font_object
, font
);
206 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
207 font
->props
[i
] = AREF (entity
, i
);
208 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
209 font
->props
[FONT_EXTRA_INDEX
]
210 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
213 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
219 static int font_pixel_size (FRAME_PTR f
, Lisp_Object
);
220 static Lisp_Object
font_open_entity (FRAME_PTR
, Lisp_Object
, int);
221 static Lisp_Object
font_matching_entity (FRAME_PTR
, Lisp_Object
*,
223 static unsigned font_encode_char (Lisp_Object
, int);
225 /* Number of registered font drivers. */
226 static int num_font_drivers
;
229 /* Return a Lispy value of a font property value at STR and LEN bytes.
230 If STR is "*", it returns nil.
231 If FORCE_SYMBOL is zero and all characters in STR are digits, it
232 returns an integer. Otherwise, it returns a symbol interned from
236 font_intern_prop (const char *str
, int len
, int force_symbol
)
241 EMACS_INT nbytes
, nchars
;
243 if (len
== 1 && *str
== '*')
245 if (!force_symbol
&& len
>=1 && isdigit (*str
))
247 for (i
= 1; i
< len
; i
++)
248 if (! isdigit (str
[i
]))
251 return make_number (atoi (str
));
254 /* The following code is copied from the function intern (in
255 lread.c), and modified to suite our purpose. */
257 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
258 obarray
= check_obarray (obarray
);
259 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
260 if (len
== nchars
|| len
!= nbytes
)
261 /* CONTENTS contains no multibyte sequences or contains an invalid
262 multibyte sequence. We'll make a unibyte string. */
263 tem
= oblookup (obarray
, str
, len
, len
);
265 tem
= oblookup (obarray
, str
, nchars
, len
);
268 if (len
== nchars
|| len
!= nbytes
)
269 tem
= make_unibyte_string (str
, len
);
271 tem
= make_multibyte_string (str
, nchars
, len
);
272 return Fintern (tem
, obarray
);
275 /* Return a pixel size of font-spec SPEC on frame F. */
278 font_pixel_size (FRAME_PTR f
, Lisp_Object spec
)
280 #ifdef HAVE_WINDOW_SYSTEM
281 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
290 font_assert (FLOATP (size
));
291 point_size
= XFLOAT_DATA (size
);
292 val
= AREF (spec
, FONT_DPI_INDEX
);
297 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
305 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
306 font vector. If VAL is not valid (i.e. not registered in
307 font_style_table), return -1 if NOERROR is zero, and return a
308 proper index if NOERROR is nonzero. In that case, register VAL in
309 font_style_table if VAL is a symbol, and return a closest index if
310 VAL is an integer. */
313 font_style_to_value (enum font_property_index prop
, Lisp_Object val
, int noerror
)
315 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
316 int len
= ASIZE (table
);
322 Lisp_Object args
[2], elt
;
324 /* At first try exact match. */
325 for (i
= 0; i
< len
; i
++)
326 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
327 if (EQ (val
, AREF (AREF (table
, i
), j
)))
328 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
329 | (i
<< 4) | (j
- 1));
330 /* Try also with case-folding match. */
331 s
= SDATA (SYMBOL_NAME (val
));
332 for (i
= 0; i
< len
; i
++)
333 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
335 elt
= AREF (AREF (table
, i
), j
);
336 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
337 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
338 | (i
<< 4) | (j
- 1));
344 elt
= Fmake_vector (make_number (2), make_number (100));
347 args
[1] = Fmake_vector (make_number (1), elt
);
348 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
349 return (100 << 8) | (i
<< 4);
354 int numeric
= XINT (val
);
356 for (i
= 0, last_n
= -1; i
< len
; i
++)
358 int n
= XINT (AREF (AREF (table
, i
), 0));
361 return (n
<< 8) | (i
<< 4);
366 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
367 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
373 return ((last_n
<< 8) | ((i
- 1) << 4));
378 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
, int for_face
)
380 Lisp_Object val
= AREF (font
, prop
);
381 Lisp_Object table
, elt
;
386 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
387 i
= XINT (val
) & 0xFF;
388 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
389 elt
= AREF (table
, ((i
>> 4) & 0xF));
390 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
391 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
394 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
395 FONTNAME. ENCODING is a charset symbol that specifies the encoding
396 of the font. REPERTORY is a charset symbol or nil. */
399 find_font_encoding (Lisp_Object fontname
)
401 Lisp_Object tail
, elt
;
403 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
407 && STRINGP (XCAR (elt
))
408 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
409 && (SYMBOLP (XCDR (elt
))
410 ? CHARSETP (XCDR (elt
))
411 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
417 /* Return encoding charset and repertory charset for REGISTRY in
418 ENCODING and REPERTORY correspondingly. If correct information for
419 REGISTRY is available, return 0. Otherwise return -1. */
422 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
425 int encoding_id
, repertory_id
;
427 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
433 encoding_id
= XINT (XCAR (val
));
434 repertory_id
= XINT (XCDR (val
));
438 val
= find_font_encoding (SYMBOL_NAME (registry
));
439 if (SYMBOLP (val
) && CHARSETP (val
))
441 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
443 else if (CONSP (val
))
445 if (! CHARSETP (XCAR (val
)))
447 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
448 if (NILP (XCDR (val
)))
452 if (! CHARSETP (XCDR (val
)))
454 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
459 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
461 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
465 *encoding
= CHARSET_FROM_ID (encoding_id
);
467 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
472 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
477 /* Font property value validaters. See the comment of
478 font_property_table for the meaning of the arguments. */
480 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
481 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
482 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
483 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
484 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
485 static int get_font_prop_index (Lisp_Object
);
488 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
491 val
= Fintern (val
, Qnil
);
494 else if (EQ (prop
, QCregistry
))
495 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
501 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
503 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
504 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
511 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
515 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
517 if ((n
& 0xF) + 1 >= ASIZE (elt
))
519 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
523 else if (SYMBOLP (val
))
525 int n
= font_style_to_value (prop
, val
, 0);
527 val
= n
>= 0 ? make_number (n
) : Qerror
;
535 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
537 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
542 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
544 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
546 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
548 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
550 if (spacing
== 'c' || spacing
== 'C')
551 return make_number (FONT_SPACING_CHARCELL
);
552 if (spacing
== 'm' || spacing
== 'M')
553 return make_number (FONT_SPACING_MONO
);
554 if (spacing
== 'p' || spacing
== 'P')
555 return make_number (FONT_SPACING_PROPORTIONAL
);
556 if (spacing
== 'd' || spacing
== 'D')
557 return make_number (FONT_SPACING_DUAL
);
563 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
565 Lisp_Object tail
, tmp
;
568 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
569 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
570 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
573 if (! SYMBOLP (XCAR (val
)))
578 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
580 for (i
= 0; i
< 2; i
++)
587 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
588 if (! SYMBOLP (XCAR (tmp
)))
596 /* Structure of known font property keys and validater of the
600 /* Pointer to the key symbol. */
602 /* Function to validate PROP's value VAL, or NULL if any value is
603 ok. The value is VAL or its regularized value if VAL is valid,
604 and Qerror if not. */
605 Lisp_Object (*validater
) (Lisp_Object prop
, Lisp_Object val
);
606 } font_property_table
[] =
607 { { &QCtype
, font_prop_validate_symbol
},
608 { &QCfoundry
, font_prop_validate_symbol
},
609 { &QCfamily
, font_prop_validate_symbol
},
610 { &QCadstyle
, font_prop_validate_symbol
},
611 { &QCregistry
, font_prop_validate_symbol
},
612 { &QCweight
, font_prop_validate_style
},
613 { &QCslant
, font_prop_validate_style
},
614 { &QCwidth
, font_prop_validate_style
},
615 { &QCsize
, font_prop_validate_non_neg
},
616 { &QCdpi
, font_prop_validate_non_neg
},
617 { &QCspacing
, font_prop_validate_spacing
},
618 { &QCavgwidth
, font_prop_validate_non_neg
},
619 /* The order of the above entries must match with enum
620 font_property_index. */
621 { &QClang
, font_prop_validate_symbol
},
622 { &QCscript
, font_prop_validate_symbol
},
623 { &QCotf
, font_prop_validate_otf
}
626 /* Size (number of elements) of the above table. */
627 #define FONT_PROPERTY_TABLE_SIZE \
628 ((sizeof font_property_table) / (sizeof *font_property_table))
630 /* Return an index number of font property KEY or -1 if KEY is not an
631 already known property. */
634 get_font_prop_index (Lisp_Object key
)
638 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
639 if (EQ (key
, *font_property_table
[i
].key
))
644 /* Validate the font property. The property key is specified by the
645 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
646 signal an error. The value is VAL or the regularized one. */
649 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
651 Lisp_Object validated
;
656 prop
= *font_property_table
[idx
].key
;
659 idx
= get_font_prop_index (prop
);
663 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
664 if (EQ (validated
, Qerror
))
665 signal_error ("invalid font property", Fcons (prop
, val
));
670 /* Store VAL as a value of extra font property PROP in FONT while
671 keeping the sorting order. Don't check the validity of VAL. */
674 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
676 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
677 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
681 Lisp_Object prev
= Qnil
;
684 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
685 prev
= extra
, extra
= XCDR (extra
);
688 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
690 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
696 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
701 /* Font name parser and unparser */
703 static int parse_matrix (const char *);
704 static int font_expand_wildcards (Lisp_Object
*, int);
705 static int font_parse_name (char *, Lisp_Object
);
707 /* An enumerator for each field of an XLFD font name. */
708 enum xlfd_field_index
727 /* An enumerator for mask bit corresponding to each XLFD field. */
730 XLFD_FOUNDRY_MASK
= 0x0001,
731 XLFD_FAMILY_MASK
= 0x0002,
732 XLFD_WEIGHT_MASK
= 0x0004,
733 XLFD_SLANT_MASK
= 0x0008,
734 XLFD_SWIDTH_MASK
= 0x0010,
735 XLFD_ADSTYLE_MASK
= 0x0020,
736 XLFD_PIXEL_MASK
= 0x0040,
737 XLFD_POINT_MASK
= 0x0080,
738 XLFD_RESX_MASK
= 0x0100,
739 XLFD_RESY_MASK
= 0x0200,
740 XLFD_SPACING_MASK
= 0x0400,
741 XLFD_AVGWIDTH_MASK
= 0x0800,
742 XLFD_REGISTRY_MASK
= 0x1000,
743 XLFD_ENCODING_MASK
= 0x2000
747 /* Parse P pointing the pixel/point size field of the form
748 `[A B C D]' which specifies a transformation matrix:
754 by which all glyphs of the font are transformed. The spec says
755 that scalar value N for the pixel/point size is equivalent to:
756 A = N * resx/resy, B = C = 0, D = N.
758 Return the scalar value N if the form is valid. Otherwise return
762 parse_matrix (const char *p
)
768 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
771 matrix
[i
] = - strtod (p
+ 1, &end
);
773 matrix
[i
] = strtod (p
, &end
);
776 return (i
== 4 ? (int) matrix
[3] : -1);
779 /* Expand a wildcard field in FIELD (the first N fields are filled) to
780 multiple fields to fill in all 14 XLFD fields while restring a
781 field position by its contents. */
784 font_expand_wildcards (Lisp_Object
*field
, int n
)
787 Lisp_Object tmp
[XLFD_LAST_INDEX
];
788 /* Array of information about where this element can go. Nth
789 element is for Nth element of FIELD. */
791 /* Minimum possible field. */
793 /* Maxinum possible field. */
795 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
797 } range
[XLFD_LAST_INDEX
];
799 int range_from
, range_to
;
802 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
803 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
804 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
805 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
806 | XLFD_AVGWIDTH_MASK)
807 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
809 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
810 field. The value is shifted to left one bit by one in the
812 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
813 range_mask
= (range_mask
<< 1) | 1;
815 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
816 position-based retriction for FIELD[I]. */
817 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
818 i
++, range_from
++, range_to
++, range_mask
<<= 1)
820 Lisp_Object val
= field
[i
];
826 range
[i
].from
= range_from
;
827 range
[i
].to
= range_to
;
828 range
[i
].mask
= range_mask
;
832 /* The triplet FROM, TO, and MASK is a value-based
833 retriction for FIELD[I]. */
839 int numeric
= XINT (val
);
842 from
= to
= XLFD_ENCODING_INDEX
,
843 mask
= XLFD_ENCODING_MASK
;
844 else if (numeric
== 0)
845 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
846 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
847 else if (numeric
<= 48)
848 from
= to
= XLFD_PIXEL_INDEX
,
849 mask
= XLFD_PIXEL_MASK
;
851 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
852 mask
= XLFD_LARGENUM_MASK
;
854 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
855 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
856 mask
= XLFD_NULL_MASK
;
858 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
861 Lisp_Object name
= SYMBOL_NAME (val
);
863 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
864 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
865 mask
= XLFD_REGENC_MASK
;
867 from
= to
= XLFD_ENCODING_INDEX
,
868 mask
= XLFD_ENCODING_MASK
;
870 else if (range_from
<= XLFD_WEIGHT_INDEX
871 && range_to
>= XLFD_WEIGHT_INDEX
872 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
873 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
874 else if (range_from
<= XLFD_SLANT_INDEX
875 && range_to
>= XLFD_SLANT_INDEX
876 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
877 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
878 else if (range_from
<= XLFD_SWIDTH_INDEX
879 && range_to
>= XLFD_SWIDTH_INDEX
880 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
881 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
884 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
885 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
887 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
888 mask
= XLFD_SYMBOL_MASK
;
891 /* Merge position-based and value-based restrictions. */
893 while (from
< range_from
)
894 mask
&= ~(1 << from
++);
895 while (from
< 14 && ! (mask
& (1 << from
)))
897 while (to
> range_to
)
898 mask
&= ~(1 << to
--);
899 while (to
>= 0 && ! (mask
& (1 << to
)))
903 range
[i
].from
= from
;
905 range
[i
].mask
= mask
;
907 if (from
> range_from
|| to
< range_to
)
909 /* The range is narrowed by value-based restrictions.
910 Reflect it to the other fields. */
912 /* Following fields should be after FROM. */
914 /* Preceding fields should be before TO. */
915 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
917 /* Check FROM for non-wildcard field. */
918 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
920 while (range
[j
].from
< from
)
921 range
[j
].mask
&= ~(1 << range
[j
].from
++);
922 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
924 range
[j
].from
= from
;
927 from
= range
[j
].from
;
928 if (range
[j
].to
> to
)
930 while (range
[j
].to
> to
)
931 range
[j
].mask
&= ~(1 << range
[j
].to
--);
932 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
945 /* Decide all fileds from restrictions in RANGE. */
946 for (i
= j
= 0; i
< n
; i
++)
948 if (j
< range
[i
].from
)
950 if (i
== 0 || ! NILP (tmp
[i
- 1]))
951 /* None of TMP[X] corresponds to Jth field. */
953 for (; j
< range
[i
].from
; j
++)
958 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
960 for (; j
< XLFD_LAST_INDEX
; j
++)
962 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
963 field
[XLFD_ENCODING_INDEX
]
964 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
969 /* Parse NAME (null terminated) as XLFD and store information in FONT
970 (font-spec or font-entity). Size property of FONT is set as
972 specified XLFD fields FONT property
973 --------------------- -------------
974 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
975 POINT_SIZE and RESY calculated pixel size (Lisp integer)
976 POINT_SIZE POINT_SIZE/10 (Lisp float)
978 If NAME is successfully parsed, return 0. Otherwise return -1.
980 FONT is usually a font-spec, but when this function is called from
981 X font backend driver, it is a font-entity. In that case, NAME is
982 a fully specified XLFD. */
985 font_parse_xlfd (char *name
, Lisp_Object font
)
987 int len
= strlen (name
);
989 char *f
[XLFD_LAST_INDEX
+ 1];
993 if (len
> 255 || !len
)
994 /* Maximum XLFD name length is 255. */
996 /* Accept "*-.." as a fully specified XLFD. */
997 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
998 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1001 for (p
= name
+ i
; *p
; p
++)
1005 if (i
== XLFD_LAST_INDEX
)
1010 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1011 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1013 if (i
== XLFD_LAST_INDEX
)
1015 /* Fully specified XLFD. */
1018 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1019 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1020 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1021 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1023 val
= INTERN_FIELD_SYM (i
);
1026 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1028 ASET (font
, j
, make_number (n
));
1031 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1032 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1033 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1035 ASET (font
, FONT_REGISTRY_INDEX
,
1036 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1037 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1039 p
= f
[XLFD_PIXEL_INDEX
];
1040 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1041 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1044 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1046 ASET (font
, FONT_SIZE_INDEX
, val
);
1047 else if (FONT_ENTITY_P (font
))
1051 double point_size
= -1;
1053 font_assert (FONT_SPEC_P (font
));
1054 p
= f
[XLFD_POINT_INDEX
];
1056 point_size
= parse_matrix (p
);
1057 else if (isdigit (*p
))
1058 point_size
= atoi (p
), point_size
/= 10;
1059 if (point_size
>= 0)
1060 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1064 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1065 if (! NILP (val
) && ! INTEGERP (val
))
1067 ASET (font
, FONT_DPI_INDEX
, val
);
1068 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1071 val
= font_prop_validate_spacing (QCspacing
, val
);
1072 if (! INTEGERP (val
))
1074 ASET (font
, FONT_SPACING_INDEX
, val
);
1076 p
= f
[XLFD_AVGWIDTH_INDEX
];
1079 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1080 if (! NILP (val
) && ! INTEGERP (val
))
1082 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1086 int wild_card_found
= 0;
1087 Lisp_Object prop
[XLFD_LAST_INDEX
];
1089 if (FONT_ENTITY_P (font
))
1091 for (j
= 0; j
< i
; j
++)
1095 if (f
[j
][1] && f
[j
][1] != '-')
1098 wild_card_found
= 1;
1101 prop
[j
] = INTERN_FIELD (j
);
1103 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1105 if (! wild_card_found
)
1107 if (font_expand_wildcards (prop
, i
) < 0)
1110 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1111 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1112 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1113 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1114 if (! NILP (prop
[i
]))
1116 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1118 ASET (font
, j
, make_number (n
));
1120 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1121 val
= prop
[XLFD_REGISTRY_INDEX
];
1124 val
= prop
[XLFD_ENCODING_INDEX
];
1126 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1128 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1129 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1131 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1132 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1134 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1136 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1137 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1138 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1140 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1142 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1145 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1146 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1147 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1149 val
= font_prop_validate_spacing (QCspacing
,
1150 prop
[XLFD_SPACING_INDEX
]);
1151 if (! INTEGERP (val
))
1153 ASET (font
, FONT_SPACING_INDEX
, val
);
1155 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1156 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1162 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1163 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1164 0, use PIXEL_SIZE instead. */
1167 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1169 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1173 font_assert (FONTP (font
));
1175 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1178 if (i
== FONT_ADSTYLE_INDEX
)
1179 j
= XLFD_ADSTYLE_INDEX
;
1180 else if (i
== FONT_REGISTRY_INDEX
)
1181 j
= XLFD_REGISTRY_INDEX
;
1182 val
= AREF (font
, i
);
1185 if (j
== XLFD_REGISTRY_INDEX
)
1186 f
[j
] = "*-*", len
+= 4;
1188 f
[j
] = "*", len
+= 2;
1193 val
= SYMBOL_NAME (val
);
1194 if (j
== XLFD_REGISTRY_INDEX
1195 && ! strchr ((char *) SDATA (val
), '-'))
1197 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1198 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1200 f
[j
] = alloca (SBYTES (val
) + 3);
1201 sprintf (f
[j
], "%s-*", SDATA (val
));
1202 len
+= SBYTES (val
) + 3;
1206 f
[j
] = alloca (SBYTES (val
) + 4);
1207 sprintf (f
[j
], "%s*-*", SDATA (val
));
1208 len
+= SBYTES (val
) + 4;
1212 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1216 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1219 val
= font_style_symbolic (font
, i
, 0);
1221 f
[j
] = "*", len
+= 2;
1224 val
= SYMBOL_NAME (val
);
1225 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1229 val
= AREF (font
, FONT_SIZE_INDEX
);
1230 font_assert (NUMBERP (val
) || NILP (val
));
1238 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1239 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1242 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1244 else if (FLOATP (val
))
1246 i
= XFLOAT_DATA (val
) * 10;
1247 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1248 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1251 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1253 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1255 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1256 f
[XLFD_RESX_INDEX
] = alloca (22);
1257 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1261 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1262 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1264 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1266 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1267 : spacing
<= FONT_SPACING_DUAL
? "d"
1268 : spacing
<= FONT_SPACING_MONO
? "m"
1273 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1274 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1276 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1277 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
], "%ld",
1278 (long) XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1281 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1282 len
++; /* for terminating '\0'. */
1285 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1286 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1287 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1288 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1289 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1290 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1291 f
[XLFD_REGISTRY_INDEX
]);
1294 /* Parse NAME (null terminated) and store information in FONT
1295 (font-spec or font-entity). NAME is supplied in either the
1296 Fontconfig or GTK font name format. If NAME is successfully
1297 parsed, return 0. Otherwise return -1.
1299 The fontconfig format is
1301 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1305 FAMILY [PROPS...] [SIZE]
1307 This function tries to guess which format it is. */
1310 font_parse_fcname (char *name
, Lisp_Object font
)
1313 char *size_beg
= NULL
, *size_end
= NULL
;
1314 char *props_beg
= NULL
, *family_end
= NULL
;
1315 int len
= strlen (name
);
1320 for (p
= name
; *p
; p
++)
1322 if (*p
== '\\' && p
[1])
1326 props_beg
= family_end
= p
;
1331 int decimal
= 0, size_found
= 1;
1332 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1335 if (*q
!= '.' || decimal
)
1354 Lisp_Object extra_props
= Qnil
;
1356 /* A fontconfig name with size and/or property data. */
1357 if (family_end
> name
)
1360 family
= font_intern_prop (name
, family_end
- name
, 1);
1361 ASET (font
, FONT_FAMILY_INDEX
, family
);
1365 double point_size
= strtod (size_beg
, &size_end
);
1366 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1367 if (*size_end
== ':' && size_end
[1])
1368 props_beg
= size_end
;
1372 /* Now parse ":KEY=VAL" patterns. */
1375 for (p
= props_beg
; *p
; p
= q
)
1377 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1380 /* Must be an enumerated value. */
1384 val
= font_intern_prop (p
, q
- p
, 1);
1386 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1388 if (PROP_MATCH ("light", 5)
1389 || PROP_MATCH ("medium", 6)
1390 || PROP_MATCH ("demibold", 8)
1391 || PROP_MATCH ("bold", 4)
1392 || PROP_MATCH ("black", 5))
1393 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1394 else if (PROP_MATCH ("roman", 5)
1395 || PROP_MATCH ("italic", 6)
1396 || PROP_MATCH ("oblique", 7))
1397 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1398 else if (PROP_MATCH ("charcell", 8))
1399 ASET (font
, FONT_SPACING_INDEX
,
1400 make_number (FONT_SPACING_CHARCELL
));
1401 else if (PROP_MATCH ("mono", 4))
1402 ASET (font
, FONT_SPACING_INDEX
,
1403 make_number (FONT_SPACING_MONO
));
1404 else if (PROP_MATCH ("proportional", 12))
1405 ASET (font
, FONT_SPACING_INDEX
,
1406 make_number (FONT_SPACING_PROPORTIONAL
));
1415 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1416 prop
= FONT_SIZE_INDEX
;
1419 key
= font_intern_prop (p
, q
- p
, 1);
1420 prop
= get_font_prop_index (key
);
1424 for (q
= p
; *q
&& *q
!= ':'; q
++);
1425 val
= font_intern_prop (p
, q
- p
, 0);
1427 if (prop
>= FONT_FOUNDRY_INDEX
1428 && prop
< FONT_EXTRA_INDEX
)
1429 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1432 extra_props
= nconc2 (extra_props
,
1433 Fcons (Fcons (key
, val
), Qnil
));
1440 if (! NILP (extra_props
))
1442 struct font_driver_list
*driver_list
= font_driver_list
;
1443 for ( ; driver_list
; driver_list
= driver_list
->next
)
1444 if (driver_list
->driver
->filter_properties
)
1445 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1451 /* Either a fontconfig-style name with no size and property
1452 data, or a GTK-style name. */
1454 int word_len
, prop_found
= 0;
1456 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1462 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1463 if (! isdigit (*q
) && *q
!= '.')
1470 double point_size
= strtod (p
, &q
);
1471 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1476 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1477 if (*q
== '\\' && q
[1])
1481 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1483 if (PROP_MATCH ("Ultra-Light", 11))
1486 prop
= font_intern_prop ("ultra-light", 11, 1);
1487 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1489 else if (PROP_MATCH ("Light", 5))
1492 prop
= font_intern_prop ("light", 5, 1);
1493 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1495 else if (PROP_MATCH ("Book", 4))
1498 prop
= font_intern_prop ("book", 4, 1);
1499 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1501 else if (PROP_MATCH ("Medium", 6))
1504 prop
= font_intern_prop ("medium", 6, 1);
1505 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1507 else if (PROP_MATCH ("Semi-Bold", 9))
1510 prop
= font_intern_prop ("semi-bold", 9, 1);
1511 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1513 else if (PROP_MATCH ("Bold", 4))
1516 prop
= font_intern_prop ("bold", 4, 1);
1517 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1519 else if (PROP_MATCH ("Italic", 6))
1522 prop
= font_intern_prop ("italic", 4, 1);
1523 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1525 else if (PROP_MATCH ("Oblique", 7))
1528 prop
= font_intern_prop ("oblique", 7, 1);
1529 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1531 else if (PROP_MATCH ("Semi-Condensed", 14))
1534 prop
= font_intern_prop ("semi-condensed", 14, 1);
1535 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, prop
);
1537 else if (PROP_MATCH ("Condensed", 9))
1540 prop
= font_intern_prop ("condensed", 9, 1);
1541 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, prop
);
1545 return -1; /* Unknown property in GTK-style font name. */
1554 family
= font_intern_prop (name
, family_end
- name
, 1);
1555 ASET (font
, FONT_FAMILY_INDEX
, family
);
1562 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1563 NAME (NBYTES length), and return the name length. If
1564 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1567 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1569 Lisp_Object family
, foundry
;
1570 Lisp_Object tail
, val
;
1574 Lisp_Object styles
[3];
1575 const char *style_names
[3] = { "weight", "slant", "width" };
1578 family
= AREF (font
, FONT_FAMILY_INDEX
);
1579 if (! NILP (family
))
1581 if (SYMBOLP (family
))
1583 family
= SYMBOL_NAME (family
);
1584 len
+= SBYTES (family
);
1590 val
= AREF (font
, FONT_SIZE_INDEX
);
1593 if (XINT (val
) != 0)
1594 pixel_size
= XINT (val
);
1596 len
+= 21; /* for ":pixelsize=NUM" */
1598 else if (FLOATP (val
))
1601 point_size
= (int) XFLOAT_DATA (val
);
1602 len
+= 11; /* for "-NUM" */
1605 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1606 if (! NILP (foundry
))
1608 if (SYMBOLP (foundry
))
1610 foundry
= SYMBOL_NAME (foundry
);
1611 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1617 for (i
= 0; i
< 3; i
++)
1619 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1620 if (! NILP (styles
[i
]))
1621 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1622 SDATA (SYMBOL_NAME (styles
[i
])));
1625 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1626 len
+= sprintf (work
, ":dpi=%ld", (long)XINT (AREF (font
, FONT_DPI_INDEX
)));
1627 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1628 len
+= strlen (":spacing=100");
1629 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1630 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1631 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1633 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1635 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1637 len
+= SBYTES (val
);
1638 else if (INTEGERP (val
))
1639 len
+= sprintf (work
, "%ld", (long) XINT (val
));
1640 else if (SYMBOLP (val
))
1641 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1647 if (! NILP (family
))
1648 p
+= sprintf (p
, "%s", SDATA (family
));
1652 p
+= sprintf (p
, "%d", point_size
);
1654 p
+= sprintf (p
, "-%d", point_size
);
1656 else if (pixel_size
> 0)
1657 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1658 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1659 p
+= sprintf (p
, ":foundry=%s",
1660 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1661 for (i
= 0; i
< 3; i
++)
1662 if (! NILP (styles
[i
]))
1663 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1664 SDATA (SYMBOL_NAME (styles
[i
])));
1665 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1666 p
+= sprintf (p
, ":dpi=%ld", (long) XINT (AREF (font
, FONT_DPI_INDEX
)));
1667 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1668 p
+= sprintf (p
, ":spacing=%ld",
1669 (long) XINT (AREF (font
, FONT_SPACING_INDEX
)));
1670 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1672 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1673 p
+= sprintf (p
, ":scalable=true");
1675 p
+= sprintf (p
, ":scalable=false");
1680 /* Parse NAME (null terminated) and store information in FONT
1681 (font-spec or font-entity). If NAME is successfully parsed, return
1682 0. Otherwise return -1. */
1685 font_parse_name (char *name
, Lisp_Object font
)
1687 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1688 return font_parse_xlfd (name
, font
);
1689 return font_parse_fcname (name
, font
);
1693 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1694 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1698 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1704 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1706 CHECK_STRING (family
);
1707 len
= SBYTES (family
);
1708 p0
= (char *) SDATA (family
);
1709 p1
= strchr (p0
, '-');
1712 if ((*p0
!= '*' && p1
- p0
> 0)
1713 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1714 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1717 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1720 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1722 if (! NILP (registry
))
1724 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1725 CHECK_STRING (registry
);
1726 len
= SBYTES (registry
);
1727 p0
= (char *) SDATA (registry
);
1728 p1
= strchr (p0
, '-');
1731 if (SDATA (registry
)[len
- 1] == '*')
1732 registry
= concat2 (registry
, build_string ("-*"));
1734 registry
= concat2 (registry
, build_string ("*-*"));
1736 registry
= Fdowncase (registry
);
1737 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1742 /* This part (through the next ^L) is still experimental and not
1743 tested much. We may drastically change codes. */
1749 #define LGSTRING_HEADER_SIZE 6
1750 #define LGSTRING_GLYPH_SIZE 8
1753 check_gstring (gstring
)
1754 Lisp_Object gstring
;
1759 CHECK_VECTOR (gstring
);
1760 val
= AREF (gstring
, 0);
1762 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1764 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1765 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1766 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1767 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1768 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1769 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1770 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1771 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1772 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1773 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1774 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1776 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1778 val
= LGSTRING_GLYPH (gstring
, i
);
1780 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1782 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1784 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1785 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1786 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1787 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1788 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1789 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1790 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1791 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1793 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1795 if (ASIZE (val
) < 3)
1797 for (j
= 0; j
< 3; j
++)
1798 CHECK_NUMBER (AREF (val
, j
));
1803 error ("Invalid glyph-string format");
1808 check_otf_features (otf_features
)
1809 Lisp_Object otf_features
;
1813 CHECK_CONS (otf_features
);
1814 CHECK_SYMBOL (XCAR (otf_features
));
1815 otf_features
= XCDR (otf_features
);
1816 CHECK_CONS (otf_features
);
1817 CHECK_SYMBOL (XCAR (otf_features
));
1818 otf_features
= XCDR (otf_features
);
1819 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1821 CHECK_SYMBOL (Fcar (val
));
1822 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1823 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1825 otf_features
= XCDR (otf_features
);
1826 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1828 CHECK_SYMBOL (Fcar (val
));
1829 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1830 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1837 Lisp_Object otf_list
;
1840 otf_tag_symbol (tag
)
1845 OTF_tag_name (tag
, name
);
1846 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1853 Lisp_Object val
= Fassoc (file
, otf_list
);
1857 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1860 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1861 val
= make_save_value (otf
, 0);
1862 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1868 /* Return a list describing which scripts/languages FONT supports by
1869 which GSUB/GPOS features of OpenType tables. See the comment of
1870 (struct font_driver).otf_capability. */
1873 font_otf_capability (font
)
1877 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1880 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1883 for (i
= 0; i
< 2; i
++)
1885 OTF_GSUB_GPOS
*gsub_gpos
;
1886 Lisp_Object script_list
= Qnil
;
1889 if (OTF_get_features (otf
, i
== 0) < 0)
1891 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1892 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1894 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1895 Lisp_Object langsys_list
= Qnil
;
1896 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1899 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1901 OTF_LangSys
*langsys
;
1902 Lisp_Object feature_list
= Qnil
;
1903 Lisp_Object langsys_tag
;
1906 if (k
== script
->LangSysCount
)
1908 langsys
= &script
->DefaultLangSys
;
1913 langsys
= script
->LangSys
+ k
;
1915 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1917 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1919 OTF_Feature
*feature
1920 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1921 Lisp_Object feature_tag
1922 = otf_tag_symbol (feature
->FeatureTag
);
1924 feature_list
= Fcons (feature_tag
, feature_list
);
1926 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1929 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1934 XSETCAR (capability
, script_list
);
1936 XSETCDR (capability
, script_list
);
1942 /* Parse OTF features in SPEC and write a proper features spec string
1943 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1944 assured that the sufficient memory has already allocated for
1948 generate_otf_features (spec
, features
)
1958 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1964 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1969 else if (! asterisk
)
1971 val
= SYMBOL_NAME (val
);
1972 p
+= sprintf (p
, "%s", SDATA (val
));
1976 val
= SYMBOL_NAME (val
);
1977 p
+= sprintf (p
, "~%s", SDATA (val
));
1981 error ("OTF spec too long");
1985 font_otf_DeviceTable (device_table
)
1986 OTF_DeviceTable
*device_table
;
1988 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1990 return Fcons (make_number (len
),
1991 make_unibyte_string (device_table
->DeltaValue
, len
));
1995 font_otf_ValueRecord (value_format
, value_record
)
1997 OTF_ValueRecord
*value_record
;
1999 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2001 if (value_format
& OTF_XPlacement
)
2002 ASET (val
, 0, make_number (value_record
->XPlacement
));
2003 if (value_format
& OTF_YPlacement
)
2004 ASET (val
, 1, make_number (value_record
->YPlacement
));
2005 if (value_format
& OTF_XAdvance
)
2006 ASET (val
, 2, make_number (value_record
->XAdvance
));
2007 if (value_format
& OTF_YAdvance
)
2008 ASET (val
, 3, make_number (value_record
->YAdvance
));
2009 if (value_format
& OTF_XPlaDevice
)
2010 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2011 if (value_format
& OTF_YPlaDevice
)
2012 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2013 if (value_format
& OTF_XAdvDevice
)
2014 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2015 if (value_format
& OTF_YAdvDevice
)
2016 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2021 font_otf_Anchor (anchor
)
2026 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2027 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2028 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2029 if (anchor
->AnchorFormat
== 2)
2030 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2033 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2034 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2038 #endif /* HAVE_LIBOTF */
2044 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
2045 static int font_compare (const void *, const void *);
2046 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
2050 font_rescale_ratio (Lisp_Object font_entity
)
2052 Lisp_Object tail
, elt
;
2053 Lisp_Object name
= Qnil
;
2055 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2058 if (FLOATP (XCDR (elt
)))
2060 if (STRINGP (XCAR (elt
)))
2063 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2064 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2065 return XFLOAT_DATA (XCDR (elt
));
2067 else if (FONT_SPEC_P (XCAR (elt
)))
2069 if (font_match_p (XCAR (elt
), font_entity
))
2070 return XFLOAT_DATA (XCDR (elt
));
2077 /* We sort fonts by scoring each of them against a specified
2078 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2079 the value is, the closer the font is to the font-spec.
2081 The lowest 2 bits of the score is used for driver type. The font
2082 available by the most preferred font driver is 0.
2084 Each 7-bit in the higher 28 bits are used for numeric properties
2085 WEIGHT, SLANT, WIDTH, and SIZE. */
2087 /* How many bits to shift to store the difference value of each font
2088 property in a score. Note that flots for FONT_TYPE_INDEX and
2089 FONT_REGISTRY_INDEX are not used. */
2090 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2092 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2093 The return value indicates how different ENTITY is compared with
2097 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2102 /* Score three style numeric fields. Maximum difference is 127. */
2103 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2104 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2106 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2111 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2114 /* Score the size. Maximum difference is 127. */
2115 i
= FONT_SIZE_INDEX
;
2116 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2117 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2119 /* We use the higher 6-bit for the actual size difference. The
2120 lowest bit is set if the DPI is different. */
2122 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2124 if (CONSP (Vface_font_rescale_alist
))
2125 pixel_size
*= font_rescale_ratio (entity
);
2126 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2130 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2131 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2133 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2134 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2136 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2143 /* Concatenate all elements of LIST into one vector. LIST is a list
2144 of font-entity vectors. */
2147 font_vconcat_entity_vectors (Lisp_Object list
)
2149 int nargs
= XINT (Flength (list
));
2150 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2153 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2154 args
[i
] = XCAR (list
);
2155 return Fvconcat (nargs
, args
);
2159 /* The structure for elements being sorted by qsort. */
2160 struct font_sort_data
2163 int font_driver_preference
;
2168 /* The comparison function for qsort. */
2171 font_compare (const void *d1
, const void *d2
)
2173 const struct font_sort_data
*data1
= d1
;
2174 const struct font_sort_data
*data2
= d2
;
2176 if (data1
->score
< data2
->score
)
2178 else if (data1
->score
> data2
->score
)
2180 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2184 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2185 If PREFER specifies a point-size, calculate the corresponding
2186 pixel-size from QCdpi property of PREFER or from the Y-resolution
2187 of FRAME before sorting.
2189 If BEST-ONLY is nonzero, return the best matching entity (that
2190 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2191 if BEST-ONLY is negative). Otherwise, return the sorted result as
2192 a single vector of font-entities.
2194 This function does no optimization for the case that the total
2195 number of elements is 1. The caller should avoid calling this in
2199 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2201 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2203 struct font_sort_data
*data
;
2204 unsigned best_score
;
2205 Lisp_Object best_entity
;
2206 struct frame
*f
= XFRAME (frame
);
2207 Lisp_Object tail
, vec
;
2210 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2211 prefer_prop
[i
] = AREF (prefer
, i
);
2212 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2213 prefer_prop
[FONT_SIZE_INDEX
]
2214 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2216 if (NILP (XCDR (list
)))
2218 /* What we have to take care of is this single vector. */
2220 maxlen
= ASIZE (vec
);
2224 /* We don't have to perform sort, so there's no need of creating
2225 a single vector. But, we must find the length of the longest
2228 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2229 if (maxlen
< ASIZE (XCAR (tail
)))
2230 maxlen
= ASIZE (XCAR (tail
));
2234 /* We have to create a single vector to sort it. */
2235 vec
= font_vconcat_entity_vectors (list
);
2236 maxlen
= ASIZE (vec
);
2239 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2240 best_score
= 0xFFFFFFFF;
2243 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2245 int font_driver_preference
= 0;
2246 Lisp_Object current_font_driver
;
2252 /* We are sure that the length of VEC > 0. */
2253 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2254 /* Score the elements. */
2255 for (i
= 0; i
< len
; i
++)
2257 data
[i
].entity
= AREF (vec
, i
);
2259 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2261 ? font_score (data
[i
].entity
, prefer_prop
)
2263 if (best_only
&& best_score
> data
[i
].score
)
2265 best_score
= data
[i
].score
;
2266 best_entity
= data
[i
].entity
;
2267 if (best_score
== 0)
2270 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2272 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2273 font_driver_preference
++;
2275 data
[i
].font_driver_preference
= font_driver_preference
;
2278 /* Sort if necessary. */
2281 qsort (data
, len
, sizeof *data
, font_compare
);
2282 for (i
= 0; i
< len
; i
++)
2283 ASET (vec
, i
, data
[i
].entity
);
2292 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2297 /* API of Font Service Layer. */
2299 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2300 sort_shift_bits. Finternal_set_font_selection_order calls this
2301 function with font_sort_order after setting up it. */
2304 font_update_sort_order (int *order
)
2308 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2310 int xlfd_idx
= order
[i
];
2312 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2313 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2314 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2315 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2316 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2317 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2319 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2324 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
, Lisp_Object features
, Lisp_Object table
)
2329 table
= assq_no_quit (script
, table
);
2332 table
= XCDR (table
);
2333 if (! NILP (langsys
))
2335 table
= assq_no_quit (langsys
, table
);
2341 val
= assq_no_quit (Qnil
, table
);
2343 table
= XCAR (table
);
2347 table
= XCDR (table
);
2348 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2350 if (NILP (XCAR (features
)))
2355 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2361 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2364 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2366 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2368 script
= XCAR (spec
);
2372 langsys
= XCAR (spec
);
2383 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2384 XCAR (otf_capability
)))
2386 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2387 XCDR (otf_capability
)))
2394 /* Check if FONT (font-entity or font-object) matches with the font
2395 specification SPEC. */
2398 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2400 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2401 Lisp_Object extra
, font_extra
;
2404 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2405 if (! NILP (AREF (spec
, i
))
2406 && ! NILP (AREF (font
, i
))
2407 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2409 props
= XFONT_SPEC (spec
)->props
;
2410 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2412 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2413 prop
[i
] = AREF (spec
, i
);
2414 prop
[FONT_SIZE_INDEX
]
2415 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2419 if (font_score (font
, props
) > 0)
2421 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2422 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2423 for (; CONSP (extra
); extra
= XCDR (extra
))
2425 Lisp_Object key
= XCAR (XCAR (extra
));
2426 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2428 if (EQ (key
, QClang
))
2430 val2
= assq_no_quit (key
, font_extra
);
2439 if (NILP (Fmemq (val
, val2
)))
2444 ? NILP (Fmemq (val
, XCDR (val2
)))
2448 else if (EQ (key
, QCscript
))
2450 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2456 /* All characters in the list must be supported. */
2457 for (; CONSP (val2
); val2
= XCDR (val2
))
2459 if (! NATNUMP (XCAR (val2
)))
2461 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2462 == FONT_INVALID_CODE
)
2466 else if (VECTORP (val2
))
2468 /* At most one character in the vector must be supported. */
2469 for (i
= 0; i
< ASIZE (val2
); i
++)
2471 if (! NATNUMP (AREF (val2
, i
)))
2473 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2474 != FONT_INVALID_CODE
)
2477 if (i
== ASIZE (val2
))
2482 else if (EQ (key
, QCotf
))
2486 if (! FONT_OBJECT_P (font
))
2488 fontp
= XFONT_OBJECT (font
);
2489 if (! fontp
->driver
->otf_capability
)
2491 val2
= fontp
->driver
->otf_capability (fontp
);
2492 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2503 Each font backend has the callback function get_cache, and it
2504 returns a cons cell of which cdr part can be freely used for
2505 caching fonts. The cons cell may be shared by multiple frames
2506 and/or multiple font drivers. So, we arrange the cdr part as this:
2508 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2510 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2511 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2512 cons (FONT-SPEC FONT-ENTITY ...). */
2514 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2515 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2516 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2517 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2518 struct font_driver
*);
2521 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2523 Lisp_Object cache
, val
;
2525 cache
= driver
->get_cache (f
);
2527 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2531 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2532 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2536 val
= XCDR (XCAR (val
));
2537 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2543 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2545 Lisp_Object cache
, val
, tmp
;
2548 cache
= driver
->get_cache (f
);
2550 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2551 cache
= val
, val
= XCDR (val
);
2552 font_assert (! NILP (val
));
2553 tmp
= XCDR (XCAR (val
));
2554 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2555 if (XINT (XCAR (tmp
)) == 0)
2557 font_clear_cache (f
, XCAR (val
), driver
);
2558 XSETCDR (cache
, XCDR (val
));
2564 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2566 Lisp_Object val
= driver
->get_cache (f
);
2567 Lisp_Object type
= driver
->type
;
2569 font_assert (CONSP (val
));
2570 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2571 font_assert (CONSP (val
));
2572 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2573 val
= XCDR (XCAR (val
));
2577 static int num_fonts
;
2580 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2582 Lisp_Object tail
, elt
;
2583 Lisp_Object tail2
, entity
;
2585 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2586 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2589 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2590 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2592 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2594 entity
= XCAR (tail2
);
2596 if (FONT_ENTITY_P (entity
)
2597 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2599 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2601 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2603 Lisp_Object val
= XCAR (objlist
);
2604 struct font
*font
= XFONT_OBJECT (val
);
2606 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2608 font_assert (font
&& driver
== font
->driver
);
2609 driver
->close (f
, font
);
2613 if (driver
->free_entity
)
2614 driver
->free_entity (entity
);
2619 XSETCDR (cache
, Qnil
);
2623 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2625 /* Check each font-entity in VEC, and return a list of font-entities
2626 that satisfy this condition:
2627 (1) matches with SPEC and SIZE if SPEC is not nil, and
2628 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2632 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2634 Lisp_Object entity
, val
;
2635 enum font_property_index prop
;
2638 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2640 entity
= AREF (vec
, i
);
2641 if (! NILP (Vface_ignored_fonts
))
2644 Lisp_Object tail
, regexp
;
2646 if (font_unparse_xlfd (entity
, 0, name
, 256) >= 0)
2648 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2650 regexp
= XCAR (tail
);
2651 if (STRINGP (regexp
)
2652 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
2661 val
= Fcons (entity
, val
);
2664 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2665 if (INTEGERP (AREF (spec
, prop
))
2666 && ((XINT (AREF (spec
, prop
)) >> 8)
2667 != (XINT (AREF (entity
, prop
)) >> 8)))
2668 prop
= FONT_SPEC_MAX
;
2669 if (prop
< FONT_SPEC_MAX
2671 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2673 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2676 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2677 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2678 prop
= FONT_SPEC_MAX
;
2680 if (prop
< FONT_SPEC_MAX
2681 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2682 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2683 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2684 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2685 prop
= FONT_SPEC_MAX
;
2686 if (prop
< FONT_SPEC_MAX
2687 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2688 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2689 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2690 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2691 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2692 prop
= FONT_SPEC_MAX
;
2693 if (prop
< FONT_SPEC_MAX
)
2694 val
= Fcons (entity
, val
);
2696 return (Fvconcat (1, &val
));
2700 /* Return a list of vectors of font-entities matching with SPEC on
2701 FRAME. Each elements in the list is a vector of entities from the
2702 same font-driver. */
2705 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2707 FRAME_PTR f
= XFRAME (frame
);
2708 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2709 Lisp_Object ftype
, val
;
2710 Lisp_Object list
= Qnil
;
2712 int need_filtering
= 0;
2715 font_assert (FONT_SPEC_P (spec
));
2717 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2718 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2719 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2720 size
= font_pixel_size (f
, spec
);
2724 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2725 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2726 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2727 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2729 ASET (scratch_font_spec
, i
, Qnil
);
2730 if (! NILP (AREF (spec
, i
)))
2732 if (i
== FONT_DPI_INDEX
)
2733 /* Skip FONT_SPACING_INDEX */
2736 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2737 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2739 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2741 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2743 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2745 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2746 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2753 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2757 val
= Fvconcat (1, &val
);
2758 copy
= Fcopy_font_spec (scratch_font_spec
);
2759 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2760 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2764 || ! NILP (Vface_ignored_fonts
)))
2765 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2766 if (ASIZE (val
) > 0)
2767 list
= Fcons (val
, list
);
2770 list
= Fnreverse (list
);
2771 FONT_ADD_LOG ("list", spec
, list
);
2776 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2777 nil, is an array of face's attributes, which specifies preferred
2778 font-related attributes. */
2781 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2783 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2784 Lisp_Object ftype
, size
, entity
;
2786 Lisp_Object work
= Fcopy_font_spec (spec
);
2788 XSETFRAME (frame
, f
);
2789 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2790 size
= AREF (spec
, FONT_SIZE_INDEX
);
2793 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2794 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2795 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2796 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2799 for (; driver_list
; driver_list
= driver_list
->next
)
2801 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2803 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2806 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2807 entity
= assoc_no_quit (work
, XCDR (cache
));
2809 entity
= XCDR (entity
);
2812 entity
= driver_list
->driver
->match (frame
, work
);
2813 copy
= Fcopy_font_spec (work
);
2814 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2815 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2817 if (! NILP (entity
))
2820 FONT_ADD_LOG ("match", work
, entity
);
2825 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2826 opened font object. */
2829 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2831 struct font_driver_list
*driver_list
;
2832 Lisp_Object objlist
, size
, val
, font_object
;
2834 int min_width
, height
;
2835 int scaled_pixel_size
;
2837 font_assert (FONT_ENTITY_P (entity
));
2838 size
= AREF (entity
, FONT_SIZE_INDEX
);
2839 if (XINT (size
) != 0)
2840 scaled_pixel_size
= pixel_size
= XINT (size
);
2841 else if (CONSP (Vface_font_rescale_alist
))
2842 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2844 val
= AREF (entity
, FONT_TYPE_INDEX
);
2845 for (driver_list
= f
->font_driver_list
;
2846 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2847 driver_list
= driver_list
->next
);
2851 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2852 objlist
= XCDR (objlist
))
2854 Lisp_Object fn
= XCAR (objlist
);
2855 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2856 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2858 if (driver_list
->driver
->cached_font_ok
== NULL
2859 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2864 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2865 if (!NILP (font_object
))
2866 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2867 FONT_ADD_LOG ("open", entity
, font_object
);
2868 if (NILP (font_object
))
2870 ASET (entity
, FONT_OBJLIST_INDEX
,
2871 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2874 font
= XFONT_OBJECT (font_object
);
2875 min_width
= (font
->min_width
? font
->min_width
2876 : font
->average_width
? font
->average_width
2877 : font
->space_width
? font
->space_width
2879 height
= (font
->height
? font
->height
: 1);
2880 #ifdef HAVE_WINDOW_SYSTEM
2881 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2882 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2884 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2885 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2886 fonts_changed_p
= 1;
2890 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2891 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2892 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2893 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2901 /* Close FONT_OBJECT that is opened on frame F. */
2904 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
2906 struct font
*font
= XFONT_OBJECT (font_object
);
2908 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2909 /* Already closed. */
2911 FONT_ADD_LOG ("close", font_object
, Qnil
);
2912 font
->driver
->close (f
, font
);
2913 #ifdef HAVE_WINDOW_SYSTEM
2914 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2915 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2921 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2922 FONT is a font-entity and it must be opened to check. */
2925 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
2929 if (FONT_ENTITY_P (font
))
2931 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2932 struct font_driver_list
*driver_list
;
2934 for (driver_list
= f
->font_driver_list
;
2935 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2936 driver_list
= driver_list
->next
);
2939 if (! driver_list
->driver
->has_char
)
2941 return driver_list
->driver
->has_char (font
, c
);
2944 font_assert (FONT_OBJECT_P (font
));
2945 fontp
= XFONT_OBJECT (font
);
2946 if (fontp
->driver
->has_char
)
2948 int result
= fontp
->driver
->has_char (font
, c
);
2953 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2957 /* Return the glyph ID of FONT_OBJECT for character C. */
2960 font_encode_char (Lisp_Object font_object
, int c
)
2964 font_assert (FONT_OBJECT_P (font_object
));
2965 font
= XFONT_OBJECT (font_object
);
2966 return font
->driver
->encode_char (font
, c
);
2970 /* Return the name of FONT_OBJECT. */
2973 font_get_name (Lisp_Object font_object
)
2975 font_assert (FONT_OBJECT_P (font_object
));
2976 return AREF (font_object
, FONT_NAME_INDEX
);
2980 /* Return the specification of FONT_OBJECT. */
2983 font_get_spec (Lisp_Object font_object
)
2985 Lisp_Object spec
= font_make_spec ();
2988 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2989 ASET (spec
, i
, AREF (font_object
, i
));
2990 ASET (spec
, FONT_SIZE_INDEX
,
2991 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2996 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2997 could not be parsed by font_parse_name, return Qnil. */
3000 font_spec_from_name (Lisp_Object font_name
)
3002 Lisp_Object spec
= Ffont_spec (0, NULL
);
3004 CHECK_STRING (font_name
);
3005 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3007 font_put_extra (spec
, QCname
, font_name
);
3008 font_put_extra (spec
, QCuser_spec
, font_name
);
3014 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
3016 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3021 if (! NILP (Ffont_get (font
, QCname
)))
3023 font
= Fcopy_font_spec (font
);
3024 font_put_extra (font
, QCname
, Qnil
);
3027 if (NILP (AREF (font
, prop
))
3028 && prop
!= FONT_FAMILY_INDEX
3029 && prop
!= FONT_FOUNDRY_INDEX
3030 && prop
!= FONT_WIDTH_INDEX
3031 && prop
!= FONT_SIZE_INDEX
)
3033 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3034 font
= Fcopy_font_spec (font
);
3035 ASET (font
, prop
, Qnil
);
3036 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3038 if (prop
== FONT_FAMILY_INDEX
)
3040 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3041 /* If we are setting the font family, we must also clear
3042 FONT_WIDTH_INDEX to avoid rejecting families that lack
3043 support for some widths. */
3044 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3046 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3047 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3048 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3049 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3050 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3051 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3053 else if (prop
== FONT_SIZE_INDEX
)
3055 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3056 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3057 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3059 else if (prop
== FONT_WIDTH_INDEX
)
3060 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3061 attrs
[LFACE_FONT_INDEX
] = font
;
3064 /* Selecte a font from ENTITIES (list of font-entity vectors) that
3065 supports C and matches best with ATTRS and PIXEL_SIZE. */
3068 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
3070 Lisp_Object font_entity
;
3073 FRAME_PTR f
= XFRAME (frame
);
3075 if (NILP (XCDR (entities
))
3076 && ASIZE (XCAR (entities
)) == 1)
3078 font_entity
= AREF (XCAR (entities
), 0);
3080 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3085 /* Sort fonts by properties specified in ATTRS. */
3086 prefer
= scratch_font_prefer
;
3088 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3089 ASET (prefer
, i
, Qnil
);
3090 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3092 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3094 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3095 ASET (prefer
, i
, AREF (face_font
, i
));
3097 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3098 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3099 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3100 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3101 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3102 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3103 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3105 return font_sort_entities (entities
, prefer
, frame
, c
);
3108 /* Return a font-entity satisfying SPEC and best matching with face's
3109 font related attributes in ATTRS. C, if not negative, is a
3110 character that the entity must support. */
3113 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3116 Lisp_Object frame
, entities
, val
;
3117 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3121 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3122 if (NILP (registry
[0]))
3124 registry
[0] = DEFAULT_ENCODING
;
3125 registry
[1] = Qascii_0
;
3126 registry
[2] = null_vector
;
3129 registry
[1] = null_vector
;
3131 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3133 struct charset
*encoding
, *repertory
;
3135 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3136 &encoding
, &repertory
) < 0)
3139 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3141 else if (c
> encoding
->max_char
)
3145 work
= Fcopy_font_spec (spec
);
3146 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3147 XSETFRAME (frame
, f
);
3148 size
= AREF (spec
, FONT_SIZE_INDEX
);
3149 pixel_size
= font_pixel_size (f
, spec
);
3150 if (pixel_size
== 0)
3152 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3154 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3156 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3157 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3158 if (! NILP (foundry
[0]))
3159 foundry
[1] = null_vector
;
3160 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3162 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3163 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3165 foundry
[2] = null_vector
;
3168 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3170 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3171 if (! NILP (adstyle
[0]))
3172 adstyle
[1] = null_vector
;
3173 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3175 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3177 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3179 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3181 adstyle
[2] = null_vector
;
3184 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3187 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3190 val
= AREF (work
, FONT_FAMILY_INDEX
);
3191 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3193 val
= attrs
[LFACE_FAMILY_INDEX
];
3194 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3198 family
= alloca ((sizeof family
[0]) * 2);
3200 family
[1] = null_vector
; /* terminator. */
3205 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3206 /* Font family names are case-sensitive under NS. */
3214 if (! NILP (alters
))
3216 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3217 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3218 family
[i
] = XCAR (alters
);
3219 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3221 family
[i
] = null_vector
;
3225 family
= alloca ((sizeof family
[0]) * 3);
3228 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3230 family
[i
] = null_vector
;
3234 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3236 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3237 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3239 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3240 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3242 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3243 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3245 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3246 entities
= font_list_entities (frame
, work
);
3247 if (! NILP (entities
))
3249 val
= font_select_entity (frame
, entities
,
3250 attrs
, pixel_size
, c
);
3263 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3267 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3268 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3269 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3270 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3271 size
= font_pixel_size (f
, spec
);
3275 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3276 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3279 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3280 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3281 if (INTEGERP (height
))
3284 abort(); /* We should never end up here. */
3288 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3292 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3293 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3297 return font_open_entity (f
, entity
, size
);
3301 /* Find a font satisfying SPEC and best matching with face's
3302 attributes in ATTRS on FRAME, and return the opened
3306 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3308 Lisp_Object entity
, name
;
3310 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3313 /* No font is listed for SPEC, but each font-backend may have
3314 the different criteria about "font matching". So, try
3316 entity
= font_matching_entity (f
, attrs
, spec
);
3320 /* Don't lose the original name that was put in initially. We need
3321 it to re-apply the font when font parameters (like hinting or dpi) have
3323 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3326 name
= Ffont_get (spec
, QCuser_spec
);
3327 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3333 /* Make FACE on frame F ready to use the font opened for FACE. */
3336 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3338 if (face
->font
->driver
->prepare_face
)
3339 face
->font
->driver
->prepare_face (f
, face
);
3343 /* Make FACE on frame F stop using the font opened for FACE. */
3346 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3348 if (face
->font
->driver
->done_face
)
3349 face
->font
->driver
->done_face (f
, face
);
3354 /* Open a font matching with font-spec SPEC on frame F. If no proper
3355 font is found, return Qnil. */
3358 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3360 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3362 /* We set up the default font-related attributes of a face to prefer
3364 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3365 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3366 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3368 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3370 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3372 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3374 return font_load_for_lface (f
, attrs
, spec
);
3378 /* Open a font matching with NAME on frame F. If no proper font is
3379 found, return Qnil. */
3382 font_open_by_name (FRAME_PTR f
, const char *name
)
3384 Lisp_Object args
[2];
3385 Lisp_Object spec
, ret
;
3388 args
[1] = make_unibyte_string (name
, strlen (name
));
3389 spec
= Ffont_spec (2, args
);
3390 ret
= font_open_by_spec (f
, spec
);
3391 /* Do not lose name originally put in. */
3393 font_put_extra (ret
, QCuser_spec
, args
[1]);
3399 /* Register font-driver DRIVER. This function is used in two ways.
3401 The first is with frame F non-NULL. In this case, make DRIVER
3402 available (but not yet activated) on F. All frame creaters
3403 (e.g. Fx_create_frame) must call this function at least once with
3404 an available font-driver.
3406 The second is with frame F NULL. In this case, DRIVER is globally
3407 registered in the variable `font_driver_list'. All font-driver
3408 implementations must call this function in its syms_of_XXXX
3409 (e.g. syms_of_xfont). */
3412 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3414 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3415 struct font_driver_list
*prev
, *list
;
3417 if (f
&& ! driver
->draw
)
3418 error ("Unusable font driver for a frame: %s",
3419 SDATA (SYMBOL_NAME (driver
->type
)));
3421 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3422 if (EQ (list
->driver
->type
, driver
->type
))
3423 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3425 list
= xmalloc (sizeof (struct font_driver_list
));
3427 list
->driver
= driver
;
3432 f
->font_driver_list
= list
;
3434 font_driver_list
= list
;
3440 free_font_driver_list (FRAME_PTR f
)
3442 struct font_driver_list
*list
, *next
;
3444 for (list
= f
->font_driver_list
; list
; list
= next
)
3449 f
->font_driver_list
= NULL
;
3453 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3454 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3455 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3457 A caller must free all realized faces if any in advance. The
3458 return value is a list of font backends actually made used on
3462 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3464 Lisp_Object active_drivers
= Qnil
;
3465 struct font_driver
*driver
;
3466 struct font_driver_list
*list
;
3468 /* At first, turn off non-requested drivers, and turn on requested
3470 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3472 driver
= list
->driver
;
3473 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3478 if (driver
->end_for_frame
)
3479 driver
->end_for_frame (f
);
3480 font_finish_cache (f
, driver
);
3485 if (! driver
->start_for_frame
3486 || driver
->start_for_frame (f
) == 0)
3488 font_prepare_cache (f
, driver
);
3495 if (NILP (new_drivers
))
3498 if (! EQ (new_drivers
, Qt
))
3500 /* Re-order the driver list according to new_drivers. */
3501 struct font_driver_list
**list_table
, **next
;
3505 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3506 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3508 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3509 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3512 list_table
[i
++] = list
;
3514 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3516 list_table
[i
++] = list
;
3517 list_table
[i
] = NULL
;
3519 next
= &f
->font_driver_list
;
3520 for (i
= 0; list_table
[i
]; i
++)
3522 *next
= list_table
[i
];
3523 next
= &(*next
)->next
;
3527 if (! f
->font_driver_list
->on
)
3528 { /* None of the drivers is enabled: enable them all.
3529 Happens if you set the list of drivers to (xft x) in your .emacs
3530 and then use it under w32 or ns. */
3531 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3533 struct font_driver
*driver
= list
->driver
;
3534 eassert (! list
->on
);
3535 if (! driver
->start_for_frame
3536 || driver
->start_for_frame (f
) == 0)
3538 font_prepare_cache (f
, driver
);
3545 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3547 active_drivers
= nconc2 (active_drivers
,
3548 Fcons (list
->driver
->type
, Qnil
));
3549 return active_drivers
;
3553 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3555 struct font_data_list
*list
, *prev
;
3557 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3558 prev
= list
, list
= list
->next
)
3559 if (list
->driver
== driver
)
3566 prev
->next
= list
->next
;
3568 f
->font_data_list
= list
->next
;
3576 list
= xmalloc (sizeof (struct font_data_list
));
3577 list
->driver
= driver
;
3578 list
->next
= f
->font_data_list
;
3579 f
->font_data_list
= list
;
3587 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3589 struct font_data_list
*list
;
3591 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3592 if (list
->driver
== driver
)
3600 /* Sets attributes on a font. Any properties that appear in ALIST and
3601 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3602 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3603 arrays of strings. This function is intended for use by the font
3604 drivers to implement their specific font_filter_properties. */
3606 font_filter_properties (Lisp_Object font
,
3608 const char *const boolean_properties
[],
3609 const char *const non_boolean_properties
[])
3614 /* Set boolean values to Qt or Qnil */
3615 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3616 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3618 Lisp_Object key
= XCAR (XCAR (it
));
3619 Lisp_Object val
= XCDR (XCAR (it
));
3620 char *keystr
= SDATA (SYMBOL_NAME (key
));
3622 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3624 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3625 : SYMBOLP (val
) ? (const char *) SDATA (SYMBOL_NAME (val
))
3628 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3629 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3630 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3631 || strcmp ("Off", str
) == 0)
3636 Ffont_put (font
, key
, val
);
3640 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3641 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3643 Lisp_Object key
= XCAR (XCAR (it
));
3644 Lisp_Object val
= XCDR (XCAR (it
));
3645 char *keystr
= SDATA (SYMBOL_NAME (key
));
3646 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3647 Ffont_put (font
, key
, val
);
3652 /* Return the font used to draw character C by FACE at buffer position
3653 POS in window W. If STRING is non-nil, it is a string containing C
3654 at index POS. If C is negative, get C from the current buffer or
3658 font_at (int c
, EMACS_INT pos
, struct face
*face
, struct window
*w
,
3663 Lisp_Object font_object
;
3665 multibyte
= (NILP (string
)
3666 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3667 : STRING_MULTIBYTE (string
));
3674 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3676 c
= FETCH_CHAR (pos_byte
);
3679 c
= FETCH_BYTE (pos
);
3685 multibyte
= STRING_MULTIBYTE (string
);
3688 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3690 str
= SDATA (string
) + pos_byte
;
3691 c
= STRING_CHAR (str
);
3694 c
= SDATA (string
)[pos
];
3698 f
= XFRAME (w
->frame
);
3699 if (! FRAME_WINDOW_P (f
))
3706 if (STRINGP (string
))
3707 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3708 DEFAULT_FACE_ID
, 0);
3710 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3712 face
= FACE_FROM_ID (f
, face_id
);
3716 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3717 face
= FACE_FROM_ID (f
, face_id
);
3722 XSETFONT (font_object
, face
->font
);
3727 #ifdef HAVE_WINDOW_SYSTEM
3729 /* Check how many characters after POS (at most to *LIMIT) can be
3730 displayed by the same font on the window W. FACE, if non-NULL, is
3731 the face selected for the character at POS. If STRING is not nil,
3732 it is the string to check instead of the current buffer. In that
3733 case, FACE must be not NULL.
3735 The return value is the font-object for the character at POS.
3736 *LIMIT is set to the position where that font can't be used.
3738 It is assured that the current buffer (or STRING) is multibyte. */
3741 font_range (EMACS_INT pos
, EMACS_INT
*limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3743 EMACS_INT pos_byte
, ignore
;
3745 Lisp_Object font_object
= Qnil
;
3749 pos_byte
= CHAR_TO_BYTE (pos
);
3754 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3756 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3762 pos_byte
= string_char_to_byte (string
, pos
);
3765 while (pos
< *limit
)
3767 Lisp_Object category
;
3770 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3772 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3773 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3774 if (EQ (category
, QCf
)
3775 || CHAR_VARIATION_SELECTOR_P (c
))
3777 if (NILP (font_object
))
3779 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3780 if (NILP (font_object
))
3784 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3794 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3795 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3796 Return nil otherwise.
3797 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3798 which kind of font it is. It must be one of `font-spec', `font-entity',
3800 (Lisp_Object object
, Lisp_Object extra_type
)
3802 if (NILP (extra_type
))
3803 return (FONTP (object
) ? Qt
: Qnil
);
3804 if (EQ (extra_type
, Qfont_spec
))
3805 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3806 if (EQ (extra_type
, Qfont_entity
))
3807 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3808 if (EQ (extra_type
, Qfont_object
))
3809 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3810 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3813 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3814 doc
: /* Return a newly created font-spec with arguments as properties.
3816 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3817 valid font property name listed below:
3819 `:family', `:weight', `:slant', `:width'
3821 They are the same as face attributes of the same name. See
3822 `set-face-attribute'.
3826 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3830 VALUE must be a string or a symbol specifying the additional
3831 typographic style information of a font, e.g. ``sans''.
3835 VALUE must be a string or a symbol specifying the charset registry and
3836 encoding of a font, e.g. ``iso8859-1''.
3840 VALUE must be a non-negative integer or a floating point number
3841 specifying the font size. It specifies the font size in pixels (if
3842 VALUE is an integer), or in points (if VALUE is a float).
3846 VALUE must be a string of XLFD-style or fontconfig-style font name.
3850 VALUE must be a symbol representing a script that the font must
3851 support. It may be a symbol representing a subgroup of a script
3852 listed in the variable `script-representative-chars'.
3856 VALUE must be a symbol of two-letter ISO-639 language names,
3861 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3862 required OpenType features.
3864 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3865 LANGSYS-TAG: OpenType language system tag symbol,
3866 or nil for the default language system.
3867 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3868 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3870 GSUB and GPOS may contain `nil' element. In such a case, the font
3871 must not have any of the remaining elements.
3873 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3874 be an OpenType font, and whose GPOS table of `thai' script's default
3875 language system must contain `mark' feature.
3877 usage: (font-spec ARGS...) */)
3878 (int nargs
, Lisp_Object
*args
)
3880 Lisp_Object spec
= font_make_spec ();
3883 for (i
= 0; i
< nargs
; i
+= 2)
3885 Lisp_Object key
= args
[i
], val
;
3889 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3892 if (EQ (key
, QCname
))
3895 font_parse_name ((char *) SDATA (val
), spec
);
3896 font_put_extra (spec
, key
, val
);
3900 int idx
= get_font_prop_index (key
);
3904 val
= font_prop_validate (idx
, Qnil
, val
);
3905 if (idx
< FONT_EXTRA_INDEX
)
3906 ASET (spec
, idx
, val
);
3908 font_put_extra (spec
, key
, val
);
3911 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3917 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3918 doc
: /* Return a copy of FONT as a font-spec. */)
3921 Lisp_Object new_spec
, tail
, prev
, extra
;
3925 new_spec
= font_make_spec ();
3926 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3927 ASET (new_spec
, i
, AREF (font
, i
));
3928 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3929 /* We must remove :font-entity property. */
3930 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3931 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3934 extra
= XCDR (extra
);
3936 XSETCDR (prev
, XCDR (tail
));
3939 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3943 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3944 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3945 Every specified properties in FROM override the corresponding
3946 properties in TO. */)
3947 (Lisp_Object from
, Lisp_Object to
)
3949 Lisp_Object extra
, tail
;
3954 to
= Fcopy_font_spec (to
);
3955 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3956 ASET (to
, i
, AREF (from
, i
));
3957 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3958 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3959 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3961 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3964 XSETCDR (slot
, XCDR (XCAR (tail
)));
3966 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3968 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3972 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3973 doc
: /* Return the value of FONT's property KEY.
3974 FONT is a font-spec, a font-entity, or a font-object.
3975 KEY is any symbol, but these are reserved for specific meanings:
3976 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3977 :size, :name, :script, :otf
3978 See the documentation of `font-spec' for their meanings.
3979 In addition, if FONT is a font-entity or a font-object, values of
3980 :script and :otf are different from those of a font-spec as below:
3982 The value of :script may be a list of scripts that are supported by the font.
3984 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3985 representing the OpenType features supported by the font by this form:
3986 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3987 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3989 (Lisp_Object font
, Lisp_Object key
)
3997 idx
= get_font_prop_index (key
);
3998 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3999 return font_style_symbolic (font
, idx
, 0);
4000 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4001 return AREF (font
, idx
);
4002 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
4003 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
4005 struct font
*fontp
= XFONT_OBJECT (font
);
4007 if (fontp
->driver
->otf_capability
)
4008 val
= fontp
->driver
->otf_capability (fontp
);
4010 val
= Fcons (Qnil
, Qnil
);
4011 font_put_extra (font
, QCotf
, val
);
4018 #ifdef HAVE_WINDOW_SYSTEM
4020 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4021 doc
: /* Return a plist of face attributes generated by FONT.
4022 FONT is a font name, a font-spec, a font-entity, or a font-object.
4023 The return value is a list of the form
4025 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4027 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4028 compatible with `set-face-attribute'. Some of these key-attribute pairs
4029 may be omitted from the list if they are not specified by FONT.
4031 The optional argument FRAME specifies the frame that the face attributes
4032 are to be displayed on. If omitted, the selected frame is used. */)
4033 (Lisp_Object font
, Lisp_Object frame
)
4036 Lisp_Object plist
[10];
4041 frame
= selected_frame
;
4042 CHECK_LIVE_FRAME (frame
);
4047 int fontset
= fs_query_fontset (font
, 0);
4048 Lisp_Object name
= font
;
4050 font
= fontset_ascii (fontset
);
4051 font
= font_spec_from_name (name
);
4053 signal_error ("Invalid font name", name
);
4055 else if (! FONTP (font
))
4056 signal_error ("Invalid font object", font
);
4058 val
= AREF (font
, FONT_FAMILY_INDEX
);
4061 plist
[n
++] = QCfamily
;
4062 plist
[n
++] = SYMBOL_NAME (val
);
4065 val
= AREF (font
, FONT_SIZE_INDEX
);
4068 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4069 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4070 plist
[n
++] = QCheight
;
4071 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4073 else if (FLOATP (val
))
4075 plist
[n
++] = QCheight
;
4076 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4079 val
= FONT_WEIGHT_FOR_FACE (font
);
4082 plist
[n
++] = QCweight
;
4086 val
= FONT_SLANT_FOR_FACE (font
);
4089 plist
[n
++] = QCslant
;
4093 val
= FONT_WIDTH_FOR_FACE (font
);
4096 plist
[n
++] = QCwidth
;
4100 return Flist (n
, plist
);
4105 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4106 doc
: /* Set one property of FONT: give property KEY value VAL.
4107 FONT is a font-spec, a font-entity, or a font-object.
4109 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4110 accepted by the function `font-spec' (which see), VAL must be what
4111 allowed in `font-spec'.
4113 If FONT is a font-entity or a font-object, KEY must not be the one
4114 accepted by `font-spec'. */)
4115 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4119 idx
= get_font_prop_index (prop
);
4120 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4122 CHECK_FONT_SPEC (font
);
4123 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4127 if (EQ (prop
, QCname
)
4128 || EQ (prop
, QCscript
)
4129 || EQ (prop
, QClang
)
4130 || EQ (prop
, QCotf
))
4131 CHECK_FONT_SPEC (font
);
4134 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4139 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4140 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4141 Optional 2nd argument FRAME specifies the target frame.
4142 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4143 Optional 4th argument PREFER, if non-nil, is a font-spec to
4144 control the order of the returned list. Fonts are sorted by
4145 how close they are to PREFER. */)
4146 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4148 Lisp_Object vec
, list
;
4152 frame
= selected_frame
;
4153 CHECK_LIVE_FRAME (frame
);
4154 CHECK_FONT_SPEC (font_spec
);
4162 if (! NILP (prefer
))
4163 CHECK_FONT_SPEC (prefer
);
4165 list
= font_list_entities (frame
, font_spec
);
4168 if (NILP (XCDR (list
))
4169 && ASIZE (XCAR (list
)) == 1)
4170 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4172 if (! NILP (prefer
))
4173 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4175 vec
= font_vconcat_entity_vectors (list
);
4176 if (n
== 0 || n
>= ASIZE (vec
))
4178 Lisp_Object args
[2];
4182 list
= Fappend (2, args
);
4186 for (list
= Qnil
, n
--; n
>= 0; n
--)
4187 list
= Fcons (AREF (vec
, n
), list
);
4192 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4193 doc
: /* List available font families on the current frame.
4194 Optional argument FRAME, if non-nil, specifies the target frame. */)
4198 struct font_driver_list
*driver_list
;
4202 frame
= selected_frame
;
4203 CHECK_LIVE_FRAME (frame
);
4206 for (driver_list
= f
->font_driver_list
; driver_list
;
4207 driver_list
= driver_list
->next
)
4208 if (driver_list
->driver
->list_family
)
4210 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4211 Lisp_Object tail
= list
;
4213 for (; CONSP (val
); val
= XCDR (val
))
4214 if (NILP (Fmemq (XCAR (val
), tail
))
4215 && SYMBOLP (XCAR (val
)))
4216 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4221 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4222 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4223 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4224 (Lisp_Object font_spec
, Lisp_Object frame
)
4226 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4233 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4234 doc
: /* Return XLFD name of FONT.
4235 FONT is a font-spec, font-entity, or font-object.
4236 If the name is too long for XLFD (maximum 255 chars), return nil.
4237 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4238 the consecutive wildcards are folded to one. */)
4239 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4246 if (FONT_OBJECT_P (font
))
4248 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4250 if (STRINGP (font_name
)
4251 && SDATA (font_name
)[0] == '-')
4253 if (NILP (fold_wildcards
))
4255 strcpy (name
, (char *) SDATA (font_name
));
4258 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4260 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4263 if (! NILP (fold_wildcards
))
4265 char *p0
= name
, *p1
;
4267 while ((p1
= strstr (p0
, "-*-*")))
4269 strcpy (p1
, p1
+ 2);
4274 return build_string (name
);
4277 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4278 doc
: /* Clear font cache. */)
4281 Lisp_Object list
, frame
;
4283 FOR_EACH_FRAME (list
, frame
)
4285 FRAME_PTR f
= XFRAME (frame
);
4286 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4288 for (; driver_list
; driver_list
= driver_list
->next
)
4289 if (driver_list
->on
)
4291 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4292 Lisp_Object val
, tmp
;
4296 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4298 font_assert (! NILP (val
));
4299 tmp
= XCDR (XCAR (val
));
4300 if (XINT (XCAR (tmp
)) == 0)
4302 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4303 XSETCDR (cache
, XCDR (val
));
4313 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4315 struct font
*font
= XFONT_OBJECT (font_object
);
4317 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4318 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4319 struct font_metrics metrics
;
4321 LGLYPH_SET_CODE (glyph
, ecode
);
4323 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4324 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4325 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4326 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4327 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4328 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4332 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4333 doc
: /* Shape the glyph-string GSTRING.
4334 Shaping means substituting glyphs and/or adjusting positions of glyphs
4335 to get the correct visual image of character sequences set in the
4336 header of the glyph-string.
4338 If the shaping was successful, the value is GSTRING itself or a newly
4339 created glyph-string. Otherwise, the value is nil. */)
4340 (Lisp_Object gstring
)
4343 Lisp_Object font_object
, n
, glyph
;
4346 if (! composition_gstring_p (gstring
))
4347 signal_error ("Invalid glyph-string: ", gstring
);
4348 if (! NILP (LGSTRING_ID (gstring
)))
4350 font_object
= LGSTRING_FONT (gstring
);
4351 CHECK_FONT_OBJECT (font_object
);
4352 font
= XFONT_OBJECT (font_object
);
4353 if (! font
->driver
->shape
)
4356 /* Try at most three times with larger gstring each time. */
4357 for (i
= 0; i
< 3; i
++)
4359 n
= font
->driver
->shape (gstring
);
4362 gstring
= larger_vector (gstring
,
4363 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4366 if (i
== 3 || XINT (n
) == 0)
4368 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4369 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4371 glyph
= LGSTRING_GLYPH (gstring
, 0);
4372 from
= LGLYPH_FROM (glyph
);
4373 to
= LGLYPH_TO (glyph
);
4374 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4376 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4380 if (NILP (LGLYPH_ADJUSTMENT (this)))
4385 glyph
= LGSTRING_GLYPH (gstring
, j
);
4386 LGLYPH_SET_FROM (glyph
, from
);
4387 LGLYPH_SET_TO (glyph
, to
);
4389 from
= LGLYPH_FROM (this);
4390 to
= LGLYPH_TO (this);
4395 if (from
> LGLYPH_FROM (this))
4396 from
= LGLYPH_FROM (this);
4397 if (to
< LGLYPH_TO (this))
4398 to
= LGLYPH_TO (this);
4404 glyph
= LGSTRING_GLYPH (gstring
, j
);
4405 LGLYPH_SET_FROM (glyph
, from
);
4406 LGLYPH_SET_TO (glyph
, to
);
4408 return composition_gstring_put_cache (gstring
, XINT (n
));
4411 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4413 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4414 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4416 VARIATION-SELECTOR is a character code of variation selection
4417 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4418 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4419 (Lisp_Object font_object
, Lisp_Object character
)
4421 unsigned variations
[256];
4426 CHECK_FONT_OBJECT (font_object
);
4427 CHECK_CHARACTER (character
);
4428 font
= XFONT_OBJECT (font_object
);
4429 if (! font
->driver
->get_variation_glyphs
)
4431 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4435 for (i
= 0; i
< 255; i
++)
4439 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4440 /* Stops GCC whining about limited range of data type. */
4441 EMACS_INT var
= variations
[i
];
4443 if (var
> MOST_POSITIVE_FIXNUM
)
4444 code
= Fcons (make_number ((variations
[i
]) >> 16),
4445 make_number ((variations
[i
]) & 0xFFFF));
4447 code
= make_number (variations
[i
]);
4448 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4455 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4456 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4457 OTF-FEATURES specifies which features to apply in this format:
4458 (SCRIPT LANGSYS GSUB GPOS)
4460 SCRIPT is a symbol specifying a script tag of OpenType,
4461 LANGSYS is a symbol specifying a langsys tag of OpenType,
4462 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4464 If LANGYS is nil, the default langsys is selected.
4466 The features are applied in the order they appear in the list. The
4467 symbol `*' means to apply all available features not present in this
4468 list, and the remaining features are ignored. For instance, (vatu
4469 pstf * haln) is to apply vatu and pstf in this order, then to apply
4470 all available features other than vatu, pstf, and haln.
4472 The features are applied to the glyphs in the range FROM and TO of
4473 the glyph-string GSTRING-IN.
4475 If some feature is actually applicable, the resulting glyphs are
4476 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4477 this case, the value is the number of produced glyphs.
4479 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4482 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4483 produced in GSTRING-OUT, and the value is nil.
4485 See the documentation of `font-make-gstring' for the format of
4487 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4489 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4494 check_otf_features (otf_features
);
4495 CHECK_FONT_OBJECT (font_object
);
4496 font
= XFONT_OBJECT (font_object
);
4497 if (! font
->driver
->otf_drive
)
4498 error ("Font backend %s can't drive OpenType GSUB table",
4499 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4500 CHECK_CONS (otf_features
);
4501 CHECK_SYMBOL (XCAR (otf_features
));
4502 val
= XCDR (otf_features
);
4503 CHECK_SYMBOL (XCAR (val
));
4504 val
= XCDR (otf_features
);
4507 len
= check_gstring (gstring_in
);
4508 CHECK_VECTOR (gstring_out
);
4509 CHECK_NATNUM (from
);
4511 CHECK_NATNUM (index
);
4513 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4514 args_out_of_range_3 (from
, to
, make_number (len
));
4515 if (XINT (index
) >= ASIZE (gstring_out
))
4516 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4517 num
= font
->driver
->otf_drive (font
, otf_features
,
4518 gstring_in
, XINT (from
), XINT (to
),
4519 gstring_out
, XINT (index
), 0);
4522 return make_number (num
);
4525 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4527 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4528 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4530 (SCRIPT LANGSYS FEATURE ...)
4531 See the documentation of `font-drive-otf' for more detail.
4533 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4534 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4535 character code corresponding to the glyph or nil if there's no
4536 corresponding character. */)
4537 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4540 Lisp_Object gstring_in
, gstring_out
, g
;
4541 Lisp_Object alternates
;
4544 CHECK_FONT_GET_OBJECT (font_object
, font
);
4545 if (! font
->driver
->otf_drive
)
4546 error ("Font backend %s can't drive OpenType GSUB table",
4547 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4548 CHECK_CHARACTER (character
);
4549 CHECK_CONS (otf_features
);
4551 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4552 g
= LGSTRING_GLYPH (gstring_in
, 0);
4553 LGLYPH_SET_CHAR (g
, XINT (character
));
4554 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4555 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4556 gstring_out
, 0, 1)) < 0)
4557 gstring_out
= Ffont_make_gstring (font_object
,
4558 make_number (ASIZE (gstring_out
) * 2));
4560 for (i
= 0; i
< num
; i
++)
4562 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4563 int c
= LGLYPH_CHAR (g
);
4564 unsigned code
= LGLYPH_CODE (g
);
4566 alternates
= Fcons (Fcons (make_number (code
),
4567 c
> 0 ? make_number (c
) : Qnil
),
4570 return Fnreverse (alternates
);
4576 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4577 doc
: /* Open FONT-ENTITY. */)
4578 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4582 CHECK_FONT_ENTITY (font_entity
);
4584 frame
= selected_frame
;
4585 CHECK_LIVE_FRAME (frame
);
4588 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4591 CHECK_NUMBER_OR_FLOAT (size
);
4593 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4595 isize
= XINT (size
);
4599 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4602 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4603 doc
: /* Close FONT-OBJECT. */)
4604 (Lisp_Object font_object
, Lisp_Object frame
)
4606 CHECK_FONT_OBJECT (font_object
);
4608 frame
= selected_frame
;
4609 CHECK_LIVE_FRAME (frame
);
4610 font_close_object (XFRAME (frame
), font_object
);
4614 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4615 doc
: /* Return information about FONT-OBJECT.
4616 The value is a vector:
4617 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4620 NAME is a string of the font name (or nil if the font backend doesn't
4623 FILENAME is a string of the font file (or nil if the font backend
4624 doesn't provide a file name).
4626 PIXEL-SIZE is a pixel size by which the font is opened.
4628 SIZE is a maximum advance width of the font in pixels.
4630 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4633 CAPABILITY is a list whose first element is a symbol representing the
4634 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4635 remaining elements describe the details of the font capability.
4637 If the font is OpenType font, the form of the list is
4638 \(opentype GSUB GPOS)
4639 where GSUB shows which "GSUB" features the font supports, and GPOS
4640 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4641 lists of the format:
4642 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4644 If the font is not OpenType font, currently the length of the form is
4647 SCRIPT is a symbol representing OpenType script tag.
4649 LANGSYS is a symbol representing OpenType langsys tag, or nil
4650 representing the default langsys.
4652 FEATURE is a symbol representing OpenType feature tag.
4654 If the font is not OpenType font, CAPABILITY is nil. */)
4655 (Lisp_Object font_object
)
4660 CHECK_FONT_GET_OBJECT (font_object
, font
);
4662 val
= Fmake_vector (make_number (9), Qnil
);
4663 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4664 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4665 ASET (val
, 2, make_number (font
->pixel_size
));
4666 ASET (val
, 3, make_number (font
->max_width
));
4667 ASET (val
, 4, make_number (font
->ascent
));
4668 ASET (val
, 5, make_number (font
->descent
));
4669 ASET (val
, 6, make_number (font
->space_width
));
4670 ASET (val
, 7, make_number (font
->average_width
));
4671 if (font
->driver
->otf_capability
)
4672 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4676 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4678 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4679 FROM and TO are positions (integers or markers) specifying a region
4680 of the current buffer.
4681 If the optional fourth arg OBJECT is not nil, it is a string or a
4682 vector containing the target characters.
4684 Each element is a vector containing information of a glyph in this format:
4685 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4687 FROM is an index numbers of a character the glyph corresponds to.
4688 TO is the same as FROM.
4689 C is the character of the glyph.
4690 CODE is the glyph-code of C in FONT-OBJECT.
4691 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4692 ADJUSTMENT is always nil.
4693 If FONT-OBJECT doesn't have a glyph for a character,
4694 the corresponding element is nil. */)
4695 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4700 Lisp_Object
*chars
, vec
;
4703 CHECK_FONT_GET_OBJECT (font_object
, font
);
4706 EMACS_INT charpos
, bytepos
;
4708 validate_region (&from
, &to
);
4711 len
= XFASTINT (to
) - XFASTINT (from
);
4712 SAFE_ALLOCA_LISP (chars
, len
);
4713 charpos
= XFASTINT (from
);
4714 bytepos
= CHAR_TO_BYTE (charpos
);
4715 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4717 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4718 chars
[i
] = make_number (c
);
4721 else if (STRINGP (object
))
4723 const unsigned char *p
;
4725 CHECK_NUMBER (from
);
4727 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4728 || XINT (to
) > SCHARS (object
))
4729 args_out_of_range_3 (object
, from
, to
);
4732 len
= XFASTINT (to
) - XFASTINT (from
);
4733 SAFE_ALLOCA_LISP (chars
, len
);
4735 if (STRING_MULTIBYTE (object
))
4736 for (i
= 0; i
< len
; i
++)
4738 c
= STRING_CHAR_ADVANCE (p
);
4739 chars
[i
] = make_number (c
);
4742 for (i
= 0; i
< len
; i
++)
4743 chars
[i
] = make_number (p
[i
]);
4747 CHECK_VECTOR (object
);
4748 CHECK_NUMBER (from
);
4750 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4751 || XINT (to
) > ASIZE (object
))
4752 args_out_of_range_3 (object
, from
, to
);
4755 len
= XFASTINT (to
) - XFASTINT (from
);
4756 for (i
= 0; i
< len
; i
++)
4758 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4759 CHECK_CHARACTER (elt
);
4761 chars
= &(AREF (object
, XFASTINT (from
)));
4764 vec
= Fmake_vector (make_number (len
), Qnil
);
4765 for (i
= 0; i
< len
; i
++)
4768 int c
= XFASTINT (chars
[i
]);
4771 struct font_metrics metrics
;
4773 cod
= code
= font
->driver
->encode_char (font
, c
);
4774 if (code
== FONT_INVALID_CODE
)
4776 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4777 LGLYPH_SET_FROM (g
, i
);
4778 LGLYPH_SET_TO (g
, i
);
4779 LGLYPH_SET_CHAR (g
, c
);
4780 LGLYPH_SET_CODE (g
, code
);
4781 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4782 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4783 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4784 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4785 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4786 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4789 if (! VECTORP (object
))
4794 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4795 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4796 FONT is a font-spec, font-entity, or font-object. */)
4797 (Lisp_Object spec
, Lisp_Object font
)
4799 CHECK_FONT_SPEC (spec
);
4802 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4805 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4806 doc
: /* Return a font-object for displaying a character at POSITION.
4807 Optional second arg WINDOW, if non-nil, is a window displaying
4808 the current buffer. It defaults to the currently selected window. */)
4809 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4816 CHECK_NUMBER_COERCE_MARKER (position
);
4817 pos
= XINT (position
);
4818 if (pos
< BEGV
|| pos
>= ZV
)
4819 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4823 CHECK_NUMBER (position
);
4824 CHECK_STRING (string
);
4825 pos
= XINT (position
);
4826 if (pos
< 0 || pos
>= SCHARS (string
))
4827 args_out_of_range (string
, position
);
4830 window
= selected_window
;
4831 CHECK_LIVE_WINDOW (window
);
4832 w
= XWINDOW (window
);
4834 return font_at (-1, pos
, NULL
, w
, string
);
4838 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4839 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4840 The value is a number of glyphs drawn.
4841 Type C-l to recover what previously shown. */)
4842 (Lisp_Object font_object
, Lisp_Object string
)
4844 Lisp_Object frame
= selected_frame
;
4845 FRAME_PTR f
= XFRAME (frame
);
4851 CHECK_FONT_GET_OBJECT (font_object
, font
);
4852 CHECK_STRING (string
);
4853 len
= SCHARS (string
);
4854 code
= alloca (sizeof (unsigned) * len
);
4855 for (i
= 0; i
< len
; i
++)
4857 Lisp_Object ch
= Faref (string
, make_number (i
));
4861 code
[i
] = font
->driver
->encode_char (font
, c
);
4862 if (code
[i
] == FONT_INVALID_CODE
)
4865 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4867 if (font
->driver
->prepare_face
)
4868 font
->driver
->prepare_face (f
, face
);
4869 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4870 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4871 if (font
->driver
->done_face
)
4872 font
->driver
->done_face (f
, face
);
4874 return make_number (len
);
4878 #endif /* FONT_DEBUG */
4880 #ifdef HAVE_WINDOW_SYSTEM
4882 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4883 doc
: /* Return information about a font named NAME on frame FRAME.
4884 If FRAME is omitted or nil, use the selected frame.
4885 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4886 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4888 OPENED-NAME is the name used for opening the font,
4889 FULL-NAME is the full name of the font,
4890 SIZE is the pixelsize of the font,
4891 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4892 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4893 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4894 how to compose characters.
4895 If the named font is not yet loaded, return nil. */)
4896 (Lisp_Object name
, Lisp_Object frame
)
4901 Lisp_Object font_object
;
4903 (*check_window_system_func
) ();
4906 CHECK_STRING (name
);
4908 frame
= selected_frame
;
4909 CHECK_LIVE_FRAME (frame
);
4914 int fontset
= fs_query_fontset (name
, 0);
4917 name
= fontset_ascii (fontset
);
4918 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4920 else if (FONT_OBJECT_P (name
))
4922 else if (FONT_ENTITY_P (name
))
4923 font_object
= font_open_entity (f
, name
, 0);
4926 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4927 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4929 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4931 if (NILP (font_object
))
4933 font
= XFONT_OBJECT (font_object
);
4935 info
= Fmake_vector (make_number (7), Qnil
);
4936 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4937 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
4938 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4939 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4940 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4941 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4942 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4945 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4946 close it now. Perhaps, we should manage font-objects
4947 by `reference-count'. */
4948 font_close_object (f
, font_object
);
4955 #define BUILD_STYLE_TABLE(TBL) \
4956 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4959 build_style_table (const struct table_entry
*entry
, int nelement
)
4962 Lisp_Object table
, elt
;
4964 table
= Fmake_vector (make_number (nelement
), Qnil
);
4965 for (i
= 0; i
< nelement
; i
++)
4967 for (j
= 0; entry
[i
].names
[j
]; j
++);
4968 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4969 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4970 for (j
= 0; entry
[i
].names
[j
]; j
++)
4971 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4972 ASET (table
, i
, elt
);
4977 Lisp_Object Vfont_log
;
4979 /* The deferred font-log data of the form [ACTION ARG RESULT].
4980 If ACTION is not nil, that is added to the log when font_add_log is
4981 called next time. At that time, ACTION is set back to nil. */
4982 static Lisp_Object Vfont_log_deferred
;
4984 /* Prepend the font-related logging data in Vfont_log if it is not
4985 `t'. ACTION describes a kind of font-related action (e.g. listing,
4986 opening), ARG is the argument for the action, and RESULT is the
4987 result of the action. */
4989 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4991 Lisp_Object tail
, val
;
4994 if (EQ (Vfont_log
, Qt
))
4996 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4998 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
5000 ASET (Vfont_log_deferred
, 0, Qnil
);
5001 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5002 AREF (Vfont_log_deferred
, 2));
5007 Lisp_Object tail
, elt
;
5008 Lisp_Object equalstr
= build_string ("=");
5010 val
= Ffont_xlfd_name (arg
, Qt
);
5011 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5015 if (EQ (XCAR (elt
), QCscript
)
5016 && SYMBOLP (XCDR (elt
)))
5017 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5018 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5019 else if (EQ (XCAR (elt
), QClang
)
5020 && SYMBOLP (XCDR (elt
)))
5021 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5022 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5023 else if (EQ (XCAR (elt
), QCotf
)
5024 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5025 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5027 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5033 && VECTORP (XCAR (result
))
5034 && ASIZE (XCAR (result
)) > 0
5035 && FONTP (AREF (XCAR (result
), 0)))
5036 result
= font_vconcat_entity_vectors (result
);
5039 val
= Ffont_xlfd_name (result
, Qt
);
5040 if (! FONT_SPEC_P (result
))
5041 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5042 build_string (":"), val
);
5045 else if (CONSP (result
))
5047 result
= Fcopy_sequence (result
);
5048 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5052 val
= Ffont_xlfd_name (val
, Qt
);
5053 XSETCAR (tail
, val
);
5056 else if (VECTORP (result
))
5058 result
= Fcopy_sequence (result
);
5059 for (i
= 0; i
< ASIZE (result
); i
++)
5061 val
= AREF (result
, i
);
5063 val
= Ffont_xlfd_name (val
, Qt
);
5064 ASET (result
, i
, val
);
5067 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5070 /* Record a font-related logging data to be added to Vfont_log when
5071 font_add_log is called next time. ACTION, ARG, RESULT are the same
5075 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5077 if (EQ (Vfont_log
, Qt
))
5079 ASET (Vfont_log_deferred
, 0, build_string (action
));
5080 ASET (Vfont_log_deferred
, 1, arg
);
5081 ASET (Vfont_log_deferred
, 2, result
);
5087 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5088 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5089 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5090 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5091 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5092 /* Note that the other elements in sort_shift_bits are not used. */
5094 staticpro (&font_charset_alist
);
5095 font_charset_alist
= Qnil
;
5097 DEFSYM (Qopentype
, "opentype");
5099 DEFSYM (Qascii_0
, "ascii-0");
5100 DEFSYM (Qiso8859_1
, "iso8859-1");
5101 DEFSYM (Qiso10646_1
, "iso10646-1");
5102 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5103 DEFSYM (Qunicode_sip
, "unicode-sip");
5107 DEFSYM (QCotf
, ":otf");
5108 DEFSYM (QClang
, ":lang");
5109 DEFSYM (QCscript
, ":script");
5110 DEFSYM (QCantialias
, ":antialias");
5112 DEFSYM (QCfoundry
, ":foundry");
5113 DEFSYM (QCadstyle
, ":adstyle");
5114 DEFSYM (QCregistry
, ":registry");
5115 DEFSYM (QCspacing
, ":spacing");
5116 DEFSYM (QCdpi
, ":dpi");
5117 DEFSYM (QCscalable
, ":scalable");
5118 DEFSYM (QCavgwidth
, ":avgwidth");
5119 DEFSYM (QCfont_entity
, ":font-entity");
5120 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5130 DEFSYM (QCuser_spec
, "user-spec");
5132 staticpro (&null_vector
);
5133 null_vector
= Fmake_vector (make_number (0), Qnil
);
5135 staticpro (&scratch_font_spec
);
5136 scratch_font_spec
= Ffont_spec (0, NULL
);
5137 staticpro (&scratch_font_prefer
);
5138 scratch_font_prefer
= Ffont_spec (0, NULL
);
5140 staticpro (&Vfont_log_deferred
);
5141 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5145 staticpro (&otf_list
);
5147 #endif /* HAVE_LIBOTF */
5151 defsubr (&Sfont_spec
);
5152 defsubr (&Sfont_get
);
5153 #ifdef HAVE_WINDOW_SYSTEM
5154 defsubr (&Sfont_face_attributes
);
5156 defsubr (&Sfont_put
);
5157 defsubr (&Slist_fonts
);
5158 defsubr (&Sfont_family_list
);
5159 defsubr (&Sfind_font
);
5160 defsubr (&Sfont_xlfd_name
);
5161 defsubr (&Sclear_font_cache
);
5162 defsubr (&Sfont_shape_gstring
);
5163 defsubr (&Sfont_variation_glyphs
);
5165 defsubr (&Sfont_drive_otf
);
5166 defsubr (&Sfont_otf_alternates
);
5170 defsubr (&Sopen_font
);
5171 defsubr (&Sclose_font
);
5172 defsubr (&Squery_font
);
5173 defsubr (&Sfont_get_glyphs
);
5174 defsubr (&Sfont_match_p
);
5175 defsubr (&Sfont_at
);
5177 defsubr (&Sdraw_string
);
5179 #endif /* FONT_DEBUG */
5180 #ifdef HAVE_WINDOW_SYSTEM
5181 defsubr (&Sfont_info
);
5184 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5186 Alist of fontname patterns vs the corresponding encoding and repertory info.
5187 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5188 where ENCODING is a charset or a char-table,
5189 and REPERTORY is a charset, a char-table, or nil.
5191 If ENCODING and REPERTORY are the same, the element can have the form
5192 \(REGEXP . ENCODING).
5194 ENCODING is for converting a character to a glyph code of the font.
5195 If ENCODING is a charset, encoding a character by the charset gives
5196 the corresponding glyph code. If ENCODING is a char-table, looking up
5197 the table by a character gives the corresponding glyph code.
5199 REPERTORY specifies a repertory of characters supported by the font.
5200 If REPERTORY is a charset, all characters beloging to the charset are
5201 supported. If REPERTORY is a char-table, all characters who have a
5202 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5203 gets the repertory information by an opened font and ENCODING. */);
5204 Vfont_encoding_alist
= Qnil
;
5206 /* FIXME: These 3 vars are not quite what they appear: setq on them
5207 won't have any effect other than disconnect them from the style
5208 table used by the font display code. So we make them read-only,
5209 to avoid this confusing situation. */
5211 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5212 doc
: /* Vector of valid font weight values.
5213 Each element has the form:
5214 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5215 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5216 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5217 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5219 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5220 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5221 See `font-weight-table' for the format of the vector. */);
5222 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5223 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5225 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5226 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5227 See `font-weight-table' for the format of the vector. */);
5228 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5229 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5231 staticpro (&font_style_table
);
5232 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5233 ASET (font_style_table
, 0, Vfont_weight_table
);
5234 ASET (font_style_table
, 1, Vfont_slant_table
);
5235 ASET (font_style_table
, 2, Vfont_width_table
);
5237 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5238 *Logging list of font related actions and results.
5239 The value t means to suppress the logging.
5240 The initial value is set to nil if the environment variable
5241 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5244 #ifdef HAVE_WINDOW_SYSTEM
5245 #ifdef HAVE_FREETYPE
5247 #ifdef HAVE_X_WINDOWS
5252 #endif /* HAVE_XFT */
5253 #endif /* HAVE_X_WINDOWS */
5254 #else /* not HAVE_FREETYPE */
5255 #ifdef HAVE_X_WINDOWS
5257 #endif /* HAVE_X_WINDOWS */
5258 #endif /* not HAVE_FREETYPE */
5261 #endif /* HAVE_BDFFONT */
5264 #endif /* WINDOWSNT */
5267 #endif /* HAVE_NS */
5268 #endif /* HAVE_WINDOW_SYSTEM */
5274 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;