1 /* font.c -- "Font" primitives.
3 Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
4 Copyright (C) 2006, 2007, 2008, 2009, 2010
5 National Institute of Advanced Industrial Science and Technology (AIST)
6 Registration Number H13PRO009
8 This file is part of GNU Emacs.
10 GNU Emacs is free software: you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation, either version 3 of the License, or
13 (at your option) any later version.
15 GNU Emacs is distributed in the hope that it will be useful,
16 but WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 GNU General Public License for more details.
20 You should have received a copy of the GNU General Public License
21 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
32 #include "dispextern.h"
34 #include "character.h"
35 #include "composite.h"
41 #endif /* HAVE_X_WINDOWS */
45 #endif /* HAVE_NTGUI */
51 Lisp_Object Qopentype
;
53 /* Important character set strings. */
54 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
56 #define DEFAULT_ENCODING Qiso8859_1
58 /* Unicode category `Cf'. */
59 static Lisp_Object QCf
;
61 /* Special vector of zero length. This is repeatedly used by (struct
62 font_driver *)->list when a specified font is not found. */
63 static Lisp_Object null_vector
;
65 static Lisp_Object Vfont_weight_table
, Vfont_slant_table
, Vfont_width_table
;
67 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
68 static Lisp_Object font_style_table
;
70 /* Structure used for tables mapping weight, slant, and width numeric
71 values and their names. */
76 /* The first one is a valid name as a face attribute.
77 The second one (if any) is a typical name in XLFD field. */
81 /* Table of weight numeric values and their names. This table must be
82 sorted by numeric values in ascending order. */
84 static const struct table_entry weight_table
[] =
87 { 20, { "ultra-light", "ultralight" }},
88 { 40, { "extra-light", "extralight" }},
90 { 75, { "semi-light", "semilight", "demilight", "book" }},
91 { 100, { "normal", "medium", "regular", "unspecified" }},
92 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
94 { 205, { "extra-bold", "extrabold" }},
95 { 210, { "ultra-bold", "ultrabold", "black" }}
98 /* Table of slant numeric values and their names. This table must be
99 sorted by numeric values in ascending order. */
101 static const struct table_entry slant_table
[] =
103 { 0, { "reverse-oblique", "ro" }},
104 { 10, { "reverse-italic", "ri" }},
105 { 100, { "normal", "r", "unspecified" }},
106 { 200, { "italic" ,"i", "ot" }},
107 { 210, { "oblique", "o" }}
110 /* Table of width numeric values and their names. This table must be
111 sorted by numeric values in ascending order. */
113 static const struct table_entry width_table
[] =
115 { 50, { "ultra-condensed", "ultracondensed" }},
116 { 63, { "extra-condensed", "extracondensed" }},
117 { 75, { "condensed", "compressed", "narrow" }},
118 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
119 { 100, { "normal", "medium", "regular", "unspecified" }},
120 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
121 { 125, { "expanded" }},
122 { 150, { "extra-expanded", "extraexpanded" }},
123 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
126 Lisp_Object QCfoundry
;
127 static Lisp_Object QCadstyle
, QCregistry
;
128 /* Symbols representing keys of font extra info. */
129 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
130 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
131 /* Symbols representing values of font spacing property. */
132 Lisp_Object Qc
, Qm
, Qp
, Qd
;
133 /* Special ADSTYLE properties to avoid fonts used for Latin
134 characters; used in xfont.c and ftfont.c. */
135 Lisp_Object Qja
, Qko
;
137 Lisp_Object QCuser_spec
;
139 Lisp_Object Vfont_encoding_alist
;
141 /* Alist of font registry symbol and the corresponding charsets
142 information. The information is retrieved from
143 Vfont_encoding_alist on demand.
145 Eash element has the form:
146 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
150 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
151 encodes a character code to a glyph code of a font, and
152 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
153 character is supported by a font.
155 The latter form means that the information for REGISTRY couldn't be
157 static Lisp_Object font_charset_alist
;
159 /* List of all font drivers. Each font-backend (XXXfont.c) calls
160 register_font_driver in syms_of_XXXfont to register its font-driver
162 static struct font_driver_list
*font_driver_list
;
166 /* Creaters of font-related Lisp object. */
169 font_make_spec (void)
171 Lisp_Object font_spec
;
172 struct font_spec
*spec
173 = ((struct font_spec
*)
174 allocate_pseudovector (VECSIZE (struct font_spec
),
175 FONT_SPEC_MAX
, PVEC_FONT
));
176 XSETFONT (font_spec
, spec
);
181 font_make_entity (void)
183 Lisp_Object font_entity
;
184 struct font_entity
*entity
185 = ((struct font_entity
*)
186 allocate_pseudovector (VECSIZE (struct font_entity
),
187 FONT_ENTITY_MAX
, PVEC_FONT
));
188 XSETFONT (font_entity
, entity
);
192 /* Create a font-object whose structure size is SIZE. If ENTITY is
193 not nil, copy properties from ENTITY to the font-object. If
194 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
196 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
198 Lisp_Object font_object
;
200 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
203 XSETFONT (font_object
, font
);
207 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
208 font
->props
[i
] = AREF (entity
, i
);
209 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
210 font
->props
[FONT_EXTRA_INDEX
]
211 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
214 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
220 static int font_pixel_size (FRAME_PTR f
, Lisp_Object
);
221 static Lisp_Object
font_open_entity (FRAME_PTR
, Lisp_Object
, int);
222 static Lisp_Object
font_matching_entity (FRAME_PTR
, Lisp_Object
*,
224 static unsigned font_encode_char (Lisp_Object
, int);
226 /* Number of registered font drivers. */
227 static int num_font_drivers
;
230 /* Return a Lispy value of a font property value at STR and LEN bytes.
231 If STR is "*", it returns nil.
232 If FORCE_SYMBOL is zero and all characters in STR are digits, it
233 returns an integer. Otherwise, it returns a symbol interned from
237 font_intern_prop (const char *str
, int len
, int force_symbol
)
242 EMACS_INT nbytes
, nchars
;
244 if (len
== 1 && *str
== '*')
246 if (!force_symbol
&& len
>=1 && isdigit (*str
))
248 for (i
= 1; i
< len
; i
++)
249 if (! isdigit (str
[i
]))
252 return make_number (atoi (str
));
255 /* The following code is copied from the function intern (in
256 lread.c), and modified to suite our purpose. */
258 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
259 obarray
= check_obarray (obarray
);
260 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
261 if (len
== nchars
|| len
!= nbytes
)
262 /* CONTENTS contains no multibyte sequences or contains an invalid
263 multibyte sequence. We'll make a unibyte string. */
264 tem
= oblookup (obarray
, str
, len
, len
);
266 tem
= oblookup (obarray
, str
, nchars
, len
);
269 if (len
== nchars
|| len
!= nbytes
)
270 tem
= make_unibyte_string (str
, len
);
272 tem
= make_multibyte_string (str
, nchars
, len
);
273 return Fintern (tem
, obarray
);
276 /* Return a pixel size of font-spec SPEC on frame F. */
279 font_pixel_size (FRAME_PTR f
, Lisp_Object spec
)
281 #ifdef HAVE_WINDOW_SYSTEM
282 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
291 font_assert (FLOATP (size
));
292 point_size
= XFLOAT_DATA (size
);
293 val
= AREF (spec
, FONT_DPI_INDEX
);
298 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
306 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
307 font vector. If VAL is not valid (i.e. not registered in
308 font_style_table), return -1 if NOERROR is zero, and return a
309 proper index if NOERROR is nonzero. In that case, register VAL in
310 font_style_table if VAL is a symbol, and return a closest index if
311 VAL is an integer. */
314 font_style_to_value (enum font_property_index prop
, Lisp_Object val
, int noerror
)
316 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
317 int len
= ASIZE (table
);
323 Lisp_Object args
[2], elt
;
325 /* At first try exact match. */
326 for (i
= 0; i
< len
; i
++)
327 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
328 if (EQ (val
, AREF (AREF (table
, i
), j
)))
329 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
330 | (i
<< 4) | (j
- 1));
331 /* Try also with case-folding match. */
332 s
= SDATA (SYMBOL_NAME (val
));
333 for (i
= 0; i
< len
; i
++)
334 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
336 elt
= AREF (AREF (table
, i
), j
);
337 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
338 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
339 | (i
<< 4) | (j
- 1));
345 elt
= Fmake_vector (make_number (2), make_number (100));
348 args
[1] = Fmake_vector (make_number (1), elt
);
349 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
350 return (100 << 8) | (i
<< 4);
355 int numeric
= XINT (val
);
357 for (i
= 0, last_n
= -1; i
< len
; i
++)
359 int n
= XINT (AREF (AREF (table
, i
), 0));
362 return (n
<< 8) | (i
<< 4);
367 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
368 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
374 return ((last_n
<< 8) | ((i
- 1) << 4));
379 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
, int for_face
)
381 Lisp_Object val
= AREF (font
, prop
);
382 Lisp_Object table
, elt
;
387 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
388 i
= XINT (val
) & 0xFF;
389 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
390 elt
= AREF (table
, ((i
>> 4) & 0xF));
391 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
392 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
395 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
396 FONTNAME. ENCODING is a charset symbol that specifies the encoding
397 of the font. REPERTORY is a charset symbol or nil. */
400 find_font_encoding (Lisp_Object fontname
)
402 Lisp_Object tail
, elt
;
404 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
408 && STRINGP (XCAR (elt
))
409 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
410 && (SYMBOLP (XCDR (elt
))
411 ? CHARSETP (XCDR (elt
))
412 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
418 /* Return encoding charset and repertory charset for REGISTRY in
419 ENCODING and REPERTORY correspondingly. If correct information for
420 REGISTRY is available, return 0. Otherwise return -1. */
423 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
426 int encoding_id
, repertory_id
;
428 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
434 encoding_id
= XINT (XCAR (val
));
435 repertory_id
= XINT (XCDR (val
));
439 val
= find_font_encoding (SYMBOL_NAME (registry
));
440 if (SYMBOLP (val
) && CHARSETP (val
))
442 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
444 else if (CONSP (val
))
446 if (! CHARSETP (XCAR (val
)))
448 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
449 if (NILP (XCDR (val
)))
453 if (! CHARSETP (XCDR (val
)))
455 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
460 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
462 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
466 *encoding
= CHARSET_FROM_ID (encoding_id
);
468 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
473 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
478 /* Font property value validaters. See the comment of
479 font_property_table for the meaning of the arguments. */
481 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
482 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
483 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
484 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
485 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
486 static int get_font_prop_index (Lisp_Object
);
489 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
492 val
= Fintern (val
, Qnil
);
495 else if (EQ (prop
, QCregistry
))
496 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
502 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
504 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
505 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
512 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
516 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
518 if ((n
& 0xF) + 1 >= ASIZE (elt
))
520 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
524 else if (SYMBOLP (val
))
526 int n
= font_style_to_value (prop
, val
, 0);
528 val
= n
>= 0 ? make_number (n
) : Qerror
;
536 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
538 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
543 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
545 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
547 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
549 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
551 if (spacing
== 'c' || spacing
== 'C')
552 return make_number (FONT_SPACING_CHARCELL
);
553 if (spacing
== 'm' || spacing
== 'M')
554 return make_number (FONT_SPACING_MONO
);
555 if (spacing
== 'p' || spacing
== 'P')
556 return make_number (FONT_SPACING_PROPORTIONAL
);
557 if (spacing
== 'd' || spacing
== 'D')
558 return make_number (FONT_SPACING_DUAL
);
564 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
566 Lisp_Object tail
, tmp
;
569 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
570 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
571 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
574 if (! SYMBOLP (XCAR (val
)))
579 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
581 for (i
= 0; i
< 2; i
++)
588 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
589 if (! SYMBOLP (XCAR (tmp
)))
597 /* Structure of known font property keys and validater of the
601 /* Pointer to the key symbol. */
603 /* Function to validate PROP's value VAL, or NULL if any value is
604 ok. The value is VAL or its regularized value if VAL is valid,
605 and Qerror if not. */
606 Lisp_Object (*validater
) (Lisp_Object prop
, Lisp_Object val
);
607 } font_property_table
[] =
608 { { &QCtype
, font_prop_validate_symbol
},
609 { &QCfoundry
, font_prop_validate_symbol
},
610 { &QCfamily
, font_prop_validate_symbol
},
611 { &QCadstyle
, font_prop_validate_symbol
},
612 { &QCregistry
, font_prop_validate_symbol
},
613 { &QCweight
, font_prop_validate_style
},
614 { &QCslant
, font_prop_validate_style
},
615 { &QCwidth
, font_prop_validate_style
},
616 { &QCsize
, font_prop_validate_non_neg
},
617 { &QCdpi
, font_prop_validate_non_neg
},
618 { &QCspacing
, font_prop_validate_spacing
},
619 { &QCavgwidth
, font_prop_validate_non_neg
},
620 /* The order of the above entries must match with enum
621 font_property_index. */
622 { &QClang
, font_prop_validate_symbol
},
623 { &QCscript
, font_prop_validate_symbol
},
624 { &QCotf
, font_prop_validate_otf
}
627 /* Size (number of elements) of the above table. */
628 #define FONT_PROPERTY_TABLE_SIZE \
629 ((sizeof font_property_table) / (sizeof *font_property_table))
631 /* Return an index number of font property KEY or -1 if KEY is not an
632 already known property. */
635 get_font_prop_index (Lisp_Object key
)
639 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
640 if (EQ (key
, *font_property_table
[i
].key
))
645 /* Validate the font property. The property key is specified by the
646 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
647 signal an error. The value is VAL or the regularized one. */
650 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
652 Lisp_Object validated
;
657 prop
= *font_property_table
[idx
].key
;
660 idx
= get_font_prop_index (prop
);
664 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
665 if (EQ (validated
, Qerror
))
666 signal_error ("invalid font property", Fcons (prop
, val
));
671 /* Store VAL as a value of extra font property PROP in FONT while
672 keeping the sorting order. Don't check the validity of VAL. */
675 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
677 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
678 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
682 Lisp_Object prev
= Qnil
;
685 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
686 prev
= extra
, extra
= XCDR (extra
);
689 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
691 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
697 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
702 /* Font name parser and unparser */
704 static int parse_matrix (const char *);
705 static int font_expand_wildcards (Lisp_Object
*, int);
706 static int font_parse_name (char *, Lisp_Object
);
708 /* An enumerator for each field of an XLFD font name. */
709 enum xlfd_field_index
728 /* An enumerator for mask bit corresponding to each XLFD field. */
731 XLFD_FOUNDRY_MASK
= 0x0001,
732 XLFD_FAMILY_MASK
= 0x0002,
733 XLFD_WEIGHT_MASK
= 0x0004,
734 XLFD_SLANT_MASK
= 0x0008,
735 XLFD_SWIDTH_MASK
= 0x0010,
736 XLFD_ADSTYLE_MASK
= 0x0020,
737 XLFD_PIXEL_MASK
= 0x0040,
738 XLFD_POINT_MASK
= 0x0080,
739 XLFD_RESX_MASK
= 0x0100,
740 XLFD_RESY_MASK
= 0x0200,
741 XLFD_SPACING_MASK
= 0x0400,
742 XLFD_AVGWIDTH_MASK
= 0x0800,
743 XLFD_REGISTRY_MASK
= 0x1000,
744 XLFD_ENCODING_MASK
= 0x2000
748 /* Parse P pointing the pixel/point size field of the form
749 `[A B C D]' which specifies a transformation matrix:
755 by which all glyphs of the font are transformed. The spec says
756 that scalar value N for the pixel/point size is equivalent to:
757 A = N * resx/resy, B = C = 0, D = N.
759 Return the scalar value N if the form is valid. Otherwise return
763 parse_matrix (const char *p
)
769 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
772 matrix
[i
] = - strtod (p
+ 1, &end
);
774 matrix
[i
] = strtod (p
, &end
);
777 return (i
== 4 ? (int) matrix
[3] : -1);
780 /* Expand a wildcard field in FIELD (the first N fields are filled) to
781 multiple fields to fill in all 14 XLFD fields while restring a
782 field position by its contents. */
785 font_expand_wildcards (Lisp_Object
*field
, int n
)
788 Lisp_Object tmp
[XLFD_LAST_INDEX
];
789 /* Array of information about where this element can go. Nth
790 element is for Nth element of FIELD. */
792 /* Minimum possible field. */
794 /* Maxinum possible field. */
796 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
798 } range
[XLFD_LAST_INDEX
];
800 int range_from
, range_to
;
803 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
804 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
805 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
806 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
807 | XLFD_AVGWIDTH_MASK)
808 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
810 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
811 field. The value is shifted to left one bit by one in the
813 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
814 range_mask
= (range_mask
<< 1) | 1;
816 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
817 position-based retriction for FIELD[I]. */
818 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
819 i
++, range_from
++, range_to
++, range_mask
<<= 1)
821 Lisp_Object val
= field
[i
];
827 range
[i
].from
= range_from
;
828 range
[i
].to
= range_to
;
829 range
[i
].mask
= range_mask
;
833 /* The triplet FROM, TO, and MASK is a value-based
834 retriction for FIELD[I]. */
840 int numeric
= XINT (val
);
843 from
= to
= XLFD_ENCODING_INDEX
,
844 mask
= XLFD_ENCODING_MASK
;
845 else if (numeric
== 0)
846 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
847 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
848 else if (numeric
<= 48)
849 from
= to
= XLFD_PIXEL_INDEX
,
850 mask
= XLFD_PIXEL_MASK
;
852 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
853 mask
= XLFD_LARGENUM_MASK
;
855 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
856 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
857 mask
= XLFD_NULL_MASK
;
859 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
862 Lisp_Object name
= SYMBOL_NAME (val
);
864 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
865 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
866 mask
= XLFD_REGENC_MASK
;
868 from
= to
= XLFD_ENCODING_INDEX
,
869 mask
= XLFD_ENCODING_MASK
;
871 else if (range_from
<= XLFD_WEIGHT_INDEX
872 && range_to
>= XLFD_WEIGHT_INDEX
873 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
874 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
875 else if (range_from
<= XLFD_SLANT_INDEX
876 && range_to
>= XLFD_SLANT_INDEX
877 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
878 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
879 else if (range_from
<= XLFD_SWIDTH_INDEX
880 && range_to
>= XLFD_SWIDTH_INDEX
881 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
882 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
885 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
886 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
888 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
889 mask
= XLFD_SYMBOL_MASK
;
892 /* Merge position-based and value-based restrictions. */
894 while (from
< range_from
)
895 mask
&= ~(1 << from
++);
896 while (from
< 14 && ! (mask
& (1 << from
)))
898 while (to
> range_to
)
899 mask
&= ~(1 << to
--);
900 while (to
>= 0 && ! (mask
& (1 << to
)))
904 range
[i
].from
= from
;
906 range
[i
].mask
= mask
;
908 if (from
> range_from
|| to
< range_to
)
910 /* The range is narrowed by value-based restrictions.
911 Reflect it to the other fields. */
913 /* Following fields should be after FROM. */
915 /* Preceding fields should be before TO. */
916 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
918 /* Check FROM for non-wildcard field. */
919 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
921 while (range
[j
].from
< from
)
922 range
[j
].mask
&= ~(1 << range
[j
].from
++);
923 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
925 range
[j
].from
= from
;
928 from
= range
[j
].from
;
929 if (range
[j
].to
> to
)
931 while (range
[j
].to
> to
)
932 range
[j
].mask
&= ~(1 << range
[j
].to
--);
933 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
946 /* Decide all fileds from restrictions in RANGE. */
947 for (i
= j
= 0; i
< n
; i
++)
949 if (j
< range
[i
].from
)
951 if (i
== 0 || ! NILP (tmp
[i
- 1]))
952 /* None of TMP[X] corresponds to Jth field. */
954 for (; j
< range
[i
].from
; j
++)
959 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
961 for (; j
< XLFD_LAST_INDEX
; j
++)
963 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
964 field
[XLFD_ENCODING_INDEX
]
965 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
970 /* Parse NAME (null terminated) as XLFD and store information in FONT
971 (font-spec or font-entity). Size property of FONT is set as
973 specified XLFD fields FONT property
974 --------------------- -------------
975 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
976 POINT_SIZE and RESY calculated pixel size (Lisp integer)
977 POINT_SIZE POINT_SIZE/10 (Lisp float)
979 If NAME is successfully parsed, return 0. Otherwise return -1.
981 FONT is usually a font-spec, but when this function is called from
982 X font backend driver, it is a font-entity. In that case, NAME is
983 a fully specified XLFD. */
986 font_parse_xlfd (char *name
, Lisp_Object font
)
988 int len
= strlen (name
);
990 char *f
[XLFD_LAST_INDEX
+ 1];
994 if (len
> 255 || !len
)
995 /* Maximum XLFD name length is 255. */
997 /* Accept "*-.." as a fully specified XLFD. */
998 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
999 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1002 for (p
= name
+ i
; *p
; p
++)
1006 if (i
== XLFD_LAST_INDEX
)
1011 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1012 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1014 if (i
== XLFD_LAST_INDEX
)
1016 /* Fully specified XLFD. */
1019 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1020 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1021 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1022 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1024 val
= INTERN_FIELD_SYM (i
);
1027 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1029 ASET (font
, j
, make_number (n
));
1032 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1033 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1034 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1036 ASET (font
, FONT_REGISTRY_INDEX
,
1037 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1038 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1040 p
= f
[XLFD_PIXEL_INDEX
];
1041 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1042 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1045 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1047 ASET (font
, FONT_SIZE_INDEX
, val
);
1048 else if (FONT_ENTITY_P (font
))
1052 double point_size
= -1;
1054 font_assert (FONT_SPEC_P (font
));
1055 p
= f
[XLFD_POINT_INDEX
];
1057 point_size
= parse_matrix (p
);
1058 else if (isdigit (*p
))
1059 point_size
= atoi (p
), point_size
/= 10;
1060 if (point_size
>= 0)
1061 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1065 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1066 if (! NILP (val
) && ! INTEGERP (val
))
1068 ASET (font
, FONT_DPI_INDEX
, val
);
1069 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1072 val
= font_prop_validate_spacing (QCspacing
, val
);
1073 if (! INTEGERP (val
))
1075 ASET (font
, FONT_SPACING_INDEX
, val
);
1077 p
= f
[XLFD_AVGWIDTH_INDEX
];
1080 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1081 if (! NILP (val
) && ! INTEGERP (val
))
1083 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1087 int wild_card_found
= 0;
1088 Lisp_Object prop
[XLFD_LAST_INDEX
];
1090 if (FONT_ENTITY_P (font
))
1092 for (j
= 0; j
< i
; j
++)
1096 if (f
[j
][1] && f
[j
][1] != '-')
1099 wild_card_found
= 1;
1102 prop
[j
] = INTERN_FIELD (j
);
1104 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1106 if (! wild_card_found
)
1108 if (font_expand_wildcards (prop
, i
) < 0)
1111 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1112 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1113 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1114 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1115 if (! NILP (prop
[i
]))
1117 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1119 ASET (font
, j
, make_number (n
));
1121 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1122 val
= prop
[XLFD_REGISTRY_INDEX
];
1125 val
= prop
[XLFD_ENCODING_INDEX
];
1127 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1129 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1130 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1132 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1133 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1135 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1137 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1138 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1139 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1141 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1143 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1146 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1147 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1148 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1150 val
= font_prop_validate_spacing (QCspacing
,
1151 prop
[XLFD_SPACING_INDEX
]);
1152 if (! INTEGERP (val
))
1154 ASET (font
, FONT_SPACING_INDEX
, val
);
1156 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1157 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1163 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1164 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1165 0, use PIXEL_SIZE instead. */
1168 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1170 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1174 font_assert (FONTP (font
));
1176 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1179 if (i
== FONT_ADSTYLE_INDEX
)
1180 j
= XLFD_ADSTYLE_INDEX
;
1181 else if (i
== FONT_REGISTRY_INDEX
)
1182 j
= XLFD_REGISTRY_INDEX
;
1183 val
= AREF (font
, i
);
1186 if (j
== XLFD_REGISTRY_INDEX
)
1187 f
[j
] = "*-*", len
+= 4;
1189 f
[j
] = "*", len
+= 2;
1194 val
= SYMBOL_NAME (val
);
1195 if (j
== XLFD_REGISTRY_INDEX
1196 && ! strchr ((char *) SDATA (val
), '-'))
1198 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1199 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1201 f
[j
] = alloca (SBYTES (val
) + 3);
1202 sprintf (f
[j
], "%s-*", SDATA (val
));
1203 len
+= SBYTES (val
) + 3;
1207 f
[j
] = alloca (SBYTES (val
) + 4);
1208 sprintf (f
[j
], "%s*-*", SDATA (val
));
1209 len
+= SBYTES (val
) + 4;
1213 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1217 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1220 val
= font_style_symbolic (font
, i
, 0);
1222 f
[j
] = "*", len
+= 2;
1225 val
= SYMBOL_NAME (val
);
1226 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1230 val
= AREF (font
, FONT_SIZE_INDEX
);
1231 font_assert (NUMBERP (val
) || NILP (val
));
1239 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1240 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1243 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1245 else if (FLOATP (val
))
1247 i
= XFLOAT_DATA (val
) * 10;
1248 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1249 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1252 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1254 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1256 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1257 f
[XLFD_RESX_INDEX
] = alloca (22);
1258 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1262 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1263 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1265 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1267 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1268 : spacing
<= FONT_SPACING_DUAL
? "d"
1269 : spacing
<= FONT_SPACING_MONO
? "m"
1274 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1275 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1277 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1278 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
], "%ld",
1279 (long) XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1282 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1283 len
++; /* for terminating '\0'. */
1286 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1287 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1288 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1289 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1290 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1291 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1292 f
[XLFD_REGISTRY_INDEX
]);
1295 /* Parse NAME (null terminated) and store information in FONT
1296 (font-spec or font-entity). NAME is supplied in either the
1297 Fontconfig or GTK font name format. If NAME is successfully
1298 parsed, return 0. Otherwise return -1.
1300 The fontconfig format is
1302 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1306 FAMILY [PROPS...] [SIZE]
1308 This function tries to guess which format it is. */
1311 font_parse_fcname (char *name
, Lisp_Object font
)
1314 char *size_beg
= NULL
, *size_end
= NULL
;
1315 char *props_beg
= NULL
, *family_end
= NULL
;
1316 int len
= strlen (name
);
1321 for (p
= name
; *p
; p
++)
1323 if (*p
== '\\' && p
[1])
1327 props_beg
= family_end
= p
;
1332 int decimal
= 0, size_found
= 1;
1333 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1336 if (*q
!= '.' || decimal
)
1355 Lisp_Object extra_props
= Qnil
;
1357 /* A fontconfig name with size and/or property data. */
1358 if (family_end
> name
)
1361 family
= font_intern_prop (name
, family_end
- name
, 1);
1362 ASET (font
, FONT_FAMILY_INDEX
, family
);
1366 double point_size
= strtod (size_beg
, &size_end
);
1367 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1368 if (*size_end
== ':' && size_end
[1])
1369 props_beg
= size_end
;
1373 /* Now parse ":KEY=VAL" patterns. */
1376 for (p
= props_beg
; *p
; p
= q
)
1378 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1381 /* Must be an enumerated value. */
1385 val
= font_intern_prop (p
, q
- p
, 1);
1387 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1389 if (PROP_MATCH ("light", 5)
1390 || PROP_MATCH ("medium", 6)
1391 || PROP_MATCH ("demibold", 8)
1392 || PROP_MATCH ("bold", 4)
1393 || PROP_MATCH ("black", 5))
1394 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1395 else if (PROP_MATCH ("roman", 5)
1396 || PROP_MATCH ("italic", 6)
1397 || PROP_MATCH ("oblique", 7))
1398 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1399 else if (PROP_MATCH ("charcell", 8))
1400 ASET (font
, FONT_SPACING_INDEX
,
1401 make_number (FONT_SPACING_CHARCELL
));
1402 else if (PROP_MATCH ("mono", 4))
1403 ASET (font
, FONT_SPACING_INDEX
,
1404 make_number (FONT_SPACING_MONO
));
1405 else if (PROP_MATCH ("proportional", 12))
1406 ASET (font
, FONT_SPACING_INDEX
,
1407 make_number (FONT_SPACING_PROPORTIONAL
));
1416 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1417 prop
= FONT_SIZE_INDEX
;
1420 key
= font_intern_prop (p
, q
- p
, 1);
1421 prop
= get_font_prop_index (key
);
1425 for (q
= p
; *q
&& *q
!= ':'; q
++);
1426 val
= font_intern_prop (p
, q
- p
, 0);
1428 if (prop
>= FONT_FOUNDRY_INDEX
1429 && prop
< FONT_EXTRA_INDEX
)
1430 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1433 extra_props
= nconc2 (extra_props
,
1434 Fcons (Fcons (key
, val
), Qnil
));
1441 if (! NILP (extra_props
))
1443 struct font_driver_list
*driver_list
= font_driver_list
;
1444 for ( ; driver_list
; driver_list
= driver_list
->next
)
1445 if (driver_list
->driver
->filter_properties
)
1446 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1452 /* Either a fontconfig-style name with no size and property
1453 data, or a GTK-style name. */
1455 int word_len
, prop_found
= 0;
1457 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1463 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1464 if (! isdigit (*q
) && *q
!= '.')
1471 double point_size
= strtod (p
, &q
);
1472 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1477 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1478 if (*q
== '\\' && q
[1])
1482 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1484 if (PROP_MATCH ("Ultra-Light", 11))
1487 prop
= font_intern_prop ("ultra-light", 11, 1);
1488 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1490 else if (PROP_MATCH ("Light", 5))
1493 prop
= font_intern_prop ("light", 5, 1);
1494 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1496 else if (PROP_MATCH ("Book", 4))
1499 prop
= font_intern_prop ("book", 4, 1);
1500 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1502 else if (PROP_MATCH ("Medium", 6))
1505 prop
= font_intern_prop ("medium", 6, 1);
1506 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1508 else if (PROP_MATCH ("Semi-Bold", 9))
1511 prop
= font_intern_prop ("semi-bold", 9, 1);
1512 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1514 else if (PROP_MATCH ("Bold", 4))
1517 prop
= font_intern_prop ("bold", 4, 1);
1518 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1520 else if (PROP_MATCH ("Italic", 6))
1523 prop
= font_intern_prop ("italic", 4, 1);
1524 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1526 else if (PROP_MATCH ("Oblique", 7))
1529 prop
= font_intern_prop ("oblique", 7, 1);
1530 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1532 else if (PROP_MATCH ("Semi-Condensed", 14))
1535 prop
= font_intern_prop ("semi-condensed", 14, 1);
1536 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, prop
);
1538 else if (PROP_MATCH ("Condensed", 9))
1541 prop
= font_intern_prop ("condensed", 9, 1);
1542 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, prop
);
1546 return -1; /* Unknown property in GTK-style font name. */
1555 family
= font_intern_prop (name
, family_end
- name
, 1);
1556 ASET (font
, FONT_FAMILY_INDEX
, family
);
1563 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1564 NAME (NBYTES length), and return the name length. If
1565 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1568 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1570 Lisp_Object family
, foundry
;
1571 Lisp_Object tail
, val
;
1575 Lisp_Object styles
[3];
1576 const char *style_names
[3] = { "weight", "slant", "width" };
1579 family
= AREF (font
, FONT_FAMILY_INDEX
);
1580 if (! NILP (family
))
1582 if (SYMBOLP (family
))
1584 family
= SYMBOL_NAME (family
);
1585 len
+= SBYTES (family
);
1591 val
= AREF (font
, FONT_SIZE_INDEX
);
1594 if (XINT (val
) != 0)
1595 pixel_size
= XINT (val
);
1597 len
+= 21; /* for ":pixelsize=NUM" */
1599 else if (FLOATP (val
))
1602 point_size
= (int) XFLOAT_DATA (val
);
1603 len
+= 11; /* for "-NUM" */
1606 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1607 if (! NILP (foundry
))
1609 if (SYMBOLP (foundry
))
1611 foundry
= SYMBOL_NAME (foundry
);
1612 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1618 for (i
= 0; i
< 3; i
++)
1620 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1621 if (! NILP (styles
[i
]))
1622 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1623 SDATA (SYMBOL_NAME (styles
[i
])));
1626 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1627 len
+= sprintf (work
, ":dpi=%ld", (long)XINT (AREF (font
, FONT_DPI_INDEX
)));
1628 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1629 len
+= strlen (":spacing=100");
1630 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1631 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1632 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1634 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1636 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1638 len
+= SBYTES (val
);
1639 else if (INTEGERP (val
))
1640 len
+= sprintf (work
, "%ld", (long) XINT (val
));
1641 else if (SYMBOLP (val
))
1642 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1648 if (! NILP (family
))
1649 p
+= sprintf (p
, "%s", SDATA (family
));
1653 p
+= sprintf (p
, "%d", point_size
);
1655 p
+= sprintf (p
, "-%d", point_size
);
1657 else if (pixel_size
> 0)
1658 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1659 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1660 p
+= sprintf (p
, ":foundry=%s",
1661 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1662 for (i
= 0; i
< 3; i
++)
1663 if (! NILP (styles
[i
]))
1664 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1665 SDATA (SYMBOL_NAME (styles
[i
])));
1666 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1667 p
+= sprintf (p
, ":dpi=%ld", (long) XINT (AREF (font
, FONT_DPI_INDEX
)));
1668 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1669 p
+= sprintf (p
, ":spacing=%ld",
1670 (long) XINT (AREF (font
, FONT_SPACING_INDEX
)));
1671 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1673 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1674 p
+= sprintf (p
, ":scalable=true");
1676 p
+= sprintf (p
, ":scalable=false");
1681 /* Parse NAME (null terminated) and store information in FONT
1682 (font-spec or font-entity). If NAME is successfully parsed, return
1683 0. Otherwise return -1. */
1686 font_parse_name (char *name
, Lisp_Object font
)
1688 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1689 return font_parse_xlfd (name
, font
);
1690 return font_parse_fcname (name
, font
);
1694 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1695 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1699 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1705 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1707 CHECK_STRING (family
);
1708 len
= SBYTES (family
);
1709 p0
= (char *) SDATA (family
);
1710 p1
= strchr (p0
, '-');
1713 if ((*p0
!= '*' && p1
- p0
> 0)
1714 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1715 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1718 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1721 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1723 if (! NILP (registry
))
1725 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1726 CHECK_STRING (registry
);
1727 len
= SBYTES (registry
);
1728 p0
= (char *) SDATA (registry
);
1729 p1
= strchr (p0
, '-');
1732 if (SDATA (registry
)[len
- 1] == '*')
1733 registry
= concat2 (registry
, build_string ("-*"));
1735 registry
= concat2 (registry
, build_string ("*-*"));
1737 registry
= Fdowncase (registry
);
1738 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1743 /* This part (through the next ^L) is still experimental and not
1744 tested much. We may drastically change codes. */
1750 #define LGSTRING_HEADER_SIZE 6
1751 #define LGSTRING_GLYPH_SIZE 8
1754 check_gstring (gstring
)
1755 Lisp_Object gstring
;
1760 CHECK_VECTOR (gstring
);
1761 val
= AREF (gstring
, 0);
1763 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1765 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1766 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1767 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1768 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1769 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1770 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1771 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1772 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1773 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1774 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1775 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1777 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1779 val
= LGSTRING_GLYPH (gstring
, i
);
1781 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1783 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1785 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1786 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1787 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1788 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1789 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1790 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1791 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1792 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1794 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1796 if (ASIZE (val
) < 3)
1798 for (j
= 0; j
< 3; j
++)
1799 CHECK_NUMBER (AREF (val
, j
));
1804 error ("Invalid glyph-string format");
1809 check_otf_features (otf_features
)
1810 Lisp_Object otf_features
;
1814 CHECK_CONS (otf_features
);
1815 CHECK_SYMBOL (XCAR (otf_features
));
1816 otf_features
= XCDR (otf_features
);
1817 CHECK_CONS (otf_features
);
1818 CHECK_SYMBOL (XCAR (otf_features
));
1819 otf_features
= XCDR (otf_features
);
1820 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1822 CHECK_SYMBOL (Fcar (val
));
1823 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1824 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1826 otf_features
= XCDR (otf_features
);
1827 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1829 CHECK_SYMBOL (Fcar (val
));
1830 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1831 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1838 Lisp_Object otf_list
;
1841 otf_tag_symbol (tag
)
1846 OTF_tag_name (tag
, name
);
1847 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1854 Lisp_Object val
= Fassoc (file
, otf_list
);
1858 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1861 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1862 val
= make_save_value (otf
, 0);
1863 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1869 /* Return a list describing which scripts/languages FONT supports by
1870 which GSUB/GPOS features of OpenType tables. See the comment of
1871 (struct font_driver).otf_capability. */
1874 font_otf_capability (font
)
1878 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1881 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1884 for (i
= 0; i
< 2; i
++)
1886 OTF_GSUB_GPOS
*gsub_gpos
;
1887 Lisp_Object script_list
= Qnil
;
1890 if (OTF_get_features (otf
, i
== 0) < 0)
1892 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1893 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1895 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1896 Lisp_Object langsys_list
= Qnil
;
1897 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1900 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1902 OTF_LangSys
*langsys
;
1903 Lisp_Object feature_list
= Qnil
;
1904 Lisp_Object langsys_tag
;
1907 if (k
== script
->LangSysCount
)
1909 langsys
= &script
->DefaultLangSys
;
1914 langsys
= script
->LangSys
+ k
;
1916 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1918 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1920 OTF_Feature
*feature
1921 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1922 Lisp_Object feature_tag
1923 = otf_tag_symbol (feature
->FeatureTag
);
1925 feature_list
= Fcons (feature_tag
, feature_list
);
1927 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1930 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1935 XSETCAR (capability
, script_list
);
1937 XSETCDR (capability
, script_list
);
1943 /* Parse OTF features in SPEC and write a proper features spec string
1944 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1945 assured that the sufficient memory has already allocated for
1949 generate_otf_features (spec
, features
)
1959 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1965 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1970 else if (! asterisk
)
1972 val
= SYMBOL_NAME (val
);
1973 p
+= sprintf (p
, "%s", SDATA (val
));
1977 val
= SYMBOL_NAME (val
);
1978 p
+= sprintf (p
, "~%s", SDATA (val
));
1982 error ("OTF spec too long");
1986 font_otf_DeviceTable (device_table
)
1987 OTF_DeviceTable
*device_table
;
1989 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1991 return Fcons (make_number (len
),
1992 make_unibyte_string (device_table
->DeltaValue
, len
));
1996 font_otf_ValueRecord (value_format
, value_record
)
1998 OTF_ValueRecord
*value_record
;
2000 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2002 if (value_format
& OTF_XPlacement
)
2003 ASET (val
, 0, make_number (value_record
->XPlacement
));
2004 if (value_format
& OTF_YPlacement
)
2005 ASET (val
, 1, make_number (value_record
->YPlacement
));
2006 if (value_format
& OTF_XAdvance
)
2007 ASET (val
, 2, make_number (value_record
->XAdvance
));
2008 if (value_format
& OTF_YAdvance
)
2009 ASET (val
, 3, make_number (value_record
->YAdvance
));
2010 if (value_format
& OTF_XPlaDevice
)
2011 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2012 if (value_format
& OTF_YPlaDevice
)
2013 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2014 if (value_format
& OTF_XAdvDevice
)
2015 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2016 if (value_format
& OTF_YAdvDevice
)
2017 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2022 font_otf_Anchor (anchor
)
2027 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2028 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2029 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2030 if (anchor
->AnchorFormat
== 2)
2031 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2034 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2035 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2039 #endif /* HAVE_LIBOTF */
2045 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
2046 static int font_compare (const void *, const void *);
2047 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
2051 font_rescale_ratio (Lisp_Object font_entity
)
2053 Lisp_Object tail
, elt
;
2054 Lisp_Object name
= Qnil
;
2056 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2059 if (FLOATP (XCDR (elt
)))
2061 if (STRINGP (XCAR (elt
)))
2064 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2065 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2066 return XFLOAT_DATA (XCDR (elt
));
2068 else if (FONT_SPEC_P (XCAR (elt
)))
2070 if (font_match_p (XCAR (elt
), font_entity
))
2071 return XFLOAT_DATA (XCDR (elt
));
2078 /* We sort fonts by scoring each of them against a specified
2079 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2080 the value is, the closer the font is to the font-spec.
2082 The lowest 2 bits of the score is used for driver type. The font
2083 available by the most preferred font driver is 0.
2085 Each 7-bit in the higher 28 bits are used for numeric properties
2086 WEIGHT, SLANT, WIDTH, and SIZE. */
2088 /* How many bits to shift to store the difference value of each font
2089 property in a score. Note that flots for FONT_TYPE_INDEX and
2090 FONT_REGISTRY_INDEX are not used. */
2091 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2093 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2094 The return value indicates how different ENTITY is compared with
2098 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2103 /* Score three style numeric fields. Maximum difference is 127. */
2104 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2105 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2107 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2112 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2115 /* Score the size. Maximum difference is 127. */
2116 i
= FONT_SIZE_INDEX
;
2117 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2118 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2120 /* We use the higher 6-bit for the actual size difference. The
2121 lowest bit is set if the DPI is different. */
2123 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2125 if (CONSP (Vface_font_rescale_alist
))
2126 pixel_size
*= font_rescale_ratio (entity
);
2127 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2131 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2132 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2134 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2135 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2137 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2144 /* Concatenate all elements of LIST into one vector. LIST is a list
2145 of font-entity vectors. */
2148 font_vconcat_entity_vectors (Lisp_Object list
)
2150 int nargs
= XINT (Flength (list
));
2151 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2154 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2155 args
[i
] = XCAR (list
);
2156 return Fvconcat (nargs
, args
);
2160 /* The structure for elements being sorted by qsort. */
2161 struct font_sort_data
2164 int font_driver_preference
;
2169 /* The comparison function for qsort. */
2172 font_compare (const void *d1
, const void *d2
)
2174 const struct font_sort_data
*data1
= d1
;
2175 const struct font_sort_data
*data2
= d2
;
2177 if (data1
->score
< data2
->score
)
2179 else if (data1
->score
> data2
->score
)
2181 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2185 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2186 If PREFER specifies a point-size, calculate the corresponding
2187 pixel-size from QCdpi property of PREFER or from the Y-resolution
2188 of FRAME before sorting.
2190 If BEST-ONLY is nonzero, return the best matching entity (that
2191 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2192 if BEST-ONLY is negative). Otherwise, return the sorted result as
2193 a single vector of font-entities.
2195 This function does no optimization for the case that the total
2196 number of elements is 1. The caller should avoid calling this in
2200 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2202 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2204 struct font_sort_data
*data
;
2205 unsigned best_score
;
2206 Lisp_Object best_entity
;
2207 struct frame
*f
= XFRAME (frame
);
2208 Lisp_Object tail
, vec
;
2211 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2212 prefer_prop
[i
] = AREF (prefer
, i
);
2213 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2214 prefer_prop
[FONT_SIZE_INDEX
]
2215 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2217 if (NILP (XCDR (list
)))
2219 /* What we have to take care of is this single vector. */
2221 maxlen
= ASIZE (vec
);
2225 /* We don't have to perform sort, so there's no need of creating
2226 a single vector. But, we must find the length of the longest
2229 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2230 if (maxlen
< ASIZE (XCAR (tail
)))
2231 maxlen
= ASIZE (XCAR (tail
));
2235 /* We have to create a single vector to sort it. */
2236 vec
= font_vconcat_entity_vectors (list
);
2237 maxlen
= ASIZE (vec
);
2240 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2241 best_score
= 0xFFFFFFFF;
2244 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2246 int font_driver_preference
= 0;
2247 Lisp_Object current_font_driver
;
2253 /* We are sure that the length of VEC > 0. */
2254 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2255 /* Score the elements. */
2256 for (i
= 0; i
< len
; i
++)
2258 data
[i
].entity
= AREF (vec
, i
);
2260 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2262 ? font_score (data
[i
].entity
, prefer_prop
)
2264 if (best_only
&& best_score
> data
[i
].score
)
2266 best_score
= data
[i
].score
;
2267 best_entity
= data
[i
].entity
;
2268 if (best_score
== 0)
2271 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2273 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2274 font_driver_preference
++;
2276 data
[i
].font_driver_preference
= font_driver_preference
;
2279 /* Sort if necessary. */
2282 qsort (data
, len
, sizeof *data
, font_compare
);
2283 for (i
= 0; i
< len
; i
++)
2284 ASET (vec
, i
, data
[i
].entity
);
2293 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2298 /* API of Font Service Layer. */
2300 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2301 sort_shift_bits. Finternal_set_font_selection_order calls this
2302 function with font_sort_order after setting up it. */
2305 font_update_sort_order (int *order
)
2309 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2311 int xlfd_idx
= order
[i
];
2313 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2314 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2315 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2316 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2317 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2318 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2320 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2325 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
, Lisp_Object features
, Lisp_Object table
)
2330 table
= assq_no_quit (script
, table
);
2333 table
= XCDR (table
);
2334 if (! NILP (langsys
))
2336 table
= assq_no_quit (langsys
, table
);
2342 val
= assq_no_quit (Qnil
, table
);
2344 table
= XCAR (table
);
2348 table
= XCDR (table
);
2349 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2351 if (NILP (XCAR (features
)))
2356 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2362 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2365 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2367 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2369 script
= XCAR (spec
);
2373 langsys
= XCAR (spec
);
2384 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2385 XCAR (otf_capability
)))
2387 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2388 XCDR (otf_capability
)))
2395 /* Check if FONT (font-entity or font-object) matches with the font
2396 specification SPEC. */
2399 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2401 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2402 Lisp_Object extra
, font_extra
;
2405 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2406 if (! NILP (AREF (spec
, i
))
2407 && ! NILP (AREF (font
, i
))
2408 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2410 props
= XFONT_SPEC (spec
)->props
;
2411 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2413 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2414 prop
[i
] = AREF (spec
, i
);
2415 prop
[FONT_SIZE_INDEX
]
2416 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2420 if (font_score (font
, props
) > 0)
2422 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2423 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2424 for (; CONSP (extra
); extra
= XCDR (extra
))
2426 Lisp_Object key
= XCAR (XCAR (extra
));
2427 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2429 if (EQ (key
, QClang
))
2431 val2
= assq_no_quit (key
, font_extra
);
2440 if (NILP (Fmemq (val
, val2
)))
2445 ? NILP (Fmemq (val
, XCDR (val2
)))
2449 else if (EQ (key
, QCscript
))
2451 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2457 /* All characters in the list must be supported. */
2458 for (; CONSP (val2
); val2
= XCDR (val2
))
2460 if (! NATNUMP (XCAR (val2
)))
2462 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2463 == FONT_INVALID_CODE
)
2467 else if (VECTORP (val2
))
2469 /* At most one character in the vector must be supported. */
2470 for (i
= 0; i
< ASIZE (val2
); i
++)
2472 if (! NATNUMP (AREF (val2
, i
)))
2474 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2475 != FONT_INVALID_CODE
)
2478 if (i
== ASIZE (val2
))
2483 else if (EQ (key
, QCotf
))
2487 if (! FONT_OBJECT_P (font
))
2489 fontp
= XFONT_OBJECT (font
);
2490 if (! fontp
->driver
->otf_capability
)
2492 val2
= fontp
->driver
->otf_capability (fontp
);
2493 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2504 Each font backend has the callback function get_cache, and it
2505 returns a cons cell of which cdr part can be freely used for
2506 caching fonts. The cons cell may be shared by multiple frames
2507 and/or multiple font drivers. So, we arrange the cdr part as this:
2509 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2511 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2512 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2513 cons (FONT-SPEC FONT-ENTITY ...). */
2515 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2516 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2517 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2518 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2519 struct font_driver
*);
2522 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2524 Lisp_Object cache
, val
;
2526 cache
= driver
->get_cache (f
);
2528 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2532 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2533 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2537 val
= XCDR (XCAR (val
));
2538 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2544 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2546 Lisp_Object cache
, val
, tmp
;
2549 cache
= driver
->get_cache (f
);
2551 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2552 cache
= val
, val
= XCDR (val
);
2553 font_assert (! NILP (val
));
2554 tmp
= XCDR (XCAR (val
));
2555 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2556 if (XINT (XCAR (tmp
)) == 0)
2558 font_clear_cache (f
, XCAR (val
), driver
);
2559 XSETCDR (cache
, XCDR (val
));
2565 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2567 Lisp_Object val
= driver
->get_cache (f
);
2568 Lisp_Object type
= driver
->type
;
2570 font_assert (CONSP (val
));
2571 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2572 font_assert (CONSP (val
));
2573 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2574 val
= XCDR (XCAR (val
));
2578 static int num_fonts
;
2581 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2583 Lisp_Object tail
, elt
;
2584 Lisp_Object tail2
, entity
;
2586 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2587 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2590 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2591 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2593 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2595 entity
= XCAR (tail2
);
2597 if (FONT_ENTITY_P (entity
)
2598 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2600 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2602 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2604 Lisp_Object val
= XCAR (objlist
);
2605 struct font
*font
= XFONT_OBJECT (val
);
2607 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2609 font_assert (font
&& driver
== font
->driver
);
2610 driver
->close (f
, font
);
2614 if (driver
->free_entity
)
2615 driver
->free_entity (entity
);
2620 XSETCDR (cache
, Qnil
);
2624 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2626 /* Check each font-entity in VEC, and return a list of font-entities
2627 that satisfy this condition:
2628 (1) matches with SPEC and SIZE if SPEC is not nil, and
2629 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2633 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2635 Lisp_Object entity
, val
;
2636 enum font_property_index prop
;
2639 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2641 entity
= AREF (vec
, i
);
2642 if (! NILP (Vface_ignored_fonts
))
2645 Lisp_Object tail
, regexp
;
2647 if (font_unparse_xlfd (entity
, 0, name
, 256) >= 0)
2649 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2651 regexp
= XCAR (tail
);
2652 if (STRINGP (regexp
)
2653 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
2662 val
= Fcons (entity
, val
);
2665 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2666 if (INTEGERP (AREF (spec
, prop
))
2667 && ((XINT (AREF (spec
, prop
)) >> 8)
2668 != (XINT (AREF (entity
, prop
)) >> 8)))
2669 prop
= FONT_SPEC_MAX
;
2670 if (prop
< FONT_SPEC_MAX
2672 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2674 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2677 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2678 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2679 prop
= FONT_SPEC_MAX
;
2681 if (prop
< FONT_SPEC_MAX
2682 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2683 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2684 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2685 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2686 prop
= FONT_SPEC_MAX
;
2687 if (prop
< FONT_SPEC_MAX
2688 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2689 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2690 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2691 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2692 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2693 prop
= FONT_SPEC_MAX
;
2694 if (prop
< FONT_SPEC_MAX
)
2695 val
= Fcons (entity
, val
);
2697 return (Fvconcat (1, &val
));
2701 /* Return a list of vectors of font-entities matching with SPEC on
2702 FRAME. Each elements in the list is a vector of entities from the
2703 same font-driver. */
2706 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2708 FRAME_PTR f
= XFRAME (frame
);
2709 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2710 Lisp_Object ftype
, val
;
2711 Lisp_Object list
= Qnil
;
2713 int need_filtering
= 0;
2716 font_assert (FONT_SPEC_P (spec
));
2718 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2719 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2720 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2721 size
= font_pixel_size (f
, spec
);
2725 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2726 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2727 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2728 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2730 ASET (scratch_font_spec
, i
, Qnil
);
2731 if (! NILP (AREF (spec
, i
)))
2733 if (i
== FONT_DPI_INDEX
)
2734 /* Skip FONT_SPACING_INDEX */
2737 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2738 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2740 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2742 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2744 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2746 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2747 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2754 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2758 val
= Fvconcat (1, &val
);
2759 copy
= Fcopy_font_spec (scratch_font_spec
);
2760 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2761 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2765 || ! NILP (Vface_ignored_fonts
)))
2766 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2767 if (ASIZE (val
) > 0)
2768 list
= Fcons (val
, list
);
2771 list
= Fnreverse (list
);
2772 FONT_ADD_LOG ("list", spec
, list
);
2777 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2778 nil, is an array of face's attributes, which specifies preferred
2779 font-related attributes. */
2782 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2784 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2785 Lisp_Object ftype
, size
, entity
;
2787 Lisp_Object work
= Fcopy_font_spec (spec
);
2789 XSETFRAME (frame
, f
);
2790 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2791 size
= AREF (spec
, FONT_SIZE_INDEX
);
2794 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2795 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2796 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2797 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2800 for (; driver_list
; driver_list
= driver_list
->next
)
2802 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2804 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2807 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2808 entity
= assoc_no_quit (work
, XCDR (cache
));
2810 entity
= XCDR (entity
);
2813 entity
= driver_list
->driver
->match (frame
, work
);
2814 copy
= Fcopy_font_spec (work
);
2815 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2816 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2818 if (! NILP (entity
))
2821 FONT_ADD_LOG ("match", work
, entity
);
2826 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2827 opened font object. */
2830 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2832 struct font_driver_list
*driver_list
;
2833 Lisp_Object objlist
, size
, val
, font_object
;
2835 int min_width
, height
;
2836 int scaled_pixel_size
;
2838 font_assert (FONT_ENTITY_P (entity
));
2839 size
= AREF (entity
, FONT_SIZE_INDEX
);
2840 if (XINT (size
) != 0)
2841 scaled_pixel_size
= pixel_size
= XINT (size
);
2842 else if (CONSP (Vface_font_rescale_alist
))
2843 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2845 val
= AREF (entity
, FONT_TYPE_INDEX
);
2846 for (driver_list
= f
->font_driver_list
;
2847 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2848 driver_list
= driver_list
->next
);
2852 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2853 objlist
= XCDR (objlist
))
2855 Lisp_Object fn
= XCAR (objlist
);
2856 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2857 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2859 if (driver_list
->driver
->cached_font_ok
== NULL
2860 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2865 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2866 if (!NILP (font_object
))
2867 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2868 FONT_ADD_LOG ("open", entity
, font_object
);
2869 if (NILP (font_object
))
2871 ASET (entity
, FONT_OBJLIST_INDEX
,
2872 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2875 font
= XFONT_OBJECT (font_object
);
2876 min_width
= (font
->min_width
? font
->min_width
2877 : font
->average_width
? font
->average_width
2878 : font
->space_width
? font
->space_width
2880 height
= (font
->height
? font
->height
: 1);
2881 #ifdef HAVE_WINDOW_SYSTEM
2882 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2883 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2885 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2886 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2887 fonts_changed_p
= 1;
2891 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2892 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2893 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2894 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2902 /* Close FONT_OBJECT that is opened on frame F. */
2905 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
2907 struct font
*font
= XFONT_OBJECT (font_object
);
2909 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2910 /* Already closed. */
2912 FONT_ADD_LOG ("close", font_object
, Qnil
);
2913 font
->driver
->close (f
, font
);
2914 #ifdef HAVE_WINDOW_SYSTEM
2915 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2916 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2922 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2923 FONT is a font-entity and it must be opened to check. */
2926 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
2930 if (FONT_ENTITY_P (font
))
2932 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2933 struct font_driver_list
*driver_list
;
2935 for (driver_list
= f
->font_driver_list
;
2936 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2937 driver_list
= driver_list
->next
);
2940 if (! driver_list
->driver
->has_char
)
2942 return driver_list
->driver
->has_char (font
, c
);
2945 font_assert (FONT_OBJECT_P (font
));
2946 fontp
= XFONT_OBJECT (font
);
2947 if (fontp
->driver
->has_char
)
2949 int result
= fontp
->driver
->has_char (font
, c
);
2954 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2958 /* Return the glyph ID of FONT_OBJECT for character C. */
2961 font_encode_char (Lisp_Object font_object
, int c
)
2965 font_assert (FONT_OBJECT_P (font_object
));
2966 font
= XFONT_OBJECT (font_object
);
2967 return font
->driver
->encode_char (font
, c
);
2971 /* Return the name of FONT_OBJECT. */
2974 font_get_name (Lisp_Object font_object
)
2976 font_assert (FONT_OBJECT_P (font_object
));
2977 return AREF (font_object
, FONT_NAME_INDEX
);
2981 /* Return the specification of FONT_OBJECT. */
2984 font_get_spec (Lisp_Object font_object
)
2986 Lisp_Object spec
= font_make_spec ();
2989 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2990 ASET (spec
, i
, AREF (font_object
, i
));
2991 ASET (spec
, FONT_SIZE_INDEX
,
2992 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2997 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2998 could not be parsed by font_parse_name, return Qnil. */
3001 font_spec_from_name (Lisp_Object font_name
)
3003 Lisp_Object spec
= Ffont_spec (0, NULL
);
3005 CHECK_STRING (font_name
);
3006 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3008 font_put_extra (spec
, QCname
, font_name
);
3009 font_put_extra (spec
, QCuser_spec
, font_name
);
3015 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
3017 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3022 if (! NILP (Ffont_get (font
, QCname
)))
3024 font
= Fcopy_font_spec (font
);
3025 font_put_extra (font
, QCname
, Qnil
);
3028 if (NILP (AREF (font
, prop
))
3029 && prop
!= FONT_FAMILY_INDEX
3030 && prop
!= FONT_FOUNDRY_INDEX
3031 && prop
!= FONT_WIDTH_INDEX
3032 && prop
!= FONT_SIZE_INDEX
)
3034 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3035 font
= Fcopy_font_spec (font
);
3036 ASET (font
, prop
, Qnil
);
3037 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3039 if (prop
== FONT_FAMILY_INDEX
)
3041 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3042 /* If we are setting the font family, we must also clear
3043 FONT_WIDTH_INDEX to avoid rejecting families that lack
3044 support for some widths. */
3045 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3047 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3048 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3049 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3050 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3051 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3052 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3054 else if (prop
== FONT_SIZE_INDEX
)
3056 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3057 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3058 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3060 else if (prop
== FONT_WIDTH_INDEX
)
3061 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3062 attrs
[LFACE_FONT_INDEX
] = font
;
3065 /* Selecte a font from ENTITIES (list of font-entity vectors) that
3066 supports C and matches best with ATTRS and PIXEL_SIZE. */
3069 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
3071 Lisp_Object font_entity
;
3074 FRAME_PTR f
= XFRAME (frame
);
3076 if (NILP (XCDR (entities
))
3077 && ASIZE (XCAR (entities
)) == 1)
3079 font_entity
= AREF (XCAR (entities
), 0);
3081 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3086 /* Sort fonts by properties specified in ATTRS. */
3087 prefer
= scratch_font_prefer
;
3089 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3090 ASET (prefer
, i
, Qnil
);
3091 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3093 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3095 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3096 ASET (prefer
, i
, AREF (face_font
, i
));
3098 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3099 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3100 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3101 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3102 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3103 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3104 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3106 return font_sort_entities (entities
, prefer
, frame
, c
);
3109 /* Return a font-entity satisfying SPEC and best matching with face's
3110 font related attributes in ATTRS. C, if not negative, is a
3111 character that the entity must support. */
3114 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3117 Lisp_Object frame
, entities
, val
;
3118 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3122 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3123 if (NILP (registry
[0]))
3125 registry
[0] = DEFAULT_ENCODING
;
3126 registry
[1] = Qascii_0
;
3127 registry
[2] = null_vector
;
3130 registry
[1] = null_vector
;
3132 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3134 struct charset
*encoding
, *repertory
;
3136 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3137 &encoding
, &repertory
) < 0)
3140 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3142 else if (c
> encoding
->max_char
)
3146 work
= Fcopy_font_spec (spec
);
3147 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3148 XSETFRAME (frame
, f
);
3149 size
= AREF (spec
, FONT_SIZE_INDEX
);
3150 pixel_size
= font_pixel_size (f
, spec
);
3151 if (pixel_size
== 0)
3153 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3155 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3157 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3158 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3159 if (! NILP (foundry
[0]))
3160 foundry
[1] = null_vector
;
3161 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3163 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3164 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3166 foundry
[2] = null_vector
;
3169 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3171 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3172 if (! NILP (adstyle
[0]))
3173 adstyle
[1] = null_vector
;
3174 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3176 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3178 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3180 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3182 adstyle
[2] = null_vector
;
3185 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3188 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3191 val
= AREF (work
, FONT_FAMILY_INDEX
);
3192 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3194 val
= attrs
[LFACE_FAMILY_INDEX
];
3195 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3199 family
= alloca ((sizeof family
[0]) * 2);
3201 family
[1] = null_vector
; /* terminator. */
3206 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3207 /* Font family names are case-sensitive under NS. */
3215 if (! NILP (alters
))
3217 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3218 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3219 family
[i
] = XCAR (alters
);
3220 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3222 family
[i
] = null_vector
;
3226 family
= alloca ((sizeof family
[0]) * 3);
3229 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3231 family
[i
] = null_vector
;
3235 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3237 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3238 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3240 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3241 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3243 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3244 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3246 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3247 entities
= font_list_entities (frame
, work
);
3248 if (! NILP (entities
))
3250 val
= font_select_entity (frame
, entities
,
3251 attrs
, pixel_size
, c
);
3264 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3268 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3269 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3270 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3271 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3272 size
= font_pixel_size (f
, spec
);
3276 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3277 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3280 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3281 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3282 if (INTEGERP (height
))
3285 abort(); /* We should never end up here. */
3289 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3293 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3294 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3298 return font_open_entity (f
, entity
, size
);
3302 /* Find a font satisfying SPEC and best matching with face's
3303 attributes in ATTRS on FRAME, and return the opened
3307 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3309 Lisp_Object entity
, name
;
3311 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3314 /* No font is listed for SPEC, but each font-backend may have
3315 the different criteria about "font matching". So, try
3317 entity
= font_matching_entity (f
, attrs
, spec
);
3321 /* Don't lose the original name that was put in initially. We need
3322 it to re-apply the font when font parameters (like hinting or dpi) have
3324 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3327 name
= Ffont_get (spec
, QCuser_spec
);
3328 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3334 /* Make FACE on frame F ready to use the font opened for FACE. */
3337 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3339 if (face
->font
->driver
->prepare_face
)
3340 face
->font
->driver
->prepare_face (f
, face
);
3344 /* Make FACE on frame F stop using the font opened for FACE. */
3347 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3349 if (face
->font
->driver
->done_face
)
3350 face
->font
->driver
->done_face (f
, face
);
3355 /* Open a font matching with font-spec SPEC on frame F. If no proper
3356 font is found, return Qnil. */
3359 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3361 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3363 /* We set up the default font-related attributes of a face to prefer
3365 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3366 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3367 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3369 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3371 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3373 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3375 return font_load_for_lface (f
, attrs
, spec
);
3379 /* Open a font matching with NAME on frame F. If no proper font is
3380 found, return Qnil. */
3383 font_open_by_name (FRAME_PTR f
, const char *name
)
3385 Lisp_Object args
[2];
3386 Lisp_Object spec
, ret
;
3389 args
[1] = make_unibyte_string (name
, strlen (name
));
3390 spec
= Ffont_spec (2, args
);
3391 ret
= font_open_by_spec (f
, spec
);
3392 /* Do not lose name originally put in. */
3394 font_put_extra (ret
, QCuser_spec
, args
[1]);
3400 /* Register font-driver DRIVER. This function is used in two ways.
3402 The first is with frame F non-NULL. In this case, make DRIVER
3403 available (but not yet activated) on F. All frame creaters
3404 (e.g. Fx_create_frame) must call this function at least once with
3405 an available font-driver.
3407 The second is with frame F NULL. In this case, DRIVER is globally
3408 registered in the variable `font_driver_list'. All font-driver
3409 implementations must call this function in its syms_of_XXXX
3410 (e.g. syms_of_xfont). */
3413 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3415 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3416 struct font_driver_list
*prev
, *list
;
3418 if (f
&& ! driver
->draw
)
3419 error ("Unusable font driver for a frame: %s",
3420 SDATA (SYMBOL_NAME (driver
->type
)));
3422 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3423 if (EQ (list
->driver
->type
, driver
->type
))
3424 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3426 list
= xmalloc (sizeof (struct font_driver_list
));
3428 list
->driver
= driver
;
3433 f
->font_driver_list
= list
;
3435 font_driver_list
= list
;
3441 free_font_driver_list (FRAME_PTR f
)
3443 struct font_driver_list
*list
, *next
;
3445 for (list
= f
->font_driver_list
; list
; list
= next
)
3450 f
->font_driver_list
= NULL
;
3454 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3455 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3456 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3458 A caller must free all realized faces if any in advance. The
3459 return value is a list of font backends actually made used on
3463 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3465 Lisp_Object active_drivers
= Qnil
;
3466 struct font_driver
*driver
;
3467 struct font_driver_list
*list
;
3469 /* At first, turn off non-requested drivers, and turn on requested
3471 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3473 driver
= list
->driver
;
3474 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3479 if (driver
->end_for_frame
)
3480 driver
->end_for_frame (f
);
3481 font_finish_cache (f
, driver
);
3486 if (! driver
->start_for_frame
3487 || driver
->start_for_frame (f
) == 0)
3489 font_prepare_cache (f
, driver
);
3496 if (NILP (new_drivers
))
3499 if (! EQ (new_drivers
, Qt
))
3501 /* Re-order the driver list according to new_drivers. */
3502 struct font_driver_list
**list_table
, **next
;
3506 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3507 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3509 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3510 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3513 list_table
[i
++] = list
;
3515 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3517 list_table
[i
++] = list
;
3518 list_table
[i
] = NULL
;
3520 next
= &f
->font_driver_list
;
3521 for (i
= 0; list_table
[i
]; i
++)
3523 *next
= list_table
[i
];
3524 next
= &(*next
)->next
;
3528 if (! f
->font_driver_list
->on
)
3529 { /* None of the drivers is enabled: enable them all.
3530 Happens if you set the list of drivers to (xft x) in your .emacs
3531 and then use it under w32 or ns. */
3532 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3534 struct font_driver
*driver
= list
->driver
;
3535 eassert (! list
->on
);
3536 if (! driver
->start_for_frame
3537 || driver
->start_for_frame (f
) == 0)
3539 font_prepare_cache (f
, driver
);
3546 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3548 active_drivers
= nconc2 (active_drivers
,
3549 Fcons (list
->driver
->type
, Qnil
));
3550 return active_drivers
;
3554 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3556 struct font_data_list
*list
, *prev
;
3558 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3559 prev
= list
, list
= list
->next
)
3560 if (list
->driver
== driver
)
3567 prev
->next
= list
->next
;
3569 f
->font_data_list
= list
->next
;
3577 list
= xmalloc (sizeof (struct font_data_list
));
3578 list
->driver
= driver
;
3579 list
->next
= f
->font_data_list
;
3580 f
->font_data_list
= list
;
3588 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3590 struct font_data_list
*list
;
3592 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3593 if (list
->driver
== driver
)
3601 /* Sets attributes on a font. Any properties that appear in ALIST and
3602 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3603 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3604 arrays of strings. This function is intended for use by the font
3605 drivers to implement their specific font_filter_properties. */
3607 font_filter_properties (Lisp_Object font
,
3609 const char *const boolean_properties
[],
3610 const char *const non_boolean_properties
[])
3615 /* Set boolean values to Qt or Qnil */
3616 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3617 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3619 Lisp_Object key
= XCAR (XCAR (it
));
3620 Lisp_Object val
= XCDR (XCAR (it
));
3621 char *keystr
= SDATA (SYMBOL_NAME (key
));
3623 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3625 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3626 : SYMBOLP (val
) ? (const char *) SDATA (SYMBOL_NAME (val
))
3629 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3630 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3631 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3632 || strcmp ("Off", str
) == 0)
3637 Ffont_put (font
, key
, val
);
3641 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3642 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3644 Lisp_Object key
= XCAR (XCAR (it
));
3645 Lisp_Object val
= XCDR (XCAR (it
));
3646 char *keystr
= SDATA (SYMBOL_NAME (key
));
3647 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3648 Ffont_put (font
, key
, val
);
3653 /* Return the font used to draw character C by FACE at buffer position
3654 POS in window W. If STRING is non-nil, it is a string containing C
3655 at index POS. If C is negative, get C from the current buffer or
3659 font_at (int c
, EMACS_INT pos
, struct face
*face
, struct window
*w
,
3664 Lisp_Object font_object
;
3666 multibyte
= (NILP (string
)
3667 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3668 : STRING_MULTIBYTE (string
));
3675 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3677 c
= FETCH_CHAR (pos_byte
);
3680 c
= FETCH_BYTE (pos
);
3686 multibyte
= STRING_MULTIBYTE (string
);
3689 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3691 str
= SDATA (string
) + pos_byte
;
3692 c
= STRING_CHAR (str
);
3695 c
= SDATA (string
)[pos
];
3699 f
= XFRAME (w
->frame
);
3700 if (! FRAME_WINDOW_P (f
))
3707 if (STRINGP (string
))
3708 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3709 DEFAULT_FACE_ID
, 0);
3711 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3713 face
= FACE_FROM_ID (f
, face_id
);
3717 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3718 face
= FACE_FROM_ID (f
, face_id
);
3723 XSETFONT (font_object
, face
->font
);
3728 #ifdef HAVE_WINDOW_SYSTEM
3730 /* Check how many characters after POS (at most to *LIMIT) can be
3731 displayed by the same font on the window W. FACE, if non-NULL, is
3732 the face selected for the character at POS. If STRING is not nil,
3733 it is the string to check instead of the current buffer. In that
3734 case, FACE must be not NULL.
3736 The return value is the font-object for the character at POS.
3737 *LIMIT is set to the position where that font can't be used.
3739 It is assured that the current buffer (or STRING) is multibyte. */
3742 font_range (EMACS_INT pos
, EMACS_INT
*limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3744 EMACS_INT pos_byte
, ignore
;
3746 Lisp_Object font_object
= Qnil
;
3750 pos_byte
= CHAR_TO_BYTE (pos
);
3755 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3757 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3763 pos_byte
= string_char_to_byte (string
, pos
);
3766 while (pos
< *limit
)
3768 Lisp_Object category
;
3771 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3773 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3774 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3775 if (EQ (category
, QCf
)
3776 || CHAR_VARIATION_SELECTOR_P (c
))
3778 if (NILP (font_object
))
3780 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3781 if (NILP (font_object
))
3785 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3795 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3796 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3797 Return nil otherwise.
3798 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3799 which kind of font it is. It must be one of `font-spec', `font-entity',
3801 (Lisp_Object object
, Lisp_Object extra_type
)
3803 if (NILP (extra_type
))
3804 return (FONTP (object
) ? Qt
: Qnil
);
3805 if (EQ (extra_type
, Qfont_spec
))
3806 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3807 if (EQ (extra_type
, Qfont_entity
))
3808 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3809 if (EQ (extra_type
, Qfont_object
))
3810 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3811 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3814 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3815 doc
: /* Return a newly created font-spec with arguments as properties.
3817 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3818 valid font property name listed below:
3820 `:family', `:weight', `:slant', `:width'
3822 They are the same as face attributes of the same name. See
3823 `set-face-attribute'.
3827 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3831 VALUE must be a string or a symbol specifying the additional
3832 typographic style information of a font, e.g. ``sans''.
3836 VALUE must be a string or a symbol specifying the charset registry and
3837 encoding of a font, e.g. ``iso8859-1''.
3841 VALUE must be a non-negative integer or a floating point number
3842 specifying the font size. It specifies the font size in pixels (if
3843 VALUE is an integer), or in points (if VALUE is a float).
3847 VALUE must be a string of XLFD-style or fontconfig-style font name.
3851 VALUE must be a symbol representing a script that the font must
3852 support. It may be a symbol representing a subgroup of a script
3853 listed in the variable `script-representative-chars'.
3857 VALUE must be a symbol of two-letter ISO-639 language names,
3862 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3863 required OpenType features.
3865 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3866 LANGSYS-TAG: OpenType language system tag symbol,
3867 or nil for the default language system.
3868 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3869 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3871 GSUB and GPOS may contain `nil' element. In such a case, the font
3872 must not have any of the remaining elements.
3874 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3875 be an OpenType font, and whose GPOS table of `thai' script's default
3876 language system must contain `mark' feature.
3878 usage: (font-spec ARGS...) */)
3879 (int nargs
, Lisp_Object
*args
)
3881 Lisp_Object spec
= font_make_spec ();
3884 for (i
= 0; i
< nargs
; i
+= 2)
3886 Lisp_Object key
= args
[i
], val
;
3890 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3893 if (EQ (key
, QCname
))
3896 font_parse_name ((char *) SDATA (val
), spec
);
3897 font_put_extra (spec
, key
, val
);
3901 int idx
= get_font_prop_index (key
);
3905 val
= font_prop_validate (idx
, Qnil
, val
);
3906 if (idx
< FONT_EXTRA_INDEX
)
3907 ASET (spec
, idx
, val
);
3909 font_put_extra (spec
, key
, val
);
3912 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3918 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3919 doc
: /* Return a copy of FONT as a font-spec. */)
3922 Lisp_Object new_spec
, tail
, prev
, extra
;
3926 new_spec
= font_make_spec ();
3927 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3928 ASET (new_spec
, i
, AREF (font
, i
));
3929 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3930 /* We must remove :font-entity property. */
3931 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3932 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3935 extra
= XCDR (extra
);
3937 XSETCDR (prev
, XCDR (tail
));
3940 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3944 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3945 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3946 Every specified properties in FROM override the corresponding
3947 properties in TO. */)
3948 (Lisp_Object from
, Lisp_Object to
)
3950 Lisp_Object extra
, tail
;
3955 to
= Fcopy_font_spec (to
);
3956 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3957 ASET (to
, i
, AREF (from
, i
));
3958 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3959 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3960 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3962 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3965 XSETCDR (slot
, XCDR (XCAR (tail
)));
3967 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3969 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3973 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3974 doc
: /* Return the value of FONT's property KEY.
3975 FONT is a font-spec, a font-entity, or a font-object.
3976 KEY is any symbol, but these are reserved for specific meanings:
3977 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3978 :size, :name, :script, :otf
3979 See the documentation of `font-spec' for their meanings.
3980 In addition, if FONT is a font-entity or a font-object, values of
3981 :script and :otf are different from those of a font-spec as below:
3983 The value of :script may be a list of scripts that are supported by the font.
3985 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3986 representing the OpenType features supported by the font by this form:
3987 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3988 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3990 (Lisp_Object font
, Lisp_Object key
)
3998 idx
= get_font_prop_index (key
);
3999 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4000 return font_style_symbolic (font
, idx
, 0);
4001 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4002 return AREF (font
, idx
);
4003 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
4004 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
4006 struct font
*fontp
= XFONT_OBJECT (font
);
4008 if (fontp
->driver
->otf_capability
)
4009 val
= fontp
->driver
->otf_capability (fontp
);
4011 val
= Fcons (Qnil
, Qnil
);
4012 font_put_extra (font
, QCotf
, val
);
4019 #ifdef HAVE_WINDOW_SYSTEM
4021 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4022 doc
: /* Return a plist of face attributes generated by FONT.
4023 FONT is a font name, a font-spec, a font-entity, or a font-object.
4024 The return value is a list of the form
4026 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4028 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4029 compatible with `set-face-attribute'. Some of these key-attribute pairs
4030 may be omitted from the list if they are not specified by FONT.
4032 The optional argument FRAME specifies the frame that the face attributes
4033 are to be displayed on. If omitted, the selected frame is used. */)
4034 (Lisp_Object font
, Lisp_Object frame
)
4037 Lisp_Object plist
[10];
4042 frame
= selected_frame
;
4043 CHECK_LIVE_FRAME (frame
);
4048 int fontset
= fs_query_fontset (font
, 0);
4049 Lisp_Object name
= font
;
4051 font
= fontset_ascii (fontset
);
4052 font
= font_spec_from_name (name
);
4054 signal_error ("Invalid font name", name
);
4056 else if (! FONTP (font
))
4057 signal_error ("Invalid font object", font
);
4059 val
= AREF (font
, FONT_FAMILY_INDEX
);
4062 plist
[n
++] = QCfamily
;
4063 plist
[n
++] = SYMBOL_NAME (val
);
4066 val
= AREF (font
, FONT_SIZE_INDEX
);
4069 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4070 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4071 plist
[n
++] = QCheight
;
4072 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4074 else if (FLOATP (val
))
4076 plist
[n
++] = QCheight
;
4077 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4080 val
= FONT_WEIGHT_FOR_FACE (font
);
4083 plist
[n
++] = QCweight
;
4087 val
= FONT_SLANT_FOR_FACE (font
);
4090 plist
[n
++] = QCslant
;
4094 val
= FONT_WIDTH_FOR_FACE (font
);
4097 plist
[n
++] = QCwidth
;
4101 return Flist (n
, plist
);
4106 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4107 doc
: /* Set one property of FONT: give property KEY value VAL.
4108 FONT is a font-spec, a font-entity, or a font-object.
4110 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4111 accepted by the function `font-spec' (which see), VAL must be what
4112 allowed in `font-spec'.
4114 If FONT is a font-entity or a font-object, KEY must not be the one
4115 accepted by `font-spec'. */)
4116 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4120 idx
= get_font_prop_index (prop
);
4121 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4123 CHECK_FONT_SPEC (font
);
4124 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4128 if (EQ (prop
, QCname
)
4129 || EQ (prop
, QCscript
)
4130 || EQ (prop
, QClang
)
4131 || EQ (prop
, QCotf
))
4132 CHECK_FONT_SPEC (font
);
4135 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4140 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4141 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4142 Optional 2nd argument FRAME specifies the target frame.
4143 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4144 Optional 4th argument PREFER, if non-nil, is a font-spec to
4145 control the order of the returned list. Fonts are sorted by
4146 how close they are to PREFER. */)
4147 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4149 Lisp_Object vec
, list
;
4153 frame
= selected_frame
;
4154 CHECK_LIVE_FRAME (frame
);
4155 CHECK_FONT_SPEC (font_spec
);
4163 if (! NILP (prefer
))
4164 CHECK_FONT_SPEC (prefer
);
4166 list
= font_list_entities (frame
, font_spec
);
4169 if (NILP (XCDR (list
))
4170 && ASIZE (XCAR (list
)) == 1)
4171 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4173 if (! NILP (prefer
))
4174 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4176 vec
= font_vconcat_entity_vectors (list
);
4177 if (n
== 0 || n
>= ASIZE (vec
))
4179 Lisp_Object args
[2];
4183 list
= Fappend (2, args
);
4187 for (list
= Qnil
, n
--; n
>= 0; n
--)
4188 list
= Fcons (AREF (vec
, n
), list
);
4193 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4194 doc
: /* List available font families on the current frame.
4195 Optional argument FRAME, if non-nil, specifies the target frame. */)
4199 struct font_driver_list
*driver_list
;
4203 frame
= selected_frame
;
4204 CHECK_LIVE_FRAME (frame
);
4207 for (driver_list
= f
->font_driver_list
; driver_list
;
4208 driver_list
= driver_list
->next
)
4209 if (driver_list
->driver
->list_family
)
4211 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4212 Lisp_Object tail
= list
;
4214 for (; CONSP (val
); val
= XCDR (val
))
4215 if (NILP (Fmemq (XCAR (val
), tail
))
4216 && SYMBOLP (XCAR (val
)))
4217 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4222 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4223 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4224 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4225 (Lisp_Object font_spec
, Lisp_Object frame
)
4227 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4234 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4235 doc
: /* Return XLFD name of FONT.
4236 FONT is a font-spec, font-entity, or font-object.
4237 If the name is too long for XLFD (maximum 255 chars), return nil.
4238 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4239 the consecutive wildcards are folded to one. */)
4240 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4247 if (FONT_OBJECT_P (font
))
4249 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4251 if (STRINGP (font_name
)
4252 && SDATA (font_name
)[0] == '-')
4254 if (NILP (fold_wildcards
))
4256 strcpy (name
, (char *) SDATA (font_name
));
4259 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4261 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4264 if (! NILP (fold_wildcards
))
4266 char *p0
= name
, *p1
;
4268 while ((p1
= strstr (p0
, "-*-*")))
4270 strcpy (p1
, p1
+ 2);
4275 return build_string (name
);
4278 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4279 doc
: /* Clear font cache. */)
4282 Lisp_Object list
, frame
;
4284 FOR_EACH_FRAME (list
, frame
)
4286 FRAME_PTR f
= XFRAME (frame
);
4287 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4289 for (; driver_list
; driver_list
= driver_list
->next
)
4290 if (driver_list
->on
)
4292 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4293 Lisp_Object val
, tmp
;
4297 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4299 font_assert (! NILP (val
));
4300 tmp
= XCDR (XCAR (val
));
4301 if (XINT (XCAR (tmp
)) == 0)
4303 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4304 XSETCDR (cache
, XCDR (val
));
4314 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4316 struct font
*font
= XFONT_OBJECT (font_object
);
4318 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4319 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4320 struct font_metrics metrics
;
4322 LGLYPH_SET_CODE (glyph
, ecode
);
4324 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4325 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4326 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4327 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4328 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4329 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4333 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4334 doc
: /* Shape the glyph-string GSTRING.
4335 Shaping means substituting glyphs and/or adjusting positions of glyphs
4336 to get the correct visual image of character sequences set in the
4337 header of the glyph-string.
4339 If the shaping was successful, the value is GSTRING itself or a newly
4340 created glyph-string. Otherwise, the value is nil. */)
4341 (Lisp_Object gstring
)
4344 Lisp_Object font_object
, n
, glyph
;
4347 if (! composition_gstring_p (gstring
))
4348 signal_error ("Invalid glyph-string: ", gstring
);
4349 if (! NILP (LGSTRING_ID (gstring
)))
4351 font_object
= LGSTRING_FONT (gstring
);
4352 CHECK_FONT_OBJECT (font_object
);
4353 font
= XFONT_OBJECT (font_object
);
4354 if (! font
->driver
->shape
)
4357 /* Try at most three times with larger gstring each time. */
4358 for (i
= 0; i
< 3; i
++)
4360 n
= font
->driver
->shape (gstring
);
4363 gstring
= larger_vector (gstring
,
4364 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4367 if (i
== 3 || XINT (n
) == 0)
4369 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4370 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4372 glyph
= LGSTRING_GLYPH (gstring
, 0);
4373 from
= LGLYPH_FROM (glyph
);
4374 to
= LGLYPH_TO (glyph
);
4375 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4377 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4381 if (NILP (LGLYPH_ADJUSTMENT (this)))
4386 glyph
= LGSTRING_GLYPH (gstring
, j
);
4387 LGLYPH_SET_FROM (glyph
, from
);
4388 LGLYPH_SET_TO (glyph
, to
);
4390 from
= LGLYPH_FROM (this);
4391 to
= LGLYPH_TO (this);
4396 if (from
> LGLYPH_FROM (this))
4397 from
= LGLYPH_FROM (this);
4398 if (to
< LGLYPH_TO (this))
4399 to
= LGLYPH_TO (this);
4405 glyph
= LGSTRING_GLYPH (gstring
, j
);
4406 LGLYPH_SET_FROM (glyph
, from
);
4407 LGLYPH_SET_TO (glyph
, to
);
4409 return composition_gstring_put_cache (gstring
, XINT (n
));
4412 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4414 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4415 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4417 VARIATION-SELECTOR is a character code of variation selection
4418 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4419 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4420 (Lisp_Object font_object
, Lisp_Object character
)
4422 unsigned variations
[256];
4427 CHECK_FONT_OBJECT (font_object
);
4428 CHECK_CHARACTER (character
);
4429 font
= XFONT_OBJECT (font_object
);
4430 if (! font
->driver
->get_variation_glyphs
)
4432 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4436 for (i
= 0; i
< 255; i
++)
4440 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4441 /* Stops GCC whining about limited range of data type. */
4442 EMACS_INT var
= variations
[i
];
4444 if (var
> MOST_POSITIVE_FIXNUM
)
4445 code
= Fcons (make_number ((variations
[i
]) >> 16),
4446 make_number ((variations
[i
]) & 0xFFFF));
4448 code
= make_number (variations
[i
]);
4449 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4456 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4457 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4458 OTF-FEATURES specifies which features to apply in this format:
4459 (SCRIPT LANGSYS GSUB GPOS)
4461 SCRIPT is a symbol specifying a script tag of OpenType,
4462 LANGSYS is a symbol specifying a langsys tag of OpenType,
4463 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4465 If LANGYS is nil, the default langsys is selected.
4467 The features are applied in the order they appear in the list. The
4468 symbol `*' means to apply all available features not present in this
4469 list, and the remaining features are ignored. For instance, (vatu
4470 pstf * haln) is to apply vatu and pstf in this order, then to apply
4471 all available features other than vatu, pstf, and haln.
4473 The features are applied to the glyphs in the range FROM and TO of
4474 the glyph-string GSTRING-IN.
4476 If some feature is actually applicable, the resulting glyphs are
4477 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4478 this case, the value is the number of produced glyphs.
4480 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4483 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4484 produced in GSTRING-OUT, and the value is nil.
4486 See the documentation of `font-make-gstring' for the format of
4488 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4490 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4495 check_otf_features (otf_features
);
4496 CHECK_FONT_OBJECT (font_object
);
4497 font
= XFONT_OBJECT (font_object
);
4498 if (! font
->driver
->otf_drive
)
4499 error ("Font backend %s can't drive OpenType GSUB table",
4500 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4501 CHECK_CONS (otf_features
);
4502 CHECK_SYMBOL (XCAR (otf_features
));
4503 val
= XCDR (otf_features
);
4504 CHECK_SYMBOL (XCAR (val
));
4505 val
= XCDR (otf_features
);
4508 len
= check_gstring (gstring_in
);
4509 CHECK_VECTOR (gstring_out
);
4510 CHECK_NATNUM (from
);
4512 CHECK_NATNUM (index
);
4514 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4515 args_out_of_range_3 (from
, to
, make_number (len
));
4516 if (XINT (index
) >= ASIZE (gstring_out
))
4517 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4518 num
= font
->driver
->otf_drive (font
, otf_features
,
4519 gstring_in
, XINT (from
), XINT (to
),
4520 gstring_out
, XINT (index
), 0);
4523 return make_number (num
);
4526 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4528 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4529 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4531 (SCRIPT LANGSYS FEATURE ...)
4532 See the documentation of `font-drive-otf' for more detail.
4534 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4535 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4536 character code corresponding to the glyph or nil if there's no
4537 corresponding character. */)
4538 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4541 Lisp_Object gstring_in
, gstring_out
, g
;
4542 Lisp_Object alternates
;
4545 CHECK_FONT_GET_OBJECT (font_object
, font
);
4546 if (! font
->driver
->otf_drive
)
4547 error ("Font backend %s can't drive OpenType GSUB table",
4548 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4549 CHECK_CHARACTER (character
);
4550 CHECK_CONS (otf_features
);
4552 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4553 g
= LGSTRING_GLYPH (gstring_in
, 0);
4554 LGLYPH_SET_CHAR (g
, XINT (character
));
4555 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4556 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4557 gstring_out
, 0, 1)) < 0)
4558 gstring_out
= Ffont_make_gstring (font_object
,
4559 make_number (ASIZE (gstring_out
) * 2));
4561 for (i
= 0; i
< num
; i
++)
4563 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4564 int c
= LGLYPH_CHAR (g
);
4565 unsigned code
= LGLYPH_CODE (g
);
4567 alternates
= Fcons (Fcons (make_number (code
),
4568 c
> 0 ? make_number (c
) : Qnil
),
4571 return Fnreverse (alternates
);
4577 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4578 doc
: /* Open FONT-ENTITY. */)
4579 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4583 CHECK_FONT_ENTITY (font_entity
);
4585 frame
= selected_frame
;
4586 CHECK_LIVE_FRAME (frame
);
4589 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4592 CHECK_NUMBER_OR_FLOAT (size
);
4594 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4596 isize
= XINT (size
);
4600 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4603 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4604 doc
: /* Close FONT-OBJECT. */)
4605 (Lisp_Object font_object
, Lisp_Object frame
)
4607 CHECK_FONT_OBJECT (font_object
);
4609 frame
= selected_frame
;
4610 CHECK_LIVE_FRAME (frame
);
4611 font_close_object (XFRAME (frame
), font_object
);
4615 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4616 doc
: /* Return information about FONT-OBJECT.
4617 The value is a vector:
4618 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4621 NAME is a string of the font name (or nil if the font backend doesn't
4624 FILENAME is a string of the font file (or nil if the font backend
4625 doesn't provide a file name).
4627 PIXEL-SIZE is a pixel size by which the font is opened.
4629 SIZE is a maximum advance width of the font in pixels.
4631 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4634 CAPABILITY is a list whose first element is a symbol representing the
4635 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4636 remaining elements describe the details of the font capability.
4638 If the font is OpenType font, the form of the list is
4639 \(opentype GSUB GPOS)
4640 where GSUB shows which "GSUB" features the font supports, and GPOS
4641 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4642 lists of the format:
4643 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4645 If the font is not OpenType font, currently the length of the form is
4648 SCRIPT is a symbol representing OpenType script tag.
4650 LANGSYS is a symbol representing OpenType langsys tag, or nil
4651 representing the default langsys.
4653 FEATURE is a symbol representing OpenType feature tag.
4655 If the font is not OpenType font, CAPABILITY is nil. */)
4656 (Lisp_Object font_object
)
4661 CHECK_FONT_GET_OBJECT (font_object
, font
);
4663 val
= Fmake_vector (make_number (9), Qnil
);
4664 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4665 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4666 ASET (val
, 2, make_number (font
->pixel_size
));
4667 ASET (val
, 3, make_number (font
->max_width
));
4668 ASET (val
, 4, make_number (font
->ascent
));
4669 ASET (val
, 5, make_number (font
->descent
));
4670 ASET (val
, 6, make_number (font
->space_width
));
4671 ASET (val
, 7, make_number (font
->average_width
));
4672 if (font
->driver
->otf_capability
)
4673 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4677 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4679 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4680 FROM and TO are positions (integers or markers) specifying a region
4681 of the current buffer.
4682 If the optional fourth arg OBJECT is not nil, it is a string or a
4683 vector containing the target characters.
4685 Each element is a vector containing information of a glyph in this format:
4686 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4688 FROM is an index numbers of a character the glyph corresponds to.
4689 TO is the same as FROM.
4690 C is the character of the glyph.
4691 CODE is the glyph-code of C in FONT-OBJECT.
4692 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4693 ADJUSTMENT is always nil.
4694 If FONT-OBJECT doesn't have a glyph for a character,
4695 the corresponding element is nil. */)
4696 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4701 Lisp_Object
*chars
, vec
;
4704 CHECK_FONT_GET_OBJECT (font_object
, font
);
4707 EMACS_INT charpos
, bytepos
;
4709 validate_region (&from
, &to
);
4712 len
= XFASTINT (to
) - XFASTINT (from
);
4713 SAFE_ALLOCA_LISP (chars
, len
);
4714 charpos
= XFASTINT (from
);
4715 bytepos
= CHAR_TO_BYTE (charpos
);
4716 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4718 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4719 chars
[i
] = make_number (c
);
4722 else if (STRINGP (object
))
4724 const unsigned char *p
;
4726 CHECK_NUMBER (from
);
4728 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4729 || XINT (to
) > SCHARS (object
))
4730 args_out_of_range_3 (object
, from
, to
);
4733 len
= XFASTINT (to
) - XFASTINT (from
);
4734 SAFE_ALLOCA_LISP (chars
, len
);
4736 if (STRING_MULTIBYTE (object
))
4737 for (i
= 0; i
< len
; i
++)
4739 c
= STRING_CHAR_ADVANCE (p
);
4740 chars
[i
] = make_number (c
);
4743 for (i
= 0; i
< len
; i
++)
4744 chars
[i
] = make_number (p
[i
]);
4748 CHECK_VECTOR (object
);
4749 CHECK_NUMBER (from
);
4751 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4752 || XINT (to
) > ASIZE (object
))
4753 args_out_of_range_3 (object
, from
, to
);
4756 len
= XFASTINT (to
) - XFASTINT (from
);
4757 for (i
= 0; i
< len
; i
++)
4759 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4760 CHECK_CHARACTER (elt
);
4762 chars
= &(AREF (object
, XFASTINT (from
)));
4765 vec
= Fmake_vector (make_number (len
), Qnil
);
4766 for (i
= 0; i
< len
; i
++)
4769 int c
= XFASTINT (chars
[i
]);
4772 struct font_metrics metrics
;
4774 cod
= code
= font
->driver
->encode_char (font
, c
);
4775 if (code
== FONT_INVALID_CODE
)
4777 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4778 LGLYPH_SET_FROM (g
, i
);
4779 LGLYPH_SET_TO (g
, i
);
4780 LGLYPH_SET_CHAR (g
, c
);
4781 LGLYPH_SET_CODE (g
, code
);
4782 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4783 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4784 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4785 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4786 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4787 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4790 if (! VECTORP (object
))
4795 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4796 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4797 FONT is a font-spec, font-entity, or font-object. */)
4798 (Lisp_Object spec
, Lisp_Object font
)
4800 CHECK_FONT_SPEC (spec
);
4803 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4806 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4807 doc
: /* Return a font-object for displaying a character at POSITION.
4808 Optional second arg WINDOW, if non-nil, is a window displaying
4809 the current buffer. It defaults to the currently selected window. */)
4810 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4817 CHECK_NUMBER_COERCE_MARKER (position
);
4818 pos
= XINT (position
);
4819 if (pos
< BEGV
|| pos
>= ZV
)
4820 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4824 CHECK_NUMBER (position
);
4825 CHECK_STRING (string
);
4826 pos
= XINT (position
);
4827 if (pos
< 0 || pos
>= SCHARS (string
))
4828 args_out_of_range (string
, position
);
4831 window
= selected_window
;
4832 CHECK_LIVE_WINDOW (window
);
4833 w
= XWINDOW (window
);
4835 return font_at (-1, pos
, NULL
, w
, string
);
4839 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4840 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4841 The value is a number of glyphs drawn.
4842 Type C-l to recover what previously shown. */)
4843 (Lisp_Object font_object
, Lisp_Object string
)
4845 Lisp_Object frame
= selected_frame
;
4846 FRAME_PTR f
= XFRAME (frame
);
4852 CHECK_FONT_GET_OBJECT (font_object
, font
);
4853 CHECK_STRING (string
);
4854 len
= SCHARS (string
);
4855 code
= alloca (sizeof (unsigned) * len
);
4856 for (i
= 0; i
< len
; i
++)
4858 Lisp_Object ch
= Faref (string
, make_number (i
));
4862 code
[i
] = font
->driver
->encode_char (font
, c
);
4863 if (code
[i
] == FONT_INVALID_CODE
)
4866 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4868 if (font
->driver
->prepare_face
)
4869 font
->driver
->prepare_face (f
, face
);
4870 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4871 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4872 if (font
->driver
->done_face
)
4873 font
->driver
->done_face (f
, face
);
4875 return make_number (len
);
4879 #endif /* FONT_DEBUG */
4881 #ifdef HAVE_WINDOW_SYSTEM
4883 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4884 doc
: /* Return information about a font named NAME on frame FRAME.
4885 If FRAME is omitted or nil, use the selected frame.
4886 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4887 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4889 OPENED-NAME is the name used for opening the font,
4890 FULL-NAME is the full name of the font,
4891 SIZE is the pixelsize of the font,
4892 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4893 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4894 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4895 how to compose characters.
4896 If the named font is not yet loaded, return nil. */)
4897 (Lisp_Object name
, Lisp_Object frame
)
4902 Lisp_Object font_object
;
4904 (*check_window_system_func
) ();
4907 CHECK_STRING (name
);
4909 frame
= selected_frame
;
4910 CHECK_LIVE_FRAME (frame
);
4915 int fontset
= fs_query_fontset (name
, 0);
4918 name
= fontset_ascii (fontset
);
4919 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4921 else if (FONT_OBJECT_P (name
))
4923 else if (FONT_ENTITY_P (name
))
4924 font_object
= font_open_entity (f
, name
, 0);
4927 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4928 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4930 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4932 if (NILP (font_object
))
4934 font
= XFONT_OBJECT (font_object
);
4936 info
= Fmake_vector (make_number (7), Qnil
);
4937 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4938 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
4939 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4940 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4941 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4942 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4943 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4946 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4947 close it now. Perhaps, we should manage font-objects
4948 by `reference-count'. */
4949 font_close_object (f
, font_object
);
4956 #define BUILD_STYLE_TABLE(TBL) \
4957 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4960 build_style_table (const struct table_entry
*entry
, int nelement
)
4963 Lisp_Object table
, elt
;
4965 table
= Fmake_vector (make_number (nelement
), Qnil
);
4966 for (i
= 0; i
< nelement
; i
++)
4968 for (j
= 0; entry
[i
].names
[j
]; j
++);
4969 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4970 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4971 for (j
= 0; entry
[i
].names
[j
]; j
++)
4972 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4973 ASET (table
, i
, elt
);
4978 Lisp_Object Vfont_log
;
4980 /* The deferred font-log data of the form [ACTION ARG RESULT].
4981 If ACTION is not nil, that is added to the log when font_add_log is
4982 called next time. At that time, ACTION is set back to nil. */
4983 static Lisp_Object Vfont_log_deferred
;
4985 /* Prepend the font-related logging data in Vfont_log if it is not
4986 `t'. ACTION describes a kind of font-related action (e.g. listing,
4987 opening), ARG is the argument for the action, and RESULT is the
4988 result of the action. */
4990 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4992 Lisp_Object tail
, val
;
4995 if (EQ (Vfont_log
, Qt
))
4997 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4999 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
5001 ASET (Vfont_log_deferred
, 0, Qnil
);
5002 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5003 AREF (Vfont_log_deferred
, 2));
5008 Lisp_Object tail
, elt
;
5009 Lisp_Object equalstr
= build_string ("=");
5011 val
= Ffont_xlfd_name (arg
, Qt
);
5012 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5016 if (EQ (XCAR (elt
), QCscript
)
5017 && SYMBOLP (XCDR (elt
)))
5018 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5019 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5020 else if (EQ (XCAR (elt
), QClang
)
5021 && SYMBOLP (XCDR (elt
)))
5022 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5023 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5024 else if (EQ (XCAR (elt
), QCotf
)
5025 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5026 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5028 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5034 && VECTORP (XCAR (result
))
5035 && ASIZE (XCAR (result
)) > 0
5036 && FONTP (AREF (XCAR (result
), 0)))
5037 result
= font_vconcat_entity_vectors (result
);
5040 val
= Ffont_xlfd_name (result
, Qt
);
5041 if (! FONT_SPEC_P (result
))
5042 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5043 build_string (":"), val
);
5046 else if (CONSP (result
))
5048 result
= Fcopy_sequence (result
);
5049 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5053 val
= Ffont_xlfd_name (val
, Qt
);
5054 XSETCAR (tail
, val
);
5057 else if (VECTORP (result
))
5059 result
= Fcopy_sequence (result
);
5060 for (i
= 0; i
< ASIZE (result
); i
++)
5062 val
= AREF (result
, i
);
5064 val
= Ffont_xlfd_name (val
, Qt
);
5065 ASET (result
, i
, val
);
5068 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5071 /* Record a font-related logging data to be added to Vfont_log when
5072 font_add_log is called next time. ACTION, ARG, RESULT are the same
5076 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5078 if (EQ (Vfont_log
, Qt
))
5080 ASET (Vfont_log_deferred
, 0, build_string (action
));
5081 ASET (Vfont_log_deferred
, 1, arg
);
5082 ASET (Vfont_log_deferred
, 2, result
);
5088 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5089 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5090 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5091 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5092 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5093 /* Note that the other elements in sort_shift_bits are not used. */
5095 staticpro (&font_charset_alist
);
5096 font_charset_alist
= Qnil
;
5098 DEFSYM (Qopentype
, "opentype");
5100 DEFSYM (Qascii_0
, "ascii-0");
5101 DEFSYM (Qiso8859_1
, "iso8859-1");
5102 DEFSYM (Qiso10646_1
, "iso10646-1");
5103 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5104 DEFSYM (Qunicode_sip
, "unicode-sip");
5108 DEFSYM (QCotf
, ":otf");
5109 DEFSYM (QClang
, ":lang");
5110 DEFSYM (QCscript
, ":script");
5111 DEFSYM (QCantialias
, ":antialias");
5113 DEFSYM (QCfoundry
, ":foundry");
5114 DEFSYM (QCadstyle
, ":adstyle");
5115 DEFSYM (QCregistry
, ":registry");
5116 DEFSYM (QCspacing
, ":spacing");
5117 DEFSYM (QCdpi
, ":dpi");
5118 DEFSYM (QCscalable
, ":scalable");
5119 DEFSYM (QCavgwidth
, ":avgwidth");
5120 DEFSYM (QCfont_entity
, ":font-entity");
5121 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5131 DEFSYM (QCuser_spec
, "user-spec");
5133 staticpro (&null_vector
);
5134 null_vector
= Fmake_vector (make_number (0), Qnil
);
5136 staticpro (&scratch_font_spec
);
5137 scratch_font_spec
= Ffont_spec (0, NULL
);
5138 staticpro (&scratch_font_prefer
);
5139 scratch_font_prefer
= Ffont_spec (0, NULL
);
5141 staticpro (&Vfont_log_deferred
);
5142 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5146 staticpro (&otf_list
);
5148 #endif /* HAVE_LIBOTF */
5152 defsubr (&Sfont_spec
);
5153 defsubr (&Sfont_get
);
5154 #ifdef HAVE_WINDOW_SYSTEM
5155 defsubr (&Sfont_face_attributes
);
5157 defsubr (&Sfont_put
);
5158 defsubr (&Slist_fonts
);
5159 defsubr (&Sfont_family_list
);
5160 defsubr (&Sfind_font
);
5161 defsubr (&Sfont_xlfd_name
);
5162 defsubr (&Sclear_font_cache
);
5163 defsubr (&Sfont_shape_gstring
);
5164 defsubr (&Sfont_variation_glyphs
);
5166 defsubr (&Sfont_drive_otf
);
5167 defsubr (&Sfont_otf_alternates
);
5171 defsubr (&Sopen_font
);
5172 defsubr (&Sclose_font
);
5173 defsubr (&Squery_font
);
5174 defsubr (&Sfont_get_glyphs
);
5175 defsubr (&Sfont_match_p
);
5176 defsubr (&Sfont_at
);
5178 defsubr (&Sdraw_string
);
5180 #endif /* FONT_DEBUG */
5181 #ifdef HAVE_WINDOW_SYSTEM
5182 defsubr (&Sfont_info
);
5185 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5187 Alist of fontname patterns vs the corresponding encoding and repertory info.
5188 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5189 where ENCODING is a charset or a char-table,
5190 and REPERTORY is a charset, a char-table, or nil.
5192 If ENCODING and REPERTORY are the same, the element can have the form
5193 \(REGEXP . ENCODING).
5195 ENCODING is for converting a character to a glyph code of the font.
5196 If ENCODING is a charset, encoding a character by the charset gives
5197 the corresponding glyph code. If ENCODING is a char-table, looking up
5198 the table by a character gives the corresponding glyph code.
5200 REPERTORY specifies a repertory of characters supported by the font.
5201 If REPERTORY is a charset, all characters beloging to the charset are
5202 supported. If REPERTORY is a char-table, all characters who have a
5203 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5204 gets the repertory information by an opened font and ENCODING. */);
5205 Vfont_encoding_alist
= Qnil
;
5207 /* FIXME: These 3 vars are not quite what they appear: setq on them
5208 won't have any effect other than disconnect them from the style
5209 table used by the font display code. So we make them read-only,
5210 to avoid this confusing situation. */
5212 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5213 doc
: /* Vector of valid font weight values.
5214 Each element has the form:
5215 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5216 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5217 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5218 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5220 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5221 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5222 See `font-weight-table' for the format of the vector. */);
5223 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5224 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5226 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5227 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5228 See `font-weight-table' for the format of the vector. */);
5229 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5230 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5232 staticpro (&font_style_table
);
5233 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5234 ASET (font_style_table
, 0, Vfont_weight_table
);
5235 ASET (font_style_table
, 1, Vfont_slant_table
);
5236 ASET (font_style_table
, 2, Vfont_width_table
);
5238 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5239 *Logging list of font related actions and results.
5240 The value t means to suppress the logging.
5241 The initial value is set to nil if the environment variable
5242 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5245 #ifdef HAVE_WINDOW_SYSTEM
5246 #ifdef HAVE_FREETYPE
5248 #ifdef HAVE_X_WINDOWS
5253 #endif /* HAVE_XFT */
5254 #endif /* HAVE_X_WINDOWS */
5255 #else /* not HAVE_FREETYPE */
5256 #ifdef HAVE_X_WINDOWS
5258 #endif /* HAVE_X_WINDOWS */
5259 #endif /* not HAVE_FREETYPE */
5262 #endif /* HAVE_BDFFONT */
5265 #endif /* WINDOWSNT */
5268 #endif /* HAVE_NS */
5269 #endif /* HAVE_WINDOW_SYSTEM */
5275 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;