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
);
1127 double point_size
= -1;
1129 font_assert (FONT_SPEC_P (font
));
1130 p
= f
[XLFD_POINT_INDEX
];
1132 point_size
= parse_matrix (p
);
1133 else if (isdigit (*p
))
1134 point_size
= atoi (p
), point_size
/= 10;
1135 if (point_size
>= 0)
1136 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1140 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1141 if (! NILP (val
) && ! INTEGERP (val
))
1143 ASET (font
, FONT_DPI_INDEX
, val
);
1144 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1147 val
= font_prop_validate_spacing (QCspacing
, val
);
1148 if (! INTEGERP (val
))
1150 ASET (font
, FONT_SPACING_INDEX
, val
);
1152 p
= f
[XLFD_AVGWIDTH_INDEX
];
1155 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1156 if (! NILP (val
) && ! INTEGERP (val
))
1158 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1162 int wild_card_found
= 0;
1163 Lisp_Object prop
[XLFD_LAST_INDEX
];
1165 if (FONT_ENTITY_P (font
))
1167 for (j
= 0; j
< i
; j
++)
1171 if (f
[j
][1] && f
[j
][1] != '-')
1174 wild_card_found
= 1;
1177 prop
[j
] = INTERN_FIELD (j
);
1179 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1181 if (! wild_card_found
)
1183 if (font_expand_wildcards (prop
, i
) < 0)
1186 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1187 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1188 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1189 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1190 if (! NILP (prop
[i
]))
1192 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1194 ASET (font
, j
, make_number (n
));
1196 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1197 val
= prop
[XLFD_REGISTRY_INDEX
];
1200 val
= prop
[XLFD_ENCODING_INDEX
];
1202 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1204 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1205 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1207 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1208 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1210 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1212 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1213 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1214 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1216 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1218 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1221 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1222 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1223 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1225 val
= font_prop_validate_spacing (QCspacing
,
1226 prop
[XLFD_SPACING_INDEX
]);
1227 if (! INTEGERP (val
))
1229 ASET (font
, FONT_SPACING_INDEX
, val
);
1231 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1232 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1238 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1239 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1240 0, use PIXEL_SIZE instead. */
1243 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1249 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1253 font_assert (FONTP (font
));
1255 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1258 if (i
== FONT_ADSTYLE_INDEX
)
1259 j
= XLFD_ADSTYLE_INDEX
;
1260 else if (i
== FONT_REGISTRY_INDEX
)
1261 j
= XLFD_REGISTRY_INDEX
;
1262 val
= AREF (font
, i
);
1265 if (j
== XLFD_REGISTRY_INDEX
)
1266 f
[j
] = "*-*", len
+= 4;
1268 f
[j
] = "*", len
+= 2;
1273 val
= SYMBOL_NAME (val
);
1274 if (j
== XLFD_REGISTRY_INDEX
1275 && ! strchr ((char *) SDATA (val
), '-'))
1277 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1278 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1280 f
[j
] = alloca (SBYTES (val
) + 3);
1281 sprintf (f
[j
], "%s-*", SDATA (val
));
1282 len
+= SBYTES (val
) + 3;
1286 f
[j
] = alloca (SBYTES (val
) + 4);
1287 sprintf (f
[j
], "%s*-*", SDATA (val
));
1288 len
+= SBYTES (val
) + 4;
1292 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1296 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1299 val
= font_style_symbolic (font
, i
, 0);
1301 f
[j
] = "*", len
+= 2;
1304 val
= SYMBOL_NAME (val
);
1305 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1309 val
= AREF (font
, FONT_SIZE_INDEX
);
1310 font_assert (NUMBERP (val
) || NILP (val
));
1318 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1319 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1322 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1324 else if (FLOATP (val
))
1326 i
= XFLOAT_DATA (val
) * 10;
1327 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1328 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1331 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1333 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1335 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1336 f
[XLFD_RESX_INDEX
] = alloca (22);
1337 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1341 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1342 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1344 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1346 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1347 : spacing
<= FONT_SPACING_DUAL
? "d"
1348 : spacing
<= FONT_SPACING_MONO
? "m"
1353 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1354 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1356 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1357 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
], "%ld",
1358 (long) XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1361 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1362 len
++; /* for terminating '\0'. */
1365 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1366 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1367 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1368 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1369 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1370 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1371 f
[XLFD_REGISTRY_INDEX
]);
1374 /* Parse NAME (null terminated) and store information in FONT
1375 (font-spec or font-entity). NAME is supplied in either the
1376 Fontconfig or GTK font name format. If NAME is successfully
1377 parsed, return 0. Otherwise return -1.
1379 The fontconfig format is
1381 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1385 FAMILY [PROPS...] [SIZE]
1387 This function tries to guess which format it is. */
1390 font_parse_fcname (name
, font
)
1395 char *size_beg
= NULL
, *size_end
= NULL
;
1396 char *props_beg
= NULL
, *family_end
= NULL
;
1397 int len
= strlen (name
);
1402 for (p
= name
; *p
; p
++)
1404 if (*p
== '\\' && p
[1])
1408 props_beg
= family_end
= p
;
1413 int decimal
= 0, size_found
= 1;
1414 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1417 if (*q
!= '.' || decimal
)
1436 Lisp_Object extra_props
= Qnil
;
1438 /* A fontconfig name with size and/or property data. */
1439 if (family_end
> name
)
1442 family
= font_intern_prop (name
, family_end
- name
, 1);
1443 ASET (font
, FONT_FAMILY_INDEX
, family
);
1447 double point_size
= strtod (size_beg
, &size_end
);
1448 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1449 if (*size_end
== ':' && size_end
[1])
1450 props_beg
= size_end
;
1454 /* Now parse ":KEY=VAL" patterns. */
1457 for (p
= props_beg
; *p
; p
= q
)
1459 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1462 /* Must be an enumerated value. */
1466 val
= font_intern_prop (p
, q
- p
, 1);
1468 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1470 if (PROP_MATCH ("light", 5)
1471 || PROP_MATCH ("medium", 6)
1472 || PROP_MATCH ("demibold", 8)
1473 || PROP_MATCH ("bold", 4)
1474 || PROP_MATCH ("black", 5))
1475 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1476 else if (PROP_MATCH ("roman", 5)
1477 || PROP_MATCH ("italic", 6)
1478 || PROP_MATCH ("oblique", 7))
1479 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1480 else if (PROP_MATCH ("charcell", 8))
1481 ASET (font
, FONT_SPACING_INDEX
,
1482 make_number (FONT_SPACING_CHARCELL
));
1483 else if (PROP_MATCH ("mono", 4))
1484 ASET (font
, FONT_SPACING_INDEX
,
1485 make_number (FONT_SPACING_MONO
));
1486 else if (PROP_MATCH ("proportional", 12))
1487 ASET (font
, FONT_SPACING_INDEX
,
1488 make_number (FONT_SPACING_PROPORTIONAL
));
1497 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1498 prop
= FONT_SIZE_INDEX
;
1501 key
= font_intern_prop (p
, q
- p
, 1);
1502 prop
= get_font_prop_index (key
);
1506 for (q
= p
; *q
&& *q
!= ':'; q
++);
1507 val
= font_intern_prop (p
, q
- p
, 0);
1509 if (prop
>= FONT_FOUNDRY_INDEX
1510 && prop
< FONT_EXTRA_INDEX
)
1511 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1514 extra_props
= nconc2 (extra_props
,
1515 Fcons (Fcons (key
, val
), Qnil
));
1522 if (! NILP (extra_props
))
1524 struct font_driver_list
*driver_list
= font_driver_list
;
1525 for ( ; driver_list
; driver_list
= driver_list
->next
)
1526 if (driver_list
->driver
->filter_properties
)
1527 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1533 /* Either a fontconfig-style name with no size and property
1534 data, or a GTK-style name. */
1536 int word_len
, prop_found
= 0;
1538 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1544 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1552 double point_size
= strtod (p
, &q
);
1553 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1558 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1559 if (*q
== '\\' && q
[1])
1563 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1565 if (PROP_MATCH ("Ultra-Light", 11))
1568 prop
= font_intern_prop ("ultra-light", 11, 1);
1569 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1571 else if (PROP_MATCH ("Light", 5))
1574 prop
= font_intern_prop ("light", 5, 1);
1575 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1577 else if (PROP_MATCH ("Semi-Bold", 9))
1580 prop
= font_intern_prop ("semi-bold", 9, 1);
1581 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1583 else if (PROP_MATCH ("Bold", 4))
1586 prop
= font_intern_prop ("bold", 4, 1);
1587 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1589 else if (PROP_MATCH ("Italic", 6))
1592 prop
= font_intern_prop ("italic", 4, 1);
1593 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1595 else if (PROP_MATCH ("Oblique", 7))
1598 prop
= font_intern_prop ("oblique", 7, 1);
1599 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1603 return -1; /* Unknown property in GTK-style font name. */
1612 family
= font_intern_prop (name
, family_end
- name
, 1);
1613 ASET (font
, FONT_FAMILY_INDEX
, family
);
1620 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1621 NAME (NBYTES length), and return the name length. If
1622 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1625 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1631 Lisp_Object family
, foundry
;
1632 Lisp_Object tail
, val
;
1636 Lisp_Object styles
[3];
1637 char *style_names
[3] = { "weight", "slant", "width" };
1640 family
= AREF (font
, FONT_FAMILY_INDEX
);
1641 if (! NILP (family
))
1643 if (SYMBOLP (family
))
1645 family
= SYMBOL_NAME (family
);
1646 len
+= SBYTES (family
);
1652 val
= AREF (font
, FONT_SIZE_INDEX
);
1655 if (XINT (val
) != 0)
1656 pixel_size
= XINT (val
);
1658 len
+= 21; /* for ":pixelsize=NUM" */
1660 else if (FLOATP (val
))
1663 point_size
= (int) XFLOAT_DATA (val
);
1664 len
+= 11; /* for "-NUM" */
1667 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1668 if (! NILP (foundry
))
1670 if (SYMBOLP (foundry
))
1672 foundry
= SYMBOL_NAME (foundry
);
1673 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1679 for (i
= 0; i
< 3; i
++)
1681 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1682 if (! NILP (styles
[i
]))
1683 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1684 SDATA (SYMBOL_NAME (styles
[i
])));
1687 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1688 len
+= sprintf (work
, ":dpi=%ld", (long)XINT (AREF (font
, FONT_DPI_INDEX
)));
1689 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1690 len
+= strlen (":spacing=100");
1691 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1692 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1693 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1695 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1697 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1699 len
+= SBYTES (val
);
1700 else if (INTEGERP (val
))
1701 len
+= sprintf (work
, "%ld", (long) XINT (val
));
1702 else if (SYMBOLP (val
))
1703 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1709 if (! NILP (family
))
1710 p
+= sprintf (p
, "%s", SDATA (family
));
1714 p
+= sprintf (p
, "%d", point_size
);
1716 p
+= sprintf (p
, "-%d", point_size
);
1718 else if (pixel_size
> 0)
1719 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1720 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1721 p
+= sprintf (p
, ":foundry=%s",
1722 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1723 for (i
= 0; i
< 3; i
++)
1724 if (! NILP (styles
[i
]))
1725 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1726 SDATA (SYMBOL_NAME (styles
[i
])));
1727 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1728 p
+= sprintf (p
, ":dpi=%ld", (long) XINT (AREF (font
, FONT_DPI_INDEX
)));
1729 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1730 p
+= sprintf (p
, ":spacing=%ld",
1731 (long) XINT (AREF (font
, FONT_SPACING_INDEX
)));
1732 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1734 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1735 p
+= sprintf (p
, ":scalable=true");
1737 p
+= sprintf (p
, ":scalable=false");
1742 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1743 NAME (NBYTES length), and return the name length. F is the frame
1744 on which the font is displayed; it is used to calculate the point
1748 font_unparse_gtkname (font
, f
, name
, nbytes
)
1756 Lisp_Object family
, weight
, slant
, size
;
1757 int point_size
= -1;
1759 family
= AREF (font
, FONT_FAMILY_INDEX
);
1760 if (! NILP (family
))
1762 if (! SYMBOLP (family
))
1764 family
= SYMBOL_NAME (family
);
1765 len
+= SBYTES (family
);
1768 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1769 if (EQ (weight
, Qnormal
))
1771 else if (! NILP (weight
))
1773 weight
= SYMBOL_NAME (weight
);
1774 len
+= SBYTES (weight
);
1777 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1778 if (EQ (slant
, Qnormal
))
1780 else if (! NILP (slant
))
1782 slant
= SYMBOL_NAME (slant
);
1783 len
+= SBYTES (slant
);
1786 size
= AREF (font
, FONT_SIZE_INDEX
);
1787 /* Convert pixel size to point size. */
1788 if (INTEGERP (size
))
1790 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1792 if (INTEGERP (font_dpi
))
1793 dpi
= XINT (font_dpi
);
1796 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1799 else if (FLOATP (size
))
1801 point_size
= (int) XFLOAT_DATA (size
);
1808 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1810 if (! NILP (weight
))
1813 p
+= sprintf (p
, " %s", SDATA (weight
));
1814 q
[1] = toupper (q
[1]);
1820 p
+= sprintf (p
, " %s", SDATA (slant
));
1821 q
[1] = toupper (q
[1]);
1825 p
+= sprintf (p
, " %d", point_size
);
1830 /* Parse NAME (null terminated) and store information in FONT
1831 (font-spec or font-entity). If NAME is successfully parsed, return
1832 0. Otherwise return -1. */
1835 font_parse_name (name
, font
)
1839 if (name
[0] == '-' || index (name
, '*') || index (name
, '?'))
1840 return font_parse_xlfd (name
, font
);
1841 return font_parse_fcname (name
, font
);
1845 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1846 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1850 font_parse_family_registry (family
, registry
, font_spec
)
1851 Lisp_Object family
, registry
, font_spec
;
1857 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1859 CHECK_STRING (family
);
1860 len
= SBYTES (family
);
1861 p0
= (char *) SDATA (family
);
1862 p1
= index (p0
, '-');
1865 if ((*p0
!= '*' && p1
- p0
> 0)
1866 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1867 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1870 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1873 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1875 if (! NILP (registry
))
1877 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1878 CHECK_STRING (registry
);
1879 len
= SBYTES (registry
);
1880 p0
= (char *) SDATA (registry
);
1881 p1
= index (p0
, '-');
1884 if (SDATA (registry
)[len
- 1] == '*')
1885 registry
= concat2 (registry
, build_string ("-*"));
1887 registry
= concat2 (registry
, build_string ("*-*"));
1889 registry
= Fdowncase (registry
);
1890 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1895 /* This part (through the next ^L) is still experimental and not
1896 tested much. We may drastically change codes. */
1902 #define LGSTRING_HEADER_SIZE 6
1903 #define LGSTRING_GLYPH_SIZE 8
1906 check_gstring (gstring
)
1907 Lisp_Object gstring
;
1912 CHECK_VECTOR (gstring
);
1913 val
= AREF (gstring
, 0);
1915 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1917 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1918 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1919 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1920 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1921 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1922 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1923 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1924 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1925 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1926 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1927 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1929 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1931 val
= LGSTRING_GLYPH (gstring
, i
);
1933 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1935 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1937 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1938 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1939 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1940 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1941 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1942 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1943 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1944 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1946 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1948 if (ASIZE (val
) < 3)
1950 for (j
= 0; j
< 3; j
++)
1951 CHECK_NUMBER (AREF (val
, j
));
1956 error ("Invalid glyph-string format");
1961 check_otf_features (otf_features
)
1962 Lisp_Object otf_features
;
1966 CHECK_CONS (otf_features
);
1967 CHECK_SYMBOL (XCAR (otf_features
));
1968 otf_features
= XCDR (otf_features
);
1969 CHECK_CONS (otf_features
);
1970 CHECK_SYMBOL (XCAR (otf_features
));
1971 otf_features
= XCDR (otf_features
);
1972 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1974 CHECK_SYMBOL (Fcar (val
));
1975 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1976 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1978 otf_features
= XCDR (otf_features
);
1979 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1981 CHECK_SYMBOL (Fcar (val
));
1982 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1983 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1990 Lisp_Object otf_list
;
1993 otf_tag_symbol (tag
)
1998 OTF_tag_name (tag
, name
);
1999 return Fintern (make_unibyte_string (name
, 4), Qnil
);
2006 Lisp_Object val
= Fassoc (file
, otf_list
);
2010 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
2013 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
2014 val
= make_save_value (otf
, 0);
2015 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
2021 /* Return a list describing which scripts/languages FONT supports by
2022 which GSUB/GPOS features of OpenType tables. See the comment of
2023 (struct font_driver).otf_capability. */
2026 font_otf_capability (font
)
2030 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
2033 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
2036 for (i
= 0; i
< 2; i
++)
2038 OTF_GSUB_GPOS
*gsub_gpos
;
2039 Lisp_Object script_list
= Qnil
;
2042 if (OTF_get_features (otf
, i
== 0) < 0)
2044 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2045 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2047 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2048 Lisp_Object langsys_list
= Qnil
;
2049 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2052 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2054 OTF_LangSys
*langsys
;
2055 Lisp_Object feature_list
= Qnil
;
2056 Lisp_Object langsys_tag
;
2059 if (k
== script
->LangSysCount
)
2061 langsys
= &script
->DefaultLangSys
;
2066 langsys
= script
->LangSys
+ k
;
2068 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2070 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2072 OTF_Feature
*feature
2073 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2074 Lisp_Object feature_tag
2075 = otf_tag_symbol (feature
->FeatureTag
);
2077 feature_list
= Fcons (feature_tag
, feature_list
);
2079 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2082 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2087 XSETCAR (capability
, script_list
);
2089 XSETCDR (capability
, script_list
);
2095 /* Parse OTF features in SPEC and write a proper features spec string
2096 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2097 assured that the sufficient memory has already allocated for
2101 generate_otf_features (spec
, features
)
2111 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2117 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2122 else if (! asterisk
)
2124 val
= SYMBOL_NAME (val
);
2125 p
+= sprintf (p
, "%s", SDATA (val
));
2129 val
= SYMBOL_NAME (val
);
2130 p
+= sprintf (p
, "~%s", SDATA (val
));
2134 error ("OTF spec too long");
2138 font_otf_DeviceTable (device_table
)
2139 OTF_DeviceTable
*device_table
;
2141 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2143 return Fcons (make_number (len
),
2144 make_unibyte_string (device_table
->DeltaValue
, len
));
2148 font_otf_ValueRecord (value_format
, value_record
)
2150 OTF_ValueRecord
*value_record
;
2152 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2154 if (value_format
& OTF_XPlacement
)
2155 ASET (val
, 0, make_number (value_record
->XPlacement
));
2156 if (value_format
& OTF_YPlacement
)
2157 ASET (val
, 1, make_number (value_record
->YPlacement
));
2158 if (value_format
& OTF_XAdvance
)
2159 ASET (val
, 2, make_number (value_record
->XAdvance
));
2160 if (value_format
& OTF_YAdvance
)
2161 ASET (val
, 3, make_number (value_record
->YAdvance
));
2162 if (value_format
& OTF_XPlaDevice
)
2163 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2164 if (value_format
& OTF_YPlaDevice
)
2165 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2166 if (value_format
& OTF_XAdvDevice
)
2167 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2168 if (value_format
& OTF_YAdvDevice
)
2169 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2174 font_otf_Anchor (anchor
)
2179 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2180 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2181 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2182 if (anchor
->AnchorFormat
== 2)
2183 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2186 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2187 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2191 #endif /* HAVE_LIBOTF */
2197 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2198 static int font_compare
P_ ((const void *, const void *));
2199 static Lisp_Object font_sort_entities
P_ ((Lisp_Object
, Lisp_Object
,
2202 /* Return a rescaling ratio of FONT_ENTITY. */
2203 extern Lisp_Object Vface_font_rescale_alist
;
2206 font_rescale_ratio (font_entity
)
2207 Lisp_Object font_entity
;
2209 Lisp_Object tail
, elt
;
2210 Lisp_Object name
= Qnil
;
2212 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2215 if (FLOATP (XCDR (elt
)))
2217 if (STRINGP (XCAR (elt
)))
2220 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2221 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2222 return XFLOAT_DATA (XCDR (elt
));
2224 else if (FONT_SPEC_P (XCAR (elt
)))
2226 if (font_match_p (XCAR (elt
), font_entity
))
2227 return XFLOAT_DATA (XCDR (elt
));
2234 /* We sort fonts by scoring each of them against a specified
2235 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2236 the value is, the closer the font is to the font-spec.
2238 The lowest 2 bits of the score is used for driver type. The font
2239 available by the most preferred font driver is 0.
2241 Each 7-bit in the higher 28 bits are used for numeric properties
2242 WEIGHT, SLANT, WIDTH, and SIZE. */
2244 /* How many bits to shift to store the difference value of each font
2245 property in a score. Note that flots for FONT_TYPE_INDEX and
2246 FONT_REGISTRY_INDEX are not used. */
2247 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2249 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2250 The return value indicates how different ENTITY is compared with
2254 font_score (entity
, spec_prop
)
2255 Lisp_Object entity
, *spec_prop
;
2260 /* Score three style numeric fields. Maximum difference is 127. */
2261 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2262 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2264 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2269 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2272 /* Score the size. Maximum difference is 127. */
2273 i
= FONT_SIZE_INDEX
;
2274 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2275 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2277 /* We use the higher 6-bit for the actual size difference. The
2278 lowest bit is set if the DPI is different. */
2280 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2282 if (CONSP (Vface_font_rescale_alist
))
2283 pixel_size
*= font_rescale_ratio (entity
);
2284 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2288 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2289 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2291 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2292 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2294 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2301 /* Concatenate all elements of LIST into one vector. LIST is a list
2302 of font-entity vectors. */
2305 font_vconcat_entity_vectors (Lisp_Object list
)
2307 int nargs
= XINT (Flength (list
));
2308 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2311 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2312 args
[i
] = XCAR (list
);
2313 return Fvconcat (nargs
, args
);
2317 /* The structure for elements being sorted by qsort. */
2318 struct font_sort_data
2321 int font_driver_preference
;
2326 /* The comparison function for qsort. */
2329 font_compare (d1
, d2
)
2330 const void *d1
, *d2
;
2332 const struct font_sort_data
*data1
= d1
;
2333 const struct font_sort_data
*data2
= d2
;
2335 if (data1
->score
< data2
->score
)
2337 else if (data1
->score
> data2
->score
)
2339 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2343 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2344 If PREFER specifies a point-size, calculate the corresponding
2345 pixel-size from QCdpi property of PREFER or from the Y-resolution
2346 of FRAME before sorting.
2348 If BEST-ONLY is nonzero, return the best matching entity (that
2349 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2350 if BEST-ONLY is negative). Otherwise, return the sorted result as
2351 a single vector of font-entities.
2353 This function does no optimization for the case that the total
2354 number of elements is 1. The caller should avoid calling this in
2358 font_sort_entities (list
, prefer
, frame
, best_only
)
2359 Lisp_Object list
, prefer
, frame
;
2362 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2364 struct font_sort_data
*data
;
2365 unsigned best_score
;
2366 Lisp_Object best_entity
;
2367 struct frame
*f
= XFRAME (frame
);
2368 Lisp_Object tail
, vec
;
2371 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2372 prefer_prop
[i
] = AREF (prefer
, i
);
2373 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2374 prefer_prop
[FONT_SIZE_INDEX
]
2375 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2377 if (NILP (XCDR (list
)))
2379 /* What we have to take care of is this single vector. */
2381 maxlen
= ASIZE (vec
);
2385 /* We don't have to perform sort, so there's no need of creating
2386 a single vector. But, we must find the length of the longest
2389 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2390 if (maxlen
< ASIZE (XCAR (tail
)))
2391 maxlen
= ASIZE (XCAR (tail
));
2395 /* We have to create a single vector to sort it. */
2396 vec
= font_vconcat_entity_vectors (list
);
2397 maxlen
= ASIZE (vec
);
2400 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2401 best_score
= 0xFFFFFFFF;
2404 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2406 int font_driver_preference
= 0;
2407 Lisp_Object current_font_driver
;
2413 /* We are sure that the length of VEC > 0. */
2414 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2415 /* Score the elements. */
2416 for (i
= 0; i
< len
; i
++)
2418 data
[i
].entity
= AREF (vec
, i
);
2420 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2422 ? font_score (data
[i
].entity
, prefer_prop
)
2424 if (best_only
&& best_score
> data
[i
].score
)
2426 best_score
= data
[i
].score
;
2427 best_entity
= data
[i
].entity
;
2428 if (best_score
== 0)
2431 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2433 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2434 font_driver_preference
++;
2436 data
[i
].font_driver_preference
= font_driver_preference
;
2439 /* Sort if necessary. */
2442 qsort (data
, len
, sizeof *data
, font_compare
);
2443 for (i
= 0; i
< len
; i
++)
2444 ASET (vec
, i
, data
[i
].entity
);
2453 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2458 /* API of Font Service Layer. */
2460 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2461 sort_shift_bits. Finternal_set_font_selection_order calls this
2462 function with font_sort_order after setting up it. */
2465 font_update_sort_order (order
)
2470 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2472 int xlfd_idx
= order
[i
];
2474 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2475 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2476 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2477 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2478 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2479 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2481 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2486 font_check_otf_features (script
, langsys
, features
, table
)
2487 Lisp_Object script
, langsys
, features
, table
;
2492 table
= assq_no_quit (script
, table
);
2495 table
= XCDR (table
);
2496 if (! NILP (langsys
))
2498 table
= assq_no_quit (langsys
, table
);
2504 val
= assq_no_quit (Qnil
, table
);
2506 table
= XCAR (table
);
2510 table
= XCDR (table
);
2511 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2513 if (NILP (XCAR (features
)))
2518 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2524 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2527 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2529 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2531 script
= XCAR (spec
);
2535 langsys
= XCAR (spec
);
2546 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2547 XCAR (otf_capability
)))
2549 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2550 XCDR (otf_capability
)))
2557 /* Check if FONT (font-entity or font-object) matches with the font
2558 specification SPEC. */
2561 font_match_p (spec
, font
)
2562 Lisp_Object spec
, font
;
2564 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2565 Lisp_Object extra
, font_extra
;
2568 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2569 if (! NILP (AREF (spec
, i
))
2570 && ! NILP (AREF (font
, i
))
2571 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2573 props
= XFONT_SPEC (spec
)->props
;
2574 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2576 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2577 prop
[i
] = AREF (spec
, i
);
2578 prop
[FONT_SIZE_INDEX
]
2579 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2583 if (font_score (font
, props
) > 0)
2585 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2586 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2587 for (; CONSP (extra
); extra
= XCDR (extra
))
2589 Lisp_Object key
= XCAR (XCAR (extra
));
2590 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2592 if (EQ (key
, QClang
))
2594 val2
= assq_no_quit (key
, font_extra
);
2603 if (NILP (Fmemq (val
, val2
)))
2608 ? NILP (Fmemq (val
, XCDR (val2
)))
2612 else if (EQ (key
, QCscript
))
2614 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2620 /* All characters in the list must be supported. */
2621 for (; CONSP (val2
); val2
= XCDR (val2
))
2623 if (! NATNUMP (XCAR (val2
)))
2625 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2626 == FONT_INVALID_CODE
)
2630 else if (VECTORP (val2
))
2632 /* At most one character in the vector must be supported. */
2633 for (i
= 0; i
< ASIZE (val2
); i
++)
2635 if (! NATNUMP (AREF (val2
, i
)))
2637 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2638 != FONT_INVALID_CODE
)
2641 if (i
== ASIZE (val2
))
2646 else if (EQ (key
, QCotf
))
2650 if (! FONT_OBJECT_P (font
))
2652 fontp
= XFONT_OBJECT (font
);
2653 if (! fontp
->driver
->otf_capability
)
2655 val2
= fontp
->driver
->otf_capability (fontp
);
2656 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2667 Each font backend has the callback function get_cache, and it
2668 returns a cons cell of which cdr part can be freely used for
2669 caching fonts. The cons cell may be shared by multiple frames
2670 and/or multiple font drivers. So, we arrange the cdr part as this:
2672 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2674 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2675 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2676 cons (FONT-SPEC FONT-ENTITY ...). */
2678 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2679 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2680 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2681 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2682 struct font_driver
*));
2685 font_prepare_cache (f
, driver
)
2687 struct font_driver
*driver
;
2689 Lisp_Object cache
, val
;
2691 cache
= driver
->get_cache (f
);
2693 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2697 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2698 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2702 val
= XCDR (XCAR (val
));
2703 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2709 font_finish_cache (f
, driver
)
2711 struct font_driver
*driver
;
2713 Lisp_Object cache
, val
, tmp
;
2716 cache
= driver
->get_cache (f
);
2718 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2719 cache
= val
, val
= XCDR (val
);
2720 font_assert (! NILP (val
));
2721 tmp
= XCDR (XCAR (val
));
2722 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2723 if (XINT (XCAR (tmp
)) == 0)
2725 font_clear_cache (f
, XCAR (val
), driver
);
2726 XSETCDR (cache
, XCDR (val
));
2732 font_get_cache (f
, driver
)
2734 struct font_driver
*driver
;
2736 Lisp_Object val
= driver
->get_cache (f
);
2737 Lisp_Object type
= driver
->type
;
2739 font_assert (CONSP (val
));
2740 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2741 font_assert (CONSP (val
));
2742 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2743 val
= XCDR (XCAR (val
));
2747 static int num_fonts
;
2750 font_clear_cache (f
, cache
, driver
)
2753 struct font_driver
*driver
;
2755 Lisp_Object tail
, elt
;
2756 Lisp_Object tail2
, entity
;
2758 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2759 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2762 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2763 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2765 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2767 entity
= XCAR (tail2
);
2769 if (FONT_ENTITY_P (entity
)
2770 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2772 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2774 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2776 Lisp_Object val
= XCAR (objlist
);
2777 struct font
*font
= XFONT_OBJECT (val
);
2779 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2781 font_assert (font
&& driver
== font
->driver
);
2782 driver
->close (f
, font
);
2786 if (driver
->free_entity
)
2787 driver
->free_entity (entity
);
2792 XSETCDR (cache
, Qnil
);
2796 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2799 font_delete_unmatched (vec
, spec
, size
)
2800 Lisp_Object vec
, spec
;
2803 Lisp_Object entity
, val
;
2804 enum font_property_index prop
;
2807 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2809 entity
= AREF (vec
, i
);
2810 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2811 if (INTEGERP (AREF (spec
, prop
))
2812 && ((XINT (AREF (spec
, prop
)) >> 8)
2813 != (XINT (AREF (entity
, prop
)) >> 8)))
2814 prop
= FONT_SPEC_MAX
;
2815 if (prop
< FONT_SPEC_MAX
2817 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2819 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2822 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2823 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2824 prop
= FONT_SPEC_MAX
;
2826 if (prop
< FONT_SPEC_MAX
2827 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2828 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2829 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2830 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2831 prop
= FONT_SPEC_MAX
;
2832 if (prop
< FONT_SPEC_MAX
2833 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2834 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2835 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2836 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2837 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2838 prop
= FONT_SPEC_MAX
;
2839 if (prop
< FONT_SPEC_MAX
)
2840 val
= Fcons (entity
, val
);
2842 return (Fvconcat (1, &val
));
2846 /* Return a list of vectors of font-entities matching with SPEC on
2847 FRAME. Each elements in the list is a vector of entities from the
2848 same font-driver. */
2851 font_list_entities (frame
, spec
)
2852 Lisp_Object frame
, spec
;
2854 FRAME_PTR f
= XFRAME (frame
);
2855 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2856 Lisp_Object ftype
, val
;
2857 Lisp_Object list
= Qnil
;
2859 int need_filtering
= 0;
2862 font_assert (FONT_SPEC_P (spec
));
2864 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2865 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2866 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2867 size
= font_pixel_size (f
, spec
);
2871 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2872 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2873 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2874 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2876 ASET (scratch_font_spec
, i
, Qnil
);
2877 if (! NILP (AREF (spec
, i
)))
2879 if (i
== FONT_DPI_INDEX
)
2880 /* Skip FONT_SPACING_INDEX */
2883 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2884 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2886 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2888 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2890 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2892 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2893 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2900 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2904 val
= Fvconcat (1, &val
);
2905 copy
= Fcopy_font_spec (scratch_font_spec
);
2906 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2907 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2909 if (ASIZE (val
) > 0 && need_filtering
)
2910 val
= font_delete_unmatched (val
, spec
, size
);
2911 if (ASIZE (val
) > 0)
2912 list
= Fcons (val
, list
);
2915 list
= Fnreverse (list
);
2916 FONT_ADD_LOG ("list", spec
, list
);
2921 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2922 nil, is an array of face's attributes, which specifies preferred
2923 font-related attributes. */
2926 font_matching_entity (f
, attrs
, spec
)
2928 Lisp_Object
*attrs
, spec
;
2930 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2931 Lisp_Object ftype
, size
, entity
;
2933 Lisp_Object work
= Fcopy_font_spec (spec
);
2935 XSETFRAME (frame
, f
);
2936 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2937 size
= AREF (spec
, FONT_SIZE_INDEX
);
2940 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2941 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2942 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2943 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2946 for (; driver_list
; driver_list
= driver_list
->next
)
2948 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2950 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2953 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2954 entity
= assoc_no_quit (work
, XCDR (cache
));
2956 entity
= XCDR (entity
);
2959 entity
= driver_list
->driver
->match (frame
, work
);
2960 copy
= Fcopy_font_spec (work
);
2961 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2962 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2964 if (! NILP (entity
))
2967 FONT_ADD_LOG ("match", work
, entity
);
2972 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2973 opened font object. */
2976 font_open_entity (f
, entity
, pixel_size
)
2981 struct font_driver_list
*driver_list
;
2982 Lisp_Object objlist
, size
, val
, font_object
;
2984 int min_width
, height
;
2985 int scaled_pixel_size
;
2987 font_assert (FONT_ENTITY_P (entity
));
2988 size
= AREF (entity
, FONT_SIZE_INDEX
);
2989 if (XINT (size
) != 0)
2990 scaled_pixel_size
= pixel_size
= XINT (size
);
2991 else if (CONSP (Vface_font_rescale_alist
))
2992 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2994 val
= AREF (entity
, FONT_TYPE_INDEX
);
2995 for (driver_list
= f
->font_driver_list
;
2996 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2997 driver_list
= driver_list
->next
);
3001 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
3002 objlist
= XCDR (objlist
))
3004 Lisp_Object fn
= XCAR (objlist
);
3005 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
3006 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
3008 if (driver_list
->driver
->cached_font_ok
== NULL
3009 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
3014 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
3015 if (!NILP (font_object
))
3016 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3017 FONT_ADD_LOG ("open", entity
, font_object
);
3018 if (NILP (font_object
))
3020 ASET (entity
, FONT_OBJLIST_INDEX
,
3021 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
3022 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
3025 font
= XFONT_OBJECT (font_object
);
3026 min_width
= (font
->min_width
? font
->min_width
3027 : font
->average_width
? font
->average_width
3028 : font
->space_width
? font
->space_width
3030 height
= (font
->height
? font
->height
: 1);
3031 #ifdef HAVE_WINDOW_SYSTEM
3032 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
3033 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
3035 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
3036 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
3037 fonts_changed_p
= 1;
3041 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
3042 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
3043 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
3044 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
3052 /* Close FONT_OBJECT that is opened on frame F. */
3055 font_close_object (f
, font_object
)
3057 Lisp_Object font_object
;
3059 struct font
*font
= XFONT_OBJECT (font_object
);
3061 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
3062 /* Already closed. */
3064 FONT_ADD_LOG ("close", font_object
, Qnil
);
3065 font
->driver
->close (f
, font
);
3066 #ifdef HAVE_WINDOW_SYSTEM
3067 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
3068 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
3074 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
3075 FONT is a font-entity and it must be opened to check. */
3078 font_has_char (f
, font
, c
)
3085 if (FONT_ENTITY_P (font
))
3087 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
3088 struct font_driver_list
*driver_list
;
3090 for (driver_list
= f
->font_driver_list
;
3091 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
3092 driver_list
= driver_list
->next
);
3095 if (! driver_list
->driver
->has_char
)
3097 return driver_list
->driver
->has_char (font
, c
);
3100 font_assert (FONT_OBJECT_P (font
));
3101 fontp
= XFONT_OBJECT (font
);
3102 if (fontp
->driver
->has_char
)
3104 int result
= fontp
->driver
->has_char (font
, c
);
3109 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
3113 /* Return the glyph ID of FONT_OBJECT for character C. */
3116 font_encode_char (font_object
, c
)
3117 Lisp_Object font_object
;
3122 font_assert (FONT_OBJECT_P (font_object
));
3123 font
= XFONT_OBJECT (font_object
);
3124 return font
->driver
->encode_char (font
, c
);
3128 /* Return the name of FONT_OBJECT. */
3131 font_get_name (font_object
)
3132 Lisp_Object font_object
;
3134 font_assert (FONT_OBJECT_P (font_object
));
3135 return AREF (font_object
, FONT_NAME_INDEX
);
3139 /* Return the specification of FONT_OBJECT. */
3142 font_get_spec (font_object
)
3143 Lisp_Object font_object
;
3145 Lisp_Object spec
= font_make_spec ();
3148 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
3149 ASET (spec
, i
, AREF (font_object
, i
));
3150 ASET (spec
, FONT_SIZE_INDEX
,
3151 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
3156 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3157 could not be parsed by font_parse_name, return Qnil. */
3160 font_spec_from_name (font_name
)
3161 Lisp_Object font_name
;
3163 Lisp_Object spec
= Ffont_spec (0, NULL
);
3165 CHECK_STRING (font_name
);
3166 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3168 font_put_extra (spec
, QCname
, font_name
);
3169 font_put_extra (spec
, QCuser_spec
, font_name
);
3175 font_clear_prop (attrs
, prop
)
3177 enum font_property_index prop
;
3179 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3184 if (! NILP (Ffont_get (font
, QCname
)))
3186 font
= Fcopy_font_spec (font
);
3187 font_put_extra (font
, QCname
, Qnil
);
3190 if (NILP (AREF (font
, prop
))
3191 && prop
!= FONT_FAMILY_INDEX
3192 && prop
!= FONT_FOUNDRY_INDEX
3193 && prop
!= FONT_WIDTH_INDEX
3194 && prop
!= FONT_SIZE_INDEX
)
3196 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3197 font
= Fcopy_font_spec (font
);
3198 ASET (font
, prop
, Qnil
);
3199 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3201 if (prop
== FONT_FAMILY_INDEX
)
3203 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3204 /* If we are setting the font family, we must also clear
3205 FONT_WIDTH_INDEX to avoid rejecting families that lack
3206 support for some widths. */
3207 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3209 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3210 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3211 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3212 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3213 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3214 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3216 else if (prop
== FONT_SIZE_INDEX
)
3218 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3219 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3220 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3222 else if (prop
== FONT_WIDTH_INDEX
)
3223 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3224 attrs
[LFACE_FONT_INDEX
] = font
;
3228 font_update_lface (f
, attrs
)
3234 spec
= attrs
[LFACE_FONT_INDEX
];
3235 if (! FONT_SPEC_P (spec
))
3238 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3239 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3240 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3241 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3242 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3243 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3244 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3245 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);
3246 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3247 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3248 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3252 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3257 val
= Ffont_get (spec
, QCdpi
);
3260 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3262 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3264 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3266 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3267 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3273 /* Selecte a font from ENTITIES (list of font-entity vectors) that
3274 supports C and matches best with ATTRS and PIXEL_SIZE. */
3277 font_select_entity (frame
, entities
, attrs
, pixel_size
, c
)
3278 Lisp_Object frame
, entities
, *attrs
;
3281 Lisp_Object font_entity
;
3284 FRAME_PTR f
= XFRAME (frame
);
3286 if (NILP (XCDR (entities
))
3287 && ASIZE (XCAR (entities
)) == 1)
3289 font_entity
= AREF (XCAR (entities
), 0);
3291 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3296 /* Sort fonts by properties specified in ATTRS. */
3297 prefer
= scratch_font_prefer
;
3299 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3300 ASET (prefer
, i
, Qnil
);
3301 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3303 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3305 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3306 ASET (prefer
, i
, AREF (face_font
, i
));
3308 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3309 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3310 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3311 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3312 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3313 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3314 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3316 return font_sort_entities (entities
, prefer
, frame
, c
);
3319 /* Return a font-entity satisfying SPEC and best matching with face's
3320 font related attributes in ATTRS. C, if not negative, is a
3321 character that the entity must support. */
3324 font_find_for_lface (f
, attrs
, spec
, c
)
3331 Lisp_Object frame
, entities
, val
;
3332 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3336 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3337 if (NILP (registry
[0]))
3339 registry
[0] = DEFAULT_ENCODING
;
3340 registry
[1] = Qascii_0
;
3341 registry
[2] = null_vector
;
3344 registry
[1] = null_vector
;
3346 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3348 struct charset
*encoding
, *repertory
;
3350 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3351 &encoding
, &repertory
) < 0)
3354 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3356 else if (c
> encoding
->max_char
)
3360 work
= Fcopy_font_spec (spec
);
3361 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3362 XSETFRAME (frame
, f
);
3363 size
= AREF (spec
, FONT_SIZE_INDEX
);
3364 pixel_size
= font_pixel_size (f
, spec
);
3365 if (pixel_size
== 0)
3367 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3369 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3371 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3372 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3373 if (! NILP (foundry
[0]))
3374 foundry
[1] = null_vector
;
3375 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3377 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3378 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3380 foundry
[2] = null_vector
;
3383 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3385 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3386 if (! NILP (adstyle
[0]))
3387 adstyle
[1] = null_vector
;
3388 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3390 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3392 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3394 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3396 adstyle
[2] = null_vector
;
3399 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3402 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3405 val
= AREF (work
, FONT_FAMILY_INDEX
);
3406 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3408 val
= attrs
[LFACE_FAMILY_INDEX
];
3409 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3413 family
= alloca ((sizeof family
[0]) * 2);
3415 family
[1] = null_vector
; /* terminator. */
3420 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3421 /* Font family names are case-sensitive under NS. */
3429 if (! NILP (alters
))
3431 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3432 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3433 family
[i
] = XCAR (alters
);
3434 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3436 family
[i
] = null_vector
;
3440 family
= alloca ((sizeof family
[0]) * 3);
3443 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3445 family
[i
] = null_vector
;
3449 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3451 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3452 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3454 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3455 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3457 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3458 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3460 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3461 entities
= font_list_entities (frame
, work
);
3462 if (! NILP (entities
))
3464 val
= font_select_entity (frame
, entities
,
3465 attrs
, pixel_size
, c
);
3478 font_open_for_lface (f
, entity
, attrs
, spec
)
3486 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3487 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3488 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3489 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3490 size
= font_pixel_size (f
, spec
);
3494 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3495 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3498 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3499 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3500 if (INTEGERP (height
))
3503 abort(); /* We should never end up here. */
3507 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3511 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3512 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3516 return font_open_entity (f
, entity
, size
);
3520 /* Find a font satisfying SPEC and best matching with face's
3521 attributes in ATTRS on FRAME, and return the opened
3525 font_load_for_lface (f
, attrs
, spec
)
3527 Lisp_Object
*attrs
, spec
;
3529 Lisp_Object entity
, name
;
3531 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3534 /* No font is listed for SPEC, but each font-backend may have
3535 the different criteria about "font matching". So, try
3537 entity
= font_matching_entity (f
, attrs
, spec
);
3541 /* Don't loose the original name that was put in initially. We need
3542 it to re-apply the font when font parameters (like hinting or dpi) have
3544 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3547 name
= Ffont_get (spec
, QCuser_spec
);
3548 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3554 /* Make FACE on frame F ready to use the font opened for FACE. */
3557 font_prepare_for_face (f
, face
)
3561 if (face
->font
->driver
->prepare_face
)
3562 face
->font
->driver
->prepare_face (f
, face
);
3566 /* Make FACE on frame F stop using the font opened for FACE. */
3569 font_done_for_face (f
, face
)
3573 if (face
->font
->driver
->done_face
)
3574 face
->font
->driver
->done_face (f
, face
);
3579 /* Open a font matching with font-spec SPEC on frame F. If no proper
3580 font is found, return Qnil. */
3583 font_open_by_spec (f
, spec
)
3587 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3589 /* We set up the default font-related attributes of a face to prefer
3591 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3592 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3593 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3595 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3597 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3599 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3601 return font_load_for_lface (f
, attrs
, spec
);
3605 /* Open a font matching with NAME on frame F. If no proper font is
3606 found, return Qnil. */
3609 font_open_by_name (f
, name
)
3613 Lisp_Object args
[2];
3614 Lisp_Object spec
, ret
;
3617 args
[1] = make_unibyte_string (name
, strlen (name
));
3618 spec
= Ffont_spec (2, args
);
3619 ret
= font_open_by_spec (f
, spec
);
3620 /* Do not loose name originally put in. */
3622 font_put_extra (ret
, QCuser_spec
, args
[1]);
3628 /* Register font-driver DRIVER. This function is used in two ways.
3630 The first is with frame F non-NULL. In this case, make DRIVER
3631 available (but not yet activated) on F. All frame creaters
3632 (e.g. Fx_create_frame) must call this function at least once with
3633 an available font-driver.
3635 The second is with frame F NULL. In this case, DRIVER is globally
3636 registered in the variable `font_driver_list'. All font-driver
3637 implementations must call this function in its syms_of_XXXX
3638 (e.g. syms_of_xfont). */
3641 register_font_driver (driver
, f
)
3642 struct font_driver
*driver
;
3645 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3646 struct font_driver_list
*prev
, *list
;
3648 if (f
&& ! driver
->draw
)
3649 error ("Unusable font driver for a frame: %s",
3650 SDATA (SYMBOL_NAME (driver
->type
)));
3652 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3653 if (EQ (list
->driver
->type
, driver
->type
))
3654 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3656 list
= xmalloc (sizeof (struct font_driver_list
));
3658 list
->driver
= driver
;
3663 f
->font_driver_list
= list
;
3665 font_driver_list
= list
;
3671 free_font_driver_list (f
)
3674 struct font_driver_list
*list
, *next
;
3676 for (list
= f
->font_driver_list
; list
; list
= next
)
3681 f
->font_driver_list
= NULL
;
3685 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3686 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3687 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3689 A caller must free all realized faces if any in advance. The
3690 return value is a list of font backends actually made used on
3694 font_update_drivers (f
, new_drivers
)
3696 Lisp_Object new_drivers
;
3698 Lisp_Object active_drivers
= Qnil
;
3699 struct font_driver
*driver
;
3700 struct font_driver_list
*list
;
3702 /* At first, turn off non-requested drivers, and turn on requested
3704 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3706 driver
= list
->driver
;
3707 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3712 if (driver
->end_for_frame
)
3713 driver
->end_for_frame (f
);
3714 font_finish_cache (f
, driver
);
3719 if (! driver
->start_for_frame
3720 || driver
->start_for_frame (f
) == 0)
3722 font_prepare_cache (f
, driver
);
3729 if (NILP (new_drivers
))
3732 if (! EQ (new_drivers
, Qt
))
3734 /* Re-order the driver list according to new_drivers. */
3735 struct font_driver_list
**list_table
, **next
;
3739 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3740 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3742 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3743 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3746 list_table
[i
++] = list
;
3748 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3750 list_table
[i
++] = list
;
3751 list_table
[i
] = NULL
;
3753 next
= &f
->font_driver_list
;
3754 for (i
= 0; list_table
[i
]; i
++)
3756 *next
= list_table
[i
];
3757 next
= &(*next
)->next
;
3761 if (! f
->font_driver_list
->on
)
3762 { /* None of the drivers is enabled: enable them all.
3763 Happens if you set the list of drivers to (xft x) in your .emacs
3764 and then use it under w32 or ns. */
3765 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3767 struct font_driver
*driver
= list
->driver
;
3768 eassert (! list
->on
);
3769 if (! driver
->start_for_frame
3770 || driver
->start_for_frame (f
) == 0)
3772 font_prepare_cache (f
, driver
);
3779 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3781 active_drivers
= nconc2 (active_drivers
,
3782 Fcons (list
->driver
->type
, Qnil
));
3783 return active_drivers
;
3787 font_put_frame_data (f
, driver
, data
)
3789 struct font_driver
*driver
;
3792 struct font_data_list
*list
, *prev
;
3794 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3795 prev
= list
, list
= list
->next
)
3796 if (list
->driver
== driver
)
3803 prev
->next
= list
->next
;
3805 f
->font_data_list
= list
->next
;
3813 list
= xmalloc (sizeof (struct font_data_list
));
3814 list
->driver
= driver
;
3815 list
->next
= f
->font_data_list
;
3816 f
->font_data_list
= list
;
3824 font_get_frame_data (f
, driver
)
3826 struct font_driver
*driver
;
3828 struct font_data_list
*list
;
3830 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3831 if (list
->driver
== driver
)
3839 /* Return the font used to draw character C by FACE at buffer position
3840 POS in window W. If STRING is non-nil, it is a string containing C
3841 at index POS. If C is negative, get C from the current buffer or
3845 font_at (c
, pos
, face
, w
, string
)
3854 Lisp_Object font_object
;
3856 multibyte
= (NILP (string
)
3857 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3858 : STRING_MULTIBYTE (string
));
3865 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3867 c
= FETCH_CHAR (pos_byte
);
3870 c
= FETCH_BYTE (pos
);
3876 multibyte
= STRING_MULTIBYTE (string
);
3879 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3881 str
= SDATA (string
) + pos_byte
;
3882 c
= STRING_CHAR (str
);
3885 c
= SDATA (string
)[pos
];
3889 f
= XFRAME (w
->frame
);
3890 if (! FRAME_WINDOW_P (f
))
3897 if (STRINGP (string
))
3898 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3899 DEFAULT_FACE_ID
, 0);
3901 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3903 face
= FACE_FROM_ID (f
, face_id
);
3907 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3908 face
= FACE_FROM_ID (f
, face_id
);
3913 XSETFONT (font_object
, face
->font
);
3918 #ifdef HAVE_WINDOW_SYSTEM
3920 /* Check how many characters after POS (at most to *LIMIT) can be
3921 displayed by the same font on the window W. FACE, if non-NULL, is
3922 the face selected for the character at POS. If STRING is not nil,
3923 it is the string to check instead of the current buffer. In that
3924 case, FACE must be not NULL.
3926 The return value is the font-object for the character at POS.
3927 *LIMIT is set to the position where that font can't be used.
3929 It is assured that the current buffer (or STRING) is multibyte. */
3932 font_range (pos
, limit
, w
, face
, string
)
3933 EMACS_INT pos
, *limit
;
3938 EMACS_INT pos_byte
, ignore
, start
, start_byte
;
3940 Lisp_Object font_object
= Qnil
;
3944 pos_byte
= CHAR_TO_BYTE (pos
);
3949 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3951 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3957 pos_byte
= string_char_to_byte (string
, pos
);
3960 start
= pos
, start_byte
= pos_byte
;
3961 while (pos
< *limit
)
3963 Lisp_Object category
;
3966 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3968 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3969 if (NILP (font_object
))
3971 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3972 if (NILP (font_object
))
3977 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3978 if (! EQ (category
, QCf
)
3979 && ! CHAR_VARIATION_SELECTOR_P (c
)
3980 && font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3982 Lisp_Object f
= font_for_char (face
, c
, pos
- 1, string
);
3983 EMACS_INT i
, i_byte
;
3991 i
= start
, i_byte
= start_byte
;
3996 FETCH_CHAR_ADVANCE_NO_CHECK (c
, i
, i_byte
);
3998 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, i
, i_byte
);
3999 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
4000 if (! EQ (category
, QCf
)
4001 && ! CHAR_VARIATION_SELECTOR_P (c
)
4002 && font_encode_char (f
, c
) == FONT_INVALID_CODE
)
4018 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
4019 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
4020 Return nil otherwise.
4021 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
4022 which kind of font it is. It must be one of `font-spec', `font-entity',
4024 (object
, extra_type
)
4025 Lisp_Object object
, extra_type
;
4027 if (NILP (extra_type
))
4028 return (FONTP (object
) ? Qt
: Qnil
);
4029 if (EQ (extra_type
, Qfont_spec
))
4030 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
4031 if (EQ (extra_type
, Qfont_entity
))
4032 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
4033 if (EQ (extra_type
, Qfont_object
))
4034 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
4035 wrong_type_argument (intern ("font-extra-type"), extra_type
);
4038 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
4039 doc
: /* Return a newly created font-spec with arguments as properties.
4041 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
4042 valid font property name listed below:
4044 `:family', `:weight', `:slant', `:width'
4046 They are the same as face attributes of the same name. See
4047 `set-face-attribute'.
4051 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
4055 VALUE must be a string or a symbol specifying the additional
4056 typographic style information of a font, e.g. ``sans''.
4060 VALUE must be a string or a symbol specifying the charset registry and
4061 encoding of a font, e.g. ``iso8859-1''.
4065 VALUE must be a non-negative integer or a floating point number
4066 specifying the font size. It specifies the font size in pixels (if
4067 VALUE is an integer), or in points (if VALUE is a float).
4071 VALUE must be a string of XLFD-style or fontconfig-style font name.
4075 VALUE must be a symbol representing a script that the font must
4076 support. It may be a symbol representing a subgroup of a script
4077 listed in the variable `script-representative-chars'.
4081 VALUE must be a symbol of two-letter ISO-639 language names,
4086 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
4087 required OpenType features.
4089 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
4090 LANGSYS-TAG: OpenType language system tag symbol,
4091 or nil for the default language system.
4092 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
4093 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
4095 GSUB and GPOS may contain `nil' element. In such a case, the font
4096 must not have any of the remaining elements.
4098 For instance, if the VALUE is `(thai nil nil (mark))', the font must
4099 be an OpenType font, and whose GPOS table of `thai' script's default
4100 language system must contain `mark' feature.
4102 usage: (font-spec ARGS...) */)
4107 Lisp_Object spec
= font_make_spec ();
4110 for (i
= 0; i
< nargs
; i
+= 2)
4112 Lisp_Object key
= args
[i
], val
;
4116 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
4119 if (EQ (key
, QCname
))
4122 font_parse_name ((char *) SDATA (val
), spec
);
4123 font_put_extra (spec
, key
, val
);
4127 int idx
= get_font_prop_index (key
);
4131 val
= font_prop_validate (idx
, Qnil
, val
);
4132 if (idx
< FONT_EXTRA_INDEX
)
4133 ASET (spec
, idx
, val
);
4135 font_put_extra (spec
, key
, val
);
4138 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
4144 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
4145 doc
: /* Return a copy of FONT as a font-spec. */)
4149 Lisp_Object new_spec
, tail
, prev
, extra
;
4153 new_spec
= font_make_spec ();
4154 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
4155 ASET (new_spec
, i
, AREF (font
, i
));
4156 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
4157 /* We must remove :font-entity property. */
4158 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
4159 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
4162 extra
= XCDR (extra
);
4164 XSETCDR (prev
, XCDR (tail
));
4167 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
4171 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
4172 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
4173 Every specified properties in FROM override the corresponding
4174 properties in TO. */)
4176 Lisp_Object from
, to
;
4178 Lisp_Object extra
, tail
;
4183 to
= Fcopy_font_spec (to
);
4184 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
4185 ASET (to
, i
, AREF (from
, i
));
4186 extra
= AREF (to
, FONT_EXTRA_INDEX
);
4187 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
4188 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
4190 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
4193 XSETCDR (slot
, XCDR (XCAR (tail
)));
4195 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
4197 ASET (to
, FONT_EXTRA_INDEX
, extra
);
4201 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
4202 doc
: /* Return the value of FONT's property KEY.
4203 FONT is a font-spec, a font-entity, or a font-object.
4204 KEY must be one of these symbols:
4205 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4206 :size, :name, :script
4207 See the documentation of `font-spec' for their meanings.
4208 If FONT is a font-entity or font-object, the value of :script may be
4209 a list of scripts that are supported by the font. */)
4211 Lisp_Object font
, key
;
4218 idx
= get_font_prop_index (key
);
4219 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4220 return font_style_symbolic (font
, idx
, 0);
4221 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4222 return AREF (font
, idx
);
4223 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
4226 #ifdef HAVE_WINDOW_SYSTEM
4228 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4229 doc
: /* Return a plist of face attributes generated by FONT.
4230 FONT is a font name, a font-spec, a font-entity, or a font-object.
4231 The return value is a list of the form
4233 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4235 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4236 compatible with `set-face-attribute'. Some of these key-attribute pairs
4237 may be omitted from the list if they are not specified by FONT.
4239 The optional argument FRAME specifies the frame that the face attributes
4240 are to be displayed on. If omitted, the selected frame is used. */)
4242 Lisp_Object font
, frame
;
4245 Lisp_Object plist
[10];
4250 frame
= selected_frame
;
4251 CHECK_LIVE_FRAME (frame
);
4256 int fontset
= fs_query_fontset (font
, 0);
4257 Lisp_Object name
= font
;
4259 font
= fontset_ascii (fontset
);
4260 font
= font_spec_from_name (name
);
4262 signal_error ("Invalid font name", name
);
4264 else if (! FONTP (font
))
4265 signal_error ("Invalid font object", font
);
4267 val
= AREF (font
, FONT_FAMILY_INDEX
);
4270 plist
[n
++] = QCfamily
;
4271 plist
[n
++] = SYMBOL_NAME (val
);
4274 val
= AREF (font
, FONT_SIZE_INDEX
);
4277 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4278 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4279 plist
[n
++] = QCheight
;
4280 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4282 else if (FLOATP (val
))
4284 plist
[n
++] = QCheight
;
4285 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4288 val
= FONT_WEIGHT_FOR_FACE (font
);
4291 plist
[n
++] = QCweight
;
4295 val
= FONT_SLANT_FOR_FACE (font
);
4298 plist
[n
++] = QCslant
;
4302 val
= FONT_WIDTH_FOR_FACE (font
);
4305 plist
[n
++] = QCwidth
;
4309 return Flist (n
, plist
);
4314 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4315 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
4316 (font_spec
, prop
, val
)
4317 Lisp_Object font_spec
, prop
, val
;
4321 CHECK_FONT_SPEC (font_spec
);
4322 idx
= get_font_prop_index (prop
);
4323 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4324 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
4326 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
4330 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4331 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4332 Optional 2nd argument FRAME specifies the target frame.
4333 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4334 Optional 4th argument PREFER, if non-nil, is a font-spec to
4335 control the order of the returned list. Fonts are sorted by
4336 how close they are to PREFER. */)
4337 (font_spec
, frame
, num
, prefer
)
4338 Lisp_Object font_spec
, frame
, num
, prefer
;
4340 Lisp_Object vec
, list
;
4344 frame
= selected_frame
;
4345 CHECK_LIVE_FRAME (frame
);
4346 CHECK_FONT_SPEC (font_spec
);
4354 if (! NILP (prefer
))
4355 CHECK_FONT_SPEC (prefer
);
4357 list
= font_list_entities (frame
, font_spec
);
4360 if (NILP (XCDR (list
))
4361 && ASIZE (XCAR (list
)) == 1)
4362 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4364 if (! NILP (prefer
))
4365 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4367 vec
= font_vconcat_entity_vectors (list
);
4368 if (n
== 0 || n
>= ASIZE (vec
))
4370 Lisp_Object args
[2];
4374 list
= Fappend (2, args
);
4378 for (list
= Qnil
, n
--; n
>= 0; n
--)
4379 list
= Fcons (AREF (vec
, n
), list
);
4384 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4385 doc
: /* List available font families on the current frame.
4386 Optional argument FRAME, if non-nil, specifies the target frame. */)
4391 struct font_driver_list
*driver_list
;
4395 frame
= selected_frame
;
4396 CHECK_LIVE_FRAME (frame
);
4399 for (driver_list
= f
->font_driver_list
; driver_list
;
4400 driver_list
= driver_list
->next
)
4401 if (driver_list
->driver
->list_family
)
4403 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4404 Lisp_Object tail
= list
;
4406 for (; CONSP (val
); val
= XCDR (val
))
4407 if (NILP (Fmemq (XCAR (val
), tail
))
4408 && SYMBOLP (XCAR (val
)))
4409 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4414 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4415 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4416 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4418 Lisp_Object font_spec
, frame
;
4420 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4427 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4428 doc
: /* Return XLFD name of FONT.
4429 FONT is a font-spec, font-entity, or font-object.
4430 If the name is too long for XLFD (maximum 255 chars), return nil.
4431 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4432 the consecutive wildcards are folded to one. */)
4433 (font
, fold_wildcards
)
4434 Lisp_Object font
, fold_wildcards
;
4441 if (FONT_OBJECT_P (font
))
4443 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4445 if (STRINGP (font_name
)
4446 && SDATA (font_name
)[0] == '-')
4448 if (NILP (fold_wildcards
))
4450 strcpy (name
, (char *) SDATA (font_name
));
4453 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4455 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4458 if (! NILP (fold_wildcards
))
4460 char *p0
= name
, *p1
;
4462 while ((p1
= strstr (p0
, "-*-*")))
4464 strcpy (p1
, p1
+ 2);
4469 return build_string (name
);
4472 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4473 doc
: /* Clear font cache. */)
4476 Lisp_Object list
, frame
;
4478 FOR_EACH_FRAME (list
, frame
)
4480 FRAME_PTR f
= XFRAME (frame
);
4481 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4483 for (; driver_list
; driver_list
= driver_list
->next
)
4484 if (driver_list
->on
)
4486 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4487 Lisp_Object val
, tmp
;
4491 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4493 font_assert (! NILP (val
));
4494 tmp
= XCDR (XCAR (val
));
4495 if (XINT (XCAR (tmp
)) == 0)
4497 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4498 XSETCDR (cache
, XCDR (val
));
4508 font_fill_lglyph_metrics (glyph
, font_object
)
4509 Lisp_Object glyph
, font_object
;
4511 struct font
*font
= XFONT_OBJECT (font_object
);
4513 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4514 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4515 struct font_metrics metrics
;
4517 LGLYPH_SET_CODE (glyph
, ecode
);
4519 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4520 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4521 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4522 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4523 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4524 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4528 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4529 doc
: /* Shape the glyph-string GSTRING.
4530 Shaping means substituting glyphs and/or adjusting positions of glyphs
4531 to get the correct visual image of character sequences set in the
4532 header of the glyph-string.
4534 If the shaping was successful, the value is GSTRING itself or a newly
4535 created glyph-string. Otherwise, the value is nil. */)
4537 Lisp_Object gstring
;
4540 Lisp_Object font_object
, n
, glyph
;
4543 if (! composition_gstring_p (gstring
))
4544 signal_error ("Invalid glyph-string: ", gstring
);
4545 if (! NILP (LGSTRING_ID (gstring
)))
4547 font_object
= LGSTRING_FONT (gstring
);
4548 CHECK_FONT_OBJECT (font_object
);
4549 font
= XFONT_OBJECT (font_object
);
4550 if (! font
->driver
->shape
)
4553 /* Try at most three times with larger gstring each time. */
4554 for (i
= 0; i
< 3; i
++)
4556 n
= font
->driver
->shape (gstring
);
4559 gstring
= larger_vector (gstring
,
4560 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4563 if (i
== 3 || XINT (n
) == 0)
4566 glyph
= LGSTRING_GLYPH (gstring
, 0);
4567 from
= LGLYPH_FROM (glyph
);
4568 to
= LGLYPH_TO (glyph
);
4569 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4571 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4575 if (NILP (LGLYPH_ADJUSTMENT (this)))
4580 glyph
= LGSTRING_GLYPH (gstring
, j
);
4581 LGLYPH_SET_FROM (glyph
, from
);
4582 LGLYPH_SET_TO (glyph
, to
);
4584 from
= LGLYPH_FROM (this);
4585 to
= LGLYPH_TO (this);
4590 if (from
> LGLYPH_FROM (this))
4591 from
= LGLYPH_FROM (this);
4592 if (to
< LGLYPH_TO (this))
4593 to
= LGLYPH_TO (this);
4599 glyph
= LGSTRING_GLYPH (gstring
, j
);
4600 LGLYPH_SET_FROM (glyph
, from
);
4601 LGLYPH_SET_TO (glyph
, to
);
4603 return composition_gstring_put_cache (gstring
, XINT (n
));
4606 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4608 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4609 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4611 VARIATION-SELECTOR is a chracter code of variation selection
4612 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4613 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4614 (font_object
, character
)
4615 Lisp_Object font_object
, character
;
4617 unsigned variations
[256];
4622 CHECK_FONT_OBJECT (font_object
);
4623 CHECK_CHARACTER (character
);
4624 font
= XFONT_OBJECT (font_object
);
4625 if (! font
->driver
->get_variation_glyphs
)
4627 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4631 for (i
= 0; i
< 255; i
++)
4635 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4636 /* Stops GCC whining about limited range of data type. */
4637 EMACS_INT var
= variations
[i
];
4639 if (var
> MOST_POSITIVE_FIXNUM
)
4640 code
= Fcons (make_number ((variations
[i
]) >> 16),
4641 make_number ((variations
[i
]) & 0xFFFF));
4643 code
= make_number (variations
[i
]);
4644 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4651 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4652 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4653 OTF-FEATURES specifies which features to apply in this format:
4654 (SCRIPT LANGSYS GSUB GPOS)
4656 SCRIPT is a symbol specifying a script tag of OpenType,
4657 LANGSYS is a symbol specifying a langsys tag of OpenType,
4658 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4660 If LANGYS is nil, the default langsys is selected.
4662 The features are applied in the order they appear in the list. The
4663 symbol `*' means to apply all available features not present in this
4664 list, and the remaining features are ignored. For instance, (vatu
4665 pstf * haln) is to apply vatu and pstf in this order, then to apply
4666 all available features other than vatu, pstf, and haln.
4668 The features are applied to the glyphs in the range FROM and TO of
4669 the glyph-string GSTRING-IN.
4671 If some feature is actually applicable, the resulting glyphs are
4672 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4673 this case, the value is the number of produced glyphs.
4675 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4678 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4679 produced in GSTRING-OUT, and the value is nil.
4681 See the documentation of `font-make-gstring' for the format of
4683 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4684 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4686 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4691 check_otf_features (otf_features
);
4692 CHECK_FONT_OBJECT (font_object
);
4693 font
= XFONT_OBJECT (font_object
);
4694 if (! font
->driver
->otf_drive
)
4695 error ("Font backend %s can't drive OpenType GSUB table",
4696 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4697 CHECK_CONS (otf_features
);
4698 CHECK_SYMBOL (XCAR (otf_features
));
4699 val
= XCDR (otf_features
);
4700 CHECK_SYMBOL (XCAR (val
));
4701 val
= XCDR (otf_features
);
4704 len
= check_gstring (gstring_in
);
4705 CHECK_VECTOR (gstring_out
);
4706 CHECK_NATNUM (from
);
4708 CHECK_NATNUM (index
);
4710 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4711 args_out_of_range_3 (from
, to
, make_number (len
));
4712 if (XINT (index
) >= ASIZE (gstring_out
))
4713 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4714 num
= font
->driver
->otf_drive (font
, otf_features
,
4715 gstring_in
, XINT (from
), XINT (to
),
4716 gstring_out
, XINT (index
), 0);
4719 return make_number (num
);
4722 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4724 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4725 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4727 (SCRIPT LANGSYS FEATURE ...)
4728 See the documentation of `font-drive-otf' for more detail.
4730 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4731 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4732 character code corresponding to the glyph or nil if there's no
4733 corresponding character. */)
4734 (font_object
, character
, otf_features
)
4735 Lisp_Object font_object
, character
, otf_features
;
4738 Lisp_Object gstring_in
, gstring_out
, g
;
4739 Lisp_Object alternates
;
4742 CHECK_FONT_GET_OBJECT (font_object
, font
);
4743 if (! font
->driver
->otf_drive
)
4744 error ("Font backend %s can't drive OpenType GSUB table",
4745 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4746 CHECK_CHARACTER (character
);
4747 CHECK_CONS (otf_features
);
4749 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4750 g
= LGSTRING_GLYPH (gstring_in
, 0);
4751 LGLYPH_SET_CHAR (g
, XINT (character
));
4752 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4753 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4754 gstring_out
, 0, 1)) < 0)
4755 gstring_out
= Ffont_make_gstring (font_object
,
4756 make_number (ASIZE (gstring_out
) * 2));
4758 for (i
= 0; i
< num
; i
++)
4760 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4761 int c
= LGLYPH_CHAR (g
);
4762 unsigned code
= LGLYPH_CODE (g
);
4764 alternates
= Fcons (Fcons (make_number (code
),
4765 c
> 0 ? make_number (c
) : Qnil
),
4768 return Fnreverse (alternates
);
4774 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4775 doc
: /* Open FONT-ENTITY. */)
4776 (font_entity
, size
, frame
)
4777 Lisp_Object font_entity
;
4783 CHECK_FONT_ENTITY (font_entity
);
4785 frame
= selected_frame
;
4786 CHECK_LIVE_FRAME (frame
);
4789 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4792 CHECK_NUMBER_OR_FLOAT (size
);
4794 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4796 isize
= XINT (size
);
4800 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4803 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4804 doc
: /* Close FONT-OBJECT. */)
4805 (font_object
, frame
)
4806 Lisp_Object font_object
, frame
;
4808 CHECK_FONT_OBJECT (font_object
);
4810 frame
= selected_frame
;
4811 CHECK_LIVE_FRAME (frame
);
4812 font_close_object (XFRAME (frame
), font_object
);
4816 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4817 doc
: /* Return information about FONT-OBJECT.
4818 The value is a vector:
4819 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4822 NAME is a string of the font name (or nil if the font backend doesn't
4825 FILENAME is a string of the font file (or nil if the font backend
4826 doesn't provide a file name).
4828 PIXEL-SIZE is a pixel size by which the font is opened.
4830 SIZE is a maximum advance width of the font in pixels.
4832 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4835 CAPABILITY is a list whose first element is a symbol representing the
4836 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4837 remaining elements describe the details of the font capability.
4839 If the font is OpenType font, the form of the list is
4840 \(opentype GSUB GPOS)
4841 where GSUB shows which "GSUB" features the font supports, and GPOS
4842 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4843 lists of the format:
4844 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4846 If the font is not OpenType font, currently the length of the form is
4849 SCRIPT is a symbol representing OpenType script tag.
4851 LANGSYS is a symbol representing OpenType langsys tag, or nil
4852 representing the default langsys.
4854 FEATURE is a symbol representing OpenType feature tag.
4856 If the font is not OpenType font, CAPABILITY is nil. */)
4858 Lisp_Object font_object
;
4863 CHECK_FONT_GET_OBJECT (font_object
, font
);
4865 val
= Fmake_vector (make_number (9), Qnil
);
4866 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4867 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4868 ASET (val
, 2, make_number (font
->pixel_size
));
4869 ASET (val
, 3, make_number (font
->max_width
));
4870 ASET (val
, 4, make_number (font
->ascent
));
4871 ASET (val
, 5, make_number (font
->descent
));
4872 ASET (val
, 6, make_number (font
->space_width
));
4873 ASET (val
, 7, make_number (font
->average_width
));
4874 if (font
->driver
->otf_capability
)
4875 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4879 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4880 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4881 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4882 (font_object
, string
)
4883 Lisp_Object font_object
, string
;
4889 CHECK_FONT_GET_OBJECT (font_object
, font
);
4890 CHECK_STRING (string
);
4891 len
= SCHARS (string
);
4892 vec
= Fmake_vector (make_number (len
), Qnil
);
4893 for (i
= 0; i
< len
; i
++)
4895 Lisp_Object ch
= Faref (string
, make_number (i
));
4900 struct font_metrics metrics
;
4902 cod
= code
= font
->driver
->encode_char (font
, c
);
4903 if (code
== FONT_INVALID_CODE
)
4905 val
= Fmake_vector (make_number (6), Qnil
);
4906 if (cod
<= MOST_POSITIVE_FIXNUM
)
4907 ASET (val
, 0, make_number (code
));
4909 ASET (val
, 0, Fcons (make_number (code
>> 16),
4910 make_number (code
& 0xFFFF)));
4911 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4912 ASET (val
, 1, make_number (metrics
.lbearing
));
4913 ASET (val
, 2, make_number (metrics
.rbearing
));
4914 ASET (val
, 3, make_number (metrics
.width
));
4915 ASET (val
, 4, make_number (metrics
.ascent
));
4916 ASET (val
, 5, make_number (metrics
.descent
));
4922 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4923 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4924 FONT is a font-spec, font-entity, or font-object. */)
4926 Lisp_Object spec
, font
;
4928 CHECK_FONT_SPEC (spec
);
4931 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4934 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4935 doc
: /* Return a font-object for displaying a character at POSITION.
4936 Optional second arg WINDOW, if non-nil, is a window displaying
4937 the current buffer. It defaults to the currently selected window. */)
4938 (position
, window
, string
)
4939 Lisp_Object position
, window
, string
;
4946 CHECK_NUMBER_COERCE_MARKER (position
);
4947 pos
= XINT (position
);
4948 if (pos
< BEGV
|| pos
>= ZV
)
4949 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4953 CHECK_NUMBER (position
);
4954 CHECK_STRING (string
);
4955 pos
= XINT (position
);
4956 if (pos
< 0 || pos
>= SCHARS (string
))
4957 args_out_of_range (string
, position
);
4960 window
= selected_window
;
4961 CHECK_LIVE_WINDOW (window
);
4962 w
= XWINDOW (window
);
4964 return font_at (-1, pos
, NULL
, w
, string
);
4968 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4969 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4970 The value is a number of glyphs drawn.
4971 Type C-l to recover what previously shown. */)
4972 (font_object
, string
)
4973 Lisp_Object font_object
, string
;
4975 Lisp_Object frame
= selected_frame
;
4976 FRAME_PTR f
= XFRAME (frame
);
4982 CHECK_FONT_GET_OBJECT (font_object
, font
);
4983 CHECK_STRING (string
);
4984 len
= SCHARS (string
);
4985 code
= alloca (sizeof (unsigned) * len
);
4986 for (i
= 0; i
< len
; i
++)
4988 Lisp_Object ch
= Faref (string
, make_number (i
));
4992 code
[i
] = font
->driver
->encode_char (font
, c
);
4993 if (code
[i
] == FONT_INVALID_CODE
)
4996 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4998 if (font
->driver
->prepare_face
)
4999 font
->driver
->prepare_face (f
, face
);
5000 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
5001 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
5002 if (font
->driver
->done_face
)
5003 font
->driver
->done_face (f
, face
);
5005 return make_number (len
);
5009 #endif /* FONT_DEBUG */
5011 #ifdef HAVE_WINDOW_SYSTEM
5013 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
5014 doc
: /* Return information about a font named NAME on frame FRAME.
5015 If FRAME is omitted or nil, use the selected frame.
5016 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
5017 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
5019 OPENED-NAME is the name used for opening the font,
5020 FULL-NAME is the full name of the font,
5021 SIZE is the pixelsize of the font,
5022 HEIGHT is the pixel-height of the font (i.e ascent + descent),
5023 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
5024 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
5025 how to compose characters.
5026 If the named font is not yet loaded, return nil. */)
5028 Lisp_Object name
, frame
;
5033 Lisp_Object font_object
;
5035 (*check_window_system_func
) ();
5038 CHECK_STRING (name
);
5040 frame
= selected_frame
;
5041 CHECK_LIVE_FRAME (frame
);
5046 int fontset
= fs_query_fontset (name
, 0);
5049 name
= fontset_ascii (fontset
);
5050 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
5052 else if (FONT_OBJECT_P (name
))
5054 else if (FONT_ENTITY_P (name
))
5055 font_object
= font_open_entity (f
, name
, 0);
5058 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5059 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
5061 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
5063 if (NILP (font_object
))
5065 font
= XFONT_OBJECT (font_object
);
5067 info
= Fmake_vector (make_number (7), Qnil
);
5068 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
5069 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
5070 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
5071 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
5072 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
5073 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
5074 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
5077 /* As font_object is still in FONT_OBJLIST of the entity, we can't
5078 close it now. Perhaps, we should manage font-objects
5079 by `reference-count'. */
5080 font_close_object (f
, font_object
);
5087 #define BUILD_STYLE_TABLE(TBL) \
5088 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
5091 build_style_table (entry
, nelement
)
5092 struct table_entry
*entry
;
5096 Lisp_Object table
, elt
;
5098 table
= Fmake_vector (make_number (nelement
), Qnil
);
5099 for (i
= 0; i
< nelement
; i
++)
5101 for (j
= 0; entry
[i
].names
[j
]; j
++);
5102 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
5103 ASET (elt
, 0, make_number (entry
[i
].numeric
));
5104 for (j
= 0; entry
[i
].names
[j
]; j
++)
5105 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
5106 ASET (table
, i
, elt
);
5111 Lisp_Object Vfont_log
;
5113 /* The deferred font-log data of the form [ACTION ARG RESULT].
5114 If ACTION is not nil, that is added to the log when font_add_log is
5115 called next time. At that time, ACTION is set back to nil. */
5116 static Lisp_Object Vfont_log_deferred
;
5118 /* Prepend the font-related logging data in Vfont_log if it is not
5119 `t'. ACTION describes a kind of font-related action (e.g. listing,
5120 opening), ARG is the argument for the action, and RESULT is the
5121 result of the action. */
5123 font_add_log (action
, arg
, result
)
5125 Lisp_Object arg
, result
;
5127 Lisp_Object tail
, val
;
5130 if (EQ (Vfont_log
, Qt
))
5132 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5134 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
5136 ASET (Vfont_log_deferred
, 0, Qnil
);
5137 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5138 AREF (Vfont_log_deferred
, 2));
5143 Lisp_Object tail
, elt
;
5144 Lisp_Object equalstr
= build_string ("=");
5146 val
= Ffont_xlfd_name (arg
, Qt
);
5147 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5151 if (EQ (XCAR (elt
), QCscript
)
5152 && SYMBOLP (XCDR (elt
)))
5153 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5154 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5155 else if (EQ (XCAR (elt
), QClang
)
5156 && SYMBOLP (XCDR (elt
)))
5157 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5158 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5159 else if (EQ (XCAR (elt
), QCotf
)
5160 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5161 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5163 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5169 && VECTORP (XCAR (result
))
5170 && ASIZE (XCAR (result
)) > 0
5171 && FONTP (AREF (XCAR (result
), 0)))
5172 result
= font_vconcat_entity_vectors (result
);
5175 val
= Ffont_xlfd_name (result
, Qt
);
5176 if (! FONT_SPEC_P (result
))
5177 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5178 build_string (":"), val
);
5181 else if (CONSP (result
))
5183 result
= Fcopy_sequence (result
);
5184 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5188 val
= Ffont_xlfd_name (val
, Qt
);
5189 XSETCAR (tail
, val
);
5192 else if (VECTORP (result
))
5194 result
= Fcopy_sequence (result
);
5195 for (i
= 0; i
< ASIZE (result
); i
++)
5197 val
= AREF (result
, i
);
5199 val
= Ffont_xlfd_name (val
, Qt
);
5200 ASET (result
, i
, val
);
5203 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5206 /* Record a font-related logging data to be added to Vfont_log when
5207 font_add_log is called next time. ACTION, ARG, RESULT are the same
5211 font_deferred_log (action
, arg
, result
)
5213 Lisp_Object arg
, result
;
5215 if (EQ (Vfont_log
, Qt
))
5217 ASET (Vfont_log_deferred
, 0, build_string (action
));
5218 ASET (Vfont_log_deferred
, 1, arg
);
5219 ASET (Vfont_log_deferred
, 2, result
);
5222 extern void syms_of_ftfont
P_ (());
5223 extern void syms_of_xfont
P_ (());
5224 extern void syms_of_xftfont
P_ (());
5225 extern void syms_of_ftxfont
P_ (());
5226 extern void syms_of_bdffont
P_ (());
5227 extern void syms_of_w32font
P_ (());
5228 extern void syms_of_atmfont
P_ (());
5229 extern void syms_of_nsfont
P_ (());
5234 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5235 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5236 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5237 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5238 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5239 /* Note that the other elements in sort_shift_bits are not used. */
5241 staticpro (&font_charset_alist
);
5242 font_charset_alist
= Qnil
;
5244 DEFSYM (Qopentype
, "opentype");
5246 DEFSYM (Qascii_0
, "ascii-0");
5247 DEFSYM (Qiso8859_1
, "iso8859-1");
5248 DEFSYM (Qiso10646_1
, "iso10646-1");
5249 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5250 DEFSYM (Qunicode_sip
, "unicode-sip");
5254 DEFSYM (QCotf
, ":otf");
5255 DEFSYM (QClang
, ":lang");
5256 DEFSYM (QCscript
, ":script");
5257 DEFSYM (QCantialias
, ":antialias");
5259 DEFSYM (QCfoundry
, ":foundry");
5260 DEFSYM (QCadstyle
, ":adstyle");
5261 DEFSYM (QCregistry
, ":registry");
5262 DEFSYM (QCspacing
, ":spacing");
5263 DEFSYM (QCdpi
, ":dpi");
5264 DEFSYM (QCscalable
, ":scalable");
5265 DEFSYM (QCavgwidth
, ":avgwidth");
5266 DEFSYM (QCfont_entity
, ":font-entity");
5267 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5277 DEFSYM (QCuser_spec
, "user-spec");
5279 staticpro (&null_vector
);
5280 null_vector
= Fmake_vector (make_number (0), Qnil
);
5282 staticpro (&scratch_font_spec
);
5283 scratch_font_spec
= Ffont_spec (0, NULL
);
5284 staticpro (&scratch_font_prefer
);
5285 scratch_font_prefer
= Ffont_spec (0, NULL
);
5287 staticpro (&Vfont_log_deferred
);
5288 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5292 staticpro (&otf_list
);
5294 #endif /* HAVE_LIBOTF */
5298 defsubr (&Sfont_spec
);
5299 defsubr (&Sfont_get
);
5300 #ifdef HAVE_WINDOW_SYSTEM
5301 defsubr (&Sfont_face_attributes
);
5303 defsubr (&Sfont_put
);
5304 defsubr (&Slist_fonts
);
5305 defsubr (&Sfont_family_list
);
5306 defsubr (&Sfind_font
);
5307 defsubr (&Sfont_xlfd_name
);
5308 defsubr (&Sclear_font_cache
);
5309 defsubr (&Sfont_shape_gstring
);
5310 defsubr (&Sfont_variation_glyphs
);
5312 defsubr (&Sfont_drive_otf
);
5313 defsubr (&Sfont_otf_alternates
);
5317 defsubr (&Sopen_font
);
5318 defsubr (&Sclose_font
);
5319 defsubr (&Squery_font
);
5320 defsubr (&Sget_font_glyphs
);
5321 defsubr (&Sfont_match_p
);
5322 defsubr (&Sfont_at
);
5324 defsubr (&Sdraw_string
);
5326 #endif /* FONT_DEBUG */
5327 #ifdef HAVE_WINDOW_SYSTEM
5328 defsubr (&Sfont_info
);
5331 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5333 Alist of fontname patterns vs the corresponding encoding and repertory info.
5334 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5335 where ENCODING is a charset or a char-table,
5336 and REPERTORY is a charset, a char-table, or nil.
5338 If ENCODING and REPERTORY are the same, the element can have the form
5339 \(REGEXP . ENCODING).
5341 ENCODING is for converting a character to a glyph code of the font.
5342 If ENCODING is a charset, encoding a character by the charset gives
5343 the corresponding glyph code. If ENCODING is a char-table, looking up
5344 the table by a character gives the corresponding glyph code.
5346 REPERTORY specifies a repertory of characters supported by the font.
5347 If REPERTORY is a charset, all characters beloging to the charset are
5348 supported. If REPERTORY is a char-table, all characters who have a
5349 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5350 gets the repertory information by an opened font and ENCODING. */);
5351 Vfont_encoding_alist
= Qnil
;
5353 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5354 doc
: /* Vector of valid font weight values.
5355 Each element has the form:
5356 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5357 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5358 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5360 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5361 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5362 See `font-weight-table' for the format of the vector. */);
5363 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5365 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5366 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5367 See `font-weight-table' for the format of the vector. */);
5368 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5370 staticpro (&font_style_table
);
5371 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5372 ASET (font_style_table
, 0, Vfont_weight_table
);
5373 ASET (font_style_table
, 1, Vfont_slant_table
);
5374 ASET (font_style_table
, 2, Vfont_width_table
);
5376 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5377 *Logging list of font related actions and results.
5378 The value t means to suppress the logging.
5379 The initial value is set to nil if the environment variable
5380 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5383 #ifdef HAVE_WINDOW_SYSTEM
5384 #ifdef HAVE_FREETYPE
5386 #ifdef HAVE_X_WINDOWS
5391 #endif /* HAVE_XFT */
5392 #endif /* HAVE_X_WINDOWS */
5393 #else /* not HAVE_FREETYPE */
5394 #ifdef HAVE_X_WINDOWS
5396 #endif /* HAVE_X_WINDOWS */
5397 #endif /* not HAVE_FREETYPE */
5400 #endif /* HAVE_BDFFONT */
5403 #endif /* WINDOWSNT */
5406 #endif /* HAVE_NS */
5407 #endif /* HAVE_WINDOW_SYSTEM */
5413 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
5416 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5417 (do not change this comment) */