1 /* font.c -- "Font" primitives.
3 Copyright (C) 2006-2014 Free Software Foundation, Inc.
4 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
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/>. */
30 #include "character.h"
34 #include "dispextern.h"
36 #include "composite.h"
40 #ifdef HAVE_WINDOW_SYSTEM
42 #endif /* HAVE_WINDOW_SYSTEM */
44 Lisp_Object Qopentype
;
46 /* Important character set strings. */
47 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
49 #define DEFAULT_ENCODING Qiso8859_1
51 /* Unicode category `Cf'. */
52 static Lisp_Object QCf
;
54 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
55 static Lisp_Object font_style_table
;
57 /* Structure used for tables mapping weight, slant, and width numeric
58 values and their names. */
63 /* The first one is a valid name as a face attribute.
64 The second one (if any) is a typical name in XLFD field. */
68 /* Table of weight numeric values and their names. This table must be
69 sorted by numeric values in ascending order. */
71 static const struct table_entry weight_table
[] =
74 { 20, { "ultra-light", "ultralight" }},
75 { 40, { "extra-light", "extralight" }},
77 { 75, { "semi-light", "semilight", "demilight", "book" }},
78 { 100, { "normal", "medium", "regular", "unspecified" }},
79 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
81 { 205, { "extra-bold", "extrabold" }},
82 { 210, { "ultra-bold", "ultrabold", "black" }}
85 /* Table of slant numeric values and their names. This table must be
86 sorted by numeric values in ascending order. */
88 static const struct table_entry slant_table
[] =
90 { 0, { "reverse-oblique", "ro" }},
91 { 10, { "reverse-italic", "ri" }},
92 { 100, { "normal", "r", "unspecified" }},
93 { 200, { "italic" ,"i", "ot" }},
94 { 210, { "oblique", "o" }}
97 /* Table of width numeric values and their names. This table must be
98 sorted by numeric values in ascending order. */
100 static const struct table_entry width_table
[] =
102 { 50, { "ultra-condensed", "ultracondensed" }},
103 { 63, { "extra-condensed", "extracondensed" }},
104 { 75, { "condensed", "compressed", "narrow" }},
105 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
106 { 100, { "normal", "medium", "regular", "unspecified" }},
107 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
108 { 125, { "expanded" }},
109 { 150, { "extra-expanded", "extraexpanded" }},
110 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
113 Lisp_Object QCfoundry
;
114 static Lisp_Object QCadstyle
, QCregistry
;
115 /* Symbols representing keys of font extra info. */
116 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
117 Lisp_Object QCantialias
, QCfont_entity
;
118 static Lisp_Object QCfc_unknown_spec
;
119 /* Symbols representing values of font spacing property. */
120 static Lisp_Object Qc
, Qm
, Qd
;
122 /* Special ADSTYLE properties to avoid fonts used for Latin
123 characters; used in xfont.c and ftfont.c. */
124 Lisp_Object Qja
, Qko
;
126 static Lisp_Object QCuser_spec
;
128 /* Alist of font registry symbols and the corresponding charset
129 information. The information is retrieved from
130 Vfont_encoding_alist on demand.
132 Eash element has the form:
133 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
137 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
138 encodes a character code to a glyph code of a font, and
139 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
140 character is supported by a font.
142 The latter form means that the information for REGISTRY couldn't be
144 static Lisp_Object font_charset_alist
;
146 /* List of all font drivers. Each font-backend (XXXfont.c) calls
147 register_font_driver in syms_of_XXXfont to register its font-driver
149 static struct font_driver_list
*font_driver_list
;
151 #ifdef ENABLE_CHECKING
153 /* Used to catch bogus pointers in font objects. */
156 valid_font_driver (struct font_driver
*drv
)
158 Lisp_Object tail
, frame
;
159 struct font_driver_list
*fdl
;
161 for (fdl
= font_driver_list
; fdl
; fdl
= fdl
->next
)
162 if (fdl
->driver
== drv
)
164 FOR_EACH_FRAME (tail
, frame
)
165 for (fdl
= XFRAME (frame
)->font_driver_list
; fdl
; fdl
= fdl
->next
)
166 if (fdl
->driver
== drv
)
171 #endif /* ENABLE_CHECKING */
173 /* Creators of font-related Lisp object. */
176 font_make_spec (void)
178 Lisp_Object font_spec
;
179 struct font_spec
*spec
180 = ((struct font_spec
*)
181 allocate_pseudovector (VECSIZE (struct font_spec
),
182 FONT_SPEC_MAX
, PVEC_FONT
));
183 XSETFONT (font_spec
, spec
);
188 font_make_entity (void)
190 Lisp_Object font_entity
;
191 struct font_entity
*entity
192 = ((struct font_entity
*)
193 allocate_pseudovector (VECSIZE (struct font_entity
),
194 FONT_ENTITY_MAX
, PVEC_FONT
));
195 XSETFONT (font_entity
, entity
);
199 /* Create a font-object whose structure size is SIZE. If ENTITY is
200 not nil, copy properties from ENTITY to the font-object. If
201 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
203 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
205 Lisp_Object font_object
;
207 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
210 XSETFONT (font_object
, font
);
214 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
215 font
->props
[i
] = AREF (entity
, i
);
216 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
217 font
->props
[FONT_EXTRA_INDEX
]
218 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
221 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
227 static int font_pixel_size (struct frame
*f
, Lisp_Object
);
228 static Lisp_Object
font_open_entity (struct frame
*, Lisp_Object
, int);
229 static Lisp_Object
font_matching_entity (struct frame
*, Lisp_Object
*,
231 static unsigned font_encode_char (Lisp_Object
, int);
233 /* Number of registered font drivers. */
234 static int num_font_drivers
;
237 /* Return a Lispy value of a font property value at STR and LEN bytes.
238 If STR is "*", return nil. If FORCE_SYMBOL, or if STR does not
239 consist entirely of one or more digits, return a symbol interned
240 from STR. Otherwise, return an integer. */
243 font_intern_prop (const char *str
, ptrdiff_t len
, bool force_symbol
)
248 ptrdiff_t nbytes
, nchars
;
250 if (len
== 1 && *str
== '*')
252 if (!force_symbol
&& 0 < len
&& '0' <= *str
&& *str
<= '9')
254 for (i
= 1; i
< len
; i
++)
255 if (! ('0' <= str
[i
] && str
[i
] <= '9'))
262 for (n
= 0; (n
+= str
[i
++] - '0') <= MOST_POSITIVE_FIXNUM
; n
*= 10)
265 return make_number (n
);
266 if (MOST_POSITIVE_FIXNUM
/ 10 < n
)
270 xsignal1 (Qoverflow_error
, make_string (str
, len
));
274 /* This code is similar to intern function from lread.c. */
275 obarray
= check_obarray (Vobarray
);
276 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
277 tem
= oblookup (obarray
, str
,
278 (len
== nchars
|| len
!= nbytes
) ? len
: nchars
, len
);
282 if (len
== nchars
|| len
!= nbytes
)
283 tem
= make_unibyte_string (str
, len
);
285 tem
= make_multibyte_string (str
, nchars
, len
);
286 return Fintern (tem
, obarray
);
289 /* Return a pixel size of font-spec SPEC on frame F. */
292 font_pixel_size (struct frame
*f
, Lisp_Object spec
)
294 #ifdef HAVE_WINDOW_SYSTEM
295 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
304 eassert (FLOATP (size
));
305 point_size
= XFLOAT_DATA (size
);
306 val
= AREF (spec
, FONT_DPI_INDEX
);
310 dpi
= FRAME_RES_Y (f
);
311 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
319 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
320 font vector. If VAL is not valid (i.e. not registered in
321 font_style_table), return -1 if NOERROR is zero, and return a
322 proper index if NOERROR is nonzero. In that case, register VAL in
323 font_style_table if VAL is a symbol, and return the closest index if
324 VAL is an integer. */
327 font_style_to_value (enum font_property_index prop
, Lisp_Object val
,
330 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
333 CHECK_VECTOR (table
);
340 Lisp_Object args
[2], elt
;
342 /* At first try exact match. */
343 for (i
= 0; i
< len
; i
++)
345 CHECK_VECTOR (AREF (table
, i
));
346 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
347 if (EQ (val
, AREF (AREF (table
, i
), j
)))
349 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
350 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
351 | (i
<< 4) | (j
- 1));
354 /* Try also with case-folding match. */
355 s
= SSDATA (SYMBOL_NAME (val
));
356 for (i
= 0; i
< len
; i
++)
357 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
359 elt
= AREF (AREF (table
, i
), j
);
360 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
362 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
363 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
364 | (i
<< 4) | (j
- 1));
370 elt
= Fmake_vector (make_number (2), make_number (100));
373 args
[1] = Fmake_vector (make_number (1), elt
);
374 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
375 return (100 << 8) | (i
<< 4);
380 EMACS_INT numeric
= XINT (val
);
382 for (i
= 0, last_n
= -1; i
< len
; i
++)
386 CHECK_VECTOR (AREF (table
, i
));
387 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
388 n
= XINT (AREF (AREF (table
, i
), 0));
390 return (n
<< 8) | (i
<< 4);
395 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
396 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
402 return ((last_n
<< 8) | ((i
- 1) << 4));
407 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
,
410 Lisp_Object val
= AREF (font
, prop
);
411 Lisp_Object table
, elt
;
416 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
417 CHECK_VECTOR (table
);
418 i
= XINT (val
) & 0xFF;
419 eassert (((i
>> 4) & 0xF) < ASIZE (table
));
420 elt
= AREF (table
, ((i
>> 4) & 0xF));
422 eassert ((i
& 0xF) + 1 < ASIZE (elt
));
423 elt
= (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
428 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
429 FONTNAME. ENCODING is a charset symbol that specifies the encoding
430 of the font. REPERTORY is a charset symbol or nil. */
433 find_font_encoding (Lisp_Object fontname
)
435 Lisp_Object tail
, elt
;
437 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
441 && STRINGP (XCAR (elt
))
442 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
443 && (SYMBOLP (XCDR (elt
))
444 ? CHARSETP (XCDR (elt
))
445 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
451 /* Return encoding charset and repertory charset for REGISTRY in
452 ENCODING and REPERTORY correspondingly. If correct information for
453 REGISTRY is available, return 0. Otherwise return -1. */
456 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
459 int encoding_id
, repertory_id
;
461 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
467 encoding_id
= XINT (XCAR (val
));
468 repertory_id
= XINT (XCDR (val
));
472 val
= find_font_encoding (SYMBOL_NAME (registry
));
473 if (SYMBOLP (val
) && CHARSETP (val
))
475 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
477 else if (CONSP (val
))
479 if (! CHARSETP (XCAR (val
)))
481 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
482 if (NILP (XCDR (val
)))
486 if (! CHARSETP (XCDR (val
)))
488 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
493 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
495 = nconc2 (font_charset_alist
, list1 (Fcons (registry
, val
)));
499 *encoding
= CHARSET_FROM_ID (encoding_id
);
501 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
506 = nconc2 (font_charset_alist
, list1 (Fcons (registry
, Qnil
)));
511 /* Font property value validators. See the comment of
512 font_property_table for the meaning of the arguments. */
514 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
515 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
516 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
517 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
518 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
519 static int get_font_prop_index (Lisp_Object
);
522 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
525 val
= Fintern (val
, Qnil
);
528 else if (EQ (prop
, QCregistry
))
529 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
535 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
537 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
538 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
542 EMACS_INT n
= XINT (val
);
543 CHECK_VECTOR (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
));
545 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
549 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
552 if ((n
& 0xF) + 1 >= ASIZE (elt
))
556 CHECK_NUMBER (AREF (elt
, 0));
557 if (XINT (AREF (elt
, 0)) != (n
>> 8))
562 else if (SYMBOLP (val
))
564 int n
= font_style_to_value (prop
, val
, 0);
566 val
= n
>= 0 ? make_number (n
) : Qerror
;
574 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
576 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
581 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
583 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
585 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
587 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
589 if (spacing
== 'c' || spacing
== 'C')
590 return make_number (FONT_SPACING_CHARCELL
);
591 if (spacing
== 'm' || spacing
== 'M')
592 return make_number (FONT_SPACING_MONO
);
593 if (spacing
== 'p' || spacing
== 'P')
594 return make_number (FONT_SPACING_PROPORTIONAL
);
595 if (spacing
== 'd' || spacing
== 'D')
596 return make_number (FONT_SPACING_DUAL
);
602 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
604 Lisp_Object tail
, tmp
;
607 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
608 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
609 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
612 if (! SYMBOLP (XCAR (val
)))
617 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
619 for (i
= 0; i
< 2; i
++)
626 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
627 if (! SYMBOLP (XCAR (tmp
)))
635 /* Structure of known font property keys and validator of the
639 /* Pointer to the key symbol. */
641 /* Function to validate PROP's value VAL, or NULL if any value is
642 ok. The value is VAL or its regularized value if VAL is valid,
643 and Qerror if not. */
644 Lisp_Object (*validator
) (Lisp_Object prop
, Lisp_Object val
);
645 } font_property_table
[] =
646 { { &QCtype
, font_prop_validate_symbol
},
647 { &QCfoundry
, font_prop_validate_symbol
},
648 { &QCfamily
, font_prop_validate_symbol
},
649 { &QCadstyle
, font_prop_validate_symbol
},
650 { &QCregistry
, font_prop_validate_symbol
},
651 { &QCweight
, font_prop_validate_style
},
652 { &QCslant
, font_prop_validate_style
},
653 { &QCwidth
, font_prop_validate_style
},
654 { &QCsize
, font_prop_validate_non_neg
},
655 { &QCdpi
, font_prop_validate_non_neg
},
656 { &QCspacing
, font_prop_validate_spacing
},
657 { &QCavgwidth
, font_prop_validate_non_neg
},
658 /* The order of the above entries must match with enum
659 font_property_index. */
660 { &QClang
, font_prop_validate_symbol
},
661 { &QCscript
, font_prop_validate_symbol
},
662 { &QCotf
, font_prop_validate_otf
}
665 /* Size (number of elements) of the above table. */
666 #define FONT_PROPERTY_TABLE_SIZE \
667 ((sizeof font_property_table) / (sizeof *font_property_table))
669 /* Return an index number of font property KEY or -1 if KEY is not an
670 already known property. */
673 get_font_prop_index (Lisp_Object key
)
677 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
678 if (EQ (key
, *font_property_table
[i
].key
))
683 /* Validate the font property. The property key is specified by the
684 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
685 signal an error. The value is VAL or the regularized one. */
688 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
690 Lisp_Object validated
;
695 prop
= *font_property_table
[idx
].key
;
698 idx
= get_font_prop_index (prop
);
702 validated
= (font_property_table
[idx
].validator
) (prop
, val
);
703 if (EQ (validated
, Qerror
))
704 signal_error ("invalid font property", Fcons (prop
, val
));
709 /* Store VAL as a value of extra font property PROP in FONT while
710 keeping the sorting order. Don't check the validity of VAL. */
713 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
715 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
716 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
720 Lisp_Object prev
= Qnil
;
723 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
724 prev
= extra
, extra
= XCDR (extra
);
727 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
729 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
735 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
740 /* Font name parser and unparser. */
742 static int parse_matrix (const char *);
743 static int font_expand_wildcards (Lisp_Object
*, int);
744 static int font_parse_name (char *, ptrdiff_t, Lisp_Object
);
746 /* An enumerator for each field of an XLFD font name. */
747 enum xlfd_field_index
766 /* An enumerator for mask bit corresponding to each XLFD field. */
769 XLFD_FOUNDRY_MASK
= 0x0001,
770 XLFD_FAMILY_MASK
= 0x0002,
771 XLFD_WEIGHT_MASK
= 0x0004,
772 XLFD_SLANT_MASK
= 0x0008,
773 XLFD_SWIDTH_MASK
= 0x0010,
774 XLFD_ADSTYLE_MASK
= 0x0020,
775 XLFD_PIXEL_MASK
= 0x0040,
776 XLFD_POINT_MASK
= 0x0080,
777 XLFD_RESX_MASK
= 0x0100,
778 XLFD_RESY_MASK
= 0x0200,
779 XLFD_SPACING_MASK
= 0x0400,
780 XLFD_AVGWIDTH_MASK
= 0x0800,
781 XLFD_REGISTRY_MASK
= 0x1000,
782 XLFD_ENCODING_MASK
= 0x2000
786 /* Parse P pointing to the pixel/point size field of the form
787 `[A B C D]' which specifies a transformation matrix:
793 by which all glyphs of the font are transformed. The spec says
794 that scalar value N for the pixel/point size is equivalent to:
795 A = N * resx/resy, B = C = 0, D = N.
797 Return the scalar value N if the form is valid. Otherwise return
801 parse_matrix (const char *p
)
807 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
810 matrix
[i
] = - strtod (p
+ 1, &end
);
812 matrix
[i
] = strtod (p
, &end
);
815 return (i
== 4 ? (int) matrix
[3] : -1);
818 /* Expand a wildcard field in FIELD (the first N fields are filled) to
819 multiple fields to fill in all 14 XLFD fields while restricting a
820 field position by its contents. */
823 font_expand_wildcards (Lisp_Object
*field
, int n
)
826 Lisp_Object tmp
[XLFD_LAST_INDEX
];
827 /* Array of information about where this element can go. Nth
828 element is for Nth element of FIELD. */
830 /* Minimum possible field. */
832 /* Maximum possible field. */
834 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
836 } range
[XLFD_LAST_INDEX
];
838 int range_from
, range_to
;
841 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
842 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
843 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
844 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
845 | XLFD_AVGWIDTH_MASK)
846 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
848 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
849 field. The value is shifted to left one bit by one in the
851 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
852 range_mask
= (range_mask
<< 1) | 1;
854 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
855 position-based restriction for FIELD[I]. */
856 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
857 i
++, range_from
++, range_to
++, range_mask
<<= 1)
859 Lisp_Object val
= field
[i
];
865 range
[i
].from
= range_from
;
866 range
[i
].to
= range_to
;
867 range
[i
].mask
= range_mask
;
871 /* The triplet FROM, TO, and MASK is a value-based
872 restriction for FIELD[I]. */
878 EMACS_INT numeric
= XINT (val
);
881 from
= to
= XLFD_ENCODING_INDEX
,
882 mask
= XLFD_ENCODING_MASK
;
883 else if (numeric
== 0)
884 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
885 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
886 else if (numeric
<= 48)
887 from
= to
= XLFD_PIXEL_INDEX
,
888 mask
= XLFD_PIXEL_MASK
;
890 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
891 mask
= XLFD_LARGENUM_MASK
;
893 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
894 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
895 mask
= XLFD_NULL_MASK
;
897 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
900 Lisp_Object name
= SYMBOL_NAME (val
);
902 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
903 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
904 mask
= XLFD_REGENC_MASK
;
906 from
= to
= XLFD_ENCODING_INDEX
,
907 mask
= XLFD_ENCODING_MASK
;
909 else if (range_from
<= XLFD_WEIGHT_INDEX
910 && range_to
>= XLFD_WEIGHT_INDEX
911 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
912 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
913 else if (range_from
<= XLFD_SLANT_INDEX
914 && range_to
>= XLFD_SLANT_INDEX
915 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
916 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
917 else if (range_from
<= XLFD_SWIDTH_INDEX
918 && range_to
>= XLFD_SWIDTH_INDEX
919 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
920 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
923 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
924 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
926 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
927 mask
= XLFD_SYMBOL_MASK
;
930 /* Merge position-based and value-based restrictions. */
932 while (from
< range_from
)
933 mask
&= ~(1 << from
++);
934 while (from
< 14 && ! (mask
& (1 << from
)))
936 while (to
> range_to
)
937 mask
&= ~(1 << to
--);
938 while (to
>= 0 && ! (mask
& (1 << to
)))
942 range
[i
].from
= from
;
944 range
[i
].mask
= mask
;
946 if (from
> range_from
|| to
< range_to
)
948 /* The range is narrowed by value-based restrictions.
949 Reflect it to the other fields. */
951 /* Following fields should be after FROM. */
953 /* Preceding fields should be before TO. */
954 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
956 /* Check FROM for non-wildcard field. */
957 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
959 while (range
[j
].from
< from
)
960 range
[j
].mask
&= ~(1 << range
[j
].from
++);
961 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
963 range
[j
].from
= from
;
966 from
= range
[j
].from
;
967 if (range
[j
].to
> to
)
969 while (range
[j
].to
> to
)
970 range
[j
].mask
&= ~(1 << range
[j
].to
--);
971 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
984 /* Decide all fields from restrictions in RANGE. */
985 for (i
= j
= 0; i
< n
; i
++)
987 if (j
< range
[i
].from
)
989 if (i
== 0 || ! NILP (tmp
[i
- 1]))
990 /* None of TMP[X] corresponds to Jth field. */
992 for (; j
< range
[i
].from
; j
++)
997 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
999 for (; j
< XLFD_LAST_INDEX
; j
++)
1001 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
1002 field
[XLFD_ENCODING_INDEX
]
1003 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1008 /* Parse NAME (null terminated) as XLFD and store information in FONT
1009 (font-spec or font-entity). Size property of FONT is set as
1011 specified XLFD fields FONT property
1012 --------------------- -------------
1013 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1014 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1015 POINT_SIZE POINT_SIZE/10 (Lisp float)
1017 If NAME is successfully parsed, return 0. Otherwise return -1.
1019 FONT is usually a font-spec, but when this function is called from
1020 X font backend driver, it is a font-entity. In that case, NAME is
1021 a fully specified XLFD. */
1024 font_parse_xlfd (char *name
, ptrdiff_t len
, Lisp_Object font
)
1027 char *f
[XLFD_LAST_INDEX
+ 1];
1031 if (len
> 255 || !len
)
1032 /* Maximum XLFD name length is 255. */
1034 /* Accept "*-.." as a fully specified XLFD. */
1035 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1036 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1039 for (p
= name
+ i
; *p
; p
++)
1043 if (i
== XLFD_LAST_INDEX
)
1048 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1049 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1051 if (i
== XLFD_LAST_INDEX
)
1053 /* Fully specified XLFD. */
1056 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1057 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1058 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1059 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1061 val
= INTERN_FIELD_SYM (i
);
1064 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1066 ASET (font
, j
, make_number (n
));
1069 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1070 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1071 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1073 ASET (font
, FONT_REGISTRY_INDEX
,
1074 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1075 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1077 p
= f
[XLFD_PIXEL_INDEX
];
1078 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1079 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1082 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1084 ASET (font
, FONT_SIZE_INDEX
, val
);
1085 else if (FONT_ENTITY_P (font
))
1089 double point_size
= -1;
1091 eassert (FONT_SPEC_P (font
));
1092 p
= f
[XLFD_POINT_INDEX
];
1094 point_size
= parse_matrix (p
);
1095 else if (c_isdigit (*p
))
1096 point_size
= atoi (p
), point_size
/= 10;
1097 if (point_size
>= 0)
1098 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1102 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1103 if (! NILP (val
) && ! INTEGERP (val
))
1105 ASET (font
, FONT_DPI_INDEX
, val
);
1106 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1109 val
= font_prop_validate_spacing (QCspacing
, val
);
1110 if (! INTEGERP (val
))
1112 ASET (font
, FONT_SPACING_INDEX
, val
);
1114 p
= f
[XLFD_AVGWIDTH_INDEX
];
1117 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1118 if (! NILP (val
) && ! INTEGERP (val
))
1120 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1124 bool wild_card_found
= 0;
1125 Lisp_Object prop
[XLFD_LAST_INDEX
];
1127 if (FONT_ENTITY_P (font
))
1129 for (j
= 0; j
< i
; j
++)
1133 if (f
[j
][1] && f
[j
][1] != '-')
1136 wild_card_found
= 1;
1139 prop
[j
] = INTERN_FIELD (j
);
1141 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1143 if (! wild_card_found
)
1145 if (font_expand_wildcards (prop
, i
) < 0)
1148 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1149 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1150 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1151 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1152 if (! NILP (prop
[i
]))
1154 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1156 ASET (font
, j
, make_number (n
));
1158 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1159 val
= prop
[XLFD_REGISTRY_INDEX
];
1162 val
= prop
[XLFD_ENCODING_INDEX
];
1164 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1166 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1167 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1169 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1170 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1172 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1174 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1175 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1176 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1178 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1180 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1183 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1184 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1185 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1187 val
= font_prop_validate_spacing (QCspacing
,
1188 prop
[XLFD_SPACING_INDEX
]);
1189 if (! INTEGERP (val
))
1191 ASET (font
, FONT_SPACING_INDEX
, val
);
1193 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1194 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1200 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1201 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1202 0, use PIXEL_SIZE instead. */
1205 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1208 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1212 eassert (FONTP (font
));
1214 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1217 if (i
== FONT_ADSTYLE_INDEX
)
1218 j
= XLFD_ADSTYLE_INDEX
;
1219 else if (i
== FONT_REGISTRY_INDEX
)
1220 j
= XLFD_REGISTRY_INDEX
;
1221 val
= AREF (font
, i
);
1224 if (j
== XLFD_REGISTRY_INDEX
)
1232 val
= SYMBOL_NAME (val
);
1233 if (j
== XLFD_REGISTRY_INDEX
1234 && ! strchr (SSDATA (val
), '-'))
1236 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1237 ptrdiff_t alloc
= SBYTES (val
) + 4;
1238 if (nbytes
<= alloc
)
1240 f
[j
] = p
= alloca (alloc
);
1241 sprintf (p
, "%s%s-*", SDATA (val
),
1242 &"*"[SDATA (val
)[SBYTES (val
) - 1] == '*']);
1245 f
[j
] = SSDATA (val
);
1249 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1252 val
= font_style_symbolic (font
, i
, 0);
1260 val
= SYMBOL_NAME (val
);
1261 alloc
= SBYTES (val
) + 1;
1262 if (nbytes
<= alloc
)
1264 f
[j
] = p
= alloca (alloc
);
1265 /* Copy the name while excluding '-', '?', ',', and '"'. */
1266 for (k
= l
= 0; k
< alloc
; k
++)
1269 if (c
!= '-' && c
!= '?' && c
!= ',' && c
!= '"')
1275 val
= AREF (font
, FONT_SIZE_INDEX
);
1276 eassert (NUMBERP (val
) || NILP (val
));
1279 EMACS_INT v
= XINT (val
);
1284 f
[XLFD_PIXEL_INDEX
] = p
=
1285 alloca (sizeof "-*" + INT_STRLEN_BOUND (EMACS_INT
));
1286 sprintf (p
, "%"pI
"d-*", v
);
1289 f
[XLFD_PIXEL_INDEX
] = "*-*";
1291 else if (FLOATP (val
))
1293 double v
= XFLOAT_DATA (val
) * 10;
1294 f
[XLFD_PIXEL_INDEX
] = p
= alloca (sizeof "*-" + 1 + DBL_MAX_10_EXP
+ 1);
1295 sprintf (p
, "*-%.0f", v
);
1298 f
[XLFD_PIXEL_INDEX
] = "*-*";
1300 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1302 EMACS_INT v
= XINT (AREF (font
, FONT_DPI_INDEX
));
1303 f
[XLFD_RESX_INDEX
] = p
=
1304 alloca (sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT
));
1305 sprintf (p
, "%"pI
"d-%"pI
"d", v
, v
);
1308 f
[XLFD_RESX_INDEX
] = "*-*";
1309 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1311 EMACS_INT spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1313 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1314 : spacing
<= FONT_SPACING_DUAL
? "d"
1315 : spacing
<= FONT_SPACING_MONO
? "m"
1319 f
[XLFD_SPACING_INDEX
] = "*";
1320 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1322 f
[XLFD_AVGWIDTH_INDEX
] = p
= alloca (INT_BUFSIZE_BOUND (EMACS_INT
));
1323 sprintf (p
, "%"pI
"d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)));
1326 f
[XLFD_AVGWIDTH_INDEX
] = "*";
1327 len
= snprintf (name
, nbytes
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1328 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1329 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1330 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1331 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1332 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1333 f
[XLFD_REGISTRY_INDEX
]);
1334 return len
< nbytes
? len
: -1;
1337 /* Parse NAME (null terminated) and store information in FONT
1338 (font-spec or font-entity). NAME is supplied in either the
1339 Fontconfig or GTK font name format. If NAME is successfully
1340 parsed, return 0. Otherwise return -1.
1342 The fontconfig format is
1344 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1348 FAMILY [PROPS...] [SIZE]
1350 This function tries to guess which format it is. */
1353 font_parse_fcname (char *name
, ptrdiff_t len
, Lisp_Object font
)
1356 char *size_beg
= NULL
, *size_end
= NULL
;
1357 char *props_beg
= NULL
, *family_end
= NULL
;
1362 for (p
= name
; *p
; p
++)
1364 if (*p
== '\\' && p
[1])
1368 props_beg
= family_end
= p
;
1373 bool decimal
= 0, size_found
= 1;
1374 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1375 if (! c_isdigit (*q
))
1377 if (*q
!= '.' || decimal
)
1396 Lisp_Object extra_props
= Qnil
;
1398 /* A fontconfig name with size and/or property data. */
1399 if (family_end
> name
)
1402 family
= font_intern_prop (name
, family_end
- name
, 1);
1403 ASET (font
, FONT_FAMILY_INDEX
, family
);
1407 double point_size
= strtod (size_beg
, &size_end
);
1408 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1409 if (*size_end
== ':' && size_end
[1])
1410 props_beg
= size_end
;
1414 /* Now parse ":KEY=VAL" patterns. */
1417 for (p
= props_beg
; *p
; p
= q
)
1419 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1422 /* Must be an enumerated value. */
1426 val
= font_intern_prop (p
, q
- p
, 1);
1428 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1429 && memcmp (p, STR, strlen (STR)) == 0)
1431 if (PROP_MATCH ("light")
1432 || PROP_MATCH ("medium")
1433 || PROP_MATCH ("demibold")
1434 || PROP_MATCH ("bold")
1435 || PROP_MATCH ("black"))
1436 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1437 else if (PROP_MATCH ("roman")
1438 || PROP_MATCH ("italic")
1439 || PROP_MATCH ("oblique"))
1440 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1441 else if (PROP_MATCH ("charcell"))
1442 ASET (font
, FONT_SPACING_INDEX
,
1443 make_number (FONT_SPACING_CHARCELL
));
1444 else if (PROP_MATCH ("mono"))
1445 ASET (font
, FONT_SPACING_INDEX
,
1446 make_number (FONT_SPACING_MONO
));
1447 else if (PROP_MATCH ("proportional"))
1448 ASET (font
, FONT_SPACING_INDEX
,
1449 make_number (FONT_SPACING_PROPORTIONAL
));
1458 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1459 prop
= FONT_SIZE_INDEX
;
1462 key
= font_intern_prop (p
, q
- p
, 1);
1463 prop
= get_font_prop_index (key
);
1467 for (q
= p
; *q
&& *q
!= ':'; q
++);
1468 val
= font_intern_prop (p
, q
- p
, 0);
1470 if (prop
>= FONT_FOUNDRY_INDEX
1471 && prop
< FONT_EXTRA_INDEX
)
1472 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1475 extra_props
= nconc2 (extra_props
,
1476 list1 (Fcons (key
, val
)));
1483 if (! NILP (extra_props
))
1485 struct font_driver_list
*driver_list
= font_driver_list
;
1486 for ( ; driver_list
; driver_list
= driver_list
->next
)
1487 if (driver_list
->driver
->filter_properties
)
1488 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1494 /* Either a fontconfig-style name with no size and property
1495 data, or a GTK-style name. */
1496 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1497 Lisp_Object width
= Qnil
, size
= Qnil
;
1501 /* Scan backwards from the end, looking for a size. */
1502 for (p
= name
+ len
- 1; p
>= name
; p
--)
1503 if (!c_isdigit (*p
))
1506 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1507 /* Found a font size. */
1508 size
= make_float (strtod (p
+ 1, NULL
));
1512 /* Now P points to the termination of the string, sans size.
1513 Scan backwards, looking for font properties. */
1514 for (; p
> name
; p
= q
)
1516 for (q
= p
- 1; q
>= name
; q
--)
1518 if (q
> name
&& *(q
-1) == '\\')
1519 --q
; /* Skip quoting backslashes. */
1525 word_len
= p
- word_start
;
1527 #define PROP_MATCH(STR) \
1528 (word_len == strlen (STR) \
1529 && memcmp (word_start, STR, strlen (STR)) == 0)
1530 #define PROP_SAVE(VAR, STR) \
1531 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1533 if (PROP_MATCH ("Ultra-Light"))
1534 PROP_SAVE (weight
, "ultra-light");
1535 else if (PROP_MATCH ("Light"))
1536 PROP_SAVE (weight
, "light");
1537 else if (PROP_MATCH ("Book"))
1538 PROP_SAVE (weight
, "book");
1539 else if (PROP_MATCH ("Medium"))
1540 PROP_SAVE (weight
, "medium");
1541 else if (PROP_MATCH ("Semi-Bold"))
1542 PROP_SAVE (weight
, "semi-bold");
1543 else if (PROP_MATCH ("Bold"))
1544 PROP_SAVE (weight
, "bold");
1545 else if (PROP_MATCH ("Italic"))
1546 PROP_SAVE (slant
, "italic");
1547 else if (PROP_MATCH ("Oblique"))
1548 PROP_SAVE (slant
, "oblique");
1549 else if (PROP_MATCH ("Semi-Condensed"))
1550 PROP_SAVE (width
, "semi-condensed");
1551 else if (PROP_MATCH ("Condensed"))
1552 PROP_SAVE (width
, "condensed");
1553 /* An unknown word must be part of the font name. */
1564 ASET (font
, FONT_FAMILY_INDEX
,
1565 font_intern_prop (name
, family_end
- name
, 1));
1567 ASET (font
, FONT_SIZE_INDEX
, size
);
1569 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1571 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1573 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1579 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1580 NAME (NBYTES length), and return the name length. If
1581 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1584 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1586 Lisp_Object family
, foundry
;
1592 Lisp_Object styles
[3];
1593 const char *style_names
[3] = { "weight", "slant", "width" };
1595 family
= AREF (font
, FONT_FAMILY_INDEX
);
1596 if (! NILP (family
))
1598 if (SYMBOLP (family
))
1599 family
= SYMBOL_NAME (family
);
1604 val
= AREF (font
, FONT_SIZE_INDEX
);
1607 if (XINT (val
) != 0)
1608 pixel_size
= XINT (val
);
1613 eassert (FLOATP (val
));
1615 point_size
= (int) XFLOAT_DATA (val
);
1618 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1619 if (! NILP (foundry
))
1621 if (SYMBOLP (foundry
))
1622 foundry
= SYMBOL_NAME (foundry
);
1627 for (i
= 0; i
< 3; i
++)
1628 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1631 lim
= name
+ nbytes
;
1632 if (! NILP (family
))
1634 int len
= snprintf (p
, lim
- p
, "%s", SSDATA (family
));
1635 if (! (0 <= len
&& len
< lim
- p
))
1641 int len
= snprintf (p
, lim
- p
, &"-%d"[p
== name
], point_size
);
1642 if (! (0 <= len
&& len
< lim
- p
))
1646 else if (pixel_size
> 0)
1648 int len
= snprintf (p
, lim
- p
, ":pixelsize=%d", pixel_size
);
1649 if (! (0 <= len
&& len
< lim
- p
))
1653 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1655 int len
= snprintf (p
, lim
- p
, ":foundry=%s",
1656 SSDATA (SYMBOL_NAME (AREF (font
,
1657 FONT_FOUNDRY_INDEX
))));
1658 if (! (0 <= len
&& len
< lim
- p
))
1662 for (i
= 0; i
< 3; i
++)
1663 if (! NILP (styles
[i
]))
1665 int len
= snprintf (p
, lim
- p
, ":%s=%s", style_names
[i
],
1666 SSDATA (SYMBOL_NAME (styles
[i
])));
1667 if (! (0 <= len
&& len
< lim
- p
))
1672 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1674 int len
= snprintf (p
, lim
- p
, ":dpi=%"pI
"d",
1675 XINT (AREF (font
, FONT_DPI_INDEX
)));
1676 if (! (0 <= len
&& len
< lim
- p
))
1681 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1683 int len
= snprintf (p
, lim
- p
, ":spacing=%"pI
"d",
1684 XINT (AREF (font
, FONT_SPACING_INDEX
)));
1685 if (! (0 <= len
&& len
< lim
- p
))
1690 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1692 int len
= snprintf (p
, lim
- p
,
1693 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1695 : ":scalable=false"));
1696 if (! (0 <= len
&& len
< lim
- p
))
1704 /* Parse NAME (null terminated) and store information in FONT
1705 (font-spec or font-entity). If NAME is successfully parsed, return
1706 0. Otherwise return -1. */
1709 font_parse_name (char *name
, ptrdiff_t namelen
, Lisp_Object font
)
1711 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1712 return font_parse_xlfd (name
, namelen
, font
);
1713 return font_parse_fcname (name
, namelen
, font
);
1717 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1718 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1722 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1728 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1730 CHECK_STRING (family
);
1731 len
= SBYTES (family
);
1732 p0
= SSDATA (family
);
1733 p1
= strchr (p0
, '-');
1736 if ((*p0
!= '*' && p1
- p0
> 0)
1737 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1738 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1741 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1744 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1746 if (! NILP (registry
))
1748 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1749 CHECK_STRING (registry
);
1750 len
= SBYTES (registry
);
1751 p0
= SSDATA (registry
);
1752 p1
= strchr (p0
, '-');
1755 if (SDATA (registry
)[len
- 1] == '*')
1756 registry
= concat2 (registry
, build_string ("-*"));
1758 registry
= concat2 (registry
, build_string ("*-*"));
1760 registry
= Fdowncase (registry
);
1761 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1766 /* This part (through the next ^L) is still experimental and not
1767 tested much. We may drastically change codes. */
1773 #define LGSTRING_HEADER_SIZE 6
1774 #define LGSTRING_GLYPH_SIZE 8
1777 check_gstring (Lisp_Object gstring
)
1783 CHECK_VECTOR (gstring
);
1784 val
= AREF (gstring
, 0);
1786 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1788 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1789 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1790 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1791 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1792 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1793 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1794 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1795 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1796 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1797 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1798 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1800 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1802 val
= LGSTRING_GLYPH (gstring
, i
);
1804 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1806 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1808 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1809 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1810 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1811 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1812 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1813 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1814 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1815 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1817 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1819 if (ASIZE (val
) < 3)
1821 for (j
= 0; j
< 3; j
++)
1822 CHECK_NUMBER (AREF (val
, j
));
1827 error ("Invalid glyph-string format");
1832 check_otf_features (Lisp_Object otf_features
)
1836 CHECK_CONS (otf_features
);
1837 CHECK_SYMBOL (XCAR (otf_features
));
1838 otf_features
= XCDR (otf_features
);
1839 CHECK_CONS (otf_features
);
1840 CHECK_SYMBOL (XCAR (otf_features
));
1841 otf_features
= XCDR (otf_features
);
1842 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1844 CHECK_SYMBOL (XCAR (val
));
1845 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1846 error ("Invalid OTF GSUB feature: %s",
1847 SDATA (SYMBOL_NAME (XCAR (val
))));
1849 otf_features
= XCDR (otf_features
);
1850 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1852 CHECK_SYMBOL (XCAR (val
));
1853 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1854 error ("Invalid OTF GPOS feature: %s",
1855 SDATA (SYMBOL_NAME (XCAR (val
))));
1862 Lisp_Object otf_list
;
1865 otf_tag_symbol (OTF_Tag tag
)
1869 OTF_tag_name (tag
, name
);
1870 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1874 otf_open (Lisp_Object file
)
1876 Lisp_Object val
= Fassoc (file
, otf_list
);
1880 otf
= XSAVE_POINTER (XCDR (val
), 0);
1883 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1884 val
= make_save_ptr (otf
);
1885 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1891 /* Return a list describing which scripts/languages FONT supports by
1892 which GSUB/GPOS features of OpenType tables. See the comment of
1893 (struct font_driver).otf_capability. */
1896 font_otf_capability (struct font
*font
)
1899 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1902 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1905 for (i
= 0; i
< 2; i
++)
1907 OTF_GSUB_GPOS
*gsub_gpos
;
1908 Lisp_Object script_list
= Qnil
;
1911 if (OTF_get_features (otf
, i
== 0) < 0)
1913 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1914 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1916 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1917 Lisp_Object langsys_list
= Qnil
;
1918 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1921 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1923 OTF_LangSys
*langsys
;
1924 Lisp_Object feature_list
= Qnil
;
1925 Lisp_Object langsys_tag
;
1928 if (k
== script
->LangSysCount
)
1930 langsys
= &script
->DefaultLangSys
;
1935 langsys
= script
->LangSys
+ k
;
1937 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1939 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1941 OTF_Feature
*feature
1942 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1943 Lisp_Object feature_tag
1944 = otf_tag_symbol (feature
->FeatureTag
);
1946 feature_list
= Fcons (feature_tag
, feature_list
);
1948 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1951 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1956 XSETCAR (capability
, script_list
);
1958 XSETCDR (capability
, script_list
);
1964 /* Parse OTF features in SPEC and write a proper features spec string
1965 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1966 assured that the sufficient memory has already allocated for
1970 generate_otf_features (Lisp_Object spec
, char *features
)
1978 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1984 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1989 else if (! asterisk
)
1991 val
= SYMBOL_NAME (val
);
1992 p
+= esprintf (p
, "%s", SDATA (val
));
1996 val
= SYMBOL_NAME (val
);
1997 p
+= esprintf (p
, "~%s", SDATA (val
));
2001 error ("OTF spec too long");
2005 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
2007 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2009 return Fcons (make_number (len
),
2010 make_unibyte_string (device_table
->DeltaValue
, len
));
2014 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
2016 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2018 if (value_format
& OTF_XPlacement
)
2019 ASET (val
, 0, make_number (value_record
->XPlacement
));
2020 if (value_format
& OTF_YPlacement
)
2021 ASET (val
, 1, make_number (value_record
->YPlacement
));
2022 if (value_format
& OTF_XAdvance
)
2023 ASET (val
, 2, make_number (value_record
->XAdvance
));
2024 if (value_format
& OTF_YAdvance
)
2025 ASET (val
, 3, make_number (value_record
->YAdvance
));
2026 if (value_format
& OTF_XPlaDevice
)
2027 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2028 if (value_format
& OTF_YPlaDevice
)
2029 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2030 if (value_format
& OTF_XAdvDevice
)
2031 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2032 if (value_format
& OTF_YAdvDevice
)
2033 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2038 font_otf_Anchor (OTF_Anchor
*anchor
)
2042 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2043 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2044 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2045 if (anchor
->AnchorFormat
== 2)
2046 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2049 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2050 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2054 #endif /* HAVE_LIBOTF */
2061 font_rescale_ratio (Lisp_Object font_entity
)
2063 Lisp_Object tail
, elt
;
2064 Lisp_Object name
= Qnil
;
2066 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2069 if (FLOATP (XCDR (elt
)))
2071 if (STRINGP (XCAR (elt
)))
2074 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2075 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2076 return XFLOAT_DATA (XCDR (elt
));
2078 else if (FONT_SPEC_P (XCAR (elt
)))
2080 if (font_match_p (XCAR (elt
), font_entity
))
2081 return XFLOAT_DATA (XCDR (elt
));
2088 /* We sort fonts by scoring each of them against a specified
2089 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2090 the value is, the closer the font is to the font-spec.
2092 The lowest 2 bits of the score are used for driver type. The font
2093 available by the most preferred font driver is 0.
2095 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2096 WEIGHT, SLANT, WIDTH, and SIZE. */
2098 /* How many bits to shift to store the difference value of each font
2099 property in a score. Note that floats for FONT_TYPE_INDEX and
2100 FONT_REGISTRY_INDEX are not used. */
2101 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2103 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2104 The return value indicates how different ENTITY is compared with
2108 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2113 /* Score three style numeric fields. Maximum difference is 127. */
2114 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2115 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2117 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2118 - (XINT (spec_prop
[i
]) >> 8));
2119 score
|= min (eabs (diff
), 127) << sort_shift_bits
[i
];
2122 /* Score the size. Maximum difference is 127. */
2123 i
= FONT_SIZE_INDEX
;
2124 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2125 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2127 /* We use the higher 6-bit for the actual size difference. The
2128 lowest bit is set if the DPI is different. */
2130 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2132 if (CONSP (Vface_font_rescale_alist
))
2133 pixel_size
*= font_rescale_ratio (entity
);
2134 diff
= eabs (pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
))) << 1;
2135 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2136 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2138 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2139 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2141 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2148 /* Concatenate all elements of LIST into one vector. LIST is a list
2149 of font-entity vectors. */
2152 font_vconcat_entity_vectors (Lisp_Object list
)
2154 int nargs
= XINT (Flength (list
));
2155 Lisp_Object
*args
= alloca (word_size
* nargs
);
2158 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2159 args
[i
] = XCAR (list
);
2160 return Fvconcat (nargs
, args
);
2164 /* The structure for elements being sorted by qsort. */
2165 struct font_sort_data
2168 int font_driver_preference
;
2173 /* The comparison function for qsort. */
2176 font_compare (const void *d1
, const void *d2
)
2178 const struct font_sort_data
*data1
= d1
;
2179 const struct font_sort_data
*data2
= d2
;
2181 if (data1
->score
< data2
->score
)
2183 else if (data1
->score
> data2
->score
)
2185 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2189 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2190 If PREFER specifies a point-size, calculate the corresponding
2191 pixel-size from QCdpi property of PREFER or from the Y-resolution
2192 of FRAME before sorting.
2194 If BEST-ONLY is nonzero, return the best matching entity (that
2195 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2196 if BEST-ONLY is negative). Otherwise, return the sorted result as
2197 a single vector of font-entities.
2199 This function does no optimization for the case that the total
2200 number of elements is 1. The caller should avoid calling this in
2204 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
,
2205 struct frame
*f
, int best_only
)
2207 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2209 struct font_sort_data
*data
;
2210 unsigned best_score
;
2211 Lisp_Object best_entity
;
2212 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2215 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2216 prefer_prop
[i
] = AREF (prefer
, i
);
2217 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2218 prefer_prop
[FONT_SIZE_INDEX
]
2219 = make_number (font_pixel_size (f
, prefer
));
2221 if (NILP (XCDR (list
)))
2223 /* What we have to take care of is this single vector. */
2225 maxlen
= ASIZE (vec
);
2229 /* We don't have to perform sort, so there's no need of creating
2230 a single vector. But, we must find the length of the longest
2233 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2234 if (maxlen
< ASIZE (XCAR (tail
)))
2235 maxlen
= ASIZE (XCAR (tail
));
2239 /* We have to create a single vector to sort it. */
2240 vec
= font_vconcat_entity_vectors (list
);
2241 maxlen
= ASIZE (vec
);
2244 data
= SAFE_ALLOCA (maxlen
* sizeof *data
);
2245 best_score
= 0xFFFFFFFF;
2248 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2250 int font_driver_preference
= 0;
2251 Lisp_Object current_font_driver
;
2257 /* We are sure that the length of VEC > 0. */
2258 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2259 /* Score the elements. */
2260 for (i
= 0; i
< len
; i
++)
2262 data
[i
].entity
= AREF (vec
, i
);
2264 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2266 ? font_score (data
[i
].entity
, prefer_prop
)
2268 if (best_only
&& best_score
> data
[i
].score
)
2270 best_score
= data
[i
].score
;
2271 best_entity
= data
[i
].entity
;
2272 if (best_score
== 0)
2275 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2277 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2278 font_driver_preference
++;
2280 data
[i
].font_driver_preference
= font_driver_preference
;
2283 /* Sort if necessary. */
2286 qsort (data
, len
, sizeof *data
, font_compare
);
2287 for (i
= 0; i
< len
; i
++)
2288 ASET (vec
, i
, data
[i
].entity
);
2297 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2302 /* API of Font Service Layer. */
2304 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2305 sort_shift_bits. Finternal_set_font_selection_order calls this
2306 function with font_sort_order after setting up it. */
2309 font_update_sort_order (int *order
)
2313 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2315 int xlfd_idx
= order
[i
];
2317 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2318 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2319 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2320 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2321 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2322 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2324 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2329 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
,
2330 Lisp_Object features
, Lisp_Object table
)
2335 table
= assq_no_quit (script
, table
);
2338 table
= XCDR (table
);
2339 if (! NILP (langsys
))
2341 table
= assq_no_quit (langsys
, table
);
2347 val
= assq_no_quit (Qnil
, table
);
2349 table
= XCAR (table
);
2353 table
= XCDR (table
);
2354 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2356 if (NILP (XCAR (features
)))
2361 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2367 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2370 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2372 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2374 script
= XCAR (spec
);
2378 langsys
= XCAR (spec
);
2389 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2390 XCAR (otf_capability
)))
2392 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2393 XCDR (otf_capability
)))
2400 /* Check if FONT (font-entity or font-object) matches with the font
2401 specification SPEC. */
2404 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2406 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2407 Lisp_Object extra
, font_extra
;
2410 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2411 if (! NILP (AREF (spec
, i
))
2412 && ! NILP (AREF (font
, i
))
2413 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2415 props
= XFONT_SPEC (spec
)->props
;
2416 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2418 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2419 prop
[i
] = AREF (spec
, i
);
2420 prop
[FONT_SIZE_INDEX
]
2421 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2425 if (font_score (font
, props
) > 0)
2427 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2428 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2429 for (; CONSP (extra
); extra
= XCDR (extra
))
2431 Lisp_Object key
= XCAR (XCAR (extra
));
2432 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2434 if (EQ (key
, QClang
))
2436 val2
= assq_no_quit (key
, font_extra
);
2445 if (NILP (Fmemq (val
, val2
)))
2450 ? NILP (Fmemq (val
, XCDR (val2
)))
2454 else if (EQ (key
, QCscript
))
2456 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2462 /* All characters in the list must be supported. */
2463 for (; CONSP (val2
); val2
= XCDR (val2
))
2465 if (! CHARACTERP (XCAR (val2
)))
2467 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2468 == FONT_INVALID_CODE
)
2472 else if (VECTORP (val2
))
2474 /* At most one character in the vector must be supported. */
2475 for (i
= 0; i
< ASIZE (val2
); i
++)
2477 if (! CHARACTERP (AREF (val2
, i
)))
2479 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2480 != FONT_INVALID_CODE
)
2483 if (i
== ASIZE (val2
))
2488 else if (EQ (key
, QCotf
))
2492 if (! FONT_OBJECT_P (font
))
2494 fontp
= XFONT_OBJECT (font
);
2495 if (! fontp
->driver
->otf_capability
)
2497 val2
= fontp
->driver
->otf_capability (fontp
);
2498 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2509 Each font backend has the callback function get_cache, and it
2510 returns a cons cell of which cdr part can be freely used for
2511 caching fonts. The cons cell may be shared by multiple frames
2512 and/or multiple font drivers. So, we arrange the cdr part as this:
2514 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2516 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2517 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2518 cons (FONT-SPEC . [FONT-ENTITY ...]). */
2520 static void font_prepare_cache (struct frame
*, struct font_driver
*);
2521 static void font_finish_cache (struct frame
*, struct font_driver
*);
2522 static Lisp_Object
font_get_cache (struct frame
*, struct font_driver
*);
2523 static void font_clear_cache (struct frame
*, Lisp_Object
,
2524 struct font_driver
*);
2527 font_prepare_cache (struct frame
*f
, struct font_driver
*driver
)
2529 Lisp_Object cache
, val
;
2531 cache
= driver
->get_cache (f
);
2533 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2537 val
= list2 (driver
->type
, make_number (1));
2538 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2542 val
= XCDR (XCAR (val
));
2543 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2549 font_finish_cache (struct frame
*f
, struct font_driver
*driver
)
2551 Lisp_Object cache
, val
, tmp
;
2554 cache
= driver
->get_cache (f
);
2556 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2557 cache
= val
, val
= XCDR (val
);
2558 eassert (! NILP (val
));
2559 tmp
= XCDR (XCAR (val
));
2560 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2561 if (XINT (XCAR (tmp
)) == 0)
2563 font_clear_cache (f
, XCAR (val
), driver
);
2564 XSETCDR (cache
, XCDR (val
));
2570 font_get_cache (struct frame
*f
, struct font_driver
*driver
)
2572 Lisp_Object val
= driver
->get_cache (f
);
2573 Lisp_Object type
= driver
->type
;
2575 eassert (CONSP (val
));
2576 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2577 eassert (CONSP (val
));
2578 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2579 val
= XCDR (XCAR (val
));
2585 font_clear_cache (struct frame
*f
, Lisp_Object cache
, struct font_driver
*driver
)
2587 Lisp_Object tail
, elt
;
2591 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2592 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2595 /* elt should have the form (FONT-SPEC . [FONT-ENTITY ...]) */
2596 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2599 eassert (VECTORP (elt
));
2600 for (i
= 0; i
< ASIZE (elt
); i
++)
2602 entity
= AREF (elt
, i
);
2604 if (FONT_ENTITY_P (entity
)
2605 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2607 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2609 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2611 Lisp_Object val
= XCAR (objlist
);
2612 struct font
*font
= XFONT_OBJECT (val
);
2614 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2616 eassert (font
&& driver
== font
->driver
);
2617 driver
->close (font
);
2620 if (driver
->free_entity
)
2621 driver
->free_entity (entity
);
2626 XSETCDR (cache
, Qnil
);
2630 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2632 /* Check each font-entity in VEC, and return a list of font-entities
2633 that satisfy these conditions:
2634 (1) matches with SPEC and SIZE if SPEC is not nil, and
2635 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2639 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2641 Lisp_Object entity
, val
;
2642 enum font_property_index prop
;
2645 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2647 entity
= AREF (vec
, i
);
2648 if (! NILP (Vface_ignored_fonts
))
2652 Lisp_Object tail
, regexp
;
2654 namelen
= font_unparse_xlfd (entity
, 0, name
, 256);
2657 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2659 regexp
= XCAR (tail
);
2660 if (STRINGP (regexp
)
2661 && fast_c_string_match_ignore_case (regexp
, name
,
2671 val
= Fcons (entity
, val
);
2674 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2675 if (INTEGERP (AREF (spec
, prop
))
2676 && ((XINT (AREF (spec
, prop
)) >> 8)
2677 != (XINT (AREF (entity
, prop
)) >> 8)))
2678 prop
= FONT_SPEC_MAX
;
2679 if (prop
< FONT_SPEC_MAX
2681 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2683 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2685 if (eabs (diff
) > FONT_PIXEL_SIZE_QUANTUM
)
2686 prop
= FONT_SPEC_MAX
;
2688 if (prop
< FONT_SPEC_MAX
2689 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2690 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2691 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2692 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2693 prop
= FONT_SPEC_MAX
;
2694 if (prop
< FONT_SPEC_MAX
2695 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2696 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2697 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2698 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2699 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2700 prop
= FONT_SPEC_MAX
;
2701 if (prop
< FONT_SPEC_MAX
)
2702 val
= Fcons (entity
, val
);
2704 return (Fvconcat (1, &val
));
2708 /* Return a list of vectors of font-entities matching with SPEC on
2709 FRAME. Each elements in the list is a vector of entities from the
2710 same font-driver. */
2713 font_list_entities (struct frame
*f
, Lisp_Object spec
)
2715 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2716 Lisp_Object ftype
, val
;
2717 Lisp_Object list
= Qnil
;
2719 bool need_filtering
= 0;
2722 eassert (FONT_SPEC_P (spec
));
2724 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2725 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2726 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2727 size
= font_pixel_size (f
, spec
);
2731 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2732 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2733 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2734 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2735 if (i
!= FONT_SPACING_INDEX
)
2737 ASET (scratch_font_spec
, i
, Qnil
);
2738 if (! NILP (AREF (spec
, i
)))
2741 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2742 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2744 for (; driver_list
; driver_list
= driver_list
->next
)
2746 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2748 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2750 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2751 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2756 val
= driver_list
->driver
->list (f
, scratch_font_spec
);
2759 Lisp_Object copy
= copy_font_spec (scratch_font_spec
);
2761 val
= Fvconcat (1, &val
);
2762 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2763 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2766 if (VECTORP (val
) && ASIZE (val
) > 0
2768 || ! NILP (Vface_ignored_fonts
)))
2769 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2770 if (VECTORP (val
) && ASIZE (val
) > 0)
2771 list
= Fcons (val
, list
);
2774 list
= Fnreverse (list
);
2775 FONT_ADD_LOG ("list", spec
, list
);
2780 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2781 nil, is an array of face's attributes, which specifies preferred
2782 font-related attributes. */
2785 font_matching_entity (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2787 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2788 Lisp_Object ftype
, size
, entity
;
2789 Lisp_Object work
= copy_font_spec (spec
);
2791 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2792 size
= AREF (spec
, FONT_SIZE_INDEX
);
2795 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2796 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2797 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2798 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2801 for (; driver_list
; driver_list
= driver_list
->next
)
2803 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2805 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 (f
, work
);
2816 Lisp_Object copy
= copy_font_spec (work
);
2817 Lisp_Object match
= Fvector (1, &entity
);
2819 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2820 XSETCDR (cache
, Fcons (Fcons (copy
, match
), XCDR (cache
)));
2823 if (! NILP (entity
))
2826 FONT_ADD_LOG ("match", work
, entity
);
2831 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2832 opened font object. */
2835 font_open_entity (struct frame
*f
, Lisp_Object entity
, int pixel_size
)
2837 struct font_driver_list
*driver_list
;
2838 Lisp_Object objlist
, size
, val
, font_object
;
2840 int min_width
, height
, psize
;
2842 eassert (FONT_ENTITY_P (entity
));
2843 size
= AREF (entity
, FONT_SIZE_INDEX
);
2844 if (XINT (size
) != 0)
2845 pixel_size
= XINT (size
);
2847 val
= AREF (entity
, FONT_TYPE_INDEX
);
2848 for (driver_list
= f
->font_driver_list
;
2849 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2850 driver_list
= driver_list
->next
);
2854 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2855 objlist
= XCDR (objlist
))
2857 Lisp_Object fn
= XCAR (objlist
);
2858 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2859 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2861 if (driver_list
->driver
->cached_font_ok
== NULL
2862 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2867 /* We always open a font of manageable size; i.e non-zero average
2868 width and height. */
2869 for (psize
= pixel_size
; ; psize
++)
2871 font_object
= driver_list
->driver
->open (f
, entity
, psize
);
2872 if (NILP (font_object
))
2874 font
= XFONT_OBJECT (font_object
);
2875 if (font
->average_width
> 0 && font
->height
> 0)
2878 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2879 FONT_ADD_LOG ("open", entity
, font_object
);
2880 ASET (entity
, FONT_OBJLIST_INDEX
,
2881 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2883 font
= XFONT_OBJECT (font_object
);
2884 min_width
= (font
->min_width
? font
->min_width
2885 : font
->average_width
? font
->average_width
2886 : font
->space_width
? font
->space_width
2888 height
= (font
->height
? font
->height
: 1);
2889 #ifdef HAVE_WINDOW_SYSTEM
2890 FRAME_DISPLAY_INFO (f
)->n_fonts
++;
2891 if (FRAME_DISPLAY_INFO (f
)->n_fonts
== 1)
2893 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2894 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2895 f
->fonts_changed
= 1;
2899 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2900 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, f
->fonts_changed
= 1;
2901 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2902 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, f
->fonts_changed
= 1;
2910 /* Close FONT_OBJECT that is opened on frame F. */
2913 font_close_object (struct frame
*f
, Lisp_Object font_object
)
2915 struct font
*font
= XFONT_OBJECT (font_object
);
2917 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2918 /* Already closed. */
2920 FONT_ADD_LOG ("close", font_object
, Qnil
);
2921 font
->driver
->close (font
);
2922 #ifdef HAVE_WINDOW_SYSTEM
2923 eassert (FRAME_DISPLAY_INFO (f
)->n_fonts
);
2924 FRAME_DISPLAY_INFO (f
)->n_fonts
--;
2929 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2930 FONT is a font-entity and it must be opened to check. */
2933 font_has_char (struct frame
*f
, Lisp_Object font
, int c
)
2937 if (FONT_ENTITY_P (font
))
2939 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2940 struct font_driver_list
*driver_list
;
2942 for (driver_list
= f
->font_driver_list
;
2943 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2944 driver_list
= driver_list
->next
);
2947 if (! driver_list
->driver
->has_char
)
2949 return driver_list
->driver
->has_char (font
, c
);
2952 eassert (FONT_OBJECT_P (font
));
2953 fontp
= XFONT_OBJECT (font
);
2954 if (fontp
->driver
->has_char
)
2956 int result
= fontp
->driver
->has_char (font
, c
);
2961 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2965 /* Return the glyph ID of FONT_OBJECT for character C. */
2968 font_encode_char (Lisp_Object font_object
, int c
)
2972 eassert (FONT_OBJECT_P (font_object
));
2973 font
= XFONT_OBJECT (font_object
);
2974 return font
->driver
->encode_char (font
, c
);
2978 /* Return the name of FONT_OBJECT. */
2981 font_get_name (Lisp_Object font_object
)
2983 eassert (FONT_OBJECT_P (font_object
));
2984 return AREF (font_object
, FONT_NAME_INDEX
);
2988 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
2989 could not be parsed by font_parse_name, return Qnil. */
2992 font_spec_from_name (Lisp_Object font_name
)
2994 Lisp_Object spec
= Ffont_spec (0, NULL
);
2996 CHECK_STRING (font_name
);
2997 if (font_parse_name (SSDATA (font_name
), SBYTES (font_name
), spec
) == -1)
2999 font_put_extra (spec
, QCname
, font_name
);
3000 font_put_extra (spec
, QCuser_spec
, font_name
);
3006 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
3008 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3013 if (! NILP (Ffont_get (font
, QCname
)))
3015 font
= copy_font_spec (font
);
3016 font_put_extra (font
, QCname
, Qnil
);
3019 if (NILP (AREF (font
, prop
))
3020 && prop
!= FONT_FAMILY_INDEX
3021 && prop
!= FONT_FOUNDRY_INDEX
3022 && prop
!= FONT_WIDTH_INDEX
3023 && prop
!= FONT_SIZE_INDEX
)
3025 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3026 font
= copy_font_spec (font
);
3027 ASET (font
, prop
, Qnil
);
3028 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3030 if (prop
== FONT_FAMILY_INDEX
)
3032 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3033 /* If we are setting the font family, we must also clear
3034 FONT_WIDTH_INDEX to avoid rejecting families that lack
3035 support for some widths. */
3036 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3038 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3039 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3040 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3041 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3042 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3043 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3045 else if (prop
== FONT_SIZE_INDEX
)
3047 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3048 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3049 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3051 else if (prop
== FONT_WIDTH_INDEX
)
3052 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3053 attrs
[LFACE_FONT_INDEX
] = font
;
3056 /* Select a font from ENTITIES (list of font-entity vectors) that
3057 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3060 font_select_entity (struct frame
*f
, Lisp_Object entities
,
3061 Lisp_Object
*attrs
, int pixel_size
, int c
)
3063 Lisp_Object font_entity
;
3067 if (NILP (XCDR (entities
))
3068 && ASIZE (XCAR (entities
)) == 1)
3070 font_entity
= AREF (XCAR (entities
), 0);
3071 if (c
< 0 || font_has_char (f
, font_entity
, c
) > 0)
3076 /* Sort fonts by properties specified in ATTRS. */
3077 prefer
= scratch_font_prefer
;
3079 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3080 ASET (prefer
, i
, Qnil
);
3081 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3083 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3085 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3086 ASET (prefer
, i
, AREF (face_font
, i
));
3088 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3089 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3090 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3091 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3092 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3093 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3094 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3096 return font_sort_entities (entities
, prefer
, f
, c
);
3099 /* Return a font-entity that satisfies SPEC and is the best match for
3100 face's font related attributes in ATTRS. C, if not negative, is a
3101 character that the entity must support. */
3104 font_find_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3107 Lisp_Object entities
, val
;
3108 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3113 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3114 if (NILP (registry
[0]))
3116 registry
[0] = DEFAULT_ENCODING
;
3117 registry
[1] = Qascii_0
;
3118 registry
[2] = zero_vector
;
3121 registry
[1] = zero_vector
;
3123 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3125 struct charset
*encoding
, *repertory
;
3127 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3128 &encoding
, &repertory
) < 0)
3131 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3133 else if (c
> encoding
->max_char
)
3137 work
= copy_font_spec (spec
);
3138 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3139 pixel_size
= font_pixel_size (f
, spec
);
3140 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3142 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3144 pixel_size
= POINT_TO_PIXEL (pt
/ 10, FRAME_RES_Y (f
));
3148 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3149 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3150 if (! NILP (foundry
[0]))
3151 foundry
[1] = zero_vector
;
3152 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3154 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3155 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3157 foundry
[2] = zero_vector
;
3160 foundry
[0] = Qnil
, foundry
[1] = zero_vector
;
3162 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3163 if (! NILP (adstyle
[0]))
3164 adstyle
[1] = zero_vector
;
3165 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3167 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3169 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3171 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3173 adstyle
[2] = zero_vector
;
3176 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3179 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3182 val
= AREF (work
, FONT_FAMILY_INDEX
);
3183 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3185 val
= attrs
[LFACE_FAMILY_INDEX
];
3186 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3190 family
= alloca ((sizeof family
[0]) * 2);
3192 family
[1] = zero_vector
; /* terminator. */
3197 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3199 if (! NILP (alters
))
3201 EMACS_INT alterslen
= XFASTINT (Flength (alters
));
3202 SAFE_ALLOCA_LISP (family
, alterslen
+ 2);
3203 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3204 family
[i
] = XCAR (alters
);
3205 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3207 family
[i
] = zero_vector
;
3211 family
= alloca ((sizeof family
[0]) * 3);
3214 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3216 family
[i
] = zero_vector
;
3220 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3222 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3223 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3225 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3226 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3228 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3229 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3231 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3232 entities
= font_list_entities (f
, work
);
3233 if (! NILP (entities
))
3235 val
= font_select_entity (f
, entities
,
3236 attrs
, pixel_size
, c
);
3254 font_open_for_lface (struct frame
*f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3258 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3259 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3260 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3263 if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3264 size
= font_pixel_size (f
, spec
);
3268 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3269 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3272 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3273 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3274 eassert (INTEGERP (height
));
3279 size
= POINT_TO_PIXEL (pt
, FRAME_RES_Y (f
));
3283 Lisp_Object ffsize
= get_frame_param (f
, Qfontsize
);
3284 size
= (NUMBERP (ffsize
)
3285 ? POINT_TO_PIXEL (XINT (ffsize
), FRAME_RES_Y (f
)) : 0);
3289 size
*= font_rescale_ratio (entity
);
3292 return font_open_entity (f
, entity
, size
);
3296 /* Find a font that satisfies SPEC and is the best match for
3297 face's attributes in ATTRS on FRAME, and return the opened
3301 font_load_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3303 Lisp_Object entity
, name
;
3305 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3308 /* No font is listed for SPEC, but each font-backend may have
3309 different criteria about "font matching". So, try it. */
3310 entity
= font_matching_entity (f
, attrs
, spec
);
3314 /* Don't lose the original name that was put in initially. We need
3315 it to re-apply the font when font parameters (like hinting or dpi) have
3317 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3320 name
= Ffont_get (spec
, QCuser_spec
);
3321 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3327 /* Make FACE on frame F ready to use the font opened for FACE. */
3330 font_prepare_for_face (struct frame
*f
, struct face
*face
)
3332 if (face
->font
->driver
->prepare_face
)
3333 face
->font
->driver
->prepare_face (f
, face
);
3337 /* Make FACE on frame F stop using the font opened for FACE. */
3340 font_done_for_face (struct frame
*f
, struct face
*face
)
3342 if (face
->font
->driver
->done_face
)
3343 face
->font
->driver
->done_face (f
, face
);
3348 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3349 font is found, return Qnil. */
3352 font_open_by_spec (struct frame
*f
, Lisp_Object spec
)
3354 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3356 /* We set up the default font-related attributes of a face to prefer
3358 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3359 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3360 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3362 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3364 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3366 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3368 return font_load_for_lface (f
, attrs
, spec
);
3372 /* Open a font that matches NAME on frame F. If no proper font is
3373 found, return Qnil. */
3376 font_open_by_name (struct frame
*f
, Lisp_Object name
)
3378 Lisp_Object args
[2];
3379 Lisp_Object spec
, ret
;
3383 spec
= Ffont_spec (2, args
);
3384 ret
= font_open_by_spec (f
, spec
);
3385 /* Do not lose name originally put in. */
3387 font_put_extra (ret
, QCuser_spec
, args
[1]);
3393 /* Register font-driver DRIVER. This function is used in two ways.
3395 The first is with frame F non-NULL. In this case, make DRIVER
3396 available (but not yet activated) on F. All frame creators
3397 (e.g. Fx_create_frame) must call this function at least once with
3398 an available font-driver.
3400 The second is with frame F NULL. In this case, DRIVER is globally
3401 registered in the variable `font_driver_list'. All font-driver
3402 implementations must call this function in its syms_of_XXXX
3403 (e.g. syms_of_xfont). */
3406 register_font_driver (struct font_driver
*driver
, struct frame
*f
)
3408 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3409 struct font_driver_list
*prev
, *list
;
3411 #ifdef HAVE_WINDOW_SYSTEM
3412 if (f
&& ! driver
->draw
)
3413 error ("Unusable font driver for a frame: %s",
3414 SDATA (SYMBOL_NAME (driver
->type
)));
3415 #endif /* HAVE_WINDOW_SYSTEM */
3417 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3418 if (EQ (list
->driver
->type
, driver
->type
))
3419 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3421 list
= xmalloc (sizeof *list
);
3423 list
->driver
= driver
;
3428 f
->font_driver_list
= list
;
3430 font_driver_list
= list
;
3436 free_font_driver_list (struct frame
*f
)
3438 struct font_driver_list
*list
, *next
;
3440 for (list
= f
->font_driver_list
; list
; list
= next
)
3445 f
->font_driver_list
= NULL
;
3449 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3450 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3451 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3453 A caller must free all realized faces if any in advance. The
3454 return value is a list of font backends actually made used on
3458 font_update_drivers (struct frame
*f
, Lisp_Object new_drivers
)
3460 Lisp_Object active_drivers
= Qnil
;
3461 struct font_driver_list
*list
;
3463 /* At first, turn off non-requested drivers, and turn on requested
3465 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3467 struct font_driver
*driver
= list
->driver
;
3468 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3473 if (driver
->end_for_frame
)
3474 driver
->end_for_frame (f
);
3475 font_finish_cache (f
, driver
);
3480 if (! driver
->start_for_frame
3481 || driver
->start_for_frame (f
) == 0)
3483 font_prepare_cache (f
, driver
);
3490 if (NILP (new_drivers
))
3493 if (! EQ (new_drivers
, Qt
))
3495 /* Re-order the driver list according to new_drivers. */
3496 struct font_driver_list
**list_table
, **next
;
3500 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3501 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3503 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3504 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3507 list_table
[i
++] = list
;
3509 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3511 list_table
[i
++] = list
;
3512 list_table
[i
] = NULL
;
3514 next
= &f
->font_driver_list
;
3515 for (i
= 0; list_table
[i
]; i
++)
3517 *next
= list_table
[i
];
3518 next
= &(*next
)->next
;
3522 if (! f
->font_driver_list
->on
)
3523 { /* None of the drivers is enabled: enable them all.
3524 Happens if you set the list of drivers to (xft x) in your .emacs
3525 and then use it under w32 or ns. */
3526 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3528 struct font_driver
*driver
= list
->driver
;
3529 eassert (! list
->on
);
3530 if (! driver
->start_for_frame
3531 || driver
->start_for_frame (f
) == 0)
3533 font_prepare_cache (f
, driver
);
3540 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3542 active_drivers
= nconc2 (active_drivers
, list1 (list
->driver
->type
));
3543 return active_drivers
;
3547 font_put_frame_data (struct frame
*f
, struct font_driver
*driver
, void *data
)
3549 struct font_data_list
*list
, *prev
;
3551 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3552 prev
= list
, list
= list
->next
)
3553 if (list
->driver
== driver
)
3560 prev
->next
= list
->next
;
3562 f
->font_data_list
= list
->next
;
3570 list
= xmalloc (sizeof *list
);
3571 list
->driver
= driver
;
3572 list
->next
= f
->font_data_list
;
3573 f
->font_data_list
= list
;
3581 font_get_frame_data (struct frame
*f
, struct font_driver
*driver
)
3583 struct font_data_list
*list
;
3585 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3586 if (list
->driver
== driver
)
3594 /* Sets attributes on a font. Any properties that appear in ALIST and
3595 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3596 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3597 arrays of strings. This function is intended for use by the font
3598 drivers to implement their specific font_filter_properties. */
3600 font_filter_properties (Lisp_Object font
,
3602 const char *const boolean_properties
[],
3603 const char *const non_boolean_properties
[])
3608 /* Set boolean values to Qt or Qnil. */
3609 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3610 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3612 Lisp_Object key
= XCAR (XCAR (it
));
3613 Lisp_Object val
= XCDR (XCAR (it
));
3614 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3616 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3618 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3619 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3622 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3623 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3624 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3625 || strcmp ("Off", str
) == 0)
3630 Ffont_put (font
, key
, val
);
3634 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3635 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3637 Lisp_Object key
= XCAR (XCAR (it
));
3638 Lisp_Object val
= XCDR (XCAR (it
));
3639 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3640 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3641 Ffont_put (font
, key
, val
);
3646 /* Return the font used to draw character C by FACE at buffer position
3647 POS in window W. If STRING is non-nil, it is a string containing C
3648 at index POS. If C is negative, get C from the current buffer or
3652 font_at (int c
, ptrdiff_t pos
, struct face
*face
, struct window
*w
,
3657 Lisp_Object font_object
;
3659 multibyte
= (NILP (string
)
3660 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3661 : STRING_MULTIBYTE (string
));
3668 ptrdiff_t pos_byte
= CHAR_TO_BYTE (pos
);
3670 c
= FETCH_CHAR (pos_byte
);
3673 c
= FETCH_BYTE (pos
);
3679 multibyte
= STRING_MULTIBYTE (string
);
3682 ptrdiff_t pos_byte
= string_char_to_byte (string
, pos
);
3684 str
= SDATA (string
) + pos_byte
;
3685 c
= STRING_CHAR (str
);
3688 c
= SDATA (string
)[pos
];
3692 f
= XFRAME (w
->frame
);
3693 if (! FRAME_WINDOW_P (f
))
3700 if (STRINGP (string
))
3701 face_id
= face_at_string_position (w
, string
, pos
, 0, &endptr
,
3702 DEFAULT_FACE_ID
, 0);
3704 face_id
= face_at_buffer_position (w
, pos
, &endptr
,
3706 face
= FACE_FROM_ID (f
, face_id
);
3710 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3711 face
= FACE_FROM_ID (f
, face_id
);
3716 XSETFONT (font_object
, face
->font
);
3721 #ifdef HAVE_WINDOW_SYSTEM
3723 /* Check how many characters after character/byte position POS/POS_BYTE
3724 (at most to *LIMIT) can be displayed by the same font in the window W.
3725 FACE, if non-NULL, is the face selected for the character at POS.
3726 If STRING is not nil, it is the string to check instead of the current
3727 buffer. In that case, FACE must be not NULL.
3729 The return value is the font-object for the character at POS.
3730 *LIMIT is set to the position where that font can't be used.
3732 It is assured that the current buffer (or STRING) is multibyte. */
3735 font_range (ptrdiff_t pos
, ptrdiff_t pos_byte
, ptrdiff_t *limit
,
3736 struct window
*w
, struct face
*face
, Lisp_Object string
)
3740 Lisp_Object font_object
= Qnil
;
3748 face_id
= face_at_buffer_position (w
, pos
, &ignore
,
3750 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3756 while (pos
< *limit
)
3758 Lisp_Object category
;
3761 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3763 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3764 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3765 if (INTEGERP (category
)
3766 && (XINT (category
) == UNICODE_CATEGORY_Cf
3767 || CHAR_VARIATION_SELECTOR_P (c
)))
3769 if (NILP (font_object
))
3771 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3772 if (NILP (font_object
))
3776 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3786 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3787 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3788 Return nil otherwise.
3789 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3790 which kind of font it is. It must be one of `font-spec', `font-entity',
3792 (Lisp_Object object
, Lisp_Object extra_type
)
3794 if (NILP (extra_type
))
3795 return (FONTP (object
) ? Qt
: Qnil
);
3796 if (EQ (extra_type
, Qfont_spec
))
3797 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3798 if (EQ (extra_type
, Qfont_entity
))
3799 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3800 if (EQ (extra_type
, Qfont_object
))
3801 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3802 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3805 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3806 doc
: /* Return a newly created font-spec with arguments as properties.
3808 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3809 valid font property name listed below:
3811 `:family', `:weight', `:slant', `:width'
3813 They are the same as face attributes of the same name. See
3814 `set-face-attribute'.
3818 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3822 VALUE must be a string or a symbol specifying the additional
3823 typographic style information of a font, e.g. ``sans''.
3827 VALUE must be a string or a symbol specifying the charset registry and
3828 encoding of a font, e.g. ``iso8859-1''.
3832 VALUE must be a non-negative integer or a floating point number
3833 specifying the font size. It specifies the font size in pixels (if
3834 VALUE is an integer), or in points (if VALUE is a float).
3838 VALUE must be a string of XLFD-style or fontconfig-style font name.
3842 VALUE must be a symbol representing a script that the font must
3843 support. It may be a symbol representing a subgroup of a script
3844 listed in the variable `script-representative-chars'.
3848 VALUE must be a symbol of two-letter ISO-639 language names,
3853 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3854 required OpenType features.
3856 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3857 LANGSYS-TAG: OpenType language system tag symbol,
3858 or nil for the default language system.
3859 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3860 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3862 GSUB and GPOS may contain `nil' element. In such a case, the font
3863 must not have any of the remaining elements.
3865 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3866 be an OpenType font whose GPOS table of `thai' script's default
3867 language system must contain `mark' feature.
3869 usage: (font-spec ARGS...) */)
3870 (ptrdiff_t nargs
, Lisp_Object
*args
)
3872 Lisp_Object spec
= font_make_spec ();
3875 for (i
= 0; i
< nargs
; i
+= 2)
3877 Lisp_Object key
= args
[i
], val
;
3881 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3884 if (EQ (key
, QCname
))
3887 if (font_parse_name (SSDATA (val
), SBYTES (val
), spec
) < 0)
3888 error ("Invalid font name: %s", SSDATA (val
));
3889 font_put_extra (spec
, key
, val
);
3893 int idx
= get_font_prop_index (key
);
3897 val
= font_prop_validate (idx
, Qnil
, val
);
3898 if (idx
< FONT_EXTRA_INDEX
)
3899 ASET (spec
, idx
, val
);
3901 font_put_extra (spec
, key
, val
);
3904 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3910 /* Return a copy of FONT as a font-spec. */
3912 copy_font_spec (Lisp_Object font
)
3914 Lisp_Object new_spec
, tail
, prev
, extra
;
3918 new_spec
= font_make_spec ();
3919 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3920 ASET (new_spec
, i
, AREF (font
, i
));
3921 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
3922 /* We must remove :font-entity property. */
3923 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3924 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3927 extra
= XCDR (extra
);
3929 XSETCDR (prev
, XCDR (tail
));
3932 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3936 /* Merge font-specs FROM and TO, and return a new font-spec.
3937 Every specified property in FROM overrides the corresponding
3940 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3942 Lisp_Object extra
, tail
;
3947 to
= copy_font_spec (to
);
3948 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3949 ASET (to
, i
, AREF (from
, i
));
3950 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3951 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3952 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3954 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3957 XSETCDR (slot
, XCDR (XCAR (tail
)));
3959 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3961 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3965 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3966 doc
: /* Return the value of FONT's property KEY.
3967 FONT is a font-spec, a font-entity, or a font-object.
3968 KEY is any symbol, but these are reserved for specific meanings:
3969 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3970 :size, :name, :script, :otf
3971 See the documentation of `font-spec' for their meanings.
3972 In addition, if FONT is a font-entity or a font-object, values of
3973 :script and :otf are different from those of a font-spec as below:
3975 The value of :script may be a list of scripts that are supported by the font.
3977 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
3978 representing the OpenType features supported by the font by this form:
3979 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3980 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
3982 (Lisp_Object font
, Lisp_Object key
)
3990 idx
= get_font_prop_index (key
);
3991 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3992 return font_style_symbolic (font
, idx
, 0);
3993 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3994 return AREF (font
, idx
);
3995 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
3996 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
3998 struct font
*fontp
= XFONT_OBJECT (font
);
4000 if (fontp
->driver
->otf_capability
)
4001 val
= fontp
->driver
->otf_capability (fontp
);
4003 val
= Fcons (Qnil
, Qnil
);
4010 #ifdef HAVE_WINDOW_SYSTEM
4012 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4013 doc
: /* Return a plist of face attributes generated by FONT.
4014 FONT is a font name, a font-spec, a font-entity, or a font-object.
4015 The return value is a list of the form
4017 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4019 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4020 compatible with `set-face-attribute'. Some of these key-attribute pairs
4021 may be omitted from the list if they are not specified by FONT.
4023 The optional argument FRAME specifies the frame that the face attributes
4024 are to be displayed on. If omitted, the selected frame is used. */)
4025 (Lisp_Object font
, Lisp_Object frame
)
4027 struct frame
*f
= decode_live_frame (frame
);
4028 Lisp_Object plist
[10];
4034 int fontset
= fs_query_fontset (font
, 0);
4035 Lisp_Object name
= font
;
4037 font
= fontset_ascii (fontset
);
4038 font
= font_spec_from_name (name
);
4040 signal_error ("Invalid font name", name
);
4042 else if (! FONTP (font
))
4043 signal_error ("Invalid font object", font
);
4045 val
= AREF (font
, FONT_FAMILY_INDEX
);
4048 plist
[n
++] = QCfamily
;
4049 plist
[n
++] = SYMBOL_NAME (val
);
4052 val
= AREF (font
, FONT_SIZE_INDEX
);
4055 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4056 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : FRAME_RES_Y (f
);
4057 plist
[n
++] = QCheight
;
4058 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4060 else if (FLOATP (val
))
4062 plist
[n
++] = QCheight
;
4063 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4066 val
= FONT_WEIGHT_FOR_FACE (font
);
4069 plist
[n
++] = QCweight
;
4073 val
= FONT_SLANT_FOR_FACE (font
);
4076 plist
[n
++] = QCslant
;
4080 val
= FONT_WIDTH_FOR_FACE (font
);
4083 plist
[n
++] = QCwidth
;
4087 return Flist (n
, plist
);
4092 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4093 doc
: /* Set one property of FONT: give property KEY value VAL.
4094 FONT is a font-spec, a font-entity, or a font-object.
4096 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4097 accepted by the function `font-spec' (which see), VAL must be what
4098 allowed in `font-spec'.
4100 If FONT is a font-entity or a font-object, KEY must not be the one
4101 accepted by `font-spec'. */)
4102 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4106 idx
= get_font_prop_index (prop
);
4107 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4109 CHECK_FONT_SPEC (font
);
4110 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4114 if (EQ (prop
, QCname
)
4115 || EQ (prop
, QCscript
)
4116 || EQ (prop
, QClang
)
4117 || EQ (prop
, QCotf
))
4118 CHECK_FONT_SPEC (font
);
4121 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4126 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4127 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4128 Optional 2nd argument FRAME specifies the target frame.
4129 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4130 Optional 4th argument PREFER, if non-nil, is a font-spec to
4131 control the order of the returned list. Fonts are sorted by
4132 how close they are to PREFER. */)
4133 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4135 struct frame
*f
= decode_live_frame (frame
);
4136 Lisp_Object vec
, list
;
4139 CHECK_FONT_SPEC (font_spec
);
4147 if (! NILP (prefer
))
4148 CHECK_FONT_SPEC (prefer
);
4150 list
= font_list_entities (f
, font_spec
);
4153 if (NILP (XCDR (list
))
4154 && ASIZE (XCAR (list
)) == 1)
4155 return list1 (AREF (XCAR (list
), 0));
4157 if (! NILP (prefer
))
4158 vec
= font_sort_entities (list
, prefer
, f
, 0);
4160 vec
= font_vconcat_entity_vectors (list
);
4161 if (n
== 0 || n
>= ASIZE (vec
))
4163 Lisp_Object args
[2];
4167 list
= Fappend (2, args
);
4171 for (list
= Qnil
, n
--; n
>= 0; n
--)
4172 list
= Fcons (AREF (vec
, n
), list
);
4177 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4178 doc
: /* List available font families on the current frame.
4179 If FRAME is omitted or nil, the selected frame is used. */)
4182 struct frame
*f
= decode_live_frame (frame
);
4183 struct font_driver_list
*driver_list
;
4184 Lisp_Object list
= Qnil
;
4186 for (driver_list
= f
->font_driver_list
; driver_list
;
4187 driver_list
= driver_list
->next
)
4188 if (driver_list
->driver
->list_family
)
4190 Lisp_Object val
= driver_list
->driver
->list_family (f
);
4191 Lisp_Object tail
= list
;
4193 for (; CONSP (val
); val
= XCDR (val
))
4194 if (NILP (Fmemq (XCAR (val
), tail
))
4195 && SYMBOLP (XCAR (val
)))
4196 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4201 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4202 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4203 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4204 (Lisp_Object font_spec
, Lisp_Object frame
)
4206 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4213 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4214 doc
: /* Return XLFD name of FONT.
4215 FONT is a font-spec, font-entity, or font-object.
4216 If the name is too long for XLFD (maximum 255 chars), return nil.
4217 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4218 the consecutive wildcards are folded into one. */)
4219 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4222 int namelen
, pixel_size
= 0;
4226 if (FONT_OBJECT_P (font
))
4228 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4230 if (STRINGP (font_name
)
4231 && SDATA (font_name
)[0] == '-')
4233 if (NILP (fold_wildcards
))
4235 strcpy (name
, SSDATA (font_name
));
4236 namelen
= SBYTES (font_name
);
4239 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4241 namelen
= font_unparse_xlfd (font
, pixel_size
, name
, 256);
4245 if (! NILP (fold_wildcards
))
4247 char *p0
= name
, *p1
;
4249 while ((p1
= strstr (p0
, "-*-*")))
4251 strcpy (p1
, p1
+ 2);
4257 return make_string (name
, namelen
);
4261 clear_font_cache (struct frame
*f
)
4263 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4265 for (; driver_list
; driver_list
= driver_list
->next
)
4266 if (driver_list
->on
)
4268 Lisp_Object val
, tmp
, cache
= driver_list
->driver
->get_cache (f
);
4272 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4274 eassert (! NILP (val
));
4275 tmp
= XCDR (XCAR (val
));
4276 if (XINT (XCAR (tmp
)) == 0)
4278 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4279 XSETCDR (cache
, XCDR (val
));
4284 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4285 doc
: /* Clear font cache of each frame. */)
4288 Lisp_Object list
, frame
;
4290 FOR_EACH_FRAME (list
, frame
)
4291 clear_font_cache (XFRAME (frame
));
4298 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4300 struct font
*font
= XFONT_OBJECT (font_object
);
4301 unsigned code
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4302 struct font_metrics metrics
;
4304 LGLYPH_SET_CODE (glyph
, code
);
4305 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4306 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4307 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4308 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4309 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4310 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4314 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4315 doc
: /* Shape the glyph-string GSTRING.
4316 Shaping means substituting glyphs and/or adjusting positions of glyphs
4317 to get the correct visual image of character sequences set in the
4318 header of the glyph-string.
4320 If the shaping was successful, the value is GSTRING itself or a newly
4321 created glyph-string. Otherwise, the value is nil.
4323 See the documentation of `composition-get-gstring' for the format of
4325 (Lisp_Object gstring
)
4328 Lisp_Object font_object
, n
, glyph
;
4329 ptrdiff_t i
, from
, to
;
4331 if (! composition_gstring_p (gstring
))
4332 signal_error ("Invalid glyph-string: ", gstring
);
4333 if (! NILP (LGSTRING_ID (gstring
)))
4335 font_object
= LGSTRING_FONT (gstring
);
4336 CHECK_FONT_OBJECT (font_object
);
4337 font
= XFONT_OBJECT (font_object
);
4338 if (! font
->driver
->shape
)
4341 /* Try at most three times with larger gstring each time. */
4342 for (i
= 0; i
< 3; i
++)
4344 n
= font
->driver
->shape (gstring
);
4347 gstring
= larger_vector (gstring
,
4348 LGSTRING_GLYPH_LEN (gstring
), -1);
4350 if (i
== 3 || XINT (n
) == 0)
4352 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4353 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4355 /* Check FROM_IDX and TO_IDX of each GLYPH in GSTRING to assure that
4356 GLYPHS covers all characters (except for the last few ones) in
4357 GSTRING. More formally, provided that NCHARS is the number of
4358 characters in GSTRING and GLYPHS[i] is the ith glyph, FROM_IDX
4359 and TO_IDX of each glyph must satisfy these conditions:
4361 GLYPHS[0].FROM_IDX == 0
4362 GLYPHS[i].FROM_IDX <= GLYPHS[i].TO_IDX
4363 if (GLYPHS[i].FROM_IDX == GLYPHS[i-1].FROM_IDX)
4364 ;; GLYPHS[i] and GLYPHS[i-1] belongs to the same grapheme cluster
4365 GLYPHS[i].TO_IDX == GLYPHS[i-1].TO_IDX
4367 ;; Be sure to cover all characters.
4368 GLYPHS[i].FROM_IDX == GLYPHS[i-1].TO_IDX + 1 */
4369 glyph
= LGSTRING_GLYPH (gstring
, 0);
4370 from
= LGLYPH_FROM (glyph
);
4371 to
= LGLYPH_TO (glyph
);
4372 if (from
!= 0 || to
< from
)
4374 for (i
= 1; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4376 glyph
= LGSTRING_GLYPH (gstring
, i
);
4379 if (! (LGLYPH_FROM (glyph
) <= LGLYPH_TO (glyph
)
4380 && (LGLYPH_FROM (glyph
) == from
4381 ? LGLYPH_TO (glyph
) == to
4382 : LGLYPH_FROM (glyph
) == to
+ 1)))
4384 from
= LGLYPH_FROM (glyph
);
4385 to
= LGLYPH_TO (glyph
);
4387 return composition_gstring_put_cache (gstring
, XINT (n
));
4393 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4395 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4396 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4398 VARIATION-SELECTOR is a character code of variation selection
4399 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4400 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4401 (Lisp_Object font_object
, Lisp_Object character
)
4403 unsigned variations
[256];
4408 CHECK_FONT_OBJECT (font_object
);
4409 CHECK_CHARACTER (character
);
4410 font
= XFONT_OBJECT (font_object
);
4411 if (! font
->driver
->get_variation_glyphs
)
4413 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4417 for (i
= 0; i
< 255; i
++)
4420 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4421 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4422 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4429 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4430 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4431 OTF-FEATURES specifies which features to apply in this format:
4432 (SCRIPT LANGSYS GSUB GPOS)
4434 SCRIPT is a symbol specifying a script tag of OpenType,
4435 LANGSYS is a symbol specifying a langsys tag of OpenType,
4436 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4438 If LANGSYS is nil, the default langsys is selected.
4440 The features are applied in the order they appear in the list. The
4441 symbol `*' means to apply all available features not present in this
4442 list, and the remaining features are ignored. For instance, (vatu
4443 pstf * haln) is to apply vatu and pstf in this order, then to apply
4444 all available features other than vatu, pstf, and haln.
4446 The features are applied to the glyphs in the range FROM and TO of
4447 the glyph-string GSTRING-IN.
4449 If some feature is actually applicable, the resulting glyphs are
4450 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4451 this case, the value is the number of produced glyphs.
4453 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4456 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4457 produced in GSTRING-OUT, and the value is nil.
4459 See the documentation of `composition-get-gstring' for the format of
4461 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4463 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4468 check_otf_features (otf_features
);
4469 CHECK_FONT_OBJECT (font_object
);
4470 font
= XFONT_OBJECT (font_object
);
4471 if (! font
->driver
->otf_drive
)
4472 error ("Font backend %s can't drive OpenType GSUB table",
4473 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4474 CHECK_CONS (otf_features
);
4475 CHECK_SYMBOL (XCAR (otf_features
));
4476 val
= XCDR (otf_features
);
4477 CHECK_SYMBOL (XCAR (val
));
4478 val
= XCDR (otf_features
);
4481 len
= check_gstring (gstring_in
);
4482 CHECK_VECTOR (gstring_out
);
4483 CHECK_NATNUM (from
);
4485 CHECK_NATNUM (index
);
4487 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4488 args_out_of_range_3 (from
, to
, make_number (len
));
4489 if (XINT (index
) >= ASIZE (gstring_out
))
4490 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4491 num
= font
->driver
->otf_drive (font
, otf_features
,
4492 gstring_in
, XINT (from
), XINT (to
),
4493 gstring_out
, XINT (index
), 0);
4496 return make_number (num
);
4499 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4501 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4502 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4504 (SCRIPT LANGSYS FEATURE ...)
4505 See the documentation of `font-drive-otf' for more detail.
4507 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4508 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4509 character code corresponding to the glyph or nil if there's no
4510 corresponding character. */)
4511 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4514 Lisp_Object gstring_in
, gstring_out
, g
;
4515 Lisp_Object alternates
;
4518 CHECK_FONT_GET_OBJECT (font_object
, font
);
4519 if (! font
->driver
->otf_drive
)
4520 error ("Font backend %s can't drive OpenType GSUB table",
4521 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4522 CHECK_CHARACTER (character
);
4523 CHECK_CONS (otf_features
);
4525 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4526 g
= LGSTRING_GLYPH (gstring_in
, 0);
4527 LGLYPH_SET_CHAR (g
, XINT (character
));
4528 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4529 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4530 gstring_out
, 0, 1)) < 0)
4531 gstring_out
= Ffont_make_gstring (font_object
,
4532 make_number (ASIZE (gstring_out
) * 2));
4534 for (i
= 0; i
< num
; i
++)
4536 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4537 int c
= LGLYPH_CHAR (g
);
4538 unsigned code
= LGLYPH_CODE (g
);
4540 alternates
= Fcons (Fcons (make_number (code
),
4541 c
> 0 ? make_number (c
) : Qnil
),
4544 return Fnreverse (alternates
);
4550 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4551 doc
: /* Open FONT-ENTITY. */)
4552 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4555 struct frame
*f
= decode_live_frame (frame
);
4557 CHECK_FONT_ENTITY (font_entity
);
4560 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4563 CHECK_NUMBER_OR_FLOAT (size
);
4565 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), FRAME_RES_Y (f
));
4567 isize
= XINT (size
);
4568 if (! (INT_MIN
<= isize
&& isize
<= INT_MAX
))
4569 args_out_of_range (font_entity
, size
);
4573 return font_open_entity (f
, font_entity
, isize
);
4576 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4577 doc
: /* Close FONT-OBJECT. */)
4578 (Lisp_Object font_object
, Lisp_Object frame
)
4580 CHECK_FONT_OBJECT (font_object
);
4581 font_close_object (decode_live_frame (frame
), font_object
);
4585 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4586 doc
: /* Return information about FONT-OBJECT.
4587 The value is a vector:
4588 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4591 NAME is the font name, a string (or nil if the font backend doesn't
4594 FILENAME is the font file name, a string (or nil if the font backend
4595 doesn't provide a file name).
4597 PIXEL-SIZE is a pixel size by which the font is opened.
4599 SIZE is a maximum advance width of the font in pixels.
4601 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4604 CAPABILITY is a list whose first element is a symbol representing the
4605 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4606 remaining elements describe the details of the font capability.
4608 If the font is OpenType font, the form of the list is
4609 \(opentype GSUB GPOS)
4610 where GSUB shows which "GSUB" features the font supports, and GPOS
4611 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4612 lists of the format:
4613 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4615 If the font is not OpenType font, currently the length of the form is
4618 SCRIPT is a symbol representing OpenType script tag.
4620 LANGSYS is a symbol representing OpenType langsys tag, or nil
4621 representing the default langsys.
4623 FEATURE is a symbol representing OpenType feature tag.
4625 If the font is not OpenType font, CAPABILITY is nil. */)
4626 (Lisp_Object font_object
)
4631 CHECK_FONT_GET_OBJECT (font_object
, font
);
4633 val
= make_uninit_vector (9);
4634 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4635 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4636 ASET (val
, 2, make_number (font
->pixel_size
));
4637 ASET (val
, 3, make_number (font
->max_width
));
4638 ASET (val
, 4, make_number (font
->ascent
));
4639 ASET (val
, 5, make_number (font
->descent
));
4640 ASET (val
, 6, make_number (font
->space_width
));
4641 ASET (val
, 7, make_number (font
->average_width
));
4642 if (font
->driver
->otf_capability
)
4643 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4645 ASET (val
, 8, Qnil
);
4649 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4651 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4652 FROM and TO are positions (integers or markers) specifying a region
4653 of the current buffer.
4654 If the optional fourth arg OBJECT is not nil, it is a string or a
4655 vector containing the target characters.
4657 Each element is a vector containing information of a glyph in this format:
4658 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4660 FROM is an index numbers of a character the glyph corresponds to.
4661 TO is the same as FROM.
4662 C is the character of the glyph.
4663 CODE is the glyph-code of C in FONT-OBJECT.
4664 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4665 ADJUSTMENT is always nil.
4666 If FONT-OBJECT doesn't have a glyph for a character,
4667 the corresponding element is nil. */)
4668 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4673 Lisp_Object
*chars
, vec
;
4676 CHECK_FONT_GET_OBJECT (font_object
, font
);
4679 ptrdiff_t charpos
, bytepos
;
4681 validate_region (&from
, &to
);
4684 len
= XFASTINT (to
) - XFASTINT (from
);
4685 SAFE_ALLOCA_LISP (chars
, len
);
4686 charpos
= XFASTINT (from
);
4687 bytepos
= CHAR_TO_BYTE (charpos
);
4688 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4691 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4692 chars
[i
] = make_number (c
);
4695 else if (STRINGP (object
))
4697 const unsigned char *p
;
4699 CHECK_NUMBER (from
);
4701 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4702 || XINT (to
) > SCHARS (object
))
4703 args_out_of_range_3 (object
, from
, to
);
4706 len
= XFASTINT (to
) - XFASTINT (from
);
4707 SAFE_ALLOCA_LISP (chars
, len
);
4709 if (STRING_MULTIBYTE (object
))
4710 for (i
= 0; i
< len
; i
++)
4712 int c
= STRING_CHAR_ADVANCE (p
);
4713 chars
[i
] = make_number (c
);
4716 for (i
= 0; i
< len
; i
++)
4717 chars
[i
] = make_number (p
[i
]);
4721 CHECK_VECTOR (object
);
4722 CHECK_NUMBER (from
);
4724 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4725 || XINT (to
) > ASIZE (object
))
4726 args_out_of_range_3 (object
, from
, to
);
4729 len
= XFASTINT (to
) - XFASTINT (from
);
4730 for (i
= 0; i
< len
; i
++)
4732 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4733 CHECK_CHARACTER (elt
);
4735 chars
= aref_addr (object
, XFASTINT (from
));
4738 vec
= make_uninit_vector (len
);
4739 for (i
= 0; i
< len
; i
++)
4742 int c
= XFASTINT (chars
[i
]);
4744 struct font_metrics metrics
;
4746 code
= font
->driver
->encode_char (font
, c
);
4747 if (code
== FONT_INVALID_CODE
)
4749 ASET (vec
, i
, Qnil
);
4753 LGLYPH_SET_FROM (g
, i
);
4754 LGLYPH_SET_TO (g
, i
);
4755 LGLYPH_SET_CHAR (g
, c
);
4756 LGLYPH_SET_CODE (g
, code
);
4757 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4758 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4759 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4760 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4761 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4762 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4765 if (! VECTORP (object
))
4770 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4771 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4772 FONT is a font-spec, font-entity, or font-object. */)
4773 (Lisp_Object spec
, Lisp_Object font
)
4775 CHECK_FONT_SPEC (spec
);
4778 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4781 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4782 doc
: /* Return a font-object for displaying a character at POSITION.
4783 Optional second arg WINDOW, if non-nil, is a window displaying
4784 the current buffer. It defaults to the currently selected window.
4785 Optional third arg STRING, if non-nil, is a string containing the target
4786 character at index specified by POSITION. */)
4787 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4789 struct window
*w
= decode_live_window (window
);
4793 if (XBUFFER (w
->contents
) != current_buffer
)
4794 error ("Specified window is not displaying the current buffer");
4795 CHECK_NUMBER_COERCE_MARKER (position
);
4796 if (! (BEGV
<= XINT (position
) && XINT (position
) < ZV
))
4797 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4801 CHECK_NUMBER (position
);
4802 CHECK_STRING (string
);
4803 if (! (0 <= XINT (position
) && XINT (position
) < SCHARS (string
)))
4804 args_out_of_range (string
, position
);
4807 return font_at (-1, XINT (position
), NULL
, w
, string
);
4811 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4812 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4813 The value is a number of glyphs drawn.
4814 Type C-l to recover what previously shown. */)
4815 (Lisp_Object font_object
, Lisp_Object string
)
4817 Lisp_Object frame
= selected_frame
;
4818 struct frame
*f
= XFRAME (frame
);
4824 CHECK_FONT_GET_OBJECT (font_object
, font
);
4825 CHECK_STRING (string
);
4826 len
= SCHARS (string
);
4827 code
= alloca (sizeof (unsigned) * len
);
4828 for (i
= 0; i
< len
; i
++)
4830 Lisp_Object ch
= Faref (string
, make_number (i
));
4834 code
[i
] = font
->driver
->encode_char (font
, c
);
4835 if (code
[i
] == FONT_INVALID_CODE
)
4838 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4840 if (font
->driver
->prepare_face
)
4841 font
->driver
->prepare_face (f
, face
);
4842 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4843 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4844 if (font
->driver
->done_face
)
4845 font
->driver
->done_face (f
, face
);
4847 return make_number (len
);
4851 DEFUN ("frame-font-cache", Fframe_font_cache
, Sframe_font_cache
, 0, 1, 0,
4852 doc
: /* Return FRAME's font cache. Mainly used for debugging.
4853 If FRAME is omitted or nil, use the selected frame. */)
4856 #ifdef HAVE_WINDOW_SYSTEM
4857 struct frame
*f
= decode_live_frame (frame
);
4859 if (FRAME_WINDOW_P (f
))
4860 return FRAME_DISPLAY_INFO (f
)->name_list_element
;
4866 #endif /* FONT_DEBUG */
4868 #ifdef HAVE_WINDOW_SYSTEM
4870 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4871 doc
: /* Return information about a font named NAME on frame FRAME.
4872 If FRAME is omitted or nil, use the selected frame.
4873 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4874 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4876 OPENED-NAME is the name used for opening the font,
4877 FULL-NAME is the full name of the font,
4878 SIZE is the pixelsize of the font,
4879 HEIGHT is the pixel-height of the font (i.e., ascent + descent),
4880 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4881 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4882 how to compose characters.
4883 If the named font is not yet loaded, return nil. */)
4884 (Lisp_Object name
, Lisp_Object frame
)
4889 Lisp_Object font_object
;
4892 CHECK_STRING (name
);
4893 f
= decode_window_system_frame (frame
);
4897 int fontset
= fs_query_fontset (name
, 0);
4900 name
= fontset_ascii (fontset
);
4901 font_object
= font_open_by_name (f
, name
);
4903 else if (FONT_OBJECT_P (name
))
4905 else if (FONT_ENTITY_P (name
))
4906 font_object
= font_open_entity (f
, name
, 0);
4909 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4910 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4912 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4914 if (NILP (font_object
))
4916 font
= XFONT_OBJECT (font_object
);
4918 info
= make_uninit_vector (7);
4919 ASET (info
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4920 ASET (info
, 1, AREF (font_object
, FONT_FULLNAME_INDEX
));
4921 ASET (info
, 2, make_number (font
->pixel_size
));
4922 ASET (info
, 3, make_number (font
->height
));
4923 ASET (info
, 4, make_number (font
->baseline_offset
));
4924 ASET (info
, 5, make_number (font
->relative_compose
));
4925 ASET (info
, 6, make_number (font
->default_ascent
));
4928 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4929 close it now. Perhaps, we should manage font-objects
4930 by `reference-count'. */
4931 font_close_object (f
, font_object
);
4938 #define BUILD_STYLE_TABLE(TBL) \
4939 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4942 build_style_table (const struct table_entry
*entry
, int nelement
)
4945 Lisp_Object table
, elt
;
4947 table
= make_uninit_vector (nelement
);
4948 for (i
= 0; i
< nelement
; i
++)
4950 for (j
= 0; entry
[i
].names
[j
]; j
++);
4951 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4952 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4953 for (j
= 0; entry
[i
].names
[j
]; j
++)
4954 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
4955 ASET (table
, i
, elt
);
4960 /* The deferred font-log data of the form [ACTION ARG RESULT].
4961 If ACTION is not nil, that is added to the log when font_add_log is
4962 called next time. At that time, ACTION is set back to nil. */
4963 static Lisp_Object Vfont_log_deferred
;
4965 /* Prepend the font-related logging data in Vfont_log if it is not
4966 `t'. ACTION describes a kind of font-related action (e.g. listing,
4967 opening), ARG is the argument for the action, and RESULT is the
4968 result of the action. */
4970 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
4975 if (EQ (Vfont_log
, Qt
))
4977 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4979 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
4981 ASET (Vfont_log_deferred
, 0, Qnil
);
4982 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4983 AREF (Vfont_log_deferred
, 2));
4988 Lisp_Object tail
, elt
;
4989 Lisp_Object equalstr
= build_string ("=");
4991 val
= Ffont_xlfd_name (arg
, Qt
);
4992 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4996 if (EQ (XCAR (elt
), QCscript
)
4997 && SYMBOLP (XCDR (elt
)))
4998 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4999 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5000 else if (EQ (XCAR (elt
), QClang
)
5001 && SYMBOLP (XCDR (elt
)))
5002 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5003 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5004 else if (EQ (XCAR (elt
), QCotf
)
5005 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5006 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5008 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5014 && VECTORP (XCAR (result
))
5015 && ASIZE (XCAR (result
)) > 0
5016 && FONTP (AREF (XCAR (result
), 0)))
5017 result
= font_vconcat_entity_vectors (result
);
5020 val
= Ffont_xlfd_name (result
, Qt
);
5021 if (! FONT_SPEC_P (result
))
5022 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5023 build_string (":"), val
);
5026 else if (CONSP (result
))
5029 result
= Fcopy_sequence (result
);
5030 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5034 val
= Ffont_xlfd_name (val
, Qt
);
5035 XSETCAR (tail
, val
);
5038 else if (VECTORP (result
))
5040 result
= Fcopy_sequence (result
);
5041 for (i
= 0; i
< ASIZE (result
); i
++)
5043 val
= AREF (result
, i
);
5045 val
= Ffont_xlfd_name (val
, Qt
);
5046 ASET (result
, i
, val
);
5049 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5052 /* Record a font-related logging data to be added to Vfont_log when
5053 font_add_log is called next time. ACTION, ARG, RESULT are the same
5057 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5059 if (EQ (Vfont_log
, Qt
))
5061 ASET (Vfont_log_deferred
, 0, build_string (action
));
5062 ASET (Vfont_log_deferred
, 1, arg
);
5063 ASET (Vfont_log_deferred
, 2, result
);
5069 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5070 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5071 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5072 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5073 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5074 /* Note that the other elements in sort_shift_bits are not used. */
5076 staticpro (&font_charset_alist
);
5077 font_charset_alist
= Qnil
;
5079 DEFSYM (Qopentype
, "opentype");
5081 DEFSYM (Qascii_0
, "ascii-0");
5082 DEFSYM (Qiso8859_1
, "iso8859-1");
5083 DEFSYM (Qiso10646_1
, "iso10646-1");
5084 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5085 DEFSYM (Qunicode_sip
, "unicode-sip");
5089 DEFSYM (QCotf
, ":otf");
5090 DEFSYM (QClang
, ":lang");
5091 DEFSYM (QCscript
, ":script");
5092 DEFSYM (QCantialias
, ":antialias");
5094 DEFSYM (QCfoundry
, ":foundry");
5095 DEFSYM (QCadstyle
, ":adstyle");
5096 DEFSYM (QCregistry
, ":registry");
5097 DEFSYM (QCspacing
, ":spacing");
5098 DEFSYM (QCdpi
, ":dpi");
5099 DEFSYM (QCscalable
, ":scalable");
5100 DEFSYM (QCavgwidth
, ":avgwidth");
5101 DEFSYM (QCfont_entity
, ":font-entity");
5102 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5112 DEFSYM (QCuser_spec
, "user-spec");
5114 staticpro (&scratch_font_spec
);
5115 scratch_font_spec
= Ffont_spec (0, NULL
);
5116 staticpro (&scratch_font_prefer
);
5117 scratch_font_prefer
= Ffont_spec (0, NULL
);
5119 staticpro (&Vfont_log_deferred
);
5120 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5124 staticpro (&otf_list
);
5126 #endif /* HAVE_LIBOTF */
5130 defsubr (&Sfont_spec
);
5131 defsubr (&Sfont_get
);
5132 #ifdef HAVE_WINDOW_SYSTEM
5133 defsubr (&Sfont_face_attributes
);
5135 defsubr (&Sfont_put
);
5136 defsubr (&Slist_fonts
);
5137 defsubr (&Sfont_family_list
);
5138 defsubr (&Sfind_font
);
5139 defsubr (&Sfont_xlfd_name
);
5140 defsubr (&Sclear_font_cache
);
5141 defsubr (&Sfont_shape_gstring
);
5142 defsubr (&Sfont_variation_glyphs
);
5144 defsubr (&Sfont_drive_otf
);
5145 defsubr (&Sfont_otf_alternates
);
5149 defsubr (&Sopen_font
);
5150 defsubr (&Sclose_font
);
5151 defsubr (&Squery_font
);
5152 defsubr (&Sfont_get_glyphs
);
5153 defsubr (&Sfont_match_p
);
5154 defsubr (&Sfont_at
);
5156 defsubr (&Sdraw_string
);
5158 defsubr (&Sframe_font_cache
);
5159 #endif /* FONT_DEBUG */
5160 #ifdef HAVE_WINDOW_SYSTEM
5161 defsubr (&Sfont_info
);
5164 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5166 Alist of fontname patterns vs the corresponding encoding and repertory info.
5167 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5168 where ENCODING is a charset or a char-table,
5169 and REPERTORY is a charset, a char-table, or nil.
5171 If ENCODING and REPERTORY are the same, the element can have the form
5172 \(REGEXP . ENCODING).
5174 ENCODING is for converting a character to a glyph code of the font.
5175 If ENCODING is a charset, encoding a character by the charset gives
5176 the corresponding glyph code. If ENCODING is a char-table, looking up
5177 the table by a character gives the corresponding glyph code.
5179 REPERTORY specifies a repertory of characters supported by the font.
5180 If REPERTORY is a charset, all characters belonging to the charset are
5181 supported. If REPERTORY is a char-table, all characters who have a
5182 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5183 gets the repertory information by an opened font and ENCODING. */);
5184 Vfont_encoding_alist
= Qnil
;
5186 /* FIXME: These 3 vars are not quite what they appear: setq on them
5187 won't have any effect other than disconnect them from the style
5188 table used by the font display code. So we make them read-only,
5189 to avoid this confusing situation. */
5191 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5192 doc
: /* Vector of valid font weight values.
5193 Each element has the form:
5194 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5195 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5196 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5197 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5199 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5200 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5201 See `font-weight-table' for the format of the vector. */);
5202 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5203 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5205 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5206 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5207 See `font-weight-table' for the format of the vector. */);
5208 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5209 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5211 staticpro (&font_style_table
);
5212 font_style_table
= make_uninit_vector (3);
5213 ASET (font_style_table
, 0, Vfont_weight_table
);
5214 ASET (font_style_table
, 1, Vfont_slant_table
);
5215 ASET (font_style_table
, 2, Vfont_width_table
);
5217 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5218 *Logging list of font related actions and results.
5219 The value t means to suppress the logging.
5220 The initial value is set to nil if the environment variable
5221 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5224 #ifdef HAVE_WINDOW_SYSTEM
5225 #ifdef HAVE_FREETYPE
5227 #ifdef HAVE_X_WINDOWS
5232 #endif /* HAVE_XFT */
5233 #endif /* HAVE_X_WINDOWS */
5234 #else /* not HAVE_FREETYPE */
5235 #ifdef HAVE_X_WINDOWS
5237 #endif /* HAVE_X_WINDOWS */
5238 #endif /* not HAVE_FREETYPE */
5241 #endif /* HAVE_BDFFONT */
5244 #endif /* HAVE_NTGUI */
5245 #endif /* HAVE_WINDOW_SYSTEM */
5251 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;