1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
3 Copyright (C) 2006, 2007, 2008, 2009, 2010
4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H13PRO009
7 This file is part of GNU Emacs.
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
32 #include "dispextern.h"
34 #include "character.h"
35 #include "composite.h"
41 #endif /* HAVE_X_WINDOWS */
45 #endif /* HAVE_NTGUI */
52 extern Lisp_Object Qfontsize
;
55 Lisp_Object Qopentype
;
57 /* Important character set strings. */
58 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
60 #define DEFAULT_ENCODING Qiso8859_1
62 /* Unicode category `Cf'. */
63 static Lisp_Object QCf
;
65 /* Special vector of zero length. This is repeatedly used by (struct
66 font_driver *)->list when a specified font is not found. */
67 static Lisp_Object null_vector
;
69 static Lisp_Object Vfont_weight_table
, Vfont_slant_table
, Vfont_width_table
;
71 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
72 static Lisp_Object font_style_table
;
74 /* Structure used for tables mapping weight, slant, and width numeric
75 values and their names. */
80 /* The first one is a valid name as a face attribute.
81 The second one (if any) is a typical name in XLFD field. */
85 /* Table of weight numeric values and their names. This table must be
86 sorted by numeric values in ascending order. */
88 static const struct table_entry weight_table
[] =
91 { 20, { "ultra-light", "ultralight" }},
92 { 40, { "extra-light", "extralight" }},
94 { 75, { "semi-light", "semilight", "demilight", "book" }},
95 { 100, { "normal", "medium", "regular", "unspecified" }},
96 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
98 { 205, { "extra-bold", "extrabold" }},
99 { 210, { "ultra-bold", "ultrabold", "black" }}
102 /* Table of slant numeric values and their names. This table must be
103 sorted by numeric values in ascending order. */
105 static const struct table_entry slant_table
[] =
107 { 0, { "reverse-oblique", "ro" }},
108 { 10, { "reverse-italic", "ri" }},
109 { 100, { "normal", "r", "unspecified" }},
110 { 200, { "italic" ,"i", "ot" }},
111 { 210, { "oblique", "o" }}
114 /* Table of width numeric values and their names. This table must be
115 sorted by numeric values in ascending order. */
117 static const struct table_entry width_table
[] =
119 { 50, { "ultra-condensed", "ultracondensed" }},
120 { 63, { "extra-condensed", "extracondensed" }},
121 { 75, { "condensed", "compressed", "narrow" }},
122 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
123 { 100, { "normal", "medium", "regular", "unspecified" }},
124 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
125 { 125, { "expanded" }},
126 { 150, { "extra-expanded", "extraexpanded" }},
127 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
130 extern Lisp_Object Qnormal
;
132 /* Symbols representing keys of normal font properties. */
133 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
;
134 extern Lisp_Object QCheight
, QCsize
, QCname
;
136 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
;
137 /* Symbols representing keys of font extra info. */
138 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
139 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
140 /* Symbols representing values of font spacing property. */
141 Lisp_Object Qc
, Qm
, Qp
, Qd
;
142 /* Special ADSTYLE properties to avoid fonts used for Latin
143 characters; used in xfont.c and ftfont.c. */
144 Lisp_Object Qja
, Qko
;
146 Lisp_Object QCuser_spec
;
148 Lisp_Object Vfont_encoding_alist
;
150 /* Alist of font registry symbol and the corresponding charsets
151 information. The information is retrieved from
152 Vfont_encoding_alist on demand.
154 Eash element has the form:
155 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
159 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
160 encodes a character code to a glyph code of a font, and
161 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
162 character is supported by a font.
164 The latter form means that the information for REGISTRY couldn't be
166 static Lisp_Object font_charset_alist
;
168 /* List of all font drivers. Each font-backend (XXXfont.c) calls
169 register_font_driver in syms_of_XXXfont to register its font-driver
171 static struct font_driver_list
*font_driver_list
;
175 /* Creaters of font-related Lisp object. */
180 Lisp_Object font_spec
;
181 struct font_spec
*spec
182 = ((struct font_spec
*)
183 allocate_pseudovector (VECSIZE (struct font_spec
),
184 FONT_SPEC_MAX
, PVEC_FONT
));
185 XSETFONT (font_spec
, spec
);
192 Lisp_Object font_entity
;
193 struct font_entity
*entity
194 = ((struct font_entity
*)
195 allocate_pseudovector (VECSIZE (struct font_entity
),
196 FONT_ENTITY_MAX
, PVEC_FONT
));
197 XSETFONT (font_entity
, entity
);
201 /* Create a font-object whose structure size is SIZE. If ENTITY is
202 not nil, copy properties from ENTITY to the font-object. If
203 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
205 font_make_object (size
, entity
, pixelsize
)
210 Lisp_Object font_object
;
212 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
215 XSETFONT (font_object
, font
);
219 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
220 font
->props
[i
] = AREF (entity
, i
);
221 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
222 font
->props
[FONT_EXTRA_INDEX
]
223 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
226 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
232 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
233 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
234 static Lisp_Object font_matching_entity
P_ ((FRAME_PTR
, Lisp_Object
*,
237 /* Number of registered font drivers. */
238 static int num_font_drivers
;
241 /* Return a Lispy value of a font property value at STR and LEN bytes.
242 If STR is "*", it returns nil.
243 If FORCE_SYMBOL is zero and all characters in STR are digits, it
244 returns an integer. Otherwise, it returns a symbol interned from
248 font_intern_prop (str
, len
, force_symbol
)
258 if (len
== 1 && *str
== '*')
260 if (!force_symbol
&& len
>=1 && isdigit (*str
))
262 for (i
= 1; i
< len
; i
++)
263 if (! isdigit (str
[i
]))
266 return make_number (atoi (str
));
269 /* The following code is copied from the function intern (in
270 lread.c), and modified to suite our purpose. */
272 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
273 obarray
= check_obarray (obarray
);
274 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
275 if (len
== nchars
|| len
!= nbytes
)
276 /* CONTENTS contains no multibyte sequences or contains an invalid
277 multibyte sequence. We'll make a unibyte string. */
278 tem
= oblookup (obarray
, str
, len
, len
);
280 tem
= oblookup (obarray
, str
, nchars
, len
);
283 if (len
== nchars
|| len
!= nbytes
)
284 tem
= make_unibyte_string (str
, len
);
286 tem
= make_multibyte_string (str
, nchars
, len
);
287 return Fintern (tem
, obarray
);
290 /* Return a pixel size of font-spec SPEC on frame F. */
293 font_pixel_size (f
, spec
)
297 #ifdef HAVE_WINDOW_SYSTEM
298 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
307 font_assert (FLOATP (size
));
308 point_size
= XFLOAT_DATA (size
);
309 val
= AREF (spec
, FONT_DPI_INDEX
);
314 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
322 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
323 font vector. If VAL is not valid (i.e. not registered in
324 font_style_table), return -1 if NOERROR is zero, and return a
325 proper index if NOERROR is nonzero. In that case, register VAL in
326 font_style_table if VAL is a symbol, and return a closest index if
327 VAL is an integer. */
330 font_style_to_value (prop
, val
, noerror
)
331 enum font_property_index prop
;
335 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
336 int len
= ASIZE (table
);
342 Lisp_Object args
[2], elt
;
344 /* At first try exact match. */
345 for (i
= 0; i
< len
; i
++)
346 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
347 if (EQ (val
, AREF (AREF (table
, i
), j
)))
348 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
349 | (i
<< 4) | (j
- 1));
350 /* Try also with case-folding match. */
351 s
= SDATA (SYMBOL_NAME (val
));
352 for (i
= 0; i
< len
; i
++)
353 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
355 elt
= AREF (AREF (table
, i
), j
);
356 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
357 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
358 | (i
<< 4) | (j
- 1));
364 elt
= Fmake_vector (make_number (2), make_number (100));
367 args
[1] = Fmake_vector (make_number (1), elt
);
368 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
369 return (100 << 8) | (i
<< 4);
374 int numeric
= XINT (val
);
376 for (i
= 0, last_n
= -1; i
< len
; i
++)
378 int n
= XINT (AREF (AREF (table
, i
), 0));
381 return (n
<< 8) | (i
<< 4);
386 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
387 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
393 return ((last_n
<< 8) | ((i
- 1) << 4));
398 font_style_symbolic (font
, prop
, for_face
)
400 enum font_property_index prop
;
403 Lisp_Object val
= AREF (font
, prop
);
404 Lisp_Object table
, elt
;
409 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
410 i
= XINT (val
) & 0xFF;
411 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
412 elt
= AREF (table
, ((i
>> 4) & 0xF));
413 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
414 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
417 extern Lisp_Object Vface_alternative_font_family_alist
;
419 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
422 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
423 FONTNAME. ENCODING is a charset symbol that specifies the encoding
424 of the font. REPERTORY is a charset symbol or nil. */
427 find_font_encoding (fontname
)
428 Lisp_Object fontname
;
430 Lisp_Object tail
, elt
;
432 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
436 && STRINGP (XCAR (elt
))
437 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
438 && (SYMBOLP (XCDR (elt
))
439 ? CHARSETP (XCDR (elt
))
440 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
446 /* Return encoding charset and repertory charset for REGISTRY in
447 ENCODING and REPERTORY correspondingly. If correct information for
448 REGISTRY is available, return 0. Otherwise return -1. */
451 font_registry_charsets (registry
, encoding
, repertory
)
452 Lisp_Object registry
;
453 struct charset
**encoding
, **repertory
;
456 int encoding_id
, repertory_id
;
458 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
464 encoding_id
= XINT (XCAR (val
));
465 repertory_id
= XINT (XCDR (val
));
469 val
= find_font_encoding (SYMBOL_NAME (registry
));
470 if (SYMBOLP (val
) && CHARSETP (val
))
472 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
474 else if (CONSP (val
))
476 if (! CHARSETP (XCAR (val
)))
478 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
479 if (NILP (XCDR (val
)))
483 if (! CHARSETP (XCDR (val
)))
485 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
490 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
492 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
496 *encoding
= CHARSET_FROM_ID (encoding_id
);
498 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
503 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
508 /* Font property value validaters. See the comment of
509 font_property_table for the meaning of the arguments. */
511 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
512 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
513 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
514 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
515 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
516 static int get_font_prop_index
P_ ((Lisp_Object
));
519 font_prop_validate_symbol (prop
, val
)
520 Lisp_Object prop
, val
;
523 val
= Fintern (val
, Qnil
);
526 else if (EQ (prop
, QCregistry
))
527 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
533 font_prop_validate_style (style
, val
)
534 Lisp_Object style
, val
;
536 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
537 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
544 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
548 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
550 if ((n
& 0xF) + 1 >= ASIZE (elt
))
552 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
556 else if (SYMBOLP (val
))
558 int n
= font_style_to_value (prop
, val
, 0);
560 val
= n
>= 0 ? make_number (n
) : Qerror
;
568 font_prop_validate_non_neg (prop
, val
)
569 Lisp_Object prop
, val
;
571 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
576 font_prop_validate_spacing (prop
, val
)
577 Lisp_Object prop
, val
;
579 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
581 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
583 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
585 if (spacing
== 'c' || spacing
== 'C')
586 return make_number (FONT_SPACING_CHARCELL
);
587 if (spacing
== 'm' || spacing
== 'M')
588 return make_number (FONT_SPACING_MONO
);
589 if (spacing
== 'p' || spacing
== 'P')
590 return make_number (FONT_SPACING_PROPORTIONAL
);
591 if (spacing
== 'd' || spacing
== 'D')
592 return make_number (FONT_SPACING_DUAL
);
598 font_prop_validate_otf (prop
, val
)
599 Lisp_Object prop
, val
;
601 Lisp_Object tail
, tmp
;
604 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
605 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
606 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
609 if (! SYMBOLP (XCAR (val
)))
614 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
616 for (i
= 0; i
< 2; i
++)
623 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
624 if (! SYMBOLP (XCAR (tmp
)))
632 /* Structure of known font property keys and validater of the
636 /* Pointer to the key symbol. */
638 /* Function to validate PROP's value VAL, or NULL if any value is
639 ok. The value is VAL or its regularized value if VAL is valid,
640 and Qerror if not. */
641 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
642 } font_property_table
[] =
643 { { &QCtype
, font_prop_validate_symbol
},
644 { &QCfoundry
, font_prop_validate_symbol
},
645 { &QCfamily
, font_prop_validate_symbol
},
646 { &QCadstyle
, font_prop_validate_symbol
},
647 { &QCregistry
, font_prop_validate_symbol
},
648 { &QCweight
, font_prop_validate_style
},
649 { &QCslant
, font_prop_validate_style
},
650 { &QCwidth
, font_prop_validate_style
},
651 { &QCsize
, font_prop_validate_non_neg
},
652 { &QCdpi
, font_prop_validate_non_neg
},
653 { &QCspacing
, font_prop_validate_spacing
},
654 { &QCavgwidth
, font_prop_validate_non_neg
},
655 /* The order of the above entries must match with enum
656 font_property_index. */
657 { &QClang
, font_prop_validate_symbol
},
658 { &QCscript
, font_prop_validate_symbol
},
659 { &QCotf
, font_prop_validate_otf
}
662 /* Size (number of elements) of the above table. */
663 #define FONT_PROPERTY_TABLE_SIZE \
664 ((sizeof font_property_table) / (sizeof *font_property_table))
666 /* Return an index number of font property KEY or -1 if KEY is not an
667 already known property. */
670 get_font_prop_index (key
)
675 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
676 if (EQ (key
, *font_property_table
[i
].key
))
681 /* Validate the font property. The property key is specified by the
682 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
683 signal an error. The value is VAL or the regularized one. */
686 font_prop_validate (idx
, prop
, val
)
688 Lisp_Object prop
, val
;
690 Lisp_Object validated
;
695 prop
= *font_property_table
[idx
].key
;
698 idx
= get_font_prop_index (prop
);
702 validated
= (font_property_table
[idx
].validater
) (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 (font
, prop
, val
)
714 Lisp_Object font
, prop
, val
;
716 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
717 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
721 Lisp_Object prev
= Qnil
;
724 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
725 prev
= extra
, extra
= XCDR (extra
);
728 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
730 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
736 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
741 /* Font name parser and unparser */
743 static int parse_matrix
P_ ((char *));
744 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
745 static int font_parse_name
P_ ((char *, Lisp_Object
));
747 /* An enumerator for each field of an XLFD font name. */
748 enum xlfd_field_index
767 /* An enumerator for mask bit corresponding to each XLFD field. */
770 XLFD_FOUNDRY_MASK
= 0x0001,
771 XLFD_FAMILY_MASK
= 0x0002,
772 XLFD_WEIGHT_MASK
= 0x0004,
773 XLFD_SLANT_MASK
= 0x0008,
774 XLFD_SWIDTH_MASK
= 0x0010,
775 XLFD_ADSTYLE_MASK
= 0x0020,
776 XLFD_PIXEL_MASK
= 0x0040,
777 XLFD_POINT_MASK
= 0x0080,
778 XLFD_RESX_MASK
= 0x0100,
779 XLFD_RESY_MASK
= 0x0200,
780 XLFD_SPACING_MASK
= 0x0400,
781 XLFD_AVGWIDTH_MASK
= 0x0800,
782 XLFD_REGISTRY_MASK
= 0x1000,
783 XLFD_ENCODING_MASK
= 0x2000
787 /* Parse P pointing the pixel/point size field of the form
788 `[A B C D]' which specifies a transformation matrix:
794 by which all glyphs of the font are transformed. The spec says
795 that scalar value N for the pixel/point size is equivalent to:
796 A = N * resx/resy, B = C = 0, D = N.
798 Return the scalar value N if the form is valid. Otherwise return
809 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
812 matrix
[i
] = - strtod (p
+ 1, &end
);
814 matrix
[i
] = strtod (p
, &end
);
817 return (i
== 4 ? (int) matrix
[3] : -1);
820 /* Expand a wildcard field in FIELD (the first N fields are filled) to
821 multiple fields to fill in all 14 XLFD fields while restring a
822 field position by its contents. */
825 font_expand_wildcards (field
, n
)
826 Lisp_Object field
[XLFD_LAST_INDEX
];
830 Lisp_Object tmp
[XLFD_LAST_INDEX
];
831 /* Array of information about where this element can go. Nth
832 element is for Nth element of FIELD. */
834 /* Minimum possible field. */
836 /* Maxinum possible field. */
838 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
840 } range
[XLFD_LAST_INDEX
];
842 int range_from
, range_to
;
845 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
846 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
847 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
848 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
849 | XLFD_AVGWIDTH_MASK)
850 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
852 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
853 field. The value is shifted to left one bit by one in the
855 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
856 range_mask
= (range_mask
<< 1) | 1;
858 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
859 position-based retriction for FIELD[I]. */
860 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
861 i
++, range_from
++, range_to
++, range_mask
<<= 1)
863 Lisp_Object val
= field
[i
];
869 range
[i
].from
= range_from
;
870 range
[i
].to
= range_to
;
871 range
[i
].mask
= range_mask
;
875 /* The triplet FROM, TO, and MASK is a value-based
876 retriction for FIELD[I]. */
882 int numeric
= XINT (val
);
885 from
= to
= XLFD_ENCODING_INDEX
,
886 mask
= XLFD_ENCODING_MASK
;
887 else if (numeric
== 0)
888 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
889 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
890 else if (numeric
<= 48)
891 from
= to
= XLFD_PIXEL_INDEX
,
892 mask
= XLFD_PIXEL_MASK
;
894 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
895 mask
= XLFD_LARGENUM_MASK
;
897 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
898 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
899 mask
= XLFD_NULL_MASK
;
901 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
904 Lisp_Object name
= SYMBOL_NAME (val
);
906 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
907 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
908 mask
= XLFD_REGENC_MASK
;
910 from
= to
= XLFD_ENCODING_INDEX
,
911 mask
= XLFD_ENCODING_MASK
;
913 else if (range_from
<= XLFD_WEIGHT_INDEX
914 && range_to
>= XLFD_WEIGHT_INDEX
915 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
916 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
917 else if (range_from
<= XLFD_SLANT_INDEX
918 && range_to
>= XLFD_SLANT_INDEX
919 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
920 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
921 else if (range_from
<= XLFD_SWIDTH_INDEX
922 && range_to
>= XLFD_SWIDTH_INDEX
923 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
924 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
927 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
928 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
930 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
931 mask
= XLFD_SYMBOL_MASK
;
934 /* Merge position-based and value-based restrictions. */
936 while (from
< range_from
)
937 mask
&= ~(1 << from
++);
938 while (from
< 14 && ! (mask
& (1 << from
)))
940 while (to
> range_to
)
941 mask
&= ~(1 << to
--);
942 while (to
>= 0 && ! (mask
& (1 << to
)))
946 range
[i
].from
= from
;
948 range
[i
].mask
= mask
;
950 if (from
> range_from
|| to
< range_to
)
952 /* The range is narrowed by value-based restrictions.
953 Reflect it to the other fields. */
955 /* Following fields should be after FROM. */
957 /* Preceding fields should be before TO. */
958 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
960 /* Check FROM for non-wildcard field. */
961 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
963 while (range
[j
].from
< from
)
964 range
[j
].mask
&= ~(1 << range
[j
].from
++);
965 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
967 range
[j
].from
= from
;
970 from
= range
[j
].from
;
971 if (range
[j
].to
> to
)
973 while (range
[j
].to
> to
)
974 range
[j
].mask
&= ~(1 << range
[j
].to
--);
975 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
988 /* Decide all fileds from restrictions in RANGE. */
989 for (i
= j
= 0; i
< n
; i
++)
991 if (j
< range
[i
].from
)
993 if (i
== 0 || ! NILP (tmp
[i
- 1]))
994 /* None of TMP[X] corresponds to Jth field. */
996 for (; j
< range
[i
].from
; j
++)
1001 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
1003 for (; j
< XLFD_LAST_INDEX
; j
++)
1005 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
1006 field
[XLFD_ENCODING_INDEX
]
1007 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1012 #ifdef ENABLE_CHECKING
1013 /* Match a 14-field XLFD pattern against a full XLFD font name. */
1015 font_match_xlfd (char *pattern
, char *name
)
1017 while (*pattern
&& *name
)
1019 if (*pattern
== *name
)
1021 else if (*pattern
== '*')
1022 if (*name
== pattern
[1])
1033 /* Make sure the font object matches the XLFD font name. */
1035 font_check_xlfd_parse (Lisp_Object font
, char *name
)
1037 char name_check
[256];
1038 font_unparse_xlfd (font
, 0, name_check
, 255);
1039 return font_match_xlfd (name_check
, name
);
1045 /* Parse NAME (null terminated) as XLFD and store information in FONT
1046 (font-spec or font-entity). Size property of FONT is set as
1048 specified XLFD fields FONT property
1049 --------------------- -------------
1050 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1051 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1052 POINT_SIZE POINT_SIZE/10 (Lisp float)
1054 If NAME is successfully parsed, return 0. Otherwise return -1.
1056 FONT is usually a font-spec, but when this function is called from
1057 X font backend driver, it is a font-entity. In that case, NAME is
1058 a fully specified XLFD. */
1061 font_parse_xlfd (name
, font
)
1065 int len
= strlen (name
);
1067 char *f
[XLFD_LAST_INDEX
+ 1];
1071 if (len
> 255 || !len
)
1072 /* Maximum XLFD name length is 255. */
1074 /* Accept "*-.." as a fully specified XLFD. */
1075 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1076 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1079 for (p
= name
+ i
; *p
; p
++)
1083 if (i
== XLFD_LAST_INDEX
)
1088 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1089 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1091 if (i
== XLFD_LAST_INDEX
)
1093 /* Fully specified XLFD. */
1096 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1097 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1098 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1099 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1101 val
= INTERN_FIELD_SYM (i
);
1104 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1106 ASET (font
, j
, make_number (n
));
1109 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1110 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1111 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1113 ASET (font
, FONT_REGISTRY_INDEX
,
1114 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1115 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1117 p
= f
[XLFD_PIXEL_INDEX
];
1118 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1119 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1122 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1124 ASET (font
, FONT_SIZE_INDEX
, val
);
1125 else if (FONT_ENTITY_P (font
))
1129 double point_size
= -1;
1131 font_assert (FONT_SPEC_P (font
));
1132 p
= f
[XLFD_POINT_INDEX
];
1134 point_size
= parse_matrix (p
);
1135 else if (isdigit (*p
))
1136 point_size
= atoi (p
), point_size
/= 10;
1137 if (point_size
>= 0)
1138 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1142 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1143 if (! NILP (val
) && ! INTEGERP (val
))
1145 ASET (font
, FONT_DPI_INDEX
, val
);
1146 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1149 val
= font_prop_validate_spacing (QCspacing
, val
);
1150 if (! INTEGERP (val
))
1152 ASET (font
, FONT_SPACING_INDEX
, val
);
1154 p
= f
[XLFD_AVGWIDTH_INDEX
];
1157 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1158 if (! NILP (val
) && ! INTEGERP (val
))
1160 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1164 int wild_card_found
= 0;
1165 Lisp_Object prop
[XLFD_LAST_INDEX
];
1167 if (FONT_ENTITY_P (font
))
1169 for (j
= 0; j
< i
; j
++)
1173 if (f
[j
][1] && f
[j
][1] != '-')
1176 wild_card_found
= 1;
1179 prop
[j
] = INTERN_FIELD (j
);
1181 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1183 if (! wild_card_found
)
1185 if (font_expand_wildcards (prop
, i
) < 0)
1188 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1189 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1190 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1191 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1192 if (! NILP (prop
[i
]))
1194 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1196 ASET (font
, j
, make_number (n
));
1198 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1199 val
= prop
[XLFD_REGISTRY_INDEX
];
1202 val
= prop
[XLFD_ENCODING_INDEX
];
1204 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1206 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1207 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1209 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1210 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1212 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1214 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1215 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1216 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1218 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1220 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1223 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1224 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1225 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1227 val
= font_prop_validate_spacing (QCspacing
,
1228 prop
[XLFD_SPACING_INDEX
]);
1229 if (! INTEGERP (val
))
1231 ASET (font
, FONT_SPACING_INDEX
, val
);
1233 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1234 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1240 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1241 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1242 0, use PIXEL_SIZE instead. */
1245 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1251 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1255 font_assert (FONTP (font
));
1257 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1260 if (i
== FONT_ADSTYLE_INDEX
)
1261 j
= XLFD_ADSTYLE_INDEX
;
1262 else if (i
== FONT_REGISTRY_INDEX
)
1263 j
= XLFD_REGISTRY_INDEX
;
1264 val
= AREF (font
, i
);
1267 if (j
== XLFD_REGISTRY_INDEX
)
1268 f
[j
] = "*-*", len
+= 4;
1270 f
[j
] = "*", len
+= 2;
1275 val
= SYMBOL_NAME (val
);
1276 if (j
== XLFD_REGISTRY_INDEX
1277 && ! strchr ((char *) SDATA (val
), '-'))
1279 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1280 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1282 f
[j
] = alloca (SBYTES (val
) + 3);
1283 sprintf (f
[j
], "%s-*", SDATA (val
));
1284 len
+= SBYTES (val
) + 3;
1288 f
[j
] = alloca (SBYTES (val
) + 4);
1289 sprintf (f
[j
], "%s*-*", SDATA (val
));
1290 len
+= SBYTES (val
) + 4;
1294 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1298 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1301 val
= font_style_symbolic (font
, i
, 0);
1303 f
[j
] = "*", len
+= 2;
1306 val
= SYMBOL_NAME (val
);
1307 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1311 val
= AREF (font
, FONT_SIZE_INDEX
);
1312 font_assert (NUMBERP (val
) || NILP (val
));
1320 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1321 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1324 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1326 else if (FLOATP (val
))
1328 i
= XFLOAT_DATA (val
) * 10;
1329 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1330 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1333 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1335 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1337 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1338 f
[XLFD_RESX_INDEX
] = alloca (22);
1339 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1343 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1344 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1346 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1348 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1349 : spacing
<= FONT_SPACING_DUAL
? "d"
1350 : spacing
<= FONT_SPACING_MONO
? "m"
1355 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1356 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1358 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1359 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
], "%ld",
1360 (long) XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1363 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1364 len
++; /* for terminating '\0'. */
1367 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1368 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1369 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1370 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1371 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1372 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1373 f
[XLFD_REGISTRY_INDEX
]);
1376 /* Parse NAME (null terminated) and store information in FONT
1377 (font-spec or font-entity). NAME is supplied in either the
1378 Fontconfig or GTK font name format. If NAME is successfully
1379 parsed, return 0. Otherwise return -1.
1381 The fontconfig format is
1383 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1387 FAMILY [PROPS...] [SIZE]
1389 This function tries to guess which format it is. */
1392 font_parse_fcname (name
, font
)
1397 char *size_beg
= NULL
, *size_end
= NULL
;
1398 char *props_beg
= NULL
, *family_end
= NULL
;
1399 int len
= strlen (name
);
1404 for (p
= name
; *p
; p
++)
1406 if (*p
== '\\' && p
[1])
1410 props_beg
= family_end
= p
;
1415 int decimal
= 0, size_found
= 1;
1416 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1419 if (*q
!= '.' || decimal
)
1438 Lisp_Object extra_props
= Qnil
;
1440 /* A fontconfig name with size and/or property data. */
1441 if (family_end
> name
)
1444 family
= font_intern_prop (name
, family_end
- name
, 1);
1445 ASET (font
, FONT_FAMILY_INDEX
, family
);
1449 double point_size
= strtod (size_beg
, &size_end
);
1450 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1451 if (*size_end
== ':' && size_end
[1])
1452 props_beg
= size_end
;
1456 /* Now parse ":KEY=VAL" patterns. */
1459 for (p
= props_beg
; *p
; p
= q
)
1461 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1464 /* Must be an enumerated value. */
1468 val
= font_intern_prop (p
, q
- p
, 1);
1470 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1472 if (PROP_MATCH ("light", 5)
1473 || PROP_MATCH ("medium", 6)
1474 || PROP_MATCH ("demibold", 8)
1475 || PROP_MATCH ("bold", 4)
1476 || PROP_MATCH ("black", 5))
1477 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1478 else if (PROP_MATCH ("roman", 5)
1479 || PROP_MATCH ("italic", 6)
1480 || PROP_MATCH ("oblique", 7))
1481 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1482 else if (PROP_MATCH ("charcell", 8))
1483 ASET (font
, FONT_SPACING_INDEX
,
1484 make_number (FONT_SPACING_CHARCELL
));
1485 else if (PROP_MATCH ("mono", 4))
1486 ASET (font
, FONT_SPACING_INDEX
,
1487 make_number (FONT_SPACING_MONO
));
1488 else if (PROP_MATCH ("proportional", 12))
1489 ASET (font
, FONT_SPACING_INDEX
,
1490 make_number (FONT_SPACING_PROPORTIONAL
));
1499 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1500 prop
= FONT_SIZE_INDEX
;
1503 key
= font_intern_prop (p
, q
- p
, 1);
1504 prop
= get_font_prop_index (key
);
1508 for (q
= p
; *q
&& *q
!= ':'; q
++);
1509 val
= font_intern_prop (p
, q
- p
, 0);
1511 if (prop
>= FONT_FOUNDRY_INDEX
1512 && prop
< FONT_EXTRA_INDEX
)
1513 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1516 extra_props
= nconc2 (extra_props
,
1517 Fcons (Fcons (key
, val
), Qnil
));
1524 if (! NILP (extra_props
))
1526 struct font_driver_list
*driver_list
= font_driver_list
;
1527 for ( ; driver_list
; driver_list
= driver_list
->next
)
1528 if (driver_list
->driver
->filter_properties
)
1529 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1535 /* Either a fontconfig-style name with no size and property
1536 data, or a GTK-style name. */
1538 int word_len
, prop_found
= 0;
1540 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1546 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1554 double point_size
= strtod (p
, &q
);
1555 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1560 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1561 if (*q
== '\\' && q
[1])
1565 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1567 if (PROP_MATCH ("Ultra-Light", 11))
1570 prop
= font_intern_prop ("ultra-light", 11, 1);
1571 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1573 else if (PROP_MATCH ("Light", 5))
1576 prop
= font_intern_prop ("light", 5, 1);
1577 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1579 else if (PROP_MATCH ("Semi-Bold", 9))
1582 prop
= font_intern_prop ("semi-bold", 9, 1);
1583 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1585 else if (PROP_MATCH ("Bold", 4))
1588 prop
= font_intern_prop ("bold", 4, 1);
1589 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1591 else if (PROP_MATCH ("Italic", 6))
1594 prop
= font_intern_prop ("italic", 4, 1);
1595 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1597 else if (PROP_MATCH ("Oblique", 7))
1600 prop
= font_intern_prop ("oblique", 7, 1);
1601 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1605 return -1; /* Unknown property in GTK-style font name. */
1614 family
= font_intern_prop (name
, family_end
- name
, 1);
1615 ASET (font
, FONT_FAMILY_INDEX
, family
);
1622 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1623 NAME (NBYTES length), and return the name length. If
1624 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1627 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1633 Lisp_Object family
, foundry
;
1634 Lisp_Object tail
, val
;
1638 Lisp_Object styles
[3];
1639 char *style_names
[3] = { "weight", "slant", "width" };
1642 family
= AREF (font
, FONT_FAMILY_INDEX
);
1643 if (! NILP (family
))
1645 if (SYMBOLP (family
))
1647 family
= SYMBOL_NAME (family
);
1648 len
+= SBYTES (family
);
1654 val
= AREF (font
, FONT_SIZE_INDEX
);
1657 if (XINT (val
) != 0)
1658 pixel_size
= XINT (val
);
1660 len
+= 21; /* for ":pixelsize=NUM" */
1662 else if (FLOATP (val
))
1665 point_size
= (int) XFLOAT_DATA (val
);
1666 len
+= 11; /* for "-NUM" */
1669 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1670 if (! NILP (foundry
))
1672 if (SYMBOLP (foundry
))
1674 foundry
= SYMBOL_NAME (foundry
);
1675 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1681 for (i
= 0; i
< 3; i
++)
1683 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1684 if (! NILP (styles
[i
]))
1685 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1686 SDATA (SYMBOL_NAME (styles
[i
])));
1689 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1690 len
+= sprintf (work
, ":dpi=%ld", (long)XINT (AREF (font
, FONT_DPI_INDEX
)));
1691 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1692 len
+= strlen (":spacing=100");
1693 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1694 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1695 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1697 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1699 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1701 len
+= SBYTES (val
);
1702 else if (INTEGERP (val
))
1703 len
+= sprintf (work
, "%ld", (long) XINT (val
));
1704 else if (SYMBOLP (val
))
1705 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1711 if (! NILP (family
))
1712 p
+= sprintf (p
, "%s", SDATA (family
));
1716 p
+= sprintf (p
, "%d", point_size
);
1718 p
+= sprintf (p
, "-%d", point_size
);
1720 else if (pixel_size
> 0)
1721 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1722 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1723 p
+= sprintf (p
, ":foundry=%s",
1724 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1725 for (i
= 0; i
< 3; i
++)
1726 if (! NILP (styles
[i
]))
1727 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1728 SDATA (SYMBOL_NAME (styles
[i
])));
1729 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1730 p
+= sprintf (p
, ":dpi=%ld", (long) XINT (AREF (font
, FONT_DPI_INDEX
)));
1731 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1732 p
+= sprintf (p
, ":spacing=%ld",
1733 (long) XINT (AREF (font
, FONT_SPACING_INDEX
)));
1734 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1736 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1737 p
+= sprintf (p
, ":scalable=true");
1739 p
+= sprintf (p
, ":scalable=false");
1744 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1745 NAME (NBYTES length), and return the name length. F is the frame
1746 on which the font is displayed; it is used to calculate the point
1750 font_unparse_gtkname (font
, f
, name
, nbytes
)
1758 Lisp_Object family
, weight
, slant
, size
;
1759 int point_size
= -1;
1761 family
= AREF (font
, FONT_FAMILY_INDEX
);
1762 if (! NILP (family
))
1764 if (! SYMBOLP (family
))
1766 family
= SYMBOL_NAME (family
);
1767 len
+= SBYTES (family
);
1770 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1771 if (EQ (weight
, Qnormal
))
1773 else if (! NILP (weight
))
1775 weight
= SYMBOL_NAME (weight
);
1776 len
+= SBYTES (weight
);
1779 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1780 if (EQ (slant
, Qnormal
))
1782 else if (! NILP (slant
))
1784 slant
= SYMBOL_NAME (slant
);
1785 len
+= SBYTES (slant
);
1788 size
= AREF (font
, FONT_SIZE_INDEX
);
1789 /* Convert pixel size to point size. */
1790 if (INTEGERP (size
))
1792 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1794 if (INTEGERP (font_dpi
))
1795 dpi
= XINT (font_dpi
);
1798 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1801 else if (FLOATP (size
))
1803 point_size
= (int) XFLOAT_DATA (size
);
1810 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1812 if (! NILP (weight
))
1815 p
+= sprintf (p
, " %s", SDATA (weight
));
1816 q
[1] = toupper (q
[1]);
1822 p
+= sprintf (p
, " %s", SDATA (slant
));
1823 q
[1] = toupper (q
[1]);
1827 p
+= sprintf (p
, " %d", point_size
);
1832 /* Parse NAME (null terminated) and store information in FONT
1833 (font-spec or font-entity). If NAME is successfully parsed, return
1834 0. Otherwise return -1. */
1837 font_parse_name (name
, font
)
1841 if (name
[0] == '-' || index (name
, '*') || index (name
, '?'))
1842 return font_parse_xlfd (name
, font
);
1843 return font_parse_fcname (name
, font
);
1847 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1848 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1852 font_parse_family_registry (family
, registry
, font_spec
)
1853 Lisp_Object family
, registry
, font_spec
;
1859 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1861 CHECK_STRING (family
);
1862 len
= SBYTES (family
);
1863 p0
= (char *) SDATA (family
);
1864 p1
= index (p0
, '-');
1867 if ((*p0
!= '*' && p1
- p0
> 0)
1868 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1869 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1872 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1875 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1877 if (! NILP (registry
))
1879 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1880 CHECK_STRING (registry
);
1881 len
= SBYTES (registry
);
1882 p0
= (char *) SDATA (registry
);
1883 p1
= index (p0
, '-');
1886 if (SDATA (registry
)[len
- 1] == '*')
1887 registry
= concat2 (registry
, build_string ("-*"));
1889 registry
= concat2 (registry
, build_string ("*-*"));
1891 registry
= Fdowncase (registry
);
1892 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1897 /* This part (through the next ^L) is still experimental and not
1898 tested much. We may drastically change codes. */
1904 #define LGSTRING_HEADER_SIZE 6
1905 #define LGSTRING_GLYPH_SIZE 8
1908 check_gstring (gstring
)
1909 Lisp_Object gstring
;
1914 CHECK_VECTOR (gstring
);
1915 val
= AREF (gstring
, 0);
1917 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1919 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1920 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1921 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1922 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1923 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1924 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1925 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1926 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1927 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1928 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1929 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1931 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1933 val
= LGSTRING_GLYPH (gstring
, i
);
1935 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1937 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1939 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1940 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1941 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1942 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1943 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1944 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1945 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1946 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1948 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1950 if (ASIZE (val
) < 3)
1952 for (j
= 0; j
< 3; j
++)
1953 CHECK_NUMBER (AREF (val
, j
));
1958 error ("Invalid glyph-string format");
1963 check_otf_features (otf_features
)
1964 Lisp_Object otf_features
;
1968 CHECK_CONS (otf_features
);
1969 CHECK_SYMBOL (XCAR (otf_features
));
1970 otf_features
= XCDR (otf_features
);
1971 CHECK_CONS (otf_features
);
1972 CHECK_SYMBOL (XCAR (otf_features
));
1973 otf_features
= XCDR (otf_features
);
1974 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1976 CHECK_SYMBOL (Fcar (val
));
1977 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1978 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1980 otf_features
= XCDR (otf_features
);
1981 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1983 CHECK_SYMBOL (Fcar (val
));
1984 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1985 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1992 Lisp_Object otf_list
;
1995 otf_tag_symbol (tag
)
2000 OTF_tag_name (tag
, name
);
2001 return Fintern (make_unibyte_string (name
, 4), Qnil
);
2008 Lisp_Object val
= Fassoc (file
, otf_list
);
2012 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
2015 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
2016 val
= make_save_value (otf
, 0);
2017 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
2023 /* Return a list describing which scripts/languages FONT supports by
2024 which GSUB/GPOS features of OpenType tables. See the comment of
2025 (struct font_driver).otf_capability. */
2028 font_otf_capability (font
)
2032 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
2035 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
2038 for (i
= 0; i
< 2; i
++)
2040 OTF_GSUB_GPOS
*gsub_gpos
;
2041 Lisp_Object script_list
= Qnil
;
2044 if (OTF_get_features (otf
, i
== 0) < 0)
2046 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2047 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2049 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2050 Lisp_Object langsys_list
= Qnil
;
2051 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2054 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2056 OTF_LangSys
*langsys
;
2057 Lisp_Object feature_list
= Qnil
;
2058 Lisp_Object langsys_tag
;
2061 if (k
== script
->LangSysCount
)
2063 langsys
= &script
->DefaultLangSys
;
2068 langsys
= script
->LangSys
+ k
;
2070 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2072 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2074 OTF_Feature
*feature
2075 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2076 Lisp_Object feature_tag
2077 = otf_tag_symbol (feature
->FeatureTag
);
2079 feature_list
= Fcons (feature_tag
, feature_list
);
2081 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2084 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2089 XSETCAR (capability
, script_list
);
2091 XSETCDR (capability
, script_list
);
2097 /* Parse OTF features in SPEC and write a proper features spec string
2098 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2099 assured that the sufficient memory has already allocated for
2103 generate_otf_features (spec
, features
)
2113 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2119 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2124 else if (! asterisk
)
2126 val
= SYMBOL_NAME (val
);
2127 p
+= sprintf (p
, "%s", SDATA (val
));
2131 val
= SYMBOL_NAME (val
);
2132 p
+= sprintf (p
, "~%s", SDATA (val
));
2136 error ("OTF spec too long");
2140 font_otf_DeviceTable (device_table
)
2141 OTF_DeviceTable
*device_table
;
2143 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2145 return Fcons (make_number (len
),
2146 make_unibyte_string (device_table
->DeltaValue
, len
));
2150 font_otf_ValueRecord (value_format
, value_record
)
2152 OTF_ValueRecord
*value_record
;
2154 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2156 if (value_format
& OTF_XPlacement
)
2157 ASET (val
, 0, make_number (value_record
->XPlacement
));
2158 if (value_format
& OTF_YPlacement
)
2159 ASET (val
, 1, make_number (value_record
->YPlacement
));
2160 if (value_format
& OTF_XAdvance
)
2161 ASET (val
, 2, make_number (value_record
->XAdvance
));
2162 if (value_format
& OTF_YAdvance
)
2163 ASET (val
, 3, make_number (value_record
->YAdvance
));
2164 if (value_format
& OTF_XPlaDevice
)
2165 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2166 if (value_format
& OTF_YPlaDevice
)
2167 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2168 if (value_format
& OTF_XAdvDevice
)
2169 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2170 if (value_format
& OTF_YAdvDevice
)
2171 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2176 font_otf_Anchor (anchor
)
2181 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2182 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2183 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2184 if (anchor
->AnchorFormat
== 2)
2185 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2188 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2189 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2193 #endif /* HAVE_LIBOTF */
2199 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2200 static int font_compare
P_ ((const void *, const void *));
2201 static Lisp_Object font_sort_entities
P_ ((Lisp_Object
, Lisp_Object
,
2204 /* Return a rescaling ratio of FONT_ENTITY. */
2205 extern Lisp_Object Vface_font_rescale_alist
;
2208 font_rescale_ratio (font_entity
)
2209 Lisp_Object font_entity
;
2211 Lisp_Object tail
, elt
;
2212 Lisp_Object name
= Qnil
;
2214 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2217 if (FLOATP (XCDR (elt
)))
2219 if (STRINGP (XCAR (elt
)))
2222 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2223 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2224 return XFLOAT_DATA (XCDR (elt
));
2226 else if (FONT_SPEC_P (XCAR (elt
)))
2228 if (font_match_p (XCAR (elt
), font_entity
))
2229 return XFLOAT_DATA (XCDR (elt
));
2236 /* We sort fonts by scoring each of them against a specified
2237 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2238 the value is, the closer the font is to the font-spec.
2240 The lowest 2 bits of the score is used for driver type. The font
2241 available by the most preferred font driver is 0.
2243 Each 7-bit in the higher 28 bits are used for numeric properties
2244 WEIGHT, SLANT, WIDTH, and SIZE. */
2246 /* How many bits to shift to store the difference value of each font
2247 property in a score. Note that flots for FONT_TYPE_INDEX and
2248 FONT_REGISTRY_INDEX are not used. */
2249 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2251 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2252 The return value indicates how different ENTITY is compared with
2256 font_score (entity
, spec_prop
)
2257 Lisp_Object entity
, *spec_prop
;
2262 /* Score three style numeric fields. Maximum difference is 127. */
2263 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2264 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2266 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2271 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2274 /* Score the size. Maximum difference is 127. */
2275 i
= FONT_SIZE_INDEX
;
2276 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2277 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2279 /* We use the higher 6-bit for the actual size difference. The
2280 lowest bit is set if the DPI is different. */
2282 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2284 if (CONSP (Vface_font_rescale_alist
))
2285 pixel_size
*= font_rescale_ratio (entity
);
2286 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2290 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2291 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2293 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2294 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2296 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2303 /* Concatenate all elements of LIST into one vector. LIST is a list
2304 of font-entity vectors. */
2307 font_vconcat_entity_vectors (Lisp_Object list
)
2309 int nargs
= XINT (Flength (list
));
2310 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2313 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2314 args
[i
] = XCAR (list
);
2315 return Fvconcat (nargs
, args
);
2319 /* The structure for elements being sorted by qsort. */
2320 struct font_sort_data
2323 int font_driver_preference
;
2328 /* The comparison function for qsort. */
2331 font_compare (d1
, d2
)
2332 const void *d1
, *d2
;
2334 const struct font_sort_data
*data1
= d1
;
2335 const struct font_sort_data
*data2
= d2
;
2337 if (data1
->score
< data2
->score
)
2339 else if (data1
->score
> data2
->score
)
2341 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2345 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2346 If PREFER specifies a point-size, calculate the corresponding
2347 pixel-size from QCdpi property of PREFER or from the Y-resolution
2348 of FRAME before sorting.
2350 If BEST-ONLY is nonzero, return the best matching entity (that
2351 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2352 if BEST-ONLY is negative). Otherwise, return the sorted result as
2353 a single vector of font-entities.
2355 This function does no optimization for the case that the total
2356 number of elements is 1. The caller should avoid calling this in
2360 font_sort_entities (list
, prefer
, frame
, best_only
)
2361 Lisp_Object list
, prefer
, frame
;
2364 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2366 struct font_sort_data
*data
;
2367 unsigned best_score
;
2368 Lisp_Object best_entity
;
2369 struct frame
*f
= XFRAME (frame
);
2370 Lisp_Object tail
, vec
;
2373 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2374 prefer_prop
[i
] = AREF (prefer
, i
);
2375 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2376 prefer_prop
[FONT_SIZE_INDEX
]
2377 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2379 if (NILP (XCDR (list
)))
2381 /* What we have to take care of is this single vector. */
2383 maxlen
= ASIZE (vec
);
2387 /* We don't have to perform sort, so there's no need of creating
2388 a single vector. But, we must find the length of the longest
2391 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2392 if (maxlen
< ASIZE (XCAR (tail
)))
2393 maxlen
= ASIZE (XCAR (tail
));
2397 /* We have to create a single vector to sort it. */
2398 vec
= font_vconcat_entity_vectors (list
);
2399 maxlen
= ASIZE (vec
);
2402 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2403 best_score
= 0xFFFFFFFF;
2406 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2408 int font_driver_preference
= 0;
2409 Lisp_Object current_font_driver
;
2415 /* We are sure that the length of VEC > 0. */
2416 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2417 /* Score the elements. */
2418 for (i
= 0; i
< len
; i
++)
2420 data
[i
].entity
= AREF (vec
, i
);
2422 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2424 ? font_score (data
[i
].entity
, prefer_prop
)
2426 if (best_only
&& best_score
> data
[i
].score
)
2428 best_score
= data
[i
].score
;
2429 best_entity
= data
[i
].entity
;
2430 if (best_score
== 0)
2433 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2435 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2436 font_driver_preference
++;
2438 data
[i
].font_driver_preference
= font_driver_preference
;
2441 /* Sort if necessary. */
2444 qsort (data
, len
, sizeof *data
, font_compare
);
2445 for (i
= 0; i
< len
; i
++)
2446 ASET (vec
, i
, data
[i
].entity
);
2455 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2460 /* API of Font Service Layer. */
2462 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2463 sort_shift_bits. Finternal_set_font_selection_order calls this
2464 function with font_sort_order after setting up it. */
2467 font_update_sort_order (order
)
2472 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2474 int xlfd_idx
= order
[i
];
2476 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2477 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2478 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2479 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2480 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2481 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2483 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2488 font_check_otf_features (script
, langsys
, features
, table
)
2489 Lisp_Object script
, langsys
, features
, table
;
2494 table
= assq_no_quit (script
, table
);
2497 table
= XCDR (table
);
2498 if (! NILP (langsys
))
2500 table
= assq_no_quit (langsys
, table
);
2506 val
= assq_no_quit (Qnil
, table
);
2508 table
= XCAR (table
);
2512 table
= XCDR (table
);
2513 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2515 if (NILP (XCAR (features
)))
2520 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2526 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2529 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2531 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2533 script
= XCAR (spec
);
2537 langsys
= XCAR (spec
);
2548 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2549 XCAR (otf_capability
)))
2551 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2552 XCDR (otf_capability
)))
2559 /* Check if FONT (font-entity or font-object) matches with the font
2560 specification SPEC. */
2563 font_match_p (spec
, font
)
2564 Lisp_Object spec
, font
;
2566 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2567 Lisp_Object extra
, font_extra
;
2570 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2571 if (! NILP (AREF (spec
, i
))
2572 && ! NILP (AREF (font
, i
))
2573 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2575 props
= XFONT_SPEC (spec
)->props
;
2576 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2578 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2579 prop
[i
] = AREF (spec
, i
);
2580 prop
[FONT_SIZE_INDEX
]
2581 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2585 if (font_score (font
, props
) > 0)
2587 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2588 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2589 for (; CONSP (extra
); extra
= XCDR (extra
))
2591 Lisp_Object key
= XCAR (XCAR (extra
));
2592 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2594 if (EQ (key
, QClang
))
2596 val2
= assq_no_quit (key
, font_extra
);
2605 if (NILP (Fmemq (val
, val2
)))
2610 ? NILP (Fmemq (val
, XCDR (val2
)))
2614 else if (EQ (key
, QCscript
))
2616 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2622 /* All characters in the list must be supported. */
2623 for (; CONSP (val2
); val2
= XCDR (val2
))
2625 if (! NATNUMP (XCAR (val2
)))
2627 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2628 == FONT_INVALID_CODE
)
2632 else if (VECTORP (val2
))
2634 /* At most one character in the vector must be supported. */
2635 for (i
= 0; i
< ASIZE (val2
); i
++)
2637 if (! NATNUMP (AREF (val2
, i
)))
2639 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2640 != FONT_INVALID_CODE
)
2643 if (i
== ASIZE (val2
))
2648 else if (EQ (key
, QCotf
))
2652 if (! FONT_OBJECT_P (font
))
2654 fontp
= XFONT_OBJECT (font
);
2655 if (! fontp
->driver
->otf_capability
)
2657 val2
= fontp
->driver
->otf_capability (fontp
);
2658 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2669 Each font backend has the callback function get_cache, and it
2670 returns a cons cell of which cdr part can be freely used for
2671 caching fonts. The cons cell may be shared by multiple frames
2672 and/or multiple font drivers. So, we arrange the cdr part as this:
2674 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2676 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2677 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2678 cons (FONT-SPEC FONT-ENTITY ...). */
2680 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2681 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2682 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2683 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2684 struct font_driver
*));
2687 font_prepare_cache (f
, driver
)
2689 struct font_driver
*driver
;
2691 Lisp_Object cache
, val
;
2693 cache
= driver
->get_cache (f
);
2695 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2699 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2700 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2704 val
= XCDR (XCAR (val
));
2705 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2711 font_finish_cache (f
, driver
)
2713 struct font_driver
*driver
;
2715 Lisp_Object cache
, val
, tmp
;
2718 cache
= driver
->get_cache (f
);
2720 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2721 cache
= val
, val
= XCDR (val
);
2722 font_assert (! NILP (val
));
2723 tmp
= XCDR (XCAR (val
));
2724 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2725 if (XINT (XCAR (tmp
)) == 0)
2727 font_clear_cache (f
, XCAR (val
), driver
);
2728 XSETCDR (cache
, XCDR (val
));
2734 font_get_cache (f
, driver
)
2736 struct font_driver
*driver
;
2738 Lisp_Object val
= driver
->get_cache (f
);
2739 Lisp_Object type
= driver
->type
;
2741 font_assert (CONSP (val
));
2742 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2743 font_assert (CONSP (val
));
2744 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2745 val
= XCDR (XCAR (val
));
2749 static int num_fonts
;
2752 font_clear_cache (f
, cache
, driver
)
2755 struct font_driver
*driver
;
2757 Lisp_Object tail
, elt
;
2758 Lisp_Object tail2
, entity
;
2760 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2761 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2764 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2765 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2767 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2769 entity
= XCAR (tail2
);
2771 if (FONT_ENTITY_P (entity
)
2772 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2774 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2776 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2778 Lisp_Object val
= XCAR (objlist
);
2779 struct font
*font
= XFONT_OBJECT (val
);
2781 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2783 font_assert (font
&& driver
== font
->driver
);
2784 driver
->close (f
, font
);
2788 if (driver
->free_entity
)
2789 driver
->free_entity (entity
);
2794 XSETCDR (cache
, Qnil
);
2798 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2801 font_delete_unmatched (vec
, spec
, size
)
2802 Lisp_Object vec
, spec
;
2805 Lisp_Object entity
, val
;
2806 enum font_property_index prop
;
2809 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2811 entity
= AREF (vec
, i
);
2812 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2813 if (INTEGERP (AREF (spec
, prop
))
2814 && ((XINT (AREF (spec
, prop
)) >> 8)
2815 != (XINT (AREF (entity
, prop
)) >> 8)))
2816 prop
= FONT_SPEC_MAX
;
2817 if (prop
< FONT_SPEC_MAX
2819 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2821 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2824 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2825 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2826 prop
= FONT_SPEC_MAX
;
2828 if (prop
< FONT_SPEC_MAX
2829 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2830 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2831 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2832 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2833 prop
= FONT_SPEC_MAX
;
2834 if (prop
< FONT_SPEC_MAX
2835 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2836 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2837 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2838 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2839 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2840 prop
= FONT_SPEC_MAX
;
2841 if (prop
< FONT_SPEC_MAX
)
2842 val
= Fcons (entity
, val
);
2844 return (Fvconcat (1, &val
));
2848 /* Return a list of vectors of font-entities matching with SPEC on
2849 FRAME. Each elements in the list is a vector of entities from the
2850 same font-driver. */
2853 font_list_entities (frame
, spec
)
2854 Lisp_Object frame
, spec
;
2856 FRAME_PTR f
= XFRAME (frame
);
2857 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2858 Lisp_Object ftype
, val
;
2859 Lisp_Object list
= Qnil
;
2861 int need_filtering
= 0;
2864 font_assert (FONT_SPEC_P (spec
));
2866 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2867 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2868 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2869 size
= font_pixel_size (f
, spec
);
2873 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2874 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2875 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2876 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2878 ASET (scratch_font_spec
, i
, Qnil
);
2879 if (! NILP (AREF (spec
, i
)))
2881 if (i
== FONT_DPI_INDEX
)
2882 /* Skip FONT_SPACING_INDEX */
2885 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2886 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2888 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2890 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2892 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2894 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2895 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2902 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2906 val
= Fvconcat (1, &val
);
2907 copy
= Fcopy_font_spec (scratch_font_spec
);
2908 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2909 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2911 if (ASIZE (val
) > 0 && need_filtering
)
2912 val
= font_delete_unmatched (val
, spec
, size
);
2913 if (ASIZE (val
) > 0)
2914 list
= Fcons (val
, list
);
2917 list
= Fnreverse (list
);
2918 FONT_ADD_LOG ("list", spec
, list
);
2923 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2924 nil, is an array of face's attributes, which specifies preferred
2925 font-related attributes. */
2928 font_matching_entity (f
, attrs
, spec
)
2930 Lisp_Object
*attrs
, spec
;
2932 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2933 Lisp_Object ftype
, size
, entity
;
2935 Lisp_Object work
= Fcopy_font_spec (spec
);
2937 XSETFRAME (frame
, f
);
2938 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2939 size
= AREF (spec
, FONT_SIZE_INDEX
);
2942 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2943 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2944 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2945 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2948 for (; driver_list
; driver_list
= driver_list
->next
)
2950 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2952 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2955 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2956 entity
= assoc_no_quit (work
, XCDR (cache
));
2958 entity
= XCDR (entity
);
2961 entity
= driver_list
->driver
->match (frame
, work
);
2962 copy
= Fcopy_font_spec (work
);
2963 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2964 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2966 if (! NILP (entity
))
2969 FONT_ADD_LOG ("match", work
, entity
);
2974 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2975 opened font object. */
2978 font_open_entity (f
, entity
, pixel_size
)
2983 struct font_driver_list
*driver_list
;
2984 Lisp_Object objlist
, size
, val
, font_object
;
2986 int min_width
, height
;
2987 int scaled_pixel_size
;
2989 font_assert (FONT_ENTITY_P (entity
));
2990 size
= AREF (entity
, FONT_SIZE_INDEX
);
2991 if (XINT (size
) != 0)
2992 scaled_pixel_size
= pixel_size
= XINT (size
);
2993 else if (CONSP (Vface_font_rescale_alist
))
2994 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2996 val
= AREF (entity
, FONT_TYPE_INDEX
);
2997 for (driver_list
= f
->font_driver_list
;
2998 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2999 driver_list
= driver_list
->next
);
3003 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
3004 objlist
= XCDR (objlist
))
3006 Lisp_Object fn
= XCAR (objlist
);
3007 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
3008 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
3010 if (driver_list
->driver
->cached_font_ok
== NULL
3011 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
3016 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
3017 if (!NILP (font_object
))
3018 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3019 FONT_ADD_LOG ("open", entity
, font_object
);
3020 if (NILP (font_object
))
3022 ASET (entity
, FONT_OBJLIST_INDEX
,
3023 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
3024 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
3027 font
= XFONT_OBJECT (font_object
);
3028 min_width
= (font
->min_width
? font
->min_width
3029 : font
->average_width
? font
->average_width
3030 : font
->space_width
? font
->space_width
3032 height
= (font
->height
? font
->height
: 1);
3033 #ifdef HAVE_WINDOW_SYSTEM
3034 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
3035 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
3037 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
3038 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
3039 fonts_changed_p
= 1;
3043 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
3044 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
3045 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
3046 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
3054 /* Close FONT_OBJECT that is opened on frame F. */
3057 font_close_object (f
, font_object
)
3059 Lisp_Object font_object
;
3061 struct font
*font
= XFONT_OBJECT (font_object
);
3063 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
3064 /* Already closed. */
3066 FONT_ADD_LOG ("close", font_object
, Qnil
);
3067 font
->driver
->close (f
, font
);
3068 #ifdef HAVE_WINDOW_SYSTEM
3069 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
3070 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
3076 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
3077 FONT is a font-entity and it must be opened to check. */
3080 font_has_char (f
, font
, c
)
3087 if (FONT_ENTITY_P (font
))
3089 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
3090 struct font_driver_list
*driver_list
;
3092 for (driver_list
= f
->font_driver_list
;
3093 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
3094 driver_list
= driver_list
->next
);
3097 if (! driver_list
->driver
->has_char
)
3099 return driver_list
->driver
->has_char (font
, c
);
3102 font_assert (FONT_OBJECT_P (font
));
3103 fontp
= XFONT_OBJECT (font
);
3104 if (fontp
->driver
->has_char
)
3106 int result
= fontp
->driver
->has_char (font
, c
);
3111 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
3115 /* Return the glyph ID of FONT_OBJECT for character C. */
3118 font_encode_char (font_object
, c
)
3119 Lisp_Object font_object
;
3124 font_assert (FONT_OBJECT_P (font_object
));
3125 font
= XFONT_OBJECT (font_object
);
3126 return font
->driver
->encode_char (font
, c
);
3130 /* Return the name of FONT_OBJECT. */
3133 font_get_name (font_object
)
3134 Lisp_Object font_object
;
3136 font_assert (FONT_OBJECT_P (font_object
));
3137 return AREF (font_object
, FONT_NAME_INDEX
);
3141 /* Return the specification of FONT_OBJECT. */
3144 font_get_spec (font_object
)
3145 Lisp_Object font_object
;
3147 Lisp_Object spec
= font_make_spec ();
3150 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
3151 ASET (spec
, i
, AREF (font_object
, i
));
3152 ASET (spec
, FONT_SIZE_INDEX
,
3153 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
3158 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3159 could not be parsed by font_parse_name, return Qnil. */
3162 font_spec_from_name (font_name
)
3163 Lisp_Object font_name
;
3165 Lisp_Object spec
= Ffont_spec (0, NULL
);
3167 CHECK_STRING (font_name
);
3168 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3170 font_put_extra (spec
, QCname
, font_name
);
3171 font_put_extra (spec
, QCuser_spec
, font_name
);
3177 font_clear_prop (attrs
, prop
)
3179 enum font_property_index prop
;
3181 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3186 if (! NILP (Ffont_get (font
, QCname
)))
3188 font
= Fcopy_font_spec (font
);
3189 font_put_extra (font
, QCname
, Qnil
);
3192 if (NILP (AREF (font
, prop
))
3193 && prop
!= FONT_FAMILY_INDEX
3194 && prop
!= FONT_FOUNDRY_INDEX
3195 && prop
!= FONT_WIDTH_INDEX
3196 && prop
!= FONT_SIZE_INDEX
)
3198 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3199 font
= Fcopy_font_spec (font
);
3200 ASET (font
, prop
, Qnil
);
3201 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3203 if (prop
== FONT_FAMILY_INDEX
)
3205 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3206 /* If we are setting the font family, we must also clear
3207 FONT_WIDTH_INDEX to avoid rejecting families that lack
3208 support for some widths. */
3209 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3211 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3212 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3213 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3214 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3215 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3216 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3218 else if (prop
== FONT_SIZE_INDEX
)
3220 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3221 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3222 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3224 else if (prop
== FONT_WIDTH_INDEX
)
3225 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3226 attrs
[LFACE_FONT_INDEX
] = font
;
3230 font_update_lface (f
, attrs
)
3236 spec
= attrs
[LFACE_FONT_INDEX
];
3237 if (! FONT_SPEC_P (spec
))
3240 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3241 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3242 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3243 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3244 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3245 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3246 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3247 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);
3248 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3249 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3250 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3254 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3259 val
= Ffont_get (spec
, QCdpi
);
3262 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3264 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3266 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3268 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3269 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3275 /* Selecte a font from ENTITIES (list of font-entity vectors) that
3276 supports C and matches best with ATTRS and PIXEL_SIZE. */
3279 font_select_entity (frame
, entities
, attrs
, pixel_size
, c
)
3280 Lisp_Object frame
, entities
, *attrs
;
3283 Lisp_Object font_entity
;
3286 FRAME_PTR f
= XFRAME (frame
);
3288 if (NILP (XCDR (entities
))
3289 && ASIZE (XCAR (entities
)) == 1)
3291 font_entity
= AREF (XCAR (entities
), 0);
3293 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3298 /* Sort fonts by properties specified in ATTRS. */
3299 prefer
= scratch_font_prefer
;
3301 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3302 ASET (prefer
, i
, Qnil
);
3303 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3305 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3307 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3308 ASET (prefer
, i
, AREF (face_font
, i
));
3310 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3311 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3312 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3313 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3314 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3315 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3316 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3318 return font_sort_entities (entities
, prefer
, frame
, c
);
3321 /* Return a font-entity satisfying SPEC and best matching with face's
3322 font related attributes in ATTRS. C, if not negative, is a
3323 character that the entity must support. */
3326 font_find_for_lface (f
, attrs
, spec
, c
)
3333 Lisp_Object frame
, entities
, val
;
3334 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3338 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3339 if (NILP (registry
[0]))
3341 registry
[0] = DEFAULT_ENCODING
;
3342 registry
[1] = Qascii_0
;
3343 registry
[2] = null_vector
;
3346 registry
[1] = null_vector
;
3348 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3350 struct charset
*encoding
, *repertory
;
3352 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3353 &encoding
, &repertory
) < 0)
3356 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3358 else if (c
> encoding
->max_char
)
3362 work
= Fcopy_font_spec (spec
);
3363 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3364 XSETFRAME (frame
, f
);
3365 size
= AREF (spec
, FONT_SIZE_INDEX
);
3366 pixel_size
= font_pixel_size (f
, spec
);
3367 if (pixel_size
== 0)
3369 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3371 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3373 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3374 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3375 if (! NILP (foundry
[0]))
3376 foundry
[1] = null_vector
;
3377 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3379 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3380 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3382 foundry
[2] = null_vector
;
3385 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3387 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3388 if (! NILP (adstyle
[0]))
3389 adstyle
[1] = null_vector
;
3390 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3392 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3394 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3396 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3398 adstyle
[2] = null_vector
;
3401 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3404 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3407 val
= AREF (work
, FONT_FAMILY_INDEX
);
3408 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3410 val
= attrs
[LFACE_FAMILY_INDEX
];
3411 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3415 family
= alloca ((sizeof family
[0]) * 2);
3417 family
[1] = null_vector
; /* terminator. */
3422 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3423 /* Font family names are case-sensitive under NS. */
3431 if (! NILP (alters
))
3433 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3434 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3435 family
[i
] = XCAR (alters
);
3436 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3438 family
[i
] = null_vector
;
3442 family
= alloca ((sizeof family
[0]) * 3);
3445 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3447 family
[i
] = null_vector
;
3451 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3453 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3454 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3456 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3457 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3459 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3460 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3462 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3463 entities
= font_list_entities (frame
, work
);
3464 if (! NILP (entities
))
3466 val
= font_select_entity (frame
, entities
,
3467 attrs
, pixel_size
, c
);
3480 font_open_for_lface (f
, entity
, attrs
, spec
)
3488 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3489 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3490 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3491 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3492 size
= font_pixel_size (f
, spec
);
3496 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3497 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3500 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3501 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3502 if (INTEGERP (height
))
3505 abort(); /* We should never end up here. */
3509 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3513 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3514 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3518 return font_open_entity (f
, entity
, size
);
3522 /* Find a font satisfying SPEC and best matching with face's
3523 attributes in ATTRS on FRAME, and return the opened
3527 font_load_for_lface (f
, attrs
, spec
)
3529 Lisp_Object
*attrs
, spec
;
3531 Lisp_Object entity
, name
;
3533 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3536 /* No font is listed for SPEC, but each font-backend may have
3537 the different criteria about "font matching". So, try
3539 entity
= font_matching_entity (f
, attrs
, spec
);
3543 /* Don't loose the original name that was put in initially. We need
3544 it to re-apply the font when font parameters (like hinting or dpi) have
3546 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3549 name
= Ffont_get (spec
, QCuser_spec
);
3550 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3556 /* Make FACE on frame F ready to use the font opened for FACE. */
3559 font_prepare_for_face (f
, face
)
3563 if (face
->font
->driver
->prepare_face
)
3564 face
->font
->driver
->prepare_face (f
, face
);
3568 /* Make FACE on frame F stop using the font opened for FACE. */
3571 font_done_for_face (f
, face
)
3575 if (face
->font
->driver
->done_face
)
3576 face
->font
->driver
->done_face (f
, face
);
3581 /* Open a font matching with font-spec SPEC on frame F. If no proper
3582 font is found, return Qnil. */
3585 font_open_by_spec (f
, spec
)
3589 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3591 /* We set up the default font-related attributes of a face to prefer
3593 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3594 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3595 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3597 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3599 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3601 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3603 return font_load_for_lface (f
, attrs
, spec
);
3607 /* Open a font matching with NAME on frame F. If no proper font is
3608 found, return Qnil. */
3611 font_open_by_name (f
, name
)
3615 Lisp_Object args
[2];
3616 Lisp_Object spec
, ret
;
3619 args
[1] = make_unibyte_string (name
, strlen (name
));
3620 spec
= Ffont_spec (2, args
);
3621 ret
= font_open_by_spec (f
, spec
);
3622 /* Do not loose name originally put in. */
3624 font_put_extra (ret
, QCuser_spec
, args
[1]);
3630 /* Register font-driver DRIVER. This function is used in two ways.
3632 The first is with frame F non-NULL. In this case, make DRIVER
3633 available (but not yet activated) on F. All frame creaters
3634 (e.g. Fx_create_frame) must call this function at least once with
3635 an available font-driver.
3637 The second is with frame F NULL. In this case, DRIVER is globally
3638 registered in the variable `font_driver_list'. All font-driver
3639 implementations must call this function in its syms_of_XXXX
3640 (e.g. syms_of_xfont). */
3643 register_font_driver (driver
, f
)
3644 struct font_driver
*driver
;
3647 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3648 struct font_driver_list
*prev
, *list
;
3650 if (f
&& ! driver
->draw
)
3651 error ("Unusable font driver for a frame: %s",
3652 SDATA (SYMBOL_NAME (driver
->type
)));
3654 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3655 if (EQ (list
->driver
->type
, driver
->type
))
3656 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3658 list
= xmalloc (sizeof (struct font_driver_list
));
3660 list
->driver
= driver
;
3665 f
->font_driver_list
= list
;
3667 font_driver_list
= list
;
3673 free_font_driver_list (f
)
3676 struct font_driver_list
*list
, *next
;
3678 for (list
= f
->font_driver_list
; list
; list
= next
)
3683 f
->font_driver_list
= NULL
;
3687 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3688 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3689 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3691 A caller must free all realized faces if any in advance. The
3692 return value is a list of font backends actually made used on
3696 font_update_drivers (f
, new_drivers
)
3698 Lisp_Object new_drivers
;
3700 Lisp_Object active_drivers
= Qnil
;
3701 struct font_driver
*driver
;
3702 struct font_driver_list
*list
;
3704 /* At first, turn off non-requested drivers, and turn on requested
3706 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3708 driver
= list
->driver
;
3709 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3714 if (driver
->end_for_frame
)
3715 driver
->end_for_frame (f
);
3716 font_finish_cache (f
, driver
);
3721 if (! driver
->start_for_frame
3722 || driver
->start_for_frame (f
) == 0)
3724 font_prepare_cache (f
, driver
);
3731 if (NILP (new_drivers
))
3734 if (! EQ (new_drivers
, Qt
))
3736 /* Re-order the driver list according to new_drivers. */
3737 struct font_driver_list
**list_table
, **next
;
3741 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3742 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3744 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3745 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3748 list_table
[i
++] = list
;
3750 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3752 list_table
[i
++] = list
;
3753 list_table
[i
] = NULL
;
3755 next
= &f
->font_driver_list
;
3756 for (i
= 0; list_table
[i
]; i
++)
3758 *next
= list_table
[i
];
3759 next
= &(*next
)->next
;
3763 if (! f
->font_driver_list
->on
)
3764 { /* None of the drivers is enabled: enable them all.
3765 Happens if you set the list of drivers to (xft x) in your .emacs
3766 and then use it under w32 or ns. */
3767 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3769 struct font_driver
*driver
= list
->driver
;
3770 eassert (! list
->on
);
3771 if (! driver
->start_for_frame
3772 || driver
->start_for_frame (f
) == 0)
3774 font_prepare_cache (f
, driver
);
3781 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3783 active_drivers
= nconc2 (active_drivers
,
3784 Fcons (list
->driver
->type
, Qnil
));
3785 return active_drivers
;
3789 font_put_frame_data (f
, driver
, data
)
3791 struct font_driver
*driver
;
3794 struct font_data_list
*list
, *prev
;
3796 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3797 prev
= list
, list
= list
->next
)
3798 if (list
->driver
== driver
)
3805 prev
->next
= list
->next
;
3807 f
->font_data_list
= list
->next
;
3815 list
= xmalloc (sizeof (struct font_data_list
));
3816 list
->driver
= driver
;
3817 list
->next
= f
->font_data_list
;
3818 f
->font_data_list
= list
;
3826 font_get_frame_data (f
, driver
)
3828 struct font_driver
*driver
;
3830 struct font_data_list
*list
;
3832 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3833 if (list
->driver
== driver
)
3841 /* Return the font used to draw character C by FACE at buffer position
3842 POS in window W. If STRING is non-nil, it is a string containing C
3843 at index POS. If C is negative, get C from the current buffer or
3847 font_at (c
, pos
, face
, w
, string
)
3856 Lisp_Object font_object
;
3858 multibyte
= (NILP (string
)
3859 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3860 : STRING_MULTIBYTE (string
));
3867 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3869 c
= FETCH_CHAR (pos_byte
);
3872 c
= FETCH_BYTE (pos
);
3878 multibyte
= STRING_MULTIBYTE (string
);
3881 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3883 str
= SDATA (string
) + pos_byte
;
3884 c
= STRING_CHAR (str
);
3887 c
= SDATA (string
)[pos
];
3891 f
= XFRAME (w
->frame
);
3892 if (! FRAME_WINDOW_P (f
))
3899 if (STRINGP (string
))
3900 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3901 DEFAULT_FACE_ID
, 0);
3903 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3905 face
= FACE_FROM_ID (f
, face_id
);
3909 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3910 face
= FACE_FROM_ID (f
, face_id
);
3915 XSETFONT (font_object
, face
->font
);
3920 #ifdef HAVE_WINDOW_SYSTEM
3922 /* Check how many characters after POS (at most to *LIMIT) can be
3923 displayed by the same font on the window W. FACE, if non-NULL, is
3924 the face selected for the character at POS. If STRING is not nil,
3925 it is the string to check instead of the current buffer. In that
3926 case, FACE must be not NULL.
3928 The return value is the font-object for the character at POS.
3929 *LIMIT is set to the position where that font can't be used.
3931 It is assured that the current buffer (or STRING) is multibyte. */
3934 font_range (pos
, limit
, w
, face
, string
)
3935 EMACS_INT pos
, *limit
;
3940 EMACS_INT pos_byte
, ignore
, start
, start_byte
;
3942 Lisp_Object font_object
= Qnil
;
3946 pos_byte
= CHAR_TO_BYTE (pos
);
3951 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3953 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3959 pos_byte
= string_char_to_byte (string
, pos
);
3962 start
= pos
, start_byte
= pos_byte
;
3963 while (pos
< *limit
)
3965 Lisp_Object category
;
3968 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3970 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3971 if (NILP (font_object
))
3973 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3974 if (NILP (font_object
))
3979 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3980 if (! EQ (category
, QCf
)
3981 && ! CHAR_VARIATION_SELECTOR_P (c
)
3982 && font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3984 Lisp_Object f
= font_for_char (face
, c
, pos
- 1, string
);
3985 EMACS_INT i
, i_byte
;
3993 i
= start
, i_byte
= start_byte
;
3998 FETCH_CHAR_ADVANCE_NO_CHECK (c
, i
, i_byte
);
4000 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, i
, i_byte
);
4001 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
4002 if (! EQ (category
, QCf
)
4003 && ! CHAR_VARIATION_SELECTOR_P (c
)
4004 && font_encode_char (f
, c
) == FONT_INVALID_CODE
)
4020 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
4021 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
4022 Return nil otherwise.
4023 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
4024 which kind of font it is. It must be one of `font-spec', `font-entity',
4026 (object
, extra_type
)
4027 Lisp_Object object
, extra_type
;
4029 if (NILP (extra_type
))
4030 return (FONTP (object
) ? Qt
: Qnil
);
4031 if (EQ (extra_type
, Qfont_spec
))
4032 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
4033 if (EQ (extra_type
, Qfont_entity
))
4034 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
4035 if (EQ (extra_type
, Qfont_object
))
4036 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
4037 wrong_type_argument (intern ("font-extra-type"), extra_type
);
4040 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
4041 doc
: /* Return a newly created font-spec with arguments as properties.
4043 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
4044 valid font property name listed below:
4046 `:family', `:weight', `:slant', `:width'
4048 They are the same as face attributes of the same name. See
4049 `set-face-attribute'.
4053 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
4057 VALUE must be a string or a symbol specifying the additional
4058 typographic style information of a font, e.g. ``sans''.
4062 VALUE must be a string or a symbol specifying the charset registry and
4063 encoding of a font, e.g. ``iso8859-1''.
4067 VALUE must be a non-negative integer or a floating point number
4068 specifying the font size. It specifies the font size in pixels (if
4069 VALUE is an integer), or in points (if VALUE is a float).
4073 VALUE must be a string of XLFD-style or fontconfig-style font name.
4077 VALUE must be a symbol representing a script that the font must
4078 support. It may be a symbol representing a subgroup of a script
4079 listed in the variable `script-representative-chars'.
4083 VALUE must be a symbol of two-letter ISO-639 language names,
4088 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
4089 required OpenType features.
4091 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
4092 LANGSYS-TAG: OpenType language system tag symbol,
4093 or nil for the default language system.
4094 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
4095 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
4097 GSUB and GPOS may contain `nil' element. In such a case, the font
4098 must not have any of the remaining elements.
4100 For instance, if the VALUE is `(thai nil nil (mark))', the font must
4101 be an OpenType font, and whose GPOS table of `thai' script's default
4102 language system must contain `mark' feature.
4104 usage: (font-spec ARGS...) */)
4109 Lisp_Object spec
= font_make_spec ();
4112 for (i
= 0; i
< nargs
; i
+= 2)
4114 Lisp_Object key
= args
[i
], val
;
4118 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
4121 if (EQ (key
, QCname
))
4124 font_parse_name ((char *) SDATA (val
), spec
);
4125 font_put_extra (spec
, key
, val
);
4129 int idx
= get_font_prop_index (key
);
4133 val
= font_prop_validate (idx
, Qnil
, val
);
4134 if (idx
< FONT_EXTRA_INDEX
)
4135 ASET (spec
, idx
, val
);
4137 font_put_extra (spec
, key
, val
);
4140 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
4146 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
4147 doc
: /* Return a copy of FONT as a font-spec. */)
4151 Lisp_Object new_spec
, tail
, prev
, extra
;
4155 new_spec
= font_make_spec ();
4156 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
4157 ASET (new_spec
, i
, AREF (font
, i
));
4158 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
4159 /* We must remove :font-entity property. */
4160 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
4161 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
4164 extra
= XCDR (extra
);
4166 XSETCDR (prev
, XCDR (tail
));
4169 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
4173 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
4174 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
4175 Every specified properties in FROM override the corresponding
4176 properties in TO. */)
4178 Lisp_Object from
, to
;
4180 Lisp_Object extra
, tail
;
4185 to
= Fcopy_font_spec (to
);
4186 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
4187 ASET (to
, i
, AREF (from
, i
));
4188 extra
= AREF (to
, FONT_EXTRA_INDEX
);
4189 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
4190 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
4192 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
4195 XSETCDR (slot
, XCDR (XCAR (tail
)));
4197 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
4199 ASET (to
, FONT_EXTRA_INDEX
, extra
);
4203 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
4204 doc
: /* Return the value of FONT's property KEY.
4205 FONT is a font-spec, a font-entity, or a font-object.
4206 KEY must be one of these symbols:
4207 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4208 :size, :name, :script
4209 See the documentation of `font-spec' for their meanings.
4210 If FONT is a font-entity or font-object, the value of :script may be
4211 a list of scripts that are supported by the font. */)
4213 Lisp_Object font
, key
;
4220 idx
= get_font_prop_index (key
);
4221 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4222 return font_style_symbolic (font
, idx
, 0);
4223 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4224 return AREF (font
, idx
);
4225 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
4228 #ifdef HAVE_WINDOW_SYSTEM
4230 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4231 doc
: /* Return a plist of face attributes generated by FONT.
4232 FONT is a font name, a font-spec, a font-entity, or a font-object.
4233 The return value is a list of the form
4235 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4237 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4238 compatible with `set-face-attribute'. Some of these key-attribute pairs
4239 may be omitted from the list if they are not specified by FONT.
4241 The optional argument FRAME specifies the frame that the face attributes
4242 are to be displayed on. If omitted, the selected frame is used. */)
4244 Lisp_Object font
, frame
;
4247 Lisp_Object plist
[10];
4252 frame
= selected_frame
;
4253 CHECK_LIVE_FRAME (frame
);
4258 int fontset
= fs_query_fontset (font
, 0);
4259 Lisp_Object name
= font
;
4261 font
= fontset_ascii (fontset
);
4262 font
= font_spec_from_name (name
);
4264 signal_error ("Invalid font name", name
);
4266 else if (! FONTP (font
))
4267 signal_error ("Invalid font object", font
);
4269 val
= AREF (font
, FONT_FAMILY_INDEX
);
4272 plist
[n
++] = QCfamily
;
4273 plist
[n
++] = SYMBOL_NAME (val
);
4276 val
= AREF (font
, FONT_SIZE_INDEX
);
4279 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4280 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4281 plist
[n
++] = QCheight
;
4282 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4284 else if (FLOATP (val
))
4286 plist
[n
++] = QCheight
;
4287 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4290 val
= FONT_WEIGHT_FOR_FACE (font
);
4293 plist
[n
++] = QCweight
;
4297 val
= FONT_SLANT_FOR_FACE (font
);
4300 plist
[n
++] = QCslant
;
4304 val
= FONT_WIDTH_FOR_FACE (font
);
4307 plist
[n
++] = QCwidth
;
4311 return Flist (n
, plist
);
4316 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4317 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
4318 (font_spec
, prop
, val
)
4319 Lisp_Object font_spec
, prop
, val
;
4323 CHECK_FONT_SPEC (font_spec
);
4324 idx
= get_font_prop_index (prop
);
4325 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4326 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
4328 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
4332 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4333 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4334 Optional 2nd argument FRAME specifies the target frame.
4335 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4336 Optional 4th argument PREFER, if non-nil, is a font-spec to
4337 control the order of the returned list. Fonts are sorted by
4338 how close they are to PREFER. */)
4339 (font_spec
, frame
, num
, prefer
)
4340 Lisp_Object font_spec
, frame
, num
, prefer
;
4342 Lisp_Object vec
, list
;
4346 frame
= selected_frame
;
4347 CHECK_LIVE_FRAME (frame
);
4348 CHECK_FONT_SPEC (font_spec
);
4356 if (! NILP (prefer
))
4357 CHECK_FONT_SPEC (prefer
);
4359 list
= font_list_entities (frame
, font_spec
);
4362 if (NILP (XCDR (list
))
4363 && ASIZE (XCAR (list
)) == 1)
4364 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4366 if (! NILP (prefer
))
4367 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4369 vec
= font_vconcat_entity_vectors (list
);
4370 if (n
== 0 || n
>= ASIZE (vec
))
4372 Lisp_Object args
[2];
4376 list
= Fappend (2, args
);
4380 for (list
= Qnil
, n
--; n
>= 0; n
--)
4381 list
= Fcons (AREF (vec
, n
), list
);
4386 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4387 doc
: /* List available font families on the current frame.
4388 Optional argument FRAME, if non-nil, specifies the target frame. */)
4393 struct font_driver_list
*driver_list
;
4397 frame
= selected_frame
;
4398 CHECK_LIVE_FRAME (frame
);
4401 for (driver_list
= f
->font_driver_list
; driver_list
;
4402 driver_list
= driver_list
->next
)
4403 if (driver_list
->driver
->list_family
)
4405 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4406 Lisp_Object tail
= list
;
4408 for (; CONSP (val
); val
= XCDR (val
))
4409 if (NILP (Fmemq (XCAR (val
), tail
))
4410 && SYMBOLP (XCAR (val
)))
4411 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4416 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4417 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4418 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4420 Lisp_Object font_spec
, frame
;
4422 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4429 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4430 doc
: /* Return XLFD name of FONT.
4431 FONT is a font-spec, font-entity, or font-object.
4432 If the name is too long for XLFD (maximum 255 chars), return nil.
4433 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4434 the consecutive wildcards are folded to one. */)
4435 (font
, fold_wildcards
)
4436 Lisp_Object font
, fold_wildcards
;
4443 if (FONT_OBJECT_P (font
))
4445 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4447 if (STRINGP (font_name
)
4448 && SDATA (font_name
)[0] == '-')
4450 if (NILP (fold_wildcards
))
4452 strcpy (name
, (char *) SDATA (font_name
));
4455 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4457 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4460 if (! NILP (fold_wildcards
))
4462 char *p0
= name
, *p1
;
4464 while ((p1
= strstr (p0
, "-*-*")))
4466 strcpy (p1
, p1
+ 2);
4471 return build_string (name
);
4474 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4475 doc
: /* Clear font cache. */)
4478 Lisp_Object list
, frame
;
4480 FOR_EACH_FRAME (list
, frame
)
4482 FRAME_PTR f
= XFRAME (frame
);
4483 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4485 for (; driver_list
; driver_list
= driver_list
->next
)
4486 if (driver_list
->on
)
4488 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4489 Lisp_Object val
, tmp
;
4493 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4495 font_assert (! NILP (val
));
4496 tmp
= XCDR (XCAR (val
));
4497 if (XINT (XCAR (tmp
)) == 0)
4499 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4500 XSETCDR (cache
, XCDR (val
));
4510 font_fill_lglyph_metrics (glyph
, font_object
)
4511 Lisp_Object glyph
, font_object
;
4513 struct font
*font
= XFONT_OBJECT (font_object
);
4515 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4516 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4517 struct font_metrics metrics
;
4519 LGLYPH_SET_CODE (glyph
, ecode
);
4521 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4522 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4523 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4524 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4525 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4526 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4530 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4531 doc
: /* Shape the glyph-string GSTRING.
4532 Shaping means substituting glyphs and/or adjusting positions of glyphs
4533 to get the correct visual image of character sequences set in the
4534 header of the glyph-string.
4536 If the shaping was successful, the value is GSTRING itself or a newly
4537 created glyph-string. Otherwise, the value is nil. */)
4539 Lisp_Object gstring
;
4542 Lisp_Object font_object
, n
, glyph
;
4545 if (! composition_gstring_p (gstring
))
4546 signal_error ("Invalid glyph-string: ", gstring
);
4547 if (! NILP (LGSTRING_ID (gstring
)))
4549 font_object
= LGSTRING_FONT (gstring
);
4550 CHECK_FONT_OBJECT (font_object
);
4551 font
= XFONT_OBJECT (font_object
);
4552 if (! font
->driver
->shape
)
4555 /* Try at most three times with larger gstring each time. */
4556 for (i
= 0; i
< 3; i
++)
4558 n
= font
->driver
->shape (gstring
);
4561 gstring
= larger_vector (gstring
,
4562 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4565 if (i
== 3 || XINT (n
) == 0)
4568 glyph
= LGSTRING_GLYPH (gstring
, 0);
4569 from
= LGLYPH_FROM (glyph
);
4570 to
= LGLYPH_TO (glyph
);
4571 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4573 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4577 if (NILP (LGLYPH_ADJUSTMENT (this)))
4582 glyph
= LGSTRING_GLYPH (gstring
, j
);
4583 LGLYPH_SET_FROM (glyph
, from
);
4584 LGLYPH_SET_TO (glyph
, to
);
4586 from
= LGLYPH_FROM (this);
4587 to
= LGLYPH_TO (this);
4592 if (from
> LGLYPH_FROM (this))
4593 from
= LGLYPH_FROM (this);
4594 if (to
< LGLYPH_TO (this))
4595 to
= LGLYPH_TO (this);
4601 glyph
= LGSTRING_GLYPH (gstring
, j
);
4602 LGLYPH_SET_FROM (glyph
, from
);
4603 LGLYPH_SET_TO (glyph
, to
);
4605 return composition_gstring_put_cache (gstring
, XINT (n
));
4608 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4610 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4611 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4613 VARIATION-SELECTOR is a chracter code of variation selection
4614 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4615 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4616 (font_object
, character
)
4617 Lisp_Object font_object
, character
;
4619 unsigned variations
[256];
4624 CHECK_FONT_OBJECT (font_object
);
4625 CHECK_CHARACTER (character
);
4626 font
= XFONT_OBJECT (font_object
);
4627 if (! font
->driver
->get_variation_glyphs
)
4629 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4633 for (i
= 0; i
< 255; i
++)
4637 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4638 /* Stops GCC whining about limited range of data type. */
4639 EMACS_INT var
= variations
[i
];
4641 if (var
> MOST_POSITIVE_FIXNUM
)
4642 code
= Fcons (make_number ((variations
[i
]) >> 16),
4643 make_number ((variations
[i
]) & 0xFFFF));
4645 code
= make_number (variations
[i
]);
4646 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4653 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4654 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4655 OTF-FEATURES specifies which features to apply in this format:
4656 (SCRIPT LANGSYS GSUB GPOS)
4658 SCRIPT is a symbol specifying a script tag of OpenType,
4659 LANGSYS is a symbol specifying a langsys tag of OpenType,
4660 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4662 If LANGYS is nil, the default langsys is selected.
4664 The features are applied in the order they appear in the list. The
4665 symbol `*' means to apply all available features not present in this
4666 list, and the remaining features are ignored. For instance, (vatu
4667 pstf * haln) is to apply vatu and pstf in this order, then to apply
4668 all available features other than vatu, pstf, and haln.
4670 The features are applied to the glyphs in the range FROM and TO of
4671 the glyph-string GSTRING-IN.
4673 If some feature is actually applicable, the resulting glyphs are
4674 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4675 this case, the value is the number of produced glyphs.
4677 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4680 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4681 produced in GSTRING-OUT, and the value is nil.
4683 See the documentation of `font-make-gstring' for the format of
4685 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4686 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4688 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4693 check_otf_features (otf_features
);
4694 CHECK_FONT_OBJECT (font_object
);
4695 font
= XFONT_OBJECT (font_object
);
4696 if (! font
->driver
->otf_drive
)
4697 error ("Font backend %s can't drive OpenType GSUB table",
4698 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4699 CHECK_CONS (otf_features
);
4700 CHECK_SYMBOL (XCAR (otf_features
));
4701 val
= XCDR (otf_features
);
4702 CHECK_SYMBOL (XCAR (val
));
4703 val
= XCDR (otf_features
);
4706 len
= check_gstring (gstring_in
);
4707 CHECK_VECTOR (gstring_out
);
4708 CHECK_NATNUM (from
);
4710 CHECK_NATNUM (index
);
4712 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4713 args_out_of_range_3 (from
, to
, make_number (len
));
4714 if (XINT (index
) >= ASIZE (gstring_out
))
4715 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4716 num
= font
->driver
->otf_drive (font
, otf_features
,
4717 gstring_in
, XINT (from
), XINT (to
),
4718 gstring_out
, XINT (index
), 0);
4721 return make_number (num
);
4724 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4726 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4727 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4729 (SCRIPT LANGSYS FEATURE ...)
4730 See the documentation of `font-drive-otf' for more detail.
4732 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4733 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4734 character code corresponding to the glyph or nil if there's no
4735 corresponding character. */)
4736 (font_object
, character
, otf_features
)
4737 Lisp_Object font_object
, character
, otf_features
;
4740 Lisp_Object gstring_in
, gstring_out
, g
;
4741 Lisp_Object alternates
;
4744 CHECK_FONT_GET_OBJECT (font_object
, font
);
4745 if (! font
->driver
->otf_drive
)
4746 error ("Font backend %s can't drive OpenType GSUB table",
4747 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4748 CHECK_CHARACTER (character
);
4749 CHECK_CONS (otf_features
);
4751 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4752 g
= LGSTRING_GLYPH (gstring_in
, 0);
4753 LGLYPH_SET_CHAR (g
, XINT (character
));
4754 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4755 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4756 gstring_out
, 0, 1)) < 0)
4757 gstring_out
= Ffont_make_gstring (font_object
,
4758 make_number (ASIZE (gstring_out
) * 2));
4760 for (i
= 0; i
< num
; i
++)
4762 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4763 int c
= LGLYPH_CHAR (g
);
4764 unsigned code
= LGLYPH_CODE (g
);
4766 alternates
= Fcons (Fcons (make_number (code
),
4767 c
> 0 ? make_number (c
) : Qnil
),
4770 return Fnreverse (alternates
);
4776 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4777 doc
: /* Open FONT-ENTITY. */)
4778 (font_entity
, size
, frame
)
4779 Lisp_Object font_entity
;
4785 CHECK_FONT_ENTITY (font_entity
);
4787 frame
= selected_frame
;
4788 CHECK_LIVE_FRAME (frame
);
4791 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4794 CHECK_NUMBER_OR_FLOAT (size
);
4796 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4798 isize
= XINT (size
);
4802 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4805 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4806 doc
: /* Close FONT-OBJECT. */)
4807 (font_object
, frame
)
4808 Lisp_Object font_object
, frame
;
4810 CHECK_FONT_OBJECT (font_object
);
4812 frame
= selected_frame
;
4813 CHECK_LIVE_FRAME (frame
);
4814 font_close_object (XFRAME (frame
), font_object
);
4818 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4819 doc
: /* Return information about FONT-OBJECT.
4820 The value is a vector:
4821 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4824 NAME is a string of the font name (or nil if the font backend doesn't
4827 FILENAME is a string of the font file (or nil if the font backend
4828 doesn't provide a file name).
4830 PIXEL-SIZE is a pixel size by which the font is opened.
4832 SIZE is a maximum advance width of the font in pixels.
4834 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4837 CAPABILITY is a list whose first element is a symbol representing the
4838 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4839 remaining elements describe the details of the font capability.
4841 If the font is OpenType font, the form of the list is
4842 \(opentype GSUB GPOS)
4843 where GSUB shows which "GSUB" features the font supports, and GPOS
4844 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4845 lists of the format:
4846 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4848 If the font is not OpenType font, currently the length of the form is
4851 SCRIPT is a symbol representing OpenType script tag.
4853 LANGSYS is a symbol representing OpenType langsys tag, or nil
4854 representing the default langsys.
4856 FEATURE is a symbol representing OpenType feature tag.
4858 If the font is not OpenType font, CAPABILITY is nil. */)
4860 Lisp_Object font_object
;
4865 CHECK_FONT_GET_OBJECT (font_object
, font
);
4867 val
= Fmake_vector (make_number (9), Qnil
);
4868 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4869 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4870 ASET (val
, 2, make_number (font
->pixel_size
));
4871 ASET (val
, 3, make_number (font
->max_width
));
4872 ASET (val
, 4, make_number (font
->ascent
));
4873 ASET (val
, 5, make_number (font
->descent
));
4874 ASET (val
, 6, make_number (font
->space_width
));
4875 ASET (val
, 7, make_number (font
->average_width
));
4876 if (font
->driver
->otf_capability
)
4877 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4881 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4882 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4883 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4884 (font_object
, string
)
4885 Lisp_Object font_object
, string
;
4891 CHECK_FONT_GET_OBJECT (font_object
, font
);
4892 CHECK_STRING (string
);
4893 len
= SCHARS (string
);
4894 vec
= Fmake_vector (make_number (len
), Qnil
);
4895 for (i
= 0; i
< len
; i
++)
4897 Lisp_Object ch
= Faref (string
, make_number (i
));
4902 struct font_metrics metrics
;
4904 cod
= code
= font
->driver
->encode_char (font
, c
);
4905 if (code
== FONT_INVALID_CODE
)
4907 val
= Fmake_vector (make_number (6), Qnil
);
4908 if (cod
<= MOST_POSITIVE_FIXNUM
)
4909 ASET (val
, 0, make_number (code
));
4911 ASET (val
, 0, Fcons (make_number (code
>> 16),
4912 make_number (code
& 0xFFFF)));
4913 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4914 ASET (val
, 1, make_number (metrics
.lbearing
));
4915 ASET (val
, 2, make_number (metrics
.rbearing
));
4916 ASET (val
, 3, make_number (metrics
.width
));
4917 ASET (val
, 4, make_number (metrics
.ascent
));
4918 ASET (val
, 5, make_number (metrics
.descent
));
4924 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4925 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4926 FONT is a font-spec, font-entity, or font-object. */)
4928 Lisp_Object spec
, font
;
4930 CHECK_FONT_SPEC (spec
);
4933 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4936 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4937 doc
: /* Return a font-object for displaying a character at POSITION.
4938 Optional second arg WINDOW, if non-nil, is a window displaying
4939 the current buffer. It defaults to the currently selected window. */)
4940 (position
, window
, string
)
4941 Lisp_Object position
, window
, string
;
4948 CHECK_NUMBER_COERCE_MARKER (position
);
4949 pos
= XINT (position
);
4950 if (pos
< BEGV
|| pos
>= ZV
)
4951 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4955 CHECK_NUMBER (position
);
4956 CHECK_STRING (string
);
4957 pos
= XINT (position
);
4958 if (pos
< 0 || pos
>= SCHARS (string
))
4959 args_out_of_range (string
, position
);
4962 window
= selected_window
;
4963 CHECK_LIVE_WINDOW (window
);
4964 w
= XWINDOW (window
);
4966 return font_at (-1, pos
, NULL
, w
, string
);
4970 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4971 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4972 The value is a number of glyphs drawn.
4973 Type C-l to recover what previously shown. */)
4974 (font_object
, string
)
4975 Lisp_Object font_object
, string
;
4977 Lisp_Object frame
= selected_frame
;
4978 FRAME_PTR f
= XFRAME (frame
);
4984 CHECK_FONT_GET_OBJECT (font_object
, font
);
4985 CHECK_STRING (string
);
4986 len
= SCHARS (string
);
4987 code
= alloca (sizeof (unsigned) * len
);
4988 for (i
= 0; i
< len
; i
++)
4990 Lisp_Object ch
= Faref (string
, make_number (i
));
4994 code
[i
] = font
->driver
->encode_char (font
, c
);
4995 if (code
[i
] == FONT_INVALID_CODE
)
4998 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5000 if (font
->driver
->prepare_face
)
5001 font
->driver
->prepare_face (f
, face
);
5002 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
5003 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
5004 if (font
->driver
->done_face
)
5005 font
->driver
->done_face (f
, face
);
5007 return make_number (len
);
5011 #endif /* FONT_DEBUG */
5013 #ifdef HAVE_WINDOW_SYSTEM
5015 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
5016 doc
: /* Return information about a font named NAME on frame FRAME.
5017 If FRAME is omitted or nil, use the selected frame.
5018 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
5019 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
5021 OPENED-NAME is the name used for opening the font,
5022 FULL-NAME is the full name of the font,
5023 SIZE is the pixelsize of the font,
5024 HEIGHT is the pixel-height of the font (i.e ascent + descent),
5025 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
5026 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
5027 how to compose characters.
5028 If the named font is not yet loaded, return nil. */)
5030 Lisp_Object name
, frame
;
5035 Lisp_Object font_object
;
5037 (*check_window_system_func
) ();
5040 CHECK_STRING (name
);
5042 frame
= selected_frame
;
5043 CHECK_LIVE_FRAME (frame
);
5048 int fontset
= fs_query_fontset (name
, 0);
5051 name
= fontset_ascii (fontset
);
5052 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
5054 else if (FONT_OBJECT_P (name
))
5056 else if (FONT_ENTITY_P (name
))
5057 font_object
= font_open_entity (f
, name
, 0);
5060 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5061 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
5063 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
5065 if (NILP (font_object
))
5067 font
= XFONT_OBJECT (font_object
);
5069 info
= Fmake_vector (make_number (7), Qnil
);
5070 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
5071 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
5072 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
5073 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
5074 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
5075 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
5076 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
5079 /* As font_object is still in FONT_OBJLIST of the entity, we can't
5080 close it now. Perhaps, we should manage font-objects
5081 by `reference-count'. */
5082 font_close_object (f
, font_object
);
5089 #define BUILD_STYLE_TABLE(TBL) \
5090 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
5093 build_style_table (entry
, nelement
)
5094 struct table_entry
*entry
;
5098 Lisp_Object table
, elt
;
5100 table
= Fmake_vector (make_number (nelement
), Qnil
);
5101 for (i
= 0; i
< nelement
; i
++)
5103 for (j
= 0; entry
[i
].names
[j
]; j
++);
5104 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
5105 ASET (elt
, 0, make_number (entry
[i
].numeric
));
5106 for (j
= 0; entry
[i
].names
[j
]; j
++)
5107 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
5108 ASET (table
, i
, elt
);
5113 Lisp_Object Vfont_log
;
5115 /* The deferred font-log data of the form [ACTION ARG RESULT].
5116 If ACTION is not nil, that is added to the log when font_add_log is
5117 called next time. At that time, ACTION is set back to nil. */
5118 static Lisp_Object Vfont_log_deferred
;
5120 /* Prepend the font-related logging data in Vfont_log if it is not
5121 `t'. ACTION describes a kind of font-related action (e.g. listing,
5122 opening), ARG is the argument for the action, and RESULT is the
5123 result of the action. */
5125 font_add_log (action
, arg
, result
)
5127 Lisp_Object arg
, result
;
5129 Lisp_Object tail
, val
;
5132 if (EQ (Vfont_log
, Qt
))
5134 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5136 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
5138 ASET (Vfont_log_deferred
, 0, Qnil
);
5139 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5140 AREF (Vfont_log_deferred
, 2));
5145 Lisp_Object tail
, elt
;
5146 Lisp_Object equalstr
= build_string ("=");
5148 val
= Ffont_xlfd_name (arg
, Qt
);
5149 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5153 if (EQ (XCAR (elt
), QCscript
)
5154 && SYMBOLP (XCDR (elt
)))
5155 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5156 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5157 else if (EQ (XCAR (elt
), QClang
)
5158 && SYMBOLP (XCDR (elt
)))
5159 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5160 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5161 else if (EQ (XCAR (elt
), QCotf
)
5162 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5163 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5165 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5171 && VECTORP (XCAR (result
))
5172 && ASIZE (XCAR (result
)) > 0
5173 && FONTP (AREF (XCAR (result
), 0)))
5174 result
= font_vconcat_entity_vectors (result
);
5177 val
= Ffont_xlfd_name (result
, Qt
);
5178 if (! FONT_SPEC_P (result
))
5179 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5180 build_string (":"), val
);
5183 else if (CONSP (result
))
5185 result
= Fcopy_sequence (result
);
5186 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5190 val
= Ffont_xlfd_name (val
, Qt
);
5191 XSETCAR (tail
, val
);
5194 else if (VECTORP (result
))
5196 result
= Fcopy_sequence (result
);
5197 for (i
= 0; i
< ASIZE (result
); i
++)
5199 val
= AREF (result
, i
);
5201 val
= Ffont_xlfd_name (val
, Qt
);
5202 ASET (result
, i
, val
);
5205 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5208 /* Record a font-related logging data to be added to Vfont_log when
5209 font_add_log is called next time. ACTION, ARG, RESULT are the same
5213 font_deferred_log (action
, arg
, result
)
5215 Lisp_Object arg
, result
;
5217 if (EQ (Vfont_log
, Qt
))
5219 ASET (Vfont_log_deferred
, 0, build_string (action
));
5220 ASET (Vfont_log_deferred
, 1, arg
);
5221 ASET (Vfont_log_deferred
, 2, result
);
5224 extern void syms_of_ftfont
P_ (());
5225 extern void syms_of_xfont
P_ (());
5226 extern void syms_of_xftfont
P_ (());
5227 extern void syms_of_ftxfont
P_ (());
5228 extern void syms_of_bdffont
P_ (());
5229 extern void syms_of_w32font
P_ (());
5230 extern void syms_of_atmfont
P_ (());
5231 extern void syms_of_nsfont
P_ (());
5236 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5237 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5238 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5239 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5240 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5241 /* Note that the other elements in sort_shift_bits are not used. */
5243 staticpro (&font_charset_alist
);
5244 font_charset_alist
= Qnil
;
5246 DEFSYM (Qopentype
, "opentype");
5248 DEFSYM (Qascii_0
, "ascii-0");
5249 DEFSYM (Qiso8859_1
, "iso8859-1");
5250 DEFSYM (Qiso10646_1
, "iso10646-1");
5251 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5252 DEFSYM (Qunicode_sip
, "unicode-sip");
5256 DEFSYM (QCotf
, ":otf");
5257 DEFSYM (QClang
, ":lang");
5258 DEFSYM (QCscript
, ":script");
5259 DEFSYM (QCantialias
, ":antialias");
5261 DEFSYM (QCfoundry
, ":foundry");
5262 DEFSYM (QCadstyle
, ":adstyle");
5263 DEFSYM (QCregistry
, ":registry");
5264 DEFSYM (QCspacing
, ":spacing");
5265 DEFSYM (QCdpi
, ":dpi");
5266 DEFSYM (QCscalable
, ":scalable");
5267 DEFSYM (QCavgwidth
, ":avgwidth");
5268 DEFSYM (QCfont_entity
, ":font-entity");
5269 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5279 DEFSYM (QCuser_spec
, "user-spec");
5281 staticpro (&null_vector
);
5282 null_vector
= Fmake_vector (make_number (0), Qnil
);
5284 staticpro (&scratch_font_spec
);
5285 scratch_font_spec
= Ffont_spec (0, NULL
);
5286 staticpro (&scratch_font_prefer
);
5287 scratch_font_prefer
= Ffont_spec (0, NULL
);
5289 staticpro (&Vfont_log_deferred
);
5290 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5294 staticpro (&otf_list
);
5296 #endif /* HAVE_LIBOTF */
5300 defsubr (&Sfont_spec
);
5301 defsubr (&Sfont_get
);
5302 #ifdef HAVE_WINDOW_SYSTEM
5303 defsubr (&Sfont_face_attributes
);
5305 defsubr (&Sfont_put
);
5306 defsubr (&Slist_fonts
);
5307 defsubr (&Sfont_family_list
);
5308 defsubr (&Sfind_font
);
5309 defsubr (&Sfont_xlfd_name
);
5310 defsubr (&Sclear_font_cache
);
5311 defsubr (&Sfont_shape_gstring
);
5312 defsubr (&Sfont_variation_glyphs
);
5314 defsubr (&Sfont_drive_otf
);
5315 defsubr (&Sfont_otf_alternates
);
5319 defsubr (&Sopen_font
);
5320 defsubr (&Sclose_font
);
5321 defsubr (&Squery_font
);
5322 defsubr (&Sget_font_glyphs
);
5323 defsubr (&Sfont_match_p
);
5324 defsubr (&Sfont_at
);
5326 defsubr (&Sdraw_string
);
5328 #endif /* FONT_DEBUG */
5329 #ifdef HAVE_WINDOW_SYSTEM
5330 defsubr (&Sfont_info
);
5333 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5335 Alist of fontname patterns vs the corresponding encoding and repertory info.
5336 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5337 where ENCODING is a charset or a char-table,
5338 and REPERTORY is a charset, a char-table, or nil.
5340 If ENCODING and REPERTORY are the same, the element can have the form
5341 \(REGEXP . ENCODING).
5343 ENCODING is for converting a character to a glyph code of the font.
5344 If ENCODING is a charset, encoding a character by the charset gives
5345 the corresponding glyph code. If ENCODING is a char-table, looking up
5346 the table by a character gives the corresponding glyph code.
5348 REPERTORY specifies a repertory of characters supported by the font.
5349 If REPERTORY is a charset, all characters beloging to the charset are
5350 supported. If REPERTORY is a char-table, all characters who have a
5351 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5352 gets the repertory information by an opened font and ENCODING. */);
5353 Vfont_encoding_alist
= Qnil
;
5355 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5356 doc
: /* Vector of valid font weight values.
5357 Each element has the form:
5358 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5359 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5360 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5362 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5363 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5364 See `font-weight-table' for the format of the vector. */);
5365 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5367 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5368 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5369 See `font-weight-table' for the format of the vector. */);
5370 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5372 staticpro (&font_style_table
);
5373 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5374 ASET (font_style_table
, 0, Vfont_weight_table
);
5375 ASET (font_style_table
, 1, Vfont_slant_table
);
5376 ASET (font_style_table
, 2, Vfont_width_table
);
5378 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5379 *Logging list of font related actions and results.
5380 The value t means to suppress the logging.
5381 The initial value is set to nil if the environment variable
5382 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5385 #ifdef HAVE_WINDOW_SYSTEM
5386 #ifdef HAVE_FREETYPE
5388 #ifdef HAVE_X_WINDOWS
5393 #endif /* HAVE_XFT */
5394 #endif /* HAVE_X_WINDOWS */
5395 #else /* not HAVE_FREETYPE */
5396 #ifdef HAVE_X_WINDOWS
5398 #endif /* HAVE_X_WINDOWS */
5399 #endif /* not HAVE_FREETYPE */
5402 #endif /* HAVE_BDFFONT */
5405 #endif /* WINDOWSNT */
5408 #endif /* HAVE_NS */
5409 #endif /* HAVE_WINDOW_SYSTEM */
5415 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
5418 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5419 (do not change this comment) */