1 /* font.c -- "Font" primitives.
3 Copyright (C) 2006-2015 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 #define DEFAULT_ENCODING Qiso8859_1
46 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
47 static Lisp_Object font_style_table
;
49 /* Structure used for tables mapping weight, slant, and width numeric
50 values and their names. */
55 /* The first one is a valid name as a face attribute.
56 The second one (if any) is a typical name in XLFD field. */
60 /* Table of weight numeric values and their names. This table must be
61 sorted by numeric values in ascending order. */
63 static const struct table_entry weight_table
[] =
66 { 20, { "ultra-light", "ultralight" }},
67 { 40, { "extra-light", "extralight" }},
69 { 75, { "semi-light", "semilight", "demilight", "book" }},
70 { 100, { "normal", "medium", "regular", "unspecified" }},
71 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
73 { 205, { "extra-bold", "extrabold" }},
74 { 210, { "ultra-bold", "ultrabold", "black" }}
77 /* Table of slant numeric values and their names. This table must be
78 sorted by numeric values in ascending order. */
80 static const struct table_entry slant_table
[] =
82 { 0, { "reverse-oblique", "ro" }},
83 { 10, { "reverse-italic", "ri" }},
84 { 100, { "normal", "r", "unspecified" }},
85 { 200, { "italic" ,"i", "ot" }},
86 { 210, { "oblique", "o" }}
89 /* Table of width numeric values and their names. This table must be
90 sorted by numeric values in ascending order. */
92 static const struct table_entry width_table
[] =
94 { 50, { "ultra-condensed", "ultracondensed" }},
95 { 63, { "extra-condensed", "extracondensed" }},
96 { 75, { "condensed", "compressed", "narrow" }},
97 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
98 { 100, { "normal", "medium", "regular", "unspecified" }},
99 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
100 { 125, { "expanded" }},
101 { 150, { "extra-expanded", "extraexpanded" }},
102 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
105 /* Alist of font registry symbols and the corresponding charset
106 information. The information is retrieved from
107 Vfont_encoding_alist on demand.
109 Eash element has the form:
110 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
114 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
115 encodes a character code to a glyph code of a font, and
116 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
117 character is supported by a font.
119 The latter form means that the information for REGISTRY couldn't be
121 static Lisp_Object font_charset_alist
;
123 /* List of all font drivers. Each font-backend (XXXfont.c) calls
124 register_font_driver in syms_of_XXXfont to register its font-driver
126 static struct font_driver_list
*font_driver_list
;
128 #ifdef ENABLE_CHECKING
130 /* Used to catch bogus pointers in font objects. */
133 valid_font_driver (struct font_driver
*drv
)
135 Lisp_Object tail
, frame
;
136 struct font_driver_list
*fdl
;
138 for (fdl
= font_driver_list
; fdl
; fdl
= fdl
->next
)
139 if (fdl
->driver
== drv
)
141 FOR_EACH_FRAME (tail
, frame
)
142 for (fdl
= XFRAME (frame
)->font_driver_list
; fdl
; fdl
= fdl
->next
)
143 if (fdl
->driver
== drv
)
148 #endif /* ENABLE_CHECKING */
150 /* Creators of font-related Lisp object. */
153 font_make_spec (void)
155 Lisp_Object font_spec
;
156 struct font_spec
*spec
157 = ((struct font_spec
*)
158 allocate_pseudovector (VECSIZE (struct font_spec
),
159 FONT_SPEC_MAX
, FONT_SPEC_MAX
, PVEC_FONT
));
160 XSETFONT (font_spec
, spec
);
165 font_make_entity (void)
167 Lisp_Object font_entity
;
168 struct font_entity
*entity
169 = ((struct font_entity
*)
170 allocate_pseudovector (VECSIZE (struct font_entity
),
171 FONT_ENTITY_MAX
, FONT_ENTITY_MAX
, PVEC_FONT
));
172 XSETFONT (font_entity
, entity
);
176 /* Create a font-object whose structure size is SIZE. If ENTITY is
177 not nil, copy properties from ENTITY to the font-object. If
178 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
180 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
182 Lisp_Object font_object
;
184 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
,
185 FONT_OBJECT_MAX
, PVEC_FONT
);
188 /* GC can happen before the driver is set up,
189 so avoid dangling pointer here (Bug#17771). */
191 XSETFONT (font_object
, font
);
195 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
196 font
->props
[i
] = AREF (entity
, i
);
197 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
198 font
->props
[FONT_EXTRA_INDEX
]
199 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
202 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
206 #if defined (HAVE_XFT) || defined (HAVE_FREETYPE) || defined (HAVE_NS)
208 static int font_unparse_fcname (Lisp_Object
, int, char *, int);
210 /* Like above, but also set `type', `name' and `fullname' properties
214 font_build_object (int vectorsize
, Lisp_Object type
,
215 Lisp_Object entity
, double pixelsize
)
219 Lisp_Object font_object
= font_make_object (vectorsize
, entity
, pixelsize
);
221 ASET (font_object
, FONT_TYPE_INDEX
, type
);
222 len
= font_unparse_xlfd (entity
, pixelsize
, name
, sizeof name
);
224 ASET (font_object
, FONT_NAME_INDEX
, make_string (name
, len
));
225 len
= font_unparse_fcname (entity
, pixelsize
, name
, sizeof name
);
227 ASET (font_object
, FONT_FULLNAME_INDEX
, make_string (name
, len
));
229 ASET (font_object
, FONT_FULLNAME_INDEX
,
230 AREF (font_object
, FONT_NAME_INDEX
));
234 #endif /* HAVE_XFT || HAVE_FREETYPE || HAVE_NS */
236 static int font_pixel_size (struct frame
*f
, Lisp_Object
);
237 static Lisp_Object
font_open_entity (struct frame
*, Lisp_Object
, int);
238 static Lisp_Object
font_matching_entity (struct frame
*, Lisp_Object
*,
240 static unsigned font_encode_char (Lisp_Object
, int);
242 /* Number of registered font drivers. */
243 static int num_font_drivers
;
246 /* Return a Lispy value of a font property value at STR and LEN bytes.
247 If STR is "*", return nil. If FORCE_SYMBOL, or if STR does not
248 consist entirely of one or more digits, return a symbol interned
249 from STR. Otherwise, return an integer. */
252 font_intern_prop (const char *str
, ptrdiff_t len
, bool force_symbol
)
254 ptrdiff_t i
, nbytes
, nchars
;
255 Lisp_Object tem
, name
, obarray
;
257 if (len
== 1 && *str
== '*')
259 if (!force_symbol
&& 0 < len
&& '0' <= *str
&& *str
<= '9')
261 for (i
= 1; i
< len
; i
++)
262 if (! ('0' <= str
[i
] && str
[i
] <= '9'))
269 for (n
= 0; (n
+= str
[i
++] - '0') <= MOST_POSITIVE_FIXNUM
; n
*= 10)
272 return make_number (n
);
273 if (MOST_POSITIVE_FIXNUM
/ 10 < n
)
277 xsignal1 (Qoverflow_error
, make_string (str
, len
));
281 /* This code is similar to intern function from lread.c. */
282 obarray
= check_obarray (Vobarray
);
283 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
284 tem
= oblookup (obarray
, str
,
285 (len
== nchars
|| len
!= nbytes
) ? len
: nchars
, len
);
288 name
= make_specified_string (str
, nchars
, len
,
289 len
!= nchars
&& len
== nbytes
);
290 return intern_driver (name
, obarray
, tem
);
293 /* Return a pixel size of font-spec SPEC on frame F. */
296 font_pixel_size (struct frame
*f
, Lisp_Object spec
)
298 #ifdef HAVE_WINDOW_SYSTEM
299 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
308 eassert (FLOATP (size
));
309 point_size
= XFLOAT_DATA (size
);
310 val
= AREF (spec
, FONT_DPI_INDEX
);
314 dpi
= FRAME_RES_Y (f
);
315 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
323 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
324 font vector. If VAL is not valid (i.e. not registered in
325 font_style_table), return -1 if NOERROR is zero, and return a
326 proper index if NOERROR is nonzero. In that case, register VAL in
327 font_style_table if VAL is a symbol, and return the closest index if
328 VAL is an integer. */
331 font_style_to_value (enum font_property_index prop
, Lisp_Object val
,
334 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
337 CHECK_VECTOR (table
);
346 /* At first try exact match. */
347 for (i
= 0; i
< len
; i
++)
349 CHECK_VECTOR (AREF (table
, i
));
350 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
351 if (EQ (val
, AREF (AREF (table
, i
), j
)))
353 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
354 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
355 | (i
<< 4) | (j
- 1));
358 /* Try also with case-folding match. */
359 s
= SSDATA (SYMBOL_NAME (val
));
360 for (i
= 0; i
< len
; i
++)
361 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
363 elt
= AREF (AREF (table
, i
), j
);
364 if (xstrcasecmp (s
, SSDATA (SYMBOL_NAME (elt
))) == 0)
366 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
367 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
368 | (i
<< 4) | (j
- 1));
374 elt
= Fmake_vector (make_number (2), make_number (100));
376 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
,
377 Fvconcat (2, ((Lisp_Object
[])
378 { table
, Fmake_vector (make_number (1), elt
) })));
379 return (100 << 8) | (i
<< 4);
384 EMACS_INT numeric
= XINT (val
);
386 for (i
= 0, last_n
= -1; i
< len
; i
++)
390 CHECK_VECTOR (AREF (table
, i
));
391 CHECK_NUMBER (AREF (AREF (table
, i
), 0));
392 n
= XINT (AREF (AREF (table
, i
), 0));
394 return (n
<< 8) | (i
<< 4);
399 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
400 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
406 return ((last_n
<< 8) | ((i
- 1) << 4));
411 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
,
414 Lisp_Object val
= AREF (font
, prop
);
415 Lisp_Object table
, elt
;
420 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
421 CHECK_VECTOR (table
);
422 i
= XINT (val
) & 0xFF;
423 eassert (((i
>> 4) & 0xF) < ASIZE (table
));
424 elt
= AREF (table
, ((i
>> 4) & 0xF));
426 eassert ((i
& 0xF) + 1 < ASIZE (elt
));
427 elt
= (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
432 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
433 FONTNAME. ENCODING is a charset symbol that specifies the encoding
434 of the font. REPERTORY is a charset symbol or nil. */
437 find_font_encoding (Lisp_Object fontname
)
439 Lisp_Object tail
, elt
;
441 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
445 && STRINGP (XCAR (elt
))
446 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
447 && (SYMBOLP (XCDR (elt
))
448 ? CHARSETP (XCDR (elt
))
449 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
455 /* Return encoding charset and repertory charset for REGISTRY in
456 ENCODING and REPERTORY correspondingly. If correct information for
457 REGISTRY is available, return 0. Otherwise return -1. */
460 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
463 int encoding_id
, repertory_id
;
465 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
471 encoding_id
= XINT (XCAR (val
));
472 repertory_id
= XINT (XCDR (val
));
476 val
= find_font_encoding (SYMBOL_NAME (registry
));
477 if (SYMBOLP (val
) && CHARSETP (val
))
479 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
481 else if (CONSP (val
))
483 if (! CHARSETP (XCAR (val
)))
485 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
486 if (NILP (XCDR (val
)))
490 if (! CHARSETP (XCDR (val
)))
492 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
497 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
499 = nconc2 (font_charset_alist
, list1 (Fcons (registry
, val
)));
503 *encoding
= CHARSET_FROM_ID (encoding_id
);
505 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
510 = nconc2 (font_charset_alist
, list1 (Fcons (registry
, Qnil
)));
515 /* Font property value validators. See the comment of
516 font_property_table for the meaning of the arguments. */
518 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
519 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
520 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
521 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
522 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
523 static int get_font_prop_index (Lisp_Object
);
526 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
529 val
= Fintern (val
, Qnil
);
532 else if (EQ (prop
, QCregistry
))
533 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
539 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
541 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
542 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
546 EMACS_INT n
= XINT (val
);
547 CHECK_VECTOR (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
));
549 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
553 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
556 if ((n
& 0xF) + 1 >= ASIZE (elt
))
560 CHECK_NUMBER (AREF (elt
, 0));
561 if (XINT (AREF (elt
, 0)) != (n
>> 8))
566 else if (SYMBOLP (val
))
568 int n
= font_style_to_value (prop
, val
, 0);
570 val
= n
>= 0 ? make_number (n
) : Qerror
;
578 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
580 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
585 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
587 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
589 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
591 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
593 if (spacing
== 'c' || spacing
== 'C')
594 return make_number (FONT_SPACING_CHARCELL
);
595 if (spacing
== 'm' || spacing
== 'M')
596 return make_number (FONT_SPACING_MONO
);
597 if (spacing
== 'p' || spacing
== 'P')
598 return make_number (FONT_SPACING_PROPORTIONAL
);
599 if (spacing
== 'd' || spacing
== 'D')
600 return make_number (FONT_SPACING_DUAL
);
606 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
608 Lisp_Object tail
, tmp
;
611 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
612 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
613 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
616 if (! SYMBOLP (XCAR (val
)))
621 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
623 for (i
= 0; i
< 2; i
++)
630 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
631 if (! SYMBOLP (XCAR (tmp
)))
639 /* Structure of known font property keys and validator of the
643 /* Index of the key symbol. */
645 /* Function to validate PROP's value VAL, or NULL if any value is
646 ok. The value is VAL or its regularized value if VAL is valid,
647 and Qerror if not. */
648 Lisp_Object (*validator
) (Lisp_Object prop
, Lisp_Object val
);
649 } font_property_table
[] =
650 { { SYMBOL_INDEX (QCtype
), font_prop_validate_symbol
},
651 { SYMBOL_INDEX (QCfoundry
), font_prop_validate_symbol
},
652 { SYMBOL_INDEX (QCfamily
), font_prop_validate_symbol
},
653 { SYMBOL_INDEX (QCadstyle
), font_prop_validate_symbol
},
654 { SYMBOL_INDEX (QCregistry
), font_prop_validate_symbol
},
655 { SYMBOL_INDEX (QCweight
), font_prop_validate_style
},
656 { SYMBOL_INDEX (QCslant
), font_prop_validate_style
},
657 { SYMBOL_INDEX (QCwidth
), font_prop_validate_style
},
658 { SYMBOL_INDEX (QCsize
), font_prop_validate_non_neg
},
659 { SYMBOL_INDEX (QCdpi
), font_prop_validate_non_neg
},
660 { SYMBOL_INDEX (QCspacing
), font_prop_validate_spacing
},
661 { SYMBOL_INDEX (QCavgwidth
), font_prop_validate_non_neg
},
662 /* The order of the above entries must match with enum
663 font_property_index. */
664 { SYMBOL_INDEX (QClang
), font_prop_validate_symbol
},
665 { SYMBOL_INDEX (QCscript
), font_prop_validate_symbol
},
666 { SYMBOL_INDEX (QCotf
), font_prop_validate_otf
}
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
< ARRAYELTS (font_property_table
); i
++)
678 if (EQ (key
, builtin_lisp_symbol (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
= builtin_lisp_symbol (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
];
1165 AUTO_STRING (star_dash
, "*-");
1166 val
= concat2 (star_dash
, SYMBOL_NAME (val
));
1169 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1171 AUTO_STRING (dash_star
, "-*");
1172 val
= concat2 (SYMBOL_NAME (val
), dash_star
);
1176 AUTO_STRING (dash
, "-");
1177 val
= concat3 (SYMBOL_NAME (val
), dash
,
1178 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1181 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1183 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1184 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1185 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1187 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1189 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1192 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1193 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1194 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1196 val
= font_prop_validate_spacing (QCspacing
,
1197 prop
[XLFD_SPACING_INDEX
]);
1198 if (! INTEGERP (val
))
1200 ASET (font
, FONT_SPACING_INDEX
, val
);
1202 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1203 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1209 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1210 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1211 0, use PIXEL_SIZE instead. */
1214 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1217 const char *f
[XLFD_REGISTRY_INDEX
+ 1];
1221 eassert (FONTP (font
));
1223 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1226 if (i
== FONT_ADSTYLE_INDEX
)
1227 j
= XLFD_ADSTYLE_INDEX
;
1228 else if (i
== FONT_REGISTRY_INDEX
)
1229 j
= XLFD_REGISTRY_INDEX
;
1230 val
= AREF (font
, i
);
1233 if (j
== XLFD_REGISTRY_INDEX
)
1241 val
= SYMBOL_NAME (val
);
1242 if (j
== XLFD_REGISTRY_INDEX
1243 && ! strchr (SSDATA (val
), '-'))
1245 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1246 ptrdiff_t alloc
= SBYTES (val
) + 4;
1247 if (nbytes
<= alloc
)
1249 f
[j
] = p
= alloca (alloc
);
1250 sprintf (p
, "%s%s-*", SDATA (val
),
1251 &"*"[SDATA (val
)[SBYTES (val
) - 1] == '*']);
1254 f
[j
] = SSDATA (val
);
1258 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1261 val
= font_style_symbolic (font
, i
, 0);
1269 val
= SYMBOL_NAME (val
);
1270 alloc
= SBYTES (val
) + 1;
1271 if (nbytes
<= alloc
)
1273 f
[j
] = p
= alloca (alloc
);
1274 /* Copy the name while excluding '-', '?', ',', and '"'. */
1275 for (k
= l
= 0; k
< alloc
; k
++)
1278 if (c
!= '-' && c
!= '?' && c
!= ',' && c
!= '"')
1284 val
= AREF (font
, FONT_SIZE_INDEX
);
1285 eassert (NUMBERP (val
) || NILP (val
));
1286 char font_size_index_buf
[sizeof "-*"
1287 + max (INT_STRLEN_BOUND (EMACS_INT
),
1288 1 + DBL_MAX_10_EXP
+ 1)];
1291 EMACS_INT v
= XINT (val
);
1296 f
[XLFD_PIXEL_INDEX
] = p
= font_size_index_buf
;
1297 sprintf (p
, "%"pI
"d-*", v
);
1300 f
[XLFD_PIXEL_INDEX
] = "*-*";
1302 else if (FLOATP (val
))
1304 double v
= XFLOAT_DATA (val
) * 10;
1305 f
[XLFD_PIXEL_INDEX
] = p
= font_size_index_buf
;
1306 sprintf (p
, "*-%.0f", v
);
1309 f
[XLFD_PIXEL_INDEX
] = "*-*";
1311 char dpi_index_buf
[sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT
)];
1312 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1314 EMACS_INT v
= XINT (AREF (font
, FONT_DPI_INDEX
));
1315 f
[XLFD_RESX_INDEX
] = p
= dpi_index_buf
;
1316 sprintf (p
, "%"pI
"d-%"pI
"d", v
, v
);
1319 f
[XLFD_RESX_INDEX
] = "*-*";
1321 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1323 EMACS_INT spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1325 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1326 : spacing
<= FONT_SPACING_DUAL
? "d"
1327 : spacing
<= FONT_SPACING_MONO
? "m"
1331 f
[XLFD_SPACING_INDEX
] = "*";
1333 char avgwidth_index_buf
[INT_BUFSIZE_BOUND (EMACS_INT
)];
1334 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1336 f
[XLFD_AVGWIDTH_INDEX
] = p
= avgwidth_index_buf
;
1337 sprintf (p
, "%"pI
"d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)));
1340 f
[XLFD_AVGWIDTH_INDEX
] = "*";
1342 len
= snprintf (name
, nbytes
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1343 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1344 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1345 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1346 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1347 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1348 f
[XLFD_REGISTRY_INDEX
]);
1349 return len
< nbytes
? len
: -1;
1352 /* Parse NAME (null terminated) and store information in FONT
1353 (font-spec or font-entity). NAME is supplied in either the
1354 Fontconfig or GTK font name format. If NAME is successfully
1355 parsed, return 0. Otherwise return -1.
1357 The fontconfig format is
1359 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1363 FAMILY [PROPS...] [SIZE]
1365 This function tries to guess which format it is. */
1368 font_parse_fcname (char *name
, ptrdiff_t len
, Lisp_Object font
)
1371 char *size_beg
= NULL
, *size_end
= NULL
;
1372 char *props_beg
= NULL
, *family_end
= NULL
;
1377 for (p
= name
; *p
; p
++)
1379 if (*p
== '\\' && p
[1])
1383 props_beg
= family_end
= p
;
1388 bool decimal
= 0, size_found
= 1;
1389 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1390 if (! c_isdigit (*q
))
1392 if (*q
!= '.' || decimal
)
1411 Lisp_Object extra_props
= Qnil
;
1413 /* A fontconfig name with size and/or property data. */
1414 if (family_end
> name
)
1417 family
= font_intern_prop (name
, family_end
- name
, 1);
1418 ASET (font
, FONT_FAMILY_INDEX
, family
);
1422 double point_size
= strtod (size_beg
, &size_end
);
1423 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1424 if (*size_end
== ':' && size_end
[1])
1425 props_beg
= size_end
;
1429 /* Now parse ":KEY=VAL" patterns. */
1432 for (p
= props_beg
; *p
; p
= q
)
1434 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1437 /* Must be an enumerated value. */
1441 val
= font_intern_prop (p
, q
- p
, 1);
1443 #define PROP_MATCH(STR) (word_len == strlen (STR) \
1444 && memcmp (p, STR, strlen (STR)) == 0)
1446 if (PROP_MATCH ("light")
1447 || PROP_MATCH ("medium")
1448 || PROP_MATCH ("demibold")
1449 || PROP_MATCH ("bold")
1450 || PROP_MATCH ("black"))
1451 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1452 else if (PROP_MATCH ("roman")
1453 || PROP_MATCH ("italic")
1454 || PROP_MATCH ("oblique"))
1455 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1456 else if (PROP_MATCH ("charcell"))
1457 ASET (font
, FONT_SPACING_INDEX
,
1458 make_number (FONT_SPACING_CHARCELL
));
1459 else if (PROP_MATCH ("mono"))
1460 ASET (font
, FONT_SPACING_INDEX
,
1461 make_number (FONT_SPACING_MONO
));
1462 else if (PROP_MATCH ("proportional"))
1463 ASET (font
, FONT_SPACING_INDEX
,
1464 make_number (FONT_SPACING_PROPORTIONAL
));
1473 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1474 prop
= FONT_SIZE_INDEX
;
1477 key
= font_intern_prop (p
, q
- p
, 1);
1478 prop
= get_font_prop_index (key
);
1482 for (q
= p
; *q
&& *q
!= ':'; q
++);
1483 val
= font_intern_prop (p
, q
- p
, 0);
1485 if (prop
>= FONT_FOUNDRY_INDEX
1486 && prop
< FONT_EXTRA_INDEX
)
1487 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1490 extra_props
= nconc2 (extra_props
,
1491 list1 (Fcons (key
, val
)));
1498 if (! NILP (extra_props
))
1500 struct font_driver_list
*driver_list
= font_driver_list
;
1501 for ( ; driver_list
; driver_list
= driver_list
->next
)
1502 if (driver_list
->driver
->filter_properties
)
1503 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1509 /* Either a fontconfig-style name with no size and property
1510 data, or a GTK-style name. */
1511 Lisp_Object weight
= Qnil
, slant
= Qnil
;
1512 Lisp_Object width
= Qnil
, size
= Qnil
;
1516 /* Scan backwards from the end, looking for a size. */
1517 for (p
= name
+ len
- 1; p
>= name
; p
--)
1518 if (!c_isdigit (*p
))
1521 if ((p
< name
+ len
- 1) && ((p
+ 1 == name
) || *p
== ' '))
1522 /* Found a font size. */
1523 size
= make_float (strtod (p
+ 1, NULL
));
1527 /* Now P points to the termination of the string, sans size.
1528 Scan backwards, looking for font properties. */
1529 for (; p
> name
; p
= q
)
1531 for (q
= p
- 1; q
>= name
; q
--)
1533 if (q
> name
&& *(q
-1) == '\\')
1534 --q
; /* Skip quoting backslashes. */
1540 word_len
= p
- word_start
;
1542 #define PROP_MATCH(STR) \
1543 (word_len == strlen (STR) \
1544 && memcmp (word_start, STR, strlen (STR)) == 0)
1545 #define PROP_SAVE(VAR, STR) \
1546 (VAR = NILP (VAR) ? font_intern_prop (STR, strlen (STR), 1) : VAR)
1548 if (PROP_MATCH ("Ultra-Light"))
1549 PROP_SAVE (weight
, "ultra-light");
1550 else if (PROP_MATCH ("Light"))
1551 PROP_SAVE (weight
, "light");
1552 else if (PROP_MATCH ("Book"))
1553 PROP_SAVE (weight
, "book");
1554 else if (PROP_MATCH ("Medium"))
1555 PROP_SAVE (weight
, "medium");
1556 else if (PROP_MATCH ("Semi-Bold"))
1557 PROP_SAVE (weight
, "semi-bold");
1558 else if (PROP_MATCH ("Bold"))
1559 PROP_SAVE (weight
, "bold");
1560 else if (PROP_MATCH ("Italic"))
1561 PROP_SAVE (slant
, "italic");
1562 else if (PROP_MATCH ("Oblique"))
1563 PROP_SAVE (slant
, "oblique");
1564 else if (PROP_MATCH ("Semi-Condensed"))
1565 PROP_SAVE (width
, "semi-condensed");
1566 else if (PROP_MATCH ("Condensed"))
1567 PROP_SAVE (width
, "condensed");
1568 /* An unknown word must be part of the font name. */
1579 ASET (font
, FONT_FAMILY_INDEX
,
1580 font_intern_prop (name
, family_end
- name
, 1));
1582 ASET (font
, FONT_SIZE_INDEX
, size
);
1584 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, weight
);
1586 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, slant
);
1588 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, width
);
1594 #if defined HAVE_XFT || defined HAVE_FREETYPE || defined HAVE_NS
1596 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1597 NAME (NBYTES length), and return the name length. If
1598 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead.
1599 Return a negative value on error. */
1602 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1604 Lisp_Object family
, foundry
;
1610 Lisp_Object styles
[3];
1611 const char *style_names
[3] = { "weight", "slant", "width" };
1613 family
= AREF (font
, FONT_FAMILY_INDEX
);
1614 if (! NILP (family
))
1616 if (SYMBOLP (family
))
1617 family
= SYMBOL_NAME (family
);
1622 val
= AREF (font
, FONT_SIZE_INDEX
);
1625 if (XINT (val
) != 0)
1626 pixel_size
= XINT (val
);
1631 eassert (FLOATP (val
));
1633 point_size
= (int) XFLOAT_DATA (val
);
1636 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1637 if (! NILP (foundry
))
1639 if (SYMBOLP (foundry
))
1640 foundry
= SYMBOL_NAME (foundry
);
1645 for (i
= 0; i
< 3; i
++)
1646 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1649 lim
= name
+ nbytes
;
1650 if (! NILP (family
))
1652 int len
= snprintf (p
, lim
- p
, "%s", SSDATA (family
));
1653 if (! (0 <= len
&& len
< lim
- p
))
1659 int len
= snprintf (p
, lim
- p
, &"-%d"[p
== name
], point_size
);
1660 if (! (0 <= len
&& len
< lim
- p
))
1664 else if (pixel_size
> 0)
1666 int len
= snprintf (p
, lim
- p
, ":pixelsize=%d", pixel_size
);
1667 if (! (0 <= len
&& len
< lim
- p
))
1671 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1673 int len
= snprintf (p
, lim
- p
, ":foundry=%s",
1674 SSDATA (SYMBOL_NAME (AREF (font
,
1675 FONT_FOUNDRY_INDEX
))));
1676 if (! (0 <= len
&& len
< lim
- p
))
1680 for (i
= 0; i
< 3; i
++)
1681 if (! NILP (styles
[i
]))
1683 int len
= snprintf (p
, lim
- p
, ":%s=%s", style_names
[i
],
1684 SSDATA (SYMBOL_NAME (styles
[i
])));
1685 if (! (0 <= len
&& len
< lim
- p
))
1690 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1692 int len
= snprintf (p
, lim
- p
, ":dpi=%"pI
"d",
1693 XINT (AREF (font
, FONT_DPI_INDEX
)));
1694 if (! (0 <= len
&& len
< lim
- p
))
1699 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1701 int len
= snprintf (p
, lim
- p
, ":spacing=%"pI
"d",
1702 XINT (AREF (font
, FONT_SPACING_INDEX
)));
1703 if (! (0 <= len
&& len
< lim
- p
))
1708 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1710 int len
= snprintf (p
, lim
- p
,
1711 (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0
1713 : ":scalable=false"));
1714 if (! (0 <= len
&& len
< lim
- p
))
1724 /* Parse NAME (null terminated) and store information in FONT
1725 (font-spec or font-entity). If NAME is successfully parsed, return
1726 0. Otherwise return -1. */
1729 font_parse_name (char *name
, ptrdiff_t namelen
, Lisp_Object font
)
1731 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1732 return font_parse_xlfd (name
, namelen
, font
);
1733 return font_parse_fcname (name
, namelen
, font
);
1737 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1738 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1742 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1748 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1750 CHECK_STRING (family
);
1751 len
= SBYTES (family
);
1752 p0
= SSDATA (family
);
1753 p1
= strchr (p0
, '-');
1756 if ((*p0
!= '*' && p1
- p0
> 0)
1757 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1758 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1761 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1764 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1766 if (! NILP (registry
))
1768 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1769 CHECK_STRING (registry
);
1770 len
= SBYTES (registry
);
1771 p0
= SSDATA (registry
);
1772 p1
= strchr (p0
, '-');
1775 AUTO_STRING (extra
, ("*-*" + (len
&& p0
[len
- 1] == '*')));
1776 registry
= concat2 (registry
, extra
);
1778 registry
= Fdowncase (registry
);
1779 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1784 /* This part (through the next ^L) is still experimental and not
1785 tested much. We may drastically change codes. */
1791 #define LGSTRING_HEADER_SIZE 6
1792 #define LGSTRING_GLYPH_SIZE 8
1795 check_gstring (Lisp_Object gstring
)
1801 CHECK_VECTOR (gstring
);
1802 val
= AREF (gstring
, 0);
1804 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1806 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1807 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1808 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1809 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1810 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1811 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1812 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1813 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1814 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1815 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1816 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1818 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1820 val
= LGSTRING_GLYPH (gstring
, i
);
1822 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1824 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1826 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1827 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1828 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1829 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1830 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1831 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1832 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1833 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1835 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1837 if (ASIZE (val
) < 3)
1839 for (j
= 0; j
< 3; j
++)
1840 CHECK_NUMBER (AREF (val
, j
));
1845 error ("Invalid glyph-string format");
1850 check_otf_features (Lisp_Object otf_features
)
1854 CHECK_CONS (otf_features
);
1855 CHECK_SYMBOL (XCAR (otf_features
));
1856 otf_features
= XCDR (otf_features
);
1857 CHECK_CONS (otf_features
);
1858 CHECK_SYMBOL (XCAR (otf_features
));
1859 otf_features
= XCDR (otf_features
);
1860 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1862 CHECK_SYMBOL (XCAR (val
));
1863 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1864 error ("Invalid OTF GSUB feature: %s",
1865 SDATA (SYMBOL_NAME (XCAR (val
))));
1867 otf_features
= XCDR (otf_features
);
1868 for (val
= Fcar (otf_features
); CONSP (val
); val
= XCDR (val
))
1870 CHECK_SYMBOL (XCAR (val
));
1871 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1872 error ("Invalid OTF GPOS feature: %s",
1873 SDATA (SYMBOL_NAME (XCAR (val
))));
1880 Lisp_Object otf_list
;
1883 otf_tag_symbol (OTF_Tag tag
)
1887 OTF_tag_name (tag
, name
);
1888 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1892 otf_open (Lisp_Object file
)
1894 Lisp_Object val
= Fassoc (file
, otf_list
);
1898 otf
= XSAVE_POINTER (XCDR (val
), 0);
1901 otf
= STRINGP (file
) ? OTF_open (SSDATA (file
)) : NULL
;
1902 val
= make_save_ptr (otf
);
1903 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1909 /* Return a list describing which scripts/languages FONT supports by
1910 which GSUB/GPOS features of OpenType tables. See the comment of
1911 (struct font_driver).otf_capability. */
1914 font_otf_capability (struct font
*font
)
1917 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1920 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1923 for (i
= 0; i
< 2; i
++)
1925 OTF_GSUB_GPOS
*gsub_gpos
;
1926 Lisp_Object script_list
= Qnil
;
1929 if (OTF_get_features (otf
, i
== 0) < 0)
1931 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1932 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1934 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1935 Lisp_Object langsys_list
= Qnil
;
1936 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1939 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1941 OTF_LangSys
*langsys
;
1942 Lisp_Object feature_list
= Qnil
;
1943 Lisp_Object langsys_tag
;
1946 if (k
== script
->LangSysCount
)
1948 langsys
= &script
->DefaultLangSys
;
1953 langsys
= script
->LangSys
+ k
;
1955 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1957 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1959 OTF_Feature
*feature
1960 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1961 Lisp_Object feature_tag
1962 = otf_tag_symbol (feature
->FeatureTag
);
1964 feature_list
= Fcons (feature_tag
, feature_list
);
1966 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1969 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1974 XSETCAR (capability
, script_list
);
1976 XSETCDR (capability
, script_list
);
1982 /* Parse OTF features in SPEC and write a proper features spec string
1983 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1984 assured that the sufficient memory has already allocated for
1988 generate_otf_features (Lisp_Object spec
, char *features
)
1996 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2002 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2007 else if (! asterisk
)
2009 val
= SYMBOL_NAME (val
);
2010 p
+= esprintf (p
, "%s", SDATA (val
));
2014 val
= SYMBOL_NAME (val
);
2015 p
+= esprintf (p
, "~%s", SDATA (val
));
2019 error ("OTF spec too long");
2023 font_otf_DeviceTable (OTF_DeviceTable
*device_table
)
2025 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2027 return Fcons (make_number (len
),
2028 make_unibyte_string (device_table
->DeltaValue
, len
));
2032 font_otf_ValueRecord (int value_format
, OTF_ValueRecord
*value_record
)
2034 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2036 if (value_format
& OTF_XPlacement
)
2037 ASET (val
, 0, make_number (value_record
->XPlacement
));
2038 if (value_format
& OTF_YPlacement
)
2039 ASET (val
, 1, make_number (value_record
->YPlacement
));
2040 if (value_format
& OTF_XAdvance
)
2041 ASET (val
, 2, make_number (value_record
->XAdvance
));
2042 if (value_format
& OTF_YAdvance
)
2043 ASET (val
, 3, make_number (value_record
->YAdvance
));
2044 if (value_format
& OTF_XPlaDevice
)
2045 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2046 if (value_format
& OTF_YPlaDevice
)
2047 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2048 if (value_format
& OTF_XAdvDevice
)
2049 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2050 if (value_format
& OTF_YAdvDevice
)
2051 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2056 font_otf_Anchor (OTF_Anchor
*anchor
)
2060 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2061 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2062 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2063 if (anchor
->AnchorFormat
== 2)
2064 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2067 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2068 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2072 #endif /* HAVE_LIBOTF */
2079 font_rescale_ratio (Lisp_Object font_entity
)
2081 Lisp_Object tail
, elt
;
2082 Lisp_Object name
= Qnil
;
2084 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2087 if (FLOATP (XCDR (elt
)))
2089 if (STRINGP (XCAR (elt
)))
2092 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2093 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2094 return XFLOAT_DATA (XCDR (elt
));
2096 else if (FONT_SPEC_P (XCAR (elt
)))
2098 if (font_match_p (XCAR (elt
), font_entity
))
2099 return XFLOAT_DATA (XCDR (elt
));
2106 /* We sort fonts by scoring each of them against a specified
2107 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2108 the value is, the closer the font is to the font-spec.
2110 The lowest 2 bits of the score are used for driver type. The font
2111 available by the most preferred font driver is 0.
2113 The 4 7-bit fields in the higher 28 bits are used for numeric properties
2114 WEIGHT, SLANT, WIDTH, and SIZE. */
2116 /* How many bits to shift to store the difference value of each font
2117 property in a score. Note that floats for FONT_TYPE_INDEX and
2118 FONT_REGISTRY_INDEX are not used. */
2119 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2121 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2122 The return value indicates how different ENTITY is compared with
2126 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2131 /* Score three style numeric fields. Maximum difference is 127. */
2132 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2133 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2135 EMACS_INT diff
= ((XINT (AREF (entity
, i
)) >> 8)
2136 - (XINT (spec_prop
[i
]) >> 8));
2137 score
|= min (eabs (diff
), 127) << sort_shift_bits
[i
];
2140 /* Score the size. Maximum difference is 127. */
2141 i
= FONT_SIZE_INDEX
;
2142 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2143 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2145 /* We use the higher 6-bit for the actual size difference. The
2146 lowest bit is set if the DPI is different. */
2148 EMACS_INT pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2149 EMACS_INT entity_size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
2151 if (CONSP (Vface_font_rescale_alist
))
2152 pixel_size
*= font_rescale_ratio (entity
);
2153 if (pixel_size
* 2 < entity_size
|| entity_size
* 2 < pixel_size
)
2154 /* This size is wrong by more than a factor 2: reject it! */
2156 diff
= eabs (pixel_size
- entity_size
) << 1;
2157 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2158 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2160 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2161 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2163 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2170 /* Concatenate all elements of LIST into one vector. LIST is a list
2171 of font-entity vectors. */
2174 font_vconcat_entity_vectors (Lisp_Object list
)
2176 EMACS_INT nargs
= XFASTINT (Flength (list
));
2179 SAFE_ALLOCA_LISP (args
, nargs
);
2182 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2183 args
[i
] = XCAR (list
);
2184 Lisp_Object result
= Fvconcat (nargs
, args
);
2190 /* The structure for elements being sorted by qsort. */
2191 struct font_sort_data
2194 int font_driver_preference
;
2199 /* The comparison function for qsort. */
2202 font_compare (const void *d1
, const void *d2
)
2204 const struct font_sort_data
*data1
= d1
;
2205 const struct font_sort_data
*data2
= d2
;
2207 if (data1
->score
< data2
->score
)
2209 else if (data1
->score
> data2
->score
)
2211 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2215 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2216 If PREFER specifies a point-size, calculate the corresponding
2217 pixel-size from QCdpi property of PREFER or from the Y-resolution
2218 of FRAME before sorting.
2220 If BEST-ONLY is nonzero, return the best matching entity (that
2221 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2222 if BEST-ONLY is negative). Otherwise, return the sorted result as
2223 a single vector of font-entities.
2225 This function does no optimization for the case that the total
2226 number of elements is 1. The caller should avoid calling this in
2230 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
,
2231 struct frame
*f
, int best_only
)
2233 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2235 struct font_sort_data
*data
;
2236 unsigned best_score
;
2237 Lisp_Object best_entity
;
2238 Lisp_Object tail
, vec
IF_LINT (= Qnil
);
2241 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2242 prefer_prop
[i
] = AREF (prefer
, i
);
2243 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2244 prefer_prop
[FONT_SIZE_INDEX
]
2245 = make_number (font_pixel_size (f
, prefer
));
2247 if (NILP (XCDR (list
)))
2249 /* What we have to take care of is this single vector. */
2251 maxlen
= ASIZE (vec
);
2255 /* We don't have to perform sort, so there's no need of creating
2256 a single vector. But, we must find the length of the longest
2259 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2260 if (maxlen
< ASIZE (XCAR (tail
)))
2261 maxlen
= ASIZE (XCAR (tail
));
2265 /* We have to create a single vector to sort it. */
2266 vec
= font_vconcat_entity_vectors (list
);
2267 maxlen
= ASIZE (vec
);
2270 data
= SAFE_ALLOCA (maxlen
* sizeof *data
);
2271 best_score
= 0xFFFFFFFF;
2274 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2276 int font_driver_preference
= 0;
2277 Lisp_Object current_font_driver
;
2283 /* We are sure that the length of VEC > 0. */
2284 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2285 /* Score the elements. */
2286 for (i
= 0; i
< len
; i
++)
2288 data
[i
].entity
= AREF (vec
, i
);
2290 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2292 ? font_score (data
[i
].entity
, prefer_prop
)
2294 if (best_only
&& best_score
> data
[i
].score
)
2296 best_score
= data
[i
].score
;
2297 best_entity
= data
[i
].entity
;
2298 if (best_score
== 0)
2301 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2303 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2304 font_driver_preference
++;
2306 data
[i
].font_driver_preference
= font_driver_preference
;
2309 /* Sort if necessary. */
2312 qsort (data
, len
, sizeof *data
, font_compare
);
2313 for (i
= 0; i
< len
; i
++)
2314 ASET (vec
, i
, data
[i
].entity
);
2323 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2328 /* API of Font Service Layer. */
2330 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2331 sort_shift_bits. Finternal_set_font_selection_order calls this
2332 function with font_sort_order after setting up it. */
2335 font_update_sort_order (int *order
)
2339 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2341 int xlfd_idx
= order
[i
];
2343 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2344 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2345 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2346 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2347 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2348 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2350 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2355 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
,
2356 Lisp_Object features
, Lisp_Object table
)
2361 table
= assq_no_quit (script
, table
);
2364 table
= XCDR (table
);
2365 if (! NILP (langsys
))
2367 table
= assq_no_quit (langsys
, table
);
2373 val
= assq_no_quit (Qnil
, table
);
2375 table
= XCAR (table
);
2379 table
= XCDR (table
);
2380 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2382 if (NILP (XCAR (features
)))
2387 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2393 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2396 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2398 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2400 script
= XCAR (spec
);
2404 langsys
= XCAR (spec
);
2415 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2416 XCAR (otf_capability
)))
2418 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2419 XCDR (otf_capability
)))
2426 /* Check if FONT (font-entity or font-object) matches with the font
2427 specification SPEC. */
2430 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2432 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2433 Lisp_Object extra
, font_extra
;
2436 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2437 if (! NILP (AREF (spec
, i
))
2438 && ! NILP (AREF (font
, i
))
2439 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2441 props
= XFONT_SPEC (spec
)->props
;
2442 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2444 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2445 prop
[i
] = AREF (spec
, i
);
2446 prop
[FONT_SIZE_INDEX
]
2447 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2451 if (font_score (font
, props
) > 0)
2453 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2454 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2455 for (; CONSP (extra
); extra
= XCDR (extra
))
2457 Lisp_Object key
= XCAR (XCAR (extra
));
2458 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2460 if (EQ (key
, QClang
))
2462 val2
= assq_no_quit (key
, font_extra
);
2471 if (NILP (Fmemq (val
, val2
)))
2476 ? NILP (Fmemq (val
, XCDR (val2
)))
2480 else if (EQ (key
, QCscript
))
2482 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2488 /* All characters in the list must be supported. */
2489 for (; CONSP (val2
); val2
= XCDR (val2
))
2491 if (! CHARACTERP (XCAR (val2
)))
2493 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2494 == FONT_INVALID_CODE
)
2498 else if (VECTORP (val2
))
2500 /* At most one character in the vector must be supported. */
2501 for (i
= 0; i
< ASIZE (val2
); i
++)
2503 if (! CHARACTERP (AREF (val2
, i
)))
2505 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2506 != FONT_INVALID_CODE
)
2509 if (i
== ASIZE (val2
))
2514 else if (EQ (key
, QCotf
))
2518 if (! FONT_OBJECT_P (font
))
2520 fontp
= XFONT_OBJECT (font
);
2521 if (! fontp
->driver
->otf_capability
)
2523 val2
= fontp
->driver
->otf_capability (fontp
);
2524 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2535 Each font backend has the callback function get_cache, and it
2536 returns a cons cell of which cdr part can be freely used for
2537 caching fonts. The cons cell may be shared by multiple frames
2538 and/or multiple font drivers. So, we arrange the cdr part as this:
2540 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2542 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2543 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2544 cons (FONT-SPEC . [FONT-ENTITY ...]). */
2546 static void font_prepare_cache (struct frame
*, struct font_driver
*);
2547 static void font_finish_cache (struct frame
*, struct font_driver
*);
2548 static Lisp_Object
font_get_cache (struct frame
*, struct font_driver
*);
2549 static void font_clear_cache (struct frame
*, Lisp_Object
,
2550 struct font_driver
*);
2553 font_prepare_cache (struct frame
*f
, struct font_driver
*driver
)
2555 Lisp_Object cache
, val
;
2557 cache
= driver
->get_cache (f
);
2559 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2563 val
= list2 (driver
->type
, make_number (1));
2564 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2568 val
= XCDR (XCAR (val
));
2569 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2575 font_finish_cache (struct frame
*f
, struct font_driver
*driver
)
2577 Lisp_Object cache
, val
, tmp
;
2580 cache
= driver
->get_cache (f
);
2582 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2583 cache
= val
, val
= XCDR (val
);
2584 eassert (! NILP (val
));
2585 tmp
= XCDR (XCAR (val
));
2586 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2587 if (XINT (XCAR (tmp
)) == 0)
2589 font_clear_cache (f
, XCAR (val
), driver
);
2590 XSETCDR (cache
, XCDR (val
));
2596 font_get_cache (struct frame
*f
, struct font_driver
*driver
)
2598 Lisp_Object val
= driver
->get_cache (f
);
2599 Lisp_Object type
= driver
->type
;
2601 eassert (CONSP (val
));
2602 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2603 eassert (CONSP (val
));
2604 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2605 val
= XCDR (XCAR (val
));
2611 font_clear_cache (struct frame
*f
, Lisp_Object cache
, struct font_driver
*driver
)
2613 Lisp_Object tail
, elt
;
2617 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2618 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2621 /* elt should have the form (FONT-SPEC . [FONT-ENTITY ...]) */
2622 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2625 eassert (VECTORP (elt
));
2626 for (i
= 0; i
< ASIZE (elt
); i
++)
2628 entity
= AREF (elt
, i
);
2630 if (FONT_ENTITY_P (entity
)
2631 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2633 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2635 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2637 Lisp_Object val
= XCAR (objlist
);
2638 struct font
*font
= XFONT_OBJECT (val
);
2640 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2642 eassert (font
&& driver
== font
->driver
);
2643 driver
->close (font
);
2646 if (driver
->free_entity
)
2647 driver
->free_entity (entity
);
2652 XSETCDR (cache
, Qnil
);
2656 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2658 /* Check each font-entity in VEC, and return a list of font-entities
2659 that satisfy these conditions:
2660 (1) matches with SPEC and SIZE if SPEC is not nil, and
2661 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2665 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2667 Lisp_Object entity
, val
;
2668 enum font_property_index prop
;
2671 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2673 entity
= AREF (vec
, i
);
2674 if (! NILP (Vface_ignored_fonts
))
2678 Lisp_Object tail
, regexp
;
2680 namelen
= font_unparse_xlfd (entity
, 0, name
, 256);
2683 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2685 regexp
= XCAR (tail
);
2686 if (STRINGP (regexp
)
2687 && fast_c_string_match_ignore_case (regexp
, name
,
2697 val
= Fcons (entity
, val
);
2700 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2701 if (INTEGERP (AREF (spec
, prop
))
2702 && ((XINT (AREF (spec
, prop
)) >> 8)
2703 != (XINT (AREF (entity
, prop
)) >> 8)))
2704 prop
= FONT_SPEC_MAX
;
2705 if (prop
< FONT_SPEC_MAX
2707 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2709 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2711 if (eabs (diff
) > FONT_PIXEL_SIZE_QUANTUM
)
2712 prop
= FONT_SPEC_MAX
;
2714 if (prop
< FONT_SPEC_MAX
2715 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2716 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2717 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2718 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2719 prop
= FONT_SPEC_MAX
;
2720 if (prop
< FONT_SPEC_MAX
2721 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2722 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2723 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2724 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2725 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2726 prop
= FONT_SPEC_MAX
;
2727 if (prop
< FONT_SPEC_MAX
)
2728 val
= Fcons (entity
, val
);
2730 return (Fvconcat (1, &val
));
2734 /* Return a list of vectors of font-entities matching with SPEC on
2735 FRAME. Each elements in the list is a vector of entities from the
2736 same font-driver. */
2739 font_list_entities (struct frame
*f
, Lisp_Object spec
)
2741 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2742 Lisp_Object ftype
, val
;
2743 Lisp_Object list
= Qnil
;
2745 bool need_filtering
= 0;
2748 eassert (FONT_SPEC_P (spec
));
2750 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2751 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2752 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2753 size
= font_pixel_size (f
, spec
);
2757 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2758 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2759 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2760 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2761 if (i
!= FONT_SPACING_INDEX
)
2763 ASET (scratch_font_spec
, i
, Qnil
);
2764 if (! NILP (AREF (spec
, i
)))
2767 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2768 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2770 for (; driver_list
; driver_list
= driver_list
->next
)
2772 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2774 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2776 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2777 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2782 val
= driver_list
->driver
->list (f
, scratch_font_spec
);
2785 Lisp_Object copy
= copy_font_spec (scratch_font_spec
);
2787 val
= Fvconcat (1, &val
);
2788 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2789 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2792 if (VECTORP (val
) && ASIZE (val
) > 0
2794 || ! NILP (Vface_ignored_fonts
)))
2795 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2796 if (VECTORP (val
) && ASIZE (val
) > 0)
2797 list
= Fcons (val
, list
);
2800 list
= Fnreverse (list
);
2801 FONT_ADD_LOG ("list", spec
, list
);
2806 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2807 nil, is an array of face's attributes, which specifies preferred
2808 font-related attributes. */
2811 font_matching_entity (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2813 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2814 Lisp_Object ftype
, size
, entity
;
2815 Lisp_Object work
= copy_font_spec (spec
);
2817 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2818 size
= AREF (spec
, FONT_SIZE_INDEX
);
2821 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2822 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2823 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2824 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2827 for (; driver_list
; driver_list
= driver_list
->next
)
2829 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2831 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2833 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2834 entity
= assoc_no_quit (work
, XCDR (cache
));
2836 entity
= AREF (XCDR (entity
), 0);
2839 entity
= driver_list
->driver
->match (f
, work
);
2842 Lisp_Object copy
= copy_font_spec (work
);
2843 Lisp_Object match
= Fvector (1, &entity
);
2845 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2846 XSETCDR (cache
, Fcons (Fcons (copy
, match
), XCDR (cache
)));
2849 if (! NILP (entity
))
2852 FONT_ADD_LOG ("match", work
, entity
);
2857 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2858 opened font object. */
2861 font_open_entity (struct frame
*f
, Lisp_Object entity
, int pixel_size
)
2863 struct font_driver_list
*driver_list
;
2864 Lisp_Object objlist
, size
, val
, font_object
;
2866 int min_width
, height
, psize
;
2868 eassert (FONT_ENTITY_P (entity
));
2869 size
= AREF (entity
, FONT_SIZE_INDEX
);
2870 if (XINT (size
) != 0)
2871 pixel_size
= XINT (size
);
2873 val
= AREF (entity
, FONT_TYPE_INDEX
);
2874 for (driver_list
= f
->font_driver_list
;
2875 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2876 driver_list
= driver_list
->next
);
2880 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2881 objlist
= XCDR (objlist
))
2883 Lisp_Object fn
= XCAR (objlist
);
2884 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2885 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2887 if (driver_list
->driver
->cached_font_ok
== NULL
2888 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2893 /* We always open a font of manageable size; i.e non-zero average
2894 width and height. */
2895 for (psize
= pixel_size
; ; psize
++)
2897 font_object
= driver_list
->driver
->open (f
, entity
, psize
);
2898 if (NILP (font_object
))
2900 font
= XFONT_OBJECT (font_object
);
2901 if (font
->average_width
> 0 && font
->height
> 0)
2904 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2905 FONT_ADD_LOG ("open", entity
, font_object
);
2906 ASET (entity
, FONT_OBJLIST_INDEX
,
2907 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2909 font
= XFONT_OBJECT (font_object
);
2910 min_width
= (font
->min_width
? font
->min_width
2911 : font
->average_width
? font
->average_width
2912 : font
->space_width
? font
->space_width
2914 height
= (font
->height
? font
->height
: 1);
2915 #ifdef HAVE_WINDOW_SYSTEM
2916 FRAME_DISPLAY_INFO (f
)->n_fonts
++;
2917 if (FRAME_DISPLAY_INFO (f
)->n_fonts
== 1)
2919 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2920 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2921 f
->fonts_changed
= 1;
2925 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2926 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, f
->fonts_changed
= 1;
2927 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2928 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, f
->fonts_changed
= 1;
2936 /* Close FONT_OBJECT that is opened on frame F. */
2939 font_close_object (struct frame
*f
, Lisp_Object font_object
)
2941 struct font
*font
= XFONT_OBJECT (font_object
);
2943 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2944 /* Already closed. */
2946 FONT_ADD_LOG ("close", font_object
, Qnil
);
2947 font
->driver
->close (font
);
2948 #ifdef HAVE_WINDOW_SYSTEM
2949 eassert (FRAME_DISPLAY_INFO (f
)->n_fonts
);
2950 FRAME_DISPLAY_INFO (f
)->n_fonts
--;
2955 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2956 FONT is a font-entity and it must be opened to check. */
2959 font_has_char (struct frame
*f
, Lisp_Object font
, int c
)
2963 if (FONT_ENTITY_P (font
))
2965 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2966 struct font_driver_list
*driver_list
;
2968 for (driver_list
= f
->font_driver_list
;
2969 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2970 driver_list
= driver_list
->next
);
2973 if (! driver_list
->driver
->has_char
)
2975 return driver_list
->driver
->has_char (font
, c
);
2978 eassert (FONT_OBJECT_P (font
));
2979 fontp
= XFONT_OBJECT (font
);
2980 if (fontp
->driver
->has_char
)
2982 int result
= fontp
->driver
->has_char (font
, c
);
2987 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2991 /* Return the glyph ID of FONT_OBJECT for character C. */
2994 font_encode_char (Lisp_Object font_object
, int c
)
2998 eassert (FONT_OBJECT_P (font_object
));
2999 font
= XFONT_OBJECT (font_object
);
3000 return font
->driver
->encode_char (font
, c
);
3004 /* Return the name of FONT_OBJECT. */
3007 font_get_name (Lisp_Object font_object
)
3009 eassert (FONT_OBJECT_P (font_object
));
3010 return AREF (font_object
, FONT_NAME_INDEX
);
3014 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3015 could not be parsed by font_parse_name, return Qnil. */
3018 font_spec_from_name (Lisp_Object font_name
)
3020 Lisp_Object spec
= Ffont_spec (0, NULL
);
3022 CHECK_STRING (font_name
);
3023 if (font_parse_name (SSDATA (font_name
), SBYTES (font_name
), spec
) == -1)
3025 font_put_extra (spec
, QCname
, font_name
);
3026 font_put_extra (spec
, QCuser_spec
, font_name
);
3032 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
3034 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3039 if (! NILP (Ffont_get (font
, QCname
)))
3041 font
= copy_font_spec (font
);
3042 font_put_extra (font
, QCname
, Qnil
);
3045 if (NILP (AREF (font
, prop
))
3046 && prop
!= FONT_FAMILY_INDEX
3047 && prop
!= FONT_FOUNDRY_INDEX
3048 && prop
!= FONT_WIDTH_INDEX
3049 && prop
!= FONT_SIZE_INDEX
)
3051 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3052 font
= copy_font_spec (font
);
3053 ASET (font
, prop
, Qnil
);
3054 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3056 if (prop
== FONT_FAMILY_INDEX
)
3058 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3059 /* If we are setting the font family, we must also clear
3060 FONT_WIDTH_INDEX to avoid rejecting families that lack
3061 support for some widths. */
3062 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3064 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3065 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3066 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3067 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3068 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3069 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3071 else if (prop
== FONT_SIZE_INDEX
)
3073 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3074 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3075 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3077 else if (prop
== FONT_WIDTH_INDEX
)
3078 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3079 attrs
[LFACE_FONT_INDEX
] = font
;
3082 /* Select a font from ENTITIES (list of font-entity vectors) that
3083 supports C and is the best match for ATTRS and PIXEL_SIZE. */
3086 font_select_entity (struct frame
*f
, Lisp_Object entities
,
3087 Lisp_Object
*attrs
, int pixel_size
, int c
)
3089 Lisp_Object font_entity
;
3093 if (NILP (XCDR (entities
))
3094 && ASIZE (XCAR (entities
)) == 1)
3096 font_entity
= AREF (XCAR (entities
), 0);
3097 if (c
< 0 || font_has_char (f
, font_entity
, c
) > 0)
3102 /* Sort fonts by properties specified in ATTRS. */
3103 prefer
= scratch_font_prefer
;
3105 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3106 ASET (prefer
, i
, Qnil
);
3107 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3109 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3111 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3112 ASET (prefer
, i
, AREF (face_font
, i
));
3114 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3115 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3116 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3117 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3118 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3119 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3120 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3122 return font_sort_entities (entities
, prefer
, f
, c
);
3125 /* Return a font-entity that satisfies SPEC and is the best match for
3126 face's font related attributes in ATTRS. C, if not negative, is a
3127 character that the entity must support. */
3130 font_find_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3133 Lisp_Object entities
, val
;
3134 Lisp_Object foundry
[3], *family
, registry
[3], adstyle
[3];
3139 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3140 if (NILP (registry
[0]))
3142 registry
[0] = DEFAULT_ENCODING
;
3143 registry
[1] = Qascii_0
;
3144 registry
[2] = zero_vector
;
3147 registry
[1] = zero_vector
;
3149 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3151 struct charset
*encoding
, *repertory
;
3153 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3154 &encoding
, &repertory
) < 0)
3157 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3159 else if (c
> encoding
->max_char
)
3163 work
= copy_font_spec (spec
);
3164 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3165 pixel_size
= font_pixel_size (f
, spec
);
3166 if (pixel_size
== 0 && INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3168 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3170 pixel_size
= POINT_TO_PIXEL (pt
/ 10, FRAME_RES_Y (f
));
3174 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3175 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3176 if (! NILP (foundry
[0]))
3177 foundry
[1] = zero_vector
;
3178 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3180 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3181 foundry
[0] = font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3183 foundry
[2] = zero_vector
;
3186 foundry
[0] = Qnil
, foundry
[1] = zero_vector
;
3188 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3189 if (! NILP (adstyle
[0]))
3190 adstyle
[1] = zero_vector
;
3191 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3193 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3195 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3197 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3199 adstyle
[2] = zero_vector
;
3202 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3205 adstyle
[0] = Qnil
, adstyle
[1] = zero_vector
;
3208 val
= AREF (work
, FONT_FAMILY_INDEX
);
3209 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3211 val
= attrs
[LFACE_FAMILY_INDEX
];
3212 val
= font_intern_prop (SSDATA (val
), SBYTES (val
), 1);
3214 Lisp_Object familybuf
[3];
3219 family
[1] = zero_vector
; /* terminator. */
3224 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3226 if (! NILP (alters
))
3228 EMACS_INT alterslen
= XFASTINT (Flength (alters
));
3229 SAFE_ALLOCA_LISP (family
, alterslen
+ 2);
3230 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3231 family
[i
] = XCAR (alters
);
3232 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3234 family
[i
] = zero_vector
;
3241 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3243 family
[i
] = zero_vector
;
3247 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3249 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3250 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3252 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3253 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3255 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3256 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3258 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3259 entities
= font_list_entities (f
, work
);
3260 if (! NILP (entities
))
3262 val
= font_select_entity (f
, entities
,
3263 attrs
, pixel_size
, c
);
3281 font_open_for_lface (struct frame
*f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3285 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3286 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3287 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3290 if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3291 size
= font_pixel_size (f
, spec
);
3295 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3296 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3299 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3300 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3301 eassert (INTEGERP (height
));
3306 size
= POINT_TO_PIXEL (pt
, FRAME_RES_Y (f
));
3310 Lisp_Object ffsize
= get_frame_param (f
, Qfontsize
);
3311 size
= (NUMBERP (ffsize
)
3312 ? POINT_TO_PIXEL (XINT (ffsize
), FRAME_RES_Y (f
)) : 0);
3316 size
*= font_rescale_ratio (entity
);
3319 return font_open_entity (f
, entity
, size
);
3323 /* Find a font that satisfies SPEC and is the best match for
3324 face's attributes in ATTRS on FRAME, and return the opened
3328 font_load_for_lface (struct frame
*f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3330 Lisp_Object entity
, name
;
3332 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3335 /* No font is listed for SPEC, but each font-backend may have
3336 different criteria about "font matching". So, try it. */
3337 entity
= font_matching_entity (f
, attrs
, spec
);
3341 /* Don't lose the original name that was put in initially. We need
3342 it to re-apply the font when font parameters (like hinting or dpi) have
3344 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3347 name
= Ffont_get (spec
, QCuser_spec
);
3348 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3354 /* Make FACE on frame F ready to use the font opened for FACE. */
3357 font_prepare_for_face (struct frame
*f
, struct face
*face
)
3359 if (face
->font
->driver
->prepare_face
)
3360 face
->font
->driver
->prepare_face (f
, face
);
3364 /* Make FACE on frame F stop using the font opened for FACE. */
3367 font_done_for_face (struct frame
*f
, struct face
*face
)
3369 if (face
->font
->driver
->done_face
)
3370 face
->font
->driver
->done_face (f
, face
);
3374 /* Open a font that is a match for font-spec SPEC on frame F. If no proper
3375 font is found, return Qnil. */
3378 font_open_by_spec (struct frame
*f
, Lisp_Object spec
)
3380 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3382 /* We set up the default font-related attributes of a face to prefer
3384 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3385 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3386 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3388 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3390 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3392 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3394 return font_load_for_lface (f
, attrs
, spec
);
3398 /* Open a font that matches NAME on frame F. If no proper font is
3399 found, return Qnil. */
3402 font_open_by_name (struct frame
*f
, Lisp_Object name
)
3404 Lisp_Object args
[2];
3405 Lisp_Object spec
, ret
;
3409 spec
= Ffont_spec (2, args
);
3410 ret
= font_open_by_spec (f
, spec
);
3411 /* Do not lose name originally put in. */
3413 font_put_extra (ret
, QCuser_spec
, args
[1]);
3419 /* Register font-driver DRIVER. This function is used in two ways.
3421 The first is with frame F non-NULL. In this case, make DRIVER
3422 available (but not yet activated) on F. All frame creators
3423 (e.g. Fx_create_frame) must call this function at least once with
3424 an available font-driver.
3426 The second is with frame F NULL. In this case, DRIVER is globally
3427 registered in the variable `font_driver_list'. All font-driver
3428 implementations must call this function in its syms_of_XXXX
3429 (e.g. syms_of_xfont). */
3432 register_font_driver (struct font_driver
*driver
, struct frame
*f
)
3434 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3435 struct font_driver_list
*prev
, *list
;
3437 #ifdef HAVE_WINDOW_SYSTEM
3438 if (f
&& ! driver
->draw
)
3439 error ("Unusable font driver for a frame: %s",
3440 SDATA (SYMBOL_NAME (driver
->type
)));
3441 #endif /* HAVE_WINDOW_SYSTEM */
3443 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3444 if (EQ (list
->driver
->type
, driver
->type
))
3445 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3447 list
= xmalloc (sizeof *list
);
3449 list
->driver
= driver
;
3454 f
->font_driver_list
= list
;
3456 font_driver_list
= list
;
3462 free_font_driver_list (struct frame
*f
)
3464 struct font_driver_list
*list
, *next
;
3466 for (list
= f
->font_driver_list
; list
; list
= next
)
3471 f
->font_driver_list
= NULL
;
3475 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3476 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3477 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3479 A caller must free all realized faces if any in advance. The
3480 return value is a list of font backends actually made used on
3484 font_update_drivers (struct frame
*f
, Lisp_Object new_drivers
)
3486 Lisp_Object active_drivers
= Qnil
;
3487 struct font_driver_list
*list
;
3489 /* At first, turn off non-requested drivers, and turn on requested
3491 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3493 struct font_driver
*driver
= list
->driver
;
3494 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3499 if (driver
->end_for_frame
)
3500 driver
->end_for_frame (f
);
3501 font_finish_cache (f
, driver
);
3506 if (! driver
->start_for_frame
3507 || driver
->start_for_frame (f
) == 0)
3509 font_prepare_cache (f
, driver
);
3516 if (NILP (new_drivers
))
3519 if (! EQ (new_drivers
, Qt
))
3521 /* Re-order the driver list according to new_drivers. */
3522 struct font_driver_list
**list_table
, **next
;
3527 SAFE_NALLOCA (list_table
, 1, num_font_drivers
+ 1);
3528 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3530 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3531 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3534 list_table
[i
++] = list
;
3536 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3538 list_table
[i
++] = list
;
3539 list_table
[i
] = NULL
;
3541 next
= &f
->font_driver_list
;
3542 for (i
= 0; list_table
[i
]; i
++)
3544 *next
= list_table
[i
];
3545 next
= &(*next
)->next
;
3550 if (! f
->font_driver_list
->on
)
3551 { /* None of the drivers is enabled: enable them all.
3552 Happens if you set the list of drivers to (xft x) in your .emacs
3553 and then use it under w32 or ns. */
3554 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3556 struct font_driver
*driver
= list
->driver
;
3557 eassert (! list
->on
);
3558 if (! driver
->start_for_frame
3559 || driver
->start_for_frame (f
) == 0)
3561 font_prepare_cache (f
, driver
);
3568 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3570 active_drivers
= nconc2 (active_drivers
, list1 (list
->driver
->type
));
3571 return active_drivers
;
3574 #if defined (HAVE_XFT) || defined (HAVE_FREETYPE)
3577 fset_font_data (struct frame
*f
, Lisp_Object val
)
3583 font_put_frame_data (struct frame
*f
, Lisp_Object driver
, void *data
)
3585 Lisp_Object val
= assq_no_quit (driver
, f
->font_data
);
3588 fset_font_data (f
, Fdelq (val
, f
->font_data
));
3592 fset_font_data (f
, Fcons (Fcons (driver
, make_save_ptr (data
)),
3595 XSETCDR (val
, make_save_ptr (data
));
3600 font_get_frame_data (struct frame
*f
, Lisp_Object driver
)
3602 Lisp_Object val
= assq_no_quit (driver
, f
->font_data
);
3604 return NILP (val
) ? NULL
: XSAVE_POINTER (XCDR (val
), 0);
3607 #endif /* HAVE_XFT || HAVE_FREETYPE */
3609 /* Sets attributes on a font. Any properties that appear in ALIST and
3610 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3611 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3612 arrays of strings. This function is intended for use by the font
3613 drivers to implement their specific font_filter_properties. */
3615 font_filter_properties (Lisp_Object font
,
3617 const char *const boolean_properties
[],
3618 const char *const non_boolean_properties
[])
3623 /* Set boolean values to Qt or Qnil. */
3624 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3625 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3627 Lisp_Object key
= XCAR (XCAR (it
));
3628 Lisp_Object val
= XCDR (XCAR (it
));
3629 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3631 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3633 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3634 : SYMBOLP (val
) ? SSDATA (SYMBOL_NAME (val
))
3637 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3638 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3639 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3640 || strcmp ("Off", str
) == 0)
3645 Ffont_put (font
, key
, val
);
3649 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3650 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3652 Lisp_Object key
= XCAR (XCAR (it
));
3653 Lisp_Object val
= XCDR (XCAR (it
));
3654 char *keystr
= SSDATA (SYMBOL_NAME (key
));
3655 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3656 Ffont_put (font
, key
, val
);
3661 /* Return the font used to draw character C by FACE at buffer position
3662 POS in window W. If STRING is non-nil, it is a string containing C
3663 at index POS. If C is negative, get C from the current buffer or
3667 font_at (int c
, ptrdiff_t pos
, struct face
*face
, struct window
*w
,
3672 Lisp_Object font_object
;
3674 multibyte
= (NILP (string
)
3675 ? ! NILP (BVAR (current_buffer
, enable_multibyte_characters
))
3676 : STRING_MULTIBYTE (string
));
3683 ptrdiff_t pos_byte
= CHAR_TO_BYTE (pos
);
3685 c
= FETCH_CHAR (pos_byte
);
3688 c
= FETCH_BYTE (pos
);
3694 multibyte
= STRING_MULTIBYTE (string
);
3697 ptrdiff_t pos_byte
= string_char_to_byte (string
, pos
);
3699 str
= SDATA (string
) + pos_byte
;
3700 c
= STRING_CHAR (str
);
3703 c
= SDATA (string
)[pos
];
3707 f
= XFRAME (w
->frame
);
3708 if (! FRAME_WINDOW_P (f
))
3715 if (STRINGP (string
))
3716 face_id
= face_at_string_position (w
, string
, pos
, 0, &endptr
,
3717 DEFAULT_FACE_ID
, 0);
3719 face_id
= face_at_buffer_position (w
, pos
, &endptr
,
3721 face
= FACE_FROM_ID (f
, face_id
);
3725 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3726 face
= FACE_FROM_ID (f
, face_id
);
3731 XSETFONT (font_object
, face
->font
);
3736 #ifdef HAVE_WINDOW_SYSTEM
3738 /* Check how many characters after character/byte position POS/POS_BYTE
3739 (at most to *LIMIT) can be displayed by the same font in the window W.
3740 FACE, if non-NULL, is the face selected for the character at POS.
3741 If STRING is not nil, it is the string to check instead of the current
3742 buffer. In that case, FACE must be not NULL.
3744 The return value is the font-object for the character at POS.
3745 *LIMIT is set to the position where that font can't be used.
3747 It is assured that the current buffer (or STRING) is multibyte. */
3750 font_range (ptrdiff_t pos
, ptrdiff_t pos_byte
, ptrdiff_t *limit
,
3751 struct window
*w
, struct face
*face
, Lisp_Object string
)
3755 Lisp_Object font_object
= Qnil
;
3763 face_id
= face_at_buffer_position (w
, pos
, &ignore
,
3765 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3771 while (pos
< *limit
)
3773 Lisp_Object category
;
3776 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3778 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3779 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3780 if (INTEGERP (category
)
3781 && (XINT (category
) == UNICODE_CATEGORY_Cf
3782 || CHAR_VARIATION_SELECTOR_P (c
)))
3784 if (NILP (font_object
))
3786 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3787 if (NILP (font_object
))
3791 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3801 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3802 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3803 Return nil otherwise.
3804 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3805 which kind of font it is. It must be one of `font-spec', `font-entity',
3807 (Lisp_Object object
, Lisp_Object extra_type
)
3809 if (NILP (extra_type
))
3810 return (FONTP (object
) ? Qt
: Qnil
);
3811 if (EQ (extra_type
, Qfont_spec
))
3812 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3813 if (EQ (extra_type
, Qfont_entity
))
3814 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3815 if (EQ (extra_type
, Qfont_object
))
3816 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3817 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3820 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3821 doc
: /* Return a newly created font-spec with arguments as properties.
3823 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3824 valid font property name listed below:
3826 `:family', `:weight', `:slant', `:width'
3828 They are the same as face attributes of the same name. See
3829 `set-face-attribute'.
3833 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3837 VALUE must be a string or a symbol specifying the additional
3838 typographic style information of a font, e.g. ``sans''.
3842 VALUE must be a string or a symbol specifying the charset registry and
3843 encoding of a font, e.g. ``iso8859-1''.
3847 VALUE must be a non-negative integer or a floating point number
3848 specifying the font size. It specifies the font size in pixels (if
3849 VALUE is an integer), or in points (if VALUE is a float).
3853 VALUE must be a string of XLFD-style or fontconfig-style font name.
3857 VALUE must be a symbol representing a script that the font must
3858 support. It may be a symbol representing a subgroup of a script
3859 listed in the variable `script-representative-chars'.
3863 VALUE must be a symbol of two-letter ISO-639 language names,
3868 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3869 required OpenType features.
3871 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3872 LANGSYS-TAG: OpenType language system tag symbol,
3873 or nil for the default language system.
3874 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3875 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3877 GSUB and GPOS may contain `nil' element. In such a case, the font
3878 must not have any of the remaining elements.
3880 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3881 be an OpenType font whose GPOS table of `thai' script's default
3882 language system must contain `mark' feature.
3884 usage: (font-spec ARGS...) */)
3885 (ptrdiff_t nargs
, Lisp_Object
*args
)
3887 Lisp_Object spec
= font_make_spec ();
3890 for (i
= 0; i
< nargs
; i
+= 2)
3892 Lisp_Object key
= args
[i
], val
;
3896 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3899 if (EQ (key
, QCname
))
3902 if (font_parse_name (SSDATA (val
), SBYTES (val
), spec
) < 0)
3903 error ("Invalid font name: %s", SSDATA (val
));
3904 font_put_extra (spec
, key
, val
);
3908 int idx
= get_font_prop_index (key
);
3912 val
= font_prop_validate (idx
, Qnil
, val
);
3913 if (idx
< FONT_EXTRA_INDEX
)
3914 ASET (spec
, idx
, val
);
3916 font_put_extra (spec
, key
, val
);
3919 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3925 /* Return a copy of FONT as a font-spec. For the sake of speed, this code
3926 relies on an internal stuff exposed from alloc.c and should be handled
3930 copy_font_spec (Lisp_Object font
)
3932 enum { font_spec_size
= VECSIZE (struct font_spec
) };
3933 Lisp_Object new_spec
, tail
, *pcdr
;
3934 struct font_spec
*spec
;
3938 /* Make an uninitialized font-spec object. */
3939 spec
= (struct font_spec
*) allocate_vector (font_spec_size
);
3940 XSETPVECTYPESIZE (spec
, PVEC_FONT
, FONT_SPEC_MAX
,
3941 font_spec_size
- FONT_SPEC_MAX
);
3943 spec
->props
[FONT_TYPE_INDEX
] = spec
->props
[FONT_EXTRA_INDEX
] = Qnil
;
3945 /* Copy basic properties FONT_FOUNDRY_INDEX..FONT_AVGWIDTH_INDEX. */
3946 memcpy (spec
->props
+ 1, XVECTOR (font
)->contents
+ 1,
3947 (FONT_EXTRA_INDEX
- 1) * word_size
);
3949 /* Copy an alist of extra information but discard :font-entity property. */
3950 pcdr
= spec
->props
+ FONT_EXTRA_INDEX
;
3951 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3952 if (!EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3953 *pcdr
= Fcons (XCAR (tail
), Qnil
), pcdr
= xcdr_addr (*pcdr
);
3955 XSETFONT (new_spec
, spec
);
3959 /* Merge font-specs FROM and TO, and return a new font-spec.
3960 Every specified property in FROM overrides the corresponding
3963 merge_font_spec (Lisp_Object from
, Lisp_Object to
)
3965 Lisp_Object extra
, tail
;
3970 to
= copy_font_spec (to
);
3971 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3972 ASET (to
, i
, AREF (from
, i
));
3973 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3974 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3975 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3977 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3980 XSETCDR (slot
, XCDR (XCAR (tail
)));
3982 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3984 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3988 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3989 doc
: /* Return the value of FONT's property KEY.
3990 FONT is a font-spec, a font-entity, or a font-object.
3991 KEY is any symbol, but these are reserved for specific meanings:
3992 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3993 :size, :name, :script, :otf
3994 See the documentation of `font-spec' for their meanings.
3995 In addition, if FONT is a font-entity or a font-object, values of
3996 :script and :otf are different from those of a font-spec as below:
3998 The value of :script may be a list of scripts that are supported by the font.
4000 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
4001 representing the OpenType features supported by the font by this form:
4002 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4003 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
4005 (Lisp_Object font
, Lisp_Object key
)
4013 idx
= get_font_prop_index (key
);
4014 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4015 return font_style_symbolic (font
, idx
, 0);
4016 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4017 return AREF (font
, idx
);
4018 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
4019 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
4021 struct font
*fontp
= XFONT_OBJECT (font
);
4023 if (fontp
->driver
->otf_capability
)
4024 val
= fontp
->driver
->otf_capability (fontp
);
4026 val
= Fcons (Qnil
, Qnil
);
4033 #ifdef HAVE_WINDOW_SYSTEM
4035 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4036 doc
: /* Return a plist of face attributes generated by FONT.
4037 FONT is a font name, a font-spec, a font-entity, or a font-object.
4038 The return value is a list of the form
4040 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4042 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4043 compatible with `set-face-attribute'. Some of these key-attribute pairs
4044 may be omitted from the list if they are not specified by FONT.
4046 The optional argument FRAME specifies the frame that the face attributes
4047 are to be displayed on. If omitted, the selected frame is used. */)
4048 (Lisp_Object font
, Lisp_Object frame
)
4050 struct frame
*f
= decode_live_frame (frame
);
4051 Lisp_Object plist
[10];
4057 int fontset
= fs_query_fontset (font
, 0);
4058 Lisp_Object name
= font
;
4060 font
= fontset_ascii (fontset
);
4061 font
= font_spec_from_name (name
);
4063 signal_error ("Invalid font name", name
);
4065 else if (! FONTP (font
))
4066 signal_error ("Invalid font object", font
);
4068 val
= AREF (font
, FONT_FAMILY_INDEX
);
4071 plist
[n
++] = QCfamily
;
4072 plist
[n
++] = SYMBOL_NAME (val
);
4075 val
= AREF (font
, FONT_SIZE_INDEX
);
4078 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4079 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : FRAME_RES_Y (f
);
4080 plist
[n
++] = QCheight
;
4081 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4083 else if (FLOATP (val
))
4085 plist
[n
++] = QCheight
;
4086 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4089 val
= FONT_WEIGHT_FOR_FACE (font
);
4092 plist
[n
++] = QCweight
;
4096 val
= FONT_SLANT_FOR_FACE (font
);
4099 plist
[n
++] = QCslant
;
4103 val
= FONT_WIDTH_FOR_FACE (font
);
4106 plist
[n
++] = QCwidth
;
4110 return Flist (n
, plist
);
4115 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4116 doc
: /* Set one property of FONT: give property KEY value VAL.
4117 FONT is a font-spec, a font-entity, or a font-object.
4119 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4120 accepted by the function `font-spec' (which see), VAL must be what
4121 allowed in `font-spec'.
4123 If FONT is a font-entity or a font-object, KEY must not be the one
4124 accepted by `font-spec'. */)
4125 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4129 idx
= get_font_prop_index (prop
);
4130 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4132 CHECK_FONT_SPEC (font
);
4133 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4137 if (EQ (prop
, QCname
)
4138 || EQ (prop
, QCscript
)
4139 || EQ (prop
, QClang
)
4140 || EQ (prop
, QCotf
))
4141 CHECK_FONT_SPEC (font
);
4144 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4149 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4150 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4151 Optional 2nd argument FRAME specifies the target frame.
4152 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4153 Optional 4th argument PREFER, if non-nil, is a font-spec to
4154 control the order of the returned list. Fonts are sorted by
4155 how close they are to PREFER. */)
4156 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4158 struct frame
*f
= decode_live_frame (frame
);
4159 Lisp_Object vec
, list
;
4162 CHECK_FONT_SPEC (font_spec
);
4170 if (! NILP (prefer
))
4171 CHECK_FONT_SPEC (prefer
);
4173 list
= font_list_entities (f
, font_spec
);
4176 if (NILP (XCDR (list
))
4177 && ASIZE (XCAR (list
)) == 1)
4178 return list1 (AREF (XCAR (list
), 0));
4180 if (! NILP (prefer
))
4181 vec
= font_sort_entities (list
, prefer
, f
, 0);
4183 vec
= font_vconcat_entity_vectors (list
);
4184 if (n
== 0 || n
>= ASIZE (vec
))
4186 Lisp_Object args
[2];
4190 list
= Fappend (2, args
);
4194 for (list
= Qnil
, n
--; n
>= 0; n
--)
4195 list
= Fcons (AREF (vec
, n
), list
);
4200 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4201 doc
: /* List available font families on the current frame.
4202 If FRAME is omitted or nil, the selected frame is used. */)
4205 struct frame
*f
= decode_live_frame (frame
);
4206 struct font_driver_list
*driver_list
;
4207 Lisp_Object list
= Qnil
;
4209 for (driver_list
= f
->font_driver_list
; driver_list
;
4210 driver_list
= driver_list
->next
)
4211 if (driver_list
->driver
->list_family
)
4213 Lisp_Object val
= driver_list
->driver
->list_family (f
);
4214 Lisp_Object tail
= list
;
4216 for (; CONSP (val
); val
= XCDR (val
))
4217 if (NILP (Fmemq (XCAR (val
), tail
))
4218 && SYMBOLP (XCAR (val
)))
4219 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4224 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4225 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4226 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4227 (Lisp_Object font_spec
, Lisp_Object frame
)
4229 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4236 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4237 doc
: /* Return XLFD name of FONT.
4238 FONT is a font-spec, font-entity, or font-object.
4239 If the name is too long for XLFD (maximum 255 chars), return nil.
4240 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4241 the consecutive wildcards are folded into one. */)
4242 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4245 int namelen
, pixel_size
= 0;
4249 if (FONT_OBJECT_P (font
))
4251 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4253 if (STRINGP (font_name
)
4254 && SDATA (font_name
)[0] == '-')
4256 if (NILP (fold_wildcards
))
4258 lispstpcpy (name
, font_name
);
4259 namelen
= SBYTES (font_name
);
4262 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4264 namelen
= font_unparse_xlfd (font
, pixel_size
, name
, 256);
4268 if (! NILP (fold_wildcards
))
4270 char *p0
= name
, *p1
;
4272 while ((p1
= strstr (p0
, "-*-*")))
4274 strcpy (p1
, p1
+ 2);
4280 return make_string (name
, namelen
);
4284 clear_font_cache (struct frame
*f
)
4286 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4288 for (; driver_list
; driver_list
= driver_list
->next
)
4289 if (driver_list
->on
)
4291 Lisp_Object val
, tmp
, cache
= driver_list
->driver
->get_cache (f
);
4295 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4297 eassert (! NILP (val
));
4298 tmp
= XCDR (XCAR (val
));
4299 if (XINT (XCAR (tmp
)) == 0)
4301 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4302 XSETCDR (cache
, XCDR (val
));
4307 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4308 doc
: /* Clear font cache of each frame. */)
4311 Lisp_Object list
, frame
;
4313 FOR_EACH_FRAME (list
, frame
)
4314 clear_font_cache (XFRAME (frame
));
4321 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4323 struct font
*font
= XFONT_OBJECT (font_object
);
4324 unsigned code
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4325 struct font_metrics metrics
;
4327 LGLYPH_SET_CODE (glyph
, code
);
4328 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4329 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4330 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4331 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4332 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4333 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4337 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4338 doc
: /* Shape the glyph-string GSTRING.
4339 Shaping means substituting glyphs and/or adjusting positions of glyphs
4340 to get the correct visual image of character sequences set in the
4341 header of the glyph-string.
4343 If the shaping was successful, the value is GSTRING itself or a newly
4344 created glyph-string. Otherwise, the value is nil.
4346 See the documentation of `composition-get-gstring' for the format of
4348 (Lisp_Object gstring
)
4351 Lisp_Object font_object
, n
, glyph
;
4352 ptrdiff_t i
, from
, to
;
4354 if (! composition_gstring_p (gstring
))
4355 signal_error ("Invalid glyph-string: ", gstring
);
4356 if (! NILP (LGSTRING_ID (gstring
)))
4358 font_object
= LGSTRING_FONT (gstring
);
4359 CHECK_FONT_OBJECT (font_object
);
4360 font
= XFONT_OBJECT (font_object
);
4361 if (! font
->driver
->shape
)
4364 /* Try at most three times with larger gstring each time. */
4365 for (i
= 0; i
< 3; i
++)
4367 n
= font
->driver
->shape (gstring
);
4370 gstring
= larger_vector (gstring
,
4371 LGSTRING_GLYPH_LEN (gstring
), -1);
4373 if (i
== 3 || XINT (n
) == 0)
4375 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4376 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4378 /* Check FROM_IDX and TO_IDX of each GLYPH in GSTRING to assure that
4379 GLYPHS covers all characters (except for the last few ones) in
4380 GSTRING. More formally, provided that NCHARS is the number of
4381 characters in GSTRING and GLYPHS[i] is the ith glyph, FROM_IDX
4382 and TO_IDX of each glyph must satisfy these conditions:
4384 GLYPHS[0].FROM_IDX == 0
4385 GLYPHS[i].FROM_IDX <= GLYPHS[i].TO_IDX
4386 if (GLYPHS[i].FROM_IDX == GLYPHS[i-1].FROM_IDX)
4387 ;; GLYPHS[i] and GLYPHS[i-1] belongs to the same grapheme cluster
4388 GLYPHS[i].TO_IDX == GLYPHS[i-1].TO_IDX
4390 ;; Be sure to cover all characters.
4391 GLYPHS[i].FROM_IDX == GLYPHS[i-1].TO_IDX + 1 */
4392 glyph
= LGSTRING_GLYPH (gstring
, 0);
4393 from
= LGLYPH_FROM (glyph
);
4394 to
= LGLYPH_TO (glyph
);
4395 if (from
!= 0 || to
< from
)
4397 for (i
= 1; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4399 glyph
= LGSTRING_GLYPH (gstring
, i
);
4402 if (! (LGLYPH_FROM (glyph
) <= LGLYPH_TO (glyph
)
4403 && (LGLYPH_FROM (glyph
) == from
4404 ? LGLYPH_TO (glyph
) == to
4405 : LGLYPH_FROM (glyph
) == to
+ 1)))
4407 from
= LGLYPH_FROM (glyph
);
4408 to
= LGLYPH_TO (glyph
);
4410 return composition_gstring_put_cache (gstring
, XINT (n
));
4416 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4418 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4419 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4421 VARIATION-SELECTOR is a character code of variation selection
4422 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4423 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4424 (Lisp_Object font_object
, Lisp_Object character
)
4426 unsigned variations
[256];
4431 CHECK_FONT_OBJECT (font_object
);
4432 CHECK_CHARACTER (character
);
4433 font
= XFONT_OBJECT (font_object
);
4434 if (! font
->driver
->get_variation_glyphs
)
4436 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4440 for (i
= 0; i
< 255; i
++)
4443 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4444 Lisp_Object code
= INTEGER_TO_CONS (variations
[i
]);
4445 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4452 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4453 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4454 OTF-FEATURES specifies which features to apply in this format:
4455 (SCRIPT LANGSYS GSUB GPOS)
4457 SCRIPT is a symbol specifying a script tag of OpenType,
4458 LANGSYS is a symbol specifying a langsys tag of OpenType,
4459 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4461 If LANGSYS is nil, the default langsys is selected.
4463 The features are applied in the order they appear in the list. The
4464 symbol `*' means to apply all available features not present in this
4465 list, and the remaining features are ignored. For instance, (vatu
4466 pstf * haln) is to apply vatu and pstf in this order, then to apply
4467 all available features other than vatu, pstf, and haln.
4469 The features are applied to the glyphs in the range FROM and TO of
4470 the glyph-string GSTRING-IN.
4472 If some feature is actually applicable, the resulting glyphs are
4473 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4474 this case, the value is the number of produced glyphs.
4476 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4479 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4480 produced in GSTRING-OUT, and the value is nil.
4482 See the documentation of `composition-get-gstring' for the format of
4484 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4486 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4491 check_otf_features (otf_features
);
4492 CHECK_FONT_OBJECT (font_object
);
4493 font
= XFONT_OBJECT (font_object
);
4494 if (! font
->driver
->otf_drive
)
4495 error ("Font backend %s can't drive OpenType GSUB table",
4496 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4497 CHECK_CONS (otf_features
);
4498 CHECK_SYMBOL (XCAR (otf_features
));
4499 val
= XCDR (otf_features
);
4500 CHECK_SYMBOL (XCAR (val
));
4501 val
= XCDR (otf_features
);
4504 len
= check_gstring (gstring_in
);
4505 CHECK_VECTOR (gstring_out
);
4506 CHECK_NATNUM (from
);
4508 CHECK_NATNUM (index
);
4510 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4511 args_out_of_range_3 (from
, to
, make_number (len
));
4512 if (XINT (index
) >= ASIZE (gstring_out
))
4513 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4514 num
= font
->driver
->otf_drive (font
, otf_features
,
4515 gstring_in
, XINT (from
), XINT (to
),
4516 gstring_out
, XINT (index
), 0);
4519 return make_number (num
);
4522 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4524 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4525 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4527 (SCRIPT LANGSYS FEATURE ...)
4528 See the documentation of `font-drive-otf' for more detail.
4530 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4531 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4532 character code corresponding to the glyph or nil if there's no
4533 corresponding character. */)
4534 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4536 struct font
*font
= CHECK_FONT_GET_OBJECT (font_object
);
4537 Lisp_Object gstring_in
, gstring_out
, g
;
4538 Lisp_Object alternates
;
4541 if (! font
->driver
->otf_drive
)
4542 error ("Font backend %s can't drive OpenType GSUB table",
4543 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4544 CHECK_CHARACTER (character
);
4545 CHECK_CONS (otf_features
);
4547 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4548 g
= LGSTRING_GLYPH (gstring_in
, 0);
4549 LGLYPH_SET_CHAR (g
, XINT (character
));
4550 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4551 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4552 gstring_out
, 0, 1)) < 0)
4553 gstring_out
= Ffont_make_gstring (font_object
,
4554 make_number (ASIZE (gstring_out
) * 2));
4556 for (i
= 0; i
< num
; i
++)
4558 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4559 int c
= LGLYPH_CHAR (g
);
4560 unsigned code
= LGLYPH_CODE (g
);
4562 alternates
= Fcons (Fcons (make_number (code
),
4563 c
> 0 ? make_number (c
) : Qnil
),
4566 return Fnreverse (alternates
);
4572 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4573 doc
: /* Open FONT-ENTITY. */)
4574 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4577 struct frame
*f
= decode_live_frame (frame
);
4579 CHECK_FONT_ENTITY (font_entity
);
4582 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4585 CHECK_NUMBER_OR_FLOAT (size
);
4587 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), FRAME_RES_Y (f
));
4589 isize
= XINT (size
);
4590 if (! (INT_MIN
<= isize
&& isize
<= INT_MAX
))
4591 args_out_of_range (font_entity
, size
);
4595 return font_open_entity (f
, font_entity
, isize
);
4598 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4599 doc
: /* Close FONT-OBJECT. */)
4600 (Lisp_Object font_object
, Lisp_Object frame
)
4602 CHECK_FONT_OBJECT (font_object
);
4603 font_close_object (decode_live_frame (frame
), font_object
);
4607 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4608 doc
: /* Return information about FONT-OBJECT.
4609 The value is a vector:
4610 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4613 NAME is the font name, a string (or nil if the font backend doesn't
4616 FILENAME is the font file name, a string (or nil if the font backend
4617 doesn't provide a file name).
4619 PIXEL-SIZE is a pixel size by which the font is opened.
4621 SIZE is a maximum advance width of the font in pixels.
4623 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4626 CAPABILITY is a list whose first element is a symbol representing the
4627 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4628 remaining elements describe the details of the font capability.
4630 If the font is OpenType font, the form of the list is
4631 \(opentype GSUB GPOS)
4632 where GSUB shows which "GSUB" features the font supports, and GPOS
4633 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4634 lists of the format:
4635 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4637 If the font is not OpenType font, currently the length of the form is
4640 SCRIPT is a symbol representing OpenType script tag.
4642 LANGSYS is a symbol representing OpenType langsys tag, or nil
4643 representing the default langsys.
4645 FEATURE is a symbol representing OpenType feature tag.
4647 If the font is not OpenType font, CAPABILITY is nil. */)
4648 (Lisp_Object font_object
)
4650 struct font
*font
= CHECK_FONT_GET_OBJECT (font_object
);
4651 Lisp_Object val
= make_uninit_vector (9);
4653 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4654 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4655 ASET (val
, 2, make_number (font
->pixel_size
));
4656 ASET (val
, 3, make_number (font
->max_width
));
4657 ASET (val
, 4, make_number (font
->ascent
));
4658 ASET (val
, 5, make_number (font
->descent
));
4659 ASET (val
, 6, make_number (font
->space_width
));
4660 ASET (val
, 7, make_number (font
->average_width
));
4661 if (font
->driver
->otf_capability
)
4662 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4664 ASET (val
, 8, Qnil
);
4668 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4670 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4671 FROM and TO are positions (integers or markers) specifying a region
4672 of the current buffer, and can be in either order. If the optional
4673 fourth arg OBJECT is not nil, it is a string or a vector containing
4674 the target characters between indices FROM and TO, which are treated
4677 Each element is a vector containing information of a glyph in this format:
4678 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4680 FROM is an index numbers of a character the glyph corresponds to.
4681 TO is the same as FROM.
4682 C is the character of the glyph.
4683 CODE is the glyph-code of C in FONT-OBJECT.
4684 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4685 ADJUSTMENT is always nil.
4686 If FONT-OBJECT doesn't have a glyph for a character,
4687 the corresponding element is nil. */)
4688 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4691 struct font
*font
= CHECK_FONT_GET_OBJECT (font_object
);
4693 Lisp_Object
*chars
, vec
;
4698 ptrdiff_t charpos
, bytepos
;
4700 validate_region (&from
, &to
);
4703 len
= XFASTINT (to
) - XFASTINT (from
);
4704 SAFE_ALLOCA_LISP (chars
, len
);
4705 charpos
= XFASTINT (from
);
4706 bytepos
= CHAR_TO_BYTE (charpos
);
4707 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4710 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4711 chars
[i
] = make_number (c
);
4714 else if (STRINGP (object
))
4716 const unsigned char *p
;
4717 ptrdiff_t ifrom
, ito
;
4719 validate_subarray (object
, from
, to
, SCHARS (object
), &ifrom
, &ito
);
4723 SAFE_ALLOCA_LISP (chars
, len
);
4725 if (STRING_MULTIBYTE (object
))
4729 /* Skip IFROM characters from the beginning. */
4730 for (i
= 0; i
< ifrom
; i
++)
4731 c
= STRING_CHAR_ADVANCE (p
);
4733 /* Now fetch an interesting characters. */
4734 for (i
= 0; i
< len
; i
++)
4736 c
= STRING_CHAR_ADVANCE (p
);
4737 chars
[i
] = make_number (c
);
4741 for (i
= 0; i
< len
; i
++)
4742 chars
[i
] = make_number (p
[ifrom
+ i
]);
4744 else if (VECTORP (object
))
4746 ptrdiff_t ifrom
, ito
;
4748 validate_subarray (object
, from
, to
, ASIZE (object
), &ifrom
, &ito
);
4752 for (i
= 0; i
< len
; i
++)
4754 Lisp_Object elt
= AREF (object
, ifrom
+ i
);
4755 CHECK_CHARACTER (elt
);
4757 chars
= aref_addr (object
, ifrom
);
4760 wrong_type_argument (Qarrayp
, object
);
4762 vec
= make_uninit_vector (len
);
4763 for (i
= 0; i
< len
; i
++)
4766 int c
= XFASTINT (chars
[i
]);
4768 struct font_metrics metrics
;
4770 code
= font
->driver
->encode_char (font
, c
);
4771 if (code
== FONT_INVALID_CODE
)
4773 ASET (vec
, i
, Qnil
);
4777 LGLYPH_SET_FROM (g
, i
);
4778 LGLYPH_SET_TO (g
, i
);
4779 LGLYPH_SET_CHAR (g
, c
);
4780 LGLYPH_SET_CODE (g
, code
);
4781 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4782 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4783 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4784 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4785 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4786 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4789 if (! VECTORP (object
))
4794 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4795 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4796 FONT is a font-spec, font-entity, or font-object. */)
4797 (Lisp_Object spec
, Lisp_Object font
)
4799 CHECK_FONT_SPEC (spec
);
4802 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4805 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4806 doc
: /* Return a font-object for displaying a character at POSITION.
4807 Optional second arg WINDOW, if non-nil, is a window displaying
4808 the current buffer. It defaults to the currently selected window.
4809 Optional third arg STRING, if non-nil, is a string containing the target
4810 character at index specified by POSITION. */)
4811 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4813 struct window
*w
= decode_live_window (window
);
4817 if (XBUFFER (w
->contents
) != current_buffer
)
4818 error ("Specified window is not displaying the current buffer");
4819 CHECK_NUMBER_COERCE_MARKER (position
);
4820 if (! (BEGV
<= XINT (position
) && XINT (position
) < ZV
))
4821 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4825 CHECK_NUMBER (position
);
4826 CHECK_STRING (string
);
4827 if (! (0 <= XINT (position
) && XINT (position
) < SCHARS (string
)))
4828 args_out_of_range (string
, position
);
4831 return font_at (-1, XINT (position
), NULL
, w
, string
);
4835 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4836 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4837 The value is a number of glyphs drawn.
4838 Type C-l to recover what previously shown. */)
4839 (Lisp_Object font_object
, Lisp_Object string
)
4841 Lisp_Object frame
= selected_frame
;
4842 struct frame
*f
= XFRAME (frame
);
4848 CHECK_FONT_GET_OBJECT (font_object
, font
);
4849 CHECK_STRING (string
);
4850 len
= SCHARS (string
);
4851 code
= alloca (sizeof (unsigned) * len
);
4852 for (i
= 0; i
< len
; i
++)
4854 Lisp_Object ch
= Faref (string
, make_number (i
));
4858 code
[i
] = font
->driver
->encode_char (font
, c
);
4859 if (code
[i
] == FONT_INVALID_CODE
)
4862 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4864 if (font
->driver
->prepare_face
)
4865 font
->driver
->prepare_face (f
, face
);
4866 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4867 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4868 if (font
->driver
->done_face
)
4869 font
->driver
->done_face (f
, face
);
4871 return make_number (len
);
4875 DEFUN ("frame-font-cache", Fframe_font_cache
, Sframe_font_cache
, 0, 1, 0,
4876 doc
: /* Return FRAME's font cache. Mainly used for debugging.
4877 If FRAME is omitted or nil, use the selected frame. */)
4880 #ifdef HAVE_WINDOW_SYSTEM
4881 struct frame
*f
= decode_live_frame (frame
);
4883 if (FRAME_WINDOW_P (f
))
4884 return FRAME_DISPLAY_INFO (f
)->name_list_element
;
4890 #endif /* FONT_DEBUG */
4892 #ifdef HAVE_WINDOW_SYSTEM
4894 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4895 doc
: /* Return information about a font named NAME on frame FRAME.
4896 If FRAME is omitted or nil, use the selected frame.
4898 The returned value is a vector:
4899 [ OPENED-NAME FULL-NAME SIZE HEIGHT BASELINE-OFFSET RELATIVE-COMPOSE
4900 DEFAULT-ASCENT MAX-WIDTH ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4903 OPENED-NAME is the name used for opening the font,
4904 FULL-NAME is the full name of the font,
4905 SIZE is the pixelsize of the font,
4906 HEIGHT is the pixel-height of the font (i.e., ascent + descent),
4907 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4908 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4909 how to compose characters,
4910 MAX-WIDTH is the maximum advance width of the font,
4911 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font
4913 FILENAME is the font file name, a string (or nil if the font backend
4914 doesn't provide a file name).
4915 CAPABILITY is a list whose first element is a symbol representing the
4916 font format, one of x, opentype, truetype, type1, pcf, or bdf.
4917 The remaining elements describe the details of the font capabilities,
4920 If the font is OpenType font, the form of the list is
4921 \(opentype GSUB GPOS)
4922 where GSUB shows which "GSUB" features the font supports, and GPOS
4923 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4925 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4928 SCRIPT is a symbol representing OpenType script tag.
4929 LANGSYS is a symbol representing OpenType langsys tag, or nil
4930 representing the default langsys.
4931 FEATURE is a symbol representing OpenType feature tag.
4933 If the font is not an OpenType font, there are no elements
4934 in CAPABILITY except the font format symbol.
4936 If the named font is not yet loaded, return nil. */)
4937 (Lisp_Object name
, Lisp_Object frame
)
4942 Lisp_Object font_object
;
4945 CHECK_STRING (name
);
4946 f
= decode_window_system_frame (frame
);
4950 int fontset
= fs_query_fontset (name
, 0);
4953 name
= fontset_ascii (fontset
);
4954 font_object
= font_open_by_name (f
, name
);
4956 else if (FONT_OBJECT_P (name
))
4958 else if (FONT_ENTITY_P (name
))
4959 font_object
= font_open_entity (f
, name
, 0);
4962 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4963 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4965 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4967 if (NILP (font_object
))
4969 font
= XFONT_OBJECT (font_object
);
4971 info
= make_uninit_vector (14);
4972 ASET (info
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4973 ASET (info
, 1, AREF (font_object
, FONT_FULLNAME_INDEX
));
4974 ASET (info
, 2, make_number (font
->pixel_size
));
4975 ASET (info
, 3, make_number (font
->height
));
4976 ASET (info
, 4, make_number (font
->baseline_offset
));
4977 ASET (info
, 5, make_number (font
->relative_compose
));
4978 ASET (info
, 6, make_number (font
->default_ascent
));
4979 ASET (info
, 7, make_number (font
->max_width
));
4980 ASET (info
, 8, make_number (font
->ascent
));
4981 ASET (info
, 9, make_number (font
->descent
));
4982 ASET (info
, 10, make_number (font
->space_width
));
4983 ASET (info
, 11, make_number (font
->average_width
));
4984 ASET (info
, 12, AREF (font_object
, FONT_FILE_INDEX
));
4985 if (font
->driver
->otf_capability
)
4986 ASET (info
, 13, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4988 ASET (info
, 13, Qnil
);
4991 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4992 close it now. Perhaps, we should manage font-objects
4993 by `reference-count'. */
4994 font_close_object (f
, font_object
);
5001 #define BUILD_STYLE_TABLE(TBL) build_style_table (TBL, ARRAYELTS (TBL))
5004 build_style_table (const struct table_entry
*entry
, int nelement
)
5007 Lisp_Object table
, elt
;
5009 table
= make_uninit_vector (nelement
);
5010 for (i
= 0; i
< nelement
; i
++)
5012 for (j
= 0; entry
[i
].names
[j
]; j
++);
5013 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
5014 ASET (elt
, 0, make_number (entry
[i
].numeric
));
5015 for (j
= 0; entry
[i
].names
[j
]; j
++)
5016 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
5017 ASET (table
, i
, elt
);
5022 /* The deferred font-log data of the form [ACTION ARG RESULT].
5023 If ACTION is not nil, that is added to the log when font_add_log is
5024 called next time. At that time, ACTION is set back to nil. */
5025 static Lisp_Object Vfont_log_deferred
;
5027 /* Prepend the font-related logging data in Vfont_log if it is not
5028 `t'. ACTION describes a kind of font-related action (e.g. listing,
5029 opening), ARG is the argument for the action, and RESULT is the
5030 result of the action. */
5032 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5037 if (EQ (Vfont_log
, Qt
))
5039 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5041 char *str
= SSDATA (AREF (Vfont_log_deferred
, 0));
5043 ASET (Vfont_log_deferred
, 0, Qnil
);
5044 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5045 AREF (Vfont_log_deferred
, 2));
5050 Lisp_Object tail
, elt
;
5051 AUTO_STRING (equal
, "=");
5053 val
= Ffont_xlfd_name (arg
, Qt
);
5054 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5058 if (EQ (XCAR (elt
), QCscript
)
5059 && SYMBOLP (XCDR (elt
)))
5060 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5061 concat2 (equal
, SYMBOL_NAME (XCDR (elt
))));
5062 else if (EQ (XCAR (elt
), QClang
)
5063 && SYMBOLP (XCDR (elt
)))
5064 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5065 concat2 (equal
, SYMBOL_NAME (XCDR (elt
))));
5066 else if (EQ (XCAR (elt
), QCotf
)
5067 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5068 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5069 concat2 (equal
, SYMBOL_NAME (XCAR (XCDR (elt
)))));
5075 && VECTORP (XCAR (result
))
5076 && ASIZE (XCAR (result
)) > 0
5077 && FONTP (AREF (XCAR (result
), 0)))
5078 result
= font_vconcat_entity_vectors (result
);
5081 val
= Ffont_xlfd_name (result
, Qt
);
5082 if (! FONT_SPEC_P (result
))
5084 AUTO_STRING (colon
, ":");
5085 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5090 else if (CONSP (result
))
5093 result
= Fcopy_sequence (result
);
5094 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5098 val
= Ffont_xlfd_name (val
, Qt
);
5099 XSETCAR (tail
, val
);
5102 else if (VECTORP (result
))
5104 result
= Fcopy_sequence (result
);
5105 for (i
= 0; i
< ASIZE (result
); i
++)
5107 val
= AREF (result
, i
);
5109 val
= Ffont_xlfd_name (val
, Qt
);
5110 ASET (result
, i
, val
);
5113 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5116 /* Record a font-related logging data to be added to Vfont_log when
5117 font_add_log is called next time. ACTION, ARG, RESULT are the same
5121 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5123 if (EQ (Vfont_log
, Qt
))
5125 ASET (Vfont_log_deferred
, 0, build_string (action
));
5126 ASET (Vfont_log_deferred
, 1, arg
);
5127 ASET (Vfont_log_deferred
, 2, result
);
5133 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5134 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5135 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5136 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5137 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5138 /* Note that the other elements in sort_shift_bits are not used. */
5140 staticpro (&font_charset_alist
);
5141 font_charset_alist
= Qnil
;
5143 DEFSYM (Qopentype
, "opentype");
5145 /* Important character set symbols. */
5146 DEFSYM (Qascii_0
, "ascii-0");
5147 DEFSYM (Qiso8859_1
, "iso8859-1");
5148 DEFSYM (Qiso10646_1
, "iso10646-1");
5149 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5150 DEFSYM (Qunicode_sip
, "unicode-sip");
5152 /* Unicode category `Cf'. */
5155 /* Symbols representing keys of font extra info. */
5156 DEFSYM (QCotf
, ":otf");
5157 DEFSYM (QClang
, ":lang");
5158 DEFSYM (QCscript
, ":script");
5159 DEFSYM (QCantialias
, ":antialias");
5160 DEFSYM (QCfoundry
, ":foundry");
5161 DEFSYM (QCadstyle
, ":adstyle");
5162 DEFSYM (QCregistry
, ":registry");
5163 DEFSYM (QCspacing
, ":spacing");
5164 DEFSYM (QCdpi
, ":dpi");
5165 DEFSYM (QCscalable
, ":scalable");
5166 DEFSYM (QCavgwidth
, ":avgwidth");
5167 DEFSYM (QCfont_entity
, ":font-entity");
5168 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5170 /* Symbols representing values of font spacing property. */
5176 /* Special ADSTYLE properties to avoid fonts used for Latin
5177 characters; used in xfont.c and ftfont.c. */
5181 DEFSYM (QCuser_spec
, "user-spec");
5183 staticpro (&scratch_font_spec
);
5184 scratch_font_spec
= Ffont_spec (0, NULL
);
5185 staticpro (&scratch_font_prefer
);
5186 scratch_font_prefer
= Ffont_spec (0, NULL
);
5188 staticpro (&Vfont_log_deferred
);
5189 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5193 staticpro (&otf_list
);
5195 #endif /* HAVE_LIBOTF */
5199 defsubr (&Sfont_spec
);
5200 defsubr (&Sfont_get
);
5201 #ifdef HAVE_WINDOW_SYSTEM
5202 defsubr (&Sfont_face_attributes
);
5204 defsubr (&Sfont_put
);
5205 defsubr (&Slist_fonts
);
5206 defsubr (&Sfont_family_list
);
5207 defsubr (&Sfind_font
);
5208 defsubr (&Sfont_xlfd_name
);
5209 defsubr (&Sclear_font_cache
);
5210 defsubr (&Sfont_shape_gstring
);
5211 defsubr (&Sfont_variation_glyphs
);
5213 defsubr (&Sfont_drive_otf
);
5214 defsubr (&Sfont_otf_alternates
);
5218 defsubr (&Sopen_font
);
5219 defsubr (&Sclose_font
);
5220 defsubr (&Squery_font
);
5221 defsubr (&Sfont_get_glyphs
);
5222 defsubr (&Sfont_match_p
);
5223 defsubr (&Sfont_at
);
5225 defsubr (&Sdraw_string
);
5227 defsubr (&Sframe_font_cache
);
5228 #endif /* FONT_DEBUG */
5229 #ifdef HAVE_WINDOW_SYSTEM
5230 defsubr (&Sfont_info
);
5233 DEFVAR_LISP ("font-encoding-alist", Vfont_encoding_alist
,
5235 Alist of fontname patterns vs the corresponding encoding and repertory info.
5236 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5237 where ENCODING is a charset or a char-table,
5238 and REPERTORY is a charset, a char-table, or nil.
5240 If ENCODING and REPERTORY are the same, the element can have the form
5241 \(REGEXP . ENCODING).
5243 ENCODING is for converting a character to a glyph code of the font.
5244 If ENCODING is a charset, encoding a character by the charset gives
5245 the corresponding glyph code. If ENCODING is a char-table, looking up
5246 the table by a character gives the corresponding glyph code.
5248 REPERTORY specifies a repertory of characters supported by the font.
5249 If REPERTORY is a charset, all characters belonging to the charset are
5250 supported. If REPERTORY is a char-table, all characters who have a
5251 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5252 gets the repertory information by an opened font and ENCODING. */);
5253 Vfont_encoding_alist
= Qnil
;
5255 /* FIXME: These 3 vars are not quite what they appear: setq on them
5256 won't have any effect other than disconnect them from the style
5257 table used by the font display code. So we make them read-only,
5258 to avoid this confusing situation. */
5260 DEFVAR_LISP_NOPRO ("font-weight-table", Vfont_weight_table
,
5261 doc
: /* Vector of valid font weight values.
5262 Each element has the form:
5263 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5264 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5265 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5266 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5268 DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table
,
5269 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5270 See `font-weight-table' for the format of the vector. */);
5271 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5272 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5274 DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table
,
5275 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5276 See `font-weight-table' for the format of the vector. */);
5277 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5278 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5280 staticpro (&font_style_table
);
5281 font_style_table
= make_uninit_vector (3);
5282 ASET (font_style_table
, 0, Vfont_weight_table
);
5283 ASET (font_style_table
, 1, Vfont_slant_table
);
5284 ASET (font_style_table
, 2, Vfont_width_table
);
5286 DEFVAR_LISP ("font-log", Vfont_log
, doc
: /*
5287 *Logging list of font related actions and results.
5288 The value t means to suppress the logging.
5289 The initial value is set to nil if the environment variable
5290 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5293 #ifdef HAVE_WINDOW_SYSTEM
5294 #ifdef HAVE_FREETYPE
5296 #ifdef HAVE_X_WINDOWS
5301 #endif /* HAVE_XFT */
5302 #endif /* HAVE_X_WINDOWS */
5303 #else /* not HAVE_FREETYPE */
5304 #ifdef HAVE_X_WINDOWS
5306 #endif /* HAVE_X_WINDOWS */
5307 #endif /* not HAVE_FREETYPE */
5310 #endif /* HAVE_BDFFONT */
5313 #endif /* HAVE_NTGUI */
5314 #endif /* HAVE_WINDOW_SYSTEM */
5320 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;