1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
3 Copyright (C) 2006, 2007, 2008, 2009, 2010
4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H13PRO009
7 This file is part of GNU Emacs.
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
32 #include "dispextern.h"
34 #include "character.h"
35 #include "composite.h"
41 #endif /* HAVE_X_WINDOWS */
45 #endif /* HAVE_NTGUI */
52 extern Lisp_Object Qfontsize
;
55 Lisp_Object Qopentype
;
57 /* Important character set strings. */
58 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
60 #define DEFAULT_ENCODING Qiso8859_1
62 /* Unicode category `Cf'. */
63 static Lisp_Object QCf
;
65 /* Special vector of zero length. This is repeatedly used by (struct
66 font_driver *)->list when a specified font is not found. */
67 static Lisp_Object null_vector
;
69 static Lisp_Object Vfont_weight_table
, Vfont_slant_table
, Vfont_width_table
;
71 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
72 static Lisp_Object font_style_table
;
74 /* Structure used for tables mapping weight, slant, and width numeric
75 values and their names. */
80 /* The first one is a valid name as a face attribute.
81 The second one (if any) is a typical name in XLFD field. */
85 /* Table of weight numeric values and their names. This table must be
86 sorted by numeric values in ascending order. */
88 static const struct table_entry weight_table
[] =
91 { 20, { "ultra-light", "ultralight" }},
92 { 40, { "extra-light", "extralight" }},
94 { 75, { "semi-light", "semilight", "demilight", "book" }},
95 { 100, { "normal", "medium", "regular", "unspecified" }},
96 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
98 { 205, { "extra-bold", "extrabold" }},
99 { 210, { "ultra-bold", "ultrabold", "black" }}
102 /* Table of slant numeric values and their names. This table must be
103 sorted by numeric values in ascending order. */
105 static const struct table_entry slant_table
[] =
107 { 0, { "reverse-oblique", "ro" }},
108 { 10, { "reverse-italic", "ri" }},
109 { 100, { "normal", "r", "unspecified" }},
110 { 200, { "italic" ,"i", "ot" }},
111 { 210, { "oblique", "o" }}
114 /* Table of width numeric values and their names. This table must be
115 sorted by numeric values in ascending order. */
117 static const struct table_entry width_table
[] =
119 { 50, { "ultra-condensed", "ultracondensed" }},
120 { 63, { "extra-condensed", "extracondensed" }},
121 { 75, { "condensed", "compressed", "narrow" }},
122 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
123 { 100, { "normal", "medium", "regular", "unspecified" }},
124 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
125 { 125, { "expanded" }},
126 { 150, { "extra-expanded", "extraexpanded" }},
127 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
130 extern Lisp_Object Qnormal
;
132 /* Symbols representing keys of normal font properties. */
133 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
;
134 extern Lisp_Object QCheight
, QCsize
, QCname
;
136 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
;
137 /* Symbols representing keys of font extra info. */
138 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
139 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
140 /* Symbols representing values of font spacing property. */
141 Lisp_Object Qc
, Qm
, Qp
, Qd
;
142 /* Special ADSTYLE properties to avoid fonts used for Latin
143 characters; used in xfont.c and ftfont.c. */
144 Lisp_Object Qja
, Qko
;
146 Lisp_Object QCuser_spec
;
148 Lisp_Object Vfont_encoding_alist
;
150 /* Alist of font registry symbol and the corresponding charsets
151 information. The information is retrieved from
152 Vfont_encoding_alist on demand.
154 Eash element has the form:
155 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
159 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
160 encodes a character code to a glyph code of a font, and
161 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
162 character is supported by a font.
164 The latter form means that the information for REGISTRY couldn't be
166 static Lisp_Object font_charset_alist
;
168 /* List of all font drivers. Each font-backend (XXXfont.c) calls
169 register_font_driver in syms_of_XXXfont to register its font-driver
171 static struct font_driver_list
*font_driver_list
;
175 /* Creaters of font-related Lisp object. */
180 Lisp_Object font_spec
;
181 struct font_spec
*spec
182 = ((struct font_spec
*)
183 allocate_pseudovector (VECSIZE (struct font_spec
),
184 FONT_SPEC_MAX
, PVEC_FONT
));
185 XSETFONT (font_spec
, spec
);
192 Lisp_Object font_entity
;
193 struct font_entity
*entity
194 = ((struct font_entity
*)
195 allocate_pseudovector (VECSIZE (struct font_entity
),
196 FONT_ENTITY_MAX
, PVEC_FONT
));
197 XSETFONT (font_entity
, entity
);
201 /* Create a font-object whose structure size is SIZE. If ENTITY is
202 not nil, copy properties from ENTITY to the font-object. If
203 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
205 font_make_object (size
, entity
, pixelsize
)
210 Lisp_Object font_object
;
212 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
215 XSETFONT (font_object
, font
);
219 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
220 font
->props
[i
] = AREF (entity
, i
);
221 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
222 font
->props
[FONT_EXTRA_INDEX
]
223 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
226 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
232 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
233 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
234 static Lisp_Object font_matching_entity
P_ ((FRAME_PTR
, Lisp_Object
*,
237 /* Number of registered font drivers. */
238 static int num_font_drivers
;
241 /* Return a Lispy value of a font property value at STR and LEN bytes.
242 If STR is "*", it returns nil.
243 If FORCE_SYMBOL is zero and all characters in STR are digits, it
244 returns an integer. Otherwise, it returns a symbol interned from
248 font_intern_prop (str
, len
, force_symbol
)
258 if (len
== 1 && *str
== '*')
260 if (!force_symbol
&& len
>=1 && isdigit (*str
))
262 for (i
= 1; i
< len
; i
++)
263 if (! isdigit (str
[i
]))
266 return make_number (atoi (str
));
269 /* The following code is copied from the function intern (in
270 lread.c), and modified to suite our purpose. */
272 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
273 obarray
= check_obarray (obarray
);
274 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
275 if (len
== nchars
|| len
!= nbytes
)
276 /* CONTENTS contains no multibyte sequences or contains an invalid
277 multibyte sequence. We'll make a unibyte string. */
278 tem
= oblookup (obarray
, str
, len
, len
);
280 tem
= oblookup (obarray
, str
, nchars
, len
);
283 if (len
== nchars
|| len
!= nbytes
)
284 tem
= make_unibyte_string (str
, len
);
286 tem
= make_multibyte_string (str
, nchars
, len
);
287 return Fintern (tem
, obarray
);
290 /* Return a pixel size of font-spec SPEC on frame F. */
293 font_pixel_size (f
, spec
)
297 #ifdef HAVE_WINDOW_SYSTEM
298 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
307 font_assert (FLOATP (size
));
308 point_size
= XFLOAT_DATA (size
);
309 val
= AREF (spec
, FONT_DPI_INDEX
);
314 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
322 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
323 font vector. If VAL is not valid (i.e. not registered in
324 font_style_table), return -1 if NOERROR is zero, and return a
325 proper index if NOERROR is nonzero. In that case, register VAL in
326 font_style_table if VAL is a symbol, and return a closest index if
327 VAL is an integer. */
330 font_style_to_value (prop
, val
, noerror
)
331 enum font_property_index prop
;
335 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
336 int len
= ASIZE (table
);
342 Lisp_Object args
[2], elt
;
344 /* At first try exact match. */
345 for (i
= 0; i
< len
; i
++)
346 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
347 if (EQ (val
, AREF (AREF (table
, i
), j
)))
348 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
349 | (i
<< 4) | (j
- 1));
350 /* Try also with case-folding match. */
351 s
= SDATA (SYMBOL_NAME (val
));
352 for (i
= 0; i
< len
; i
++)
353 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
355 elt
= AREF (AREF (table
, i
), j
);
356 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
357 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
358 | (i
<< 4) | (j
- 1));
364 elt
= Fmake_vector (make_number (2), make_number (100));
367 args
[1] = Fmake_vector (make_number (1), elt
);
368 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
369 return (100 << 8) | (i
<< 4);
374 int numeric
= XINT (val
);
376 for (i
= 0, last_n
= -1; i
< len
; i
++)
378 int n
= XINT (AREF (AREF (table
, i
), 0));
381 return (n
<< 8) | (i
<< 4);
386 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
387 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
393 return ((last_n
<< 8) | ((i
- 1) << 4));
398 font_style_symbolic (font
, prop
, for_face
)
400 enum font_property_index prop
;
403 Lisp_Object val
= AREF (font
, prop
);
404 Lisp_Object table
, elt
;
409 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
410 i
= XINT (val
) & 0xFF;
411 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
412 elt
= AREF (table
, ((i
>> 4) & 0xF));
413 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
414 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
417 extern Lisp_Object Vface_alternative_font_family_alist
;
419 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
422 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
423 FONTNAME. ENCODING is a charset symbol that specifies the encoding
424 of the font. REPERTORY is a charset symbol or nil. */
427 find_font_encoding (fontname
)
428 Lisp_Object fontname
;
430 Lisp_Object tail
, elt
;
432 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
436 && STRINGP (XCAR (elt
))
437 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
438 && (SYMBOLP (XCDR (elt
))
439 ? CHARSETP (XCDR (elt
))
440 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
446 /* Return encoding charset and repertory charset for REGISTRY in
447 ENCODING and REPERTORY correspondingly. If correct information for
448 REGISTRY is available, return 0. Otherwise return -1. */
451 font_registry_charsets (registry
, encoding
, repertory
)
452 Lisp_Object registry
;
453 struct charset
**encoding
, **repertory
;
456 int encoding_id
, repertory_id
;
458 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
464 encoding_id
= XINT (XCAR (val
));
465 repertory_id
= XINT (XCDR (val
));
469 val
= find_font_encoding (SYMBOL_NAME (registry
));
470 if (SYMBOLP (val
) && CHARSETP (val
))
472 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
474 else if (CONSP (val
))
476 if (! CHARSETP (XCAR (val
)))
478 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
479 if (NILP (XCDR (val
)))
483 if (! CHARSETP (XCDR (val
)))
485 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
490 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
492 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
496 *encoding
= CHARSET_FROM_ID (encoding_id
);
498 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
503 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
508 /* Font property value validaters. See the comment of
509 font_property_table for the meaning of the arguments. */
511 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
512 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
513 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
514 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
515 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
516 static int get_font_prop_index
P_ ((Lisp_Object
));
519 font_prop_validate_symbol (prop
, val
)
520 Lisp_Object prop
, val
;
523 val
= Fintern (val
, Qnil
);
526 else if (EQ (prop
, QCregistry
))
527 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
533 font_prop_validate_style (style
, val
)
534 Lisp_Object style
, val
;
536 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
537 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
544 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
548 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
550 if ((n
& 0xF) + 1 >= ASIZE (elt
))
552 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
556 else if (SYMBOLP (val
))
558 int n
= font_style_to_value (prop
, val
, 0);
560 val
= n
>= 0 ? make_number (n
) : Qerror
;
568 font_prop_validate_non_neg (prop
, val
)
569 Lisp_Object prop
, val
;
571 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
576 font_prop_validate_spacing (prop
, val
)
577 Lisp_Object prop
, val
;
579 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
581 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
583 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
585 if (spacing
== 'c' || spacing
== 'C')
586 return make_number (FONT_SPACING_CHARCELL
);
587 if (spacing
== 'm' || spacing
== 'M')
588 return make_number (FONT_SPACING_MONO
);
589 if (spacing
== 'p' || spacing
== 'P')
590 return make_number (FONT_SPACING_PROPORTIONAL
);
591 if (spacing
== 'd' || spacing
== 'D')
592 return make_number (FONT_SPACING_DUAL
);
598 font_prop_validate_otf (prop
, val
)
599 Lisp_Object prop
, val
;
601 Lisp_Object tail
, tmp
;
604 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
605 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
606 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
609 if (! SYMBOLP (XCAR (val
)))
614 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
616 for (i
= 0; i
< 2; i
++)
623 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
624 if (! SYMBOLP (XCAR (tmp
)))
632 /* Structure of known font property keys and validater of the
636 /* Pointer to the key symbol. */
638 /* Function to validate PROP's value VAL, or NULL if any value is
639 ok. The value is VAL or its regularized value if VAL is valid,
640 and Qerror if not. */
641 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
642 } font_property_table
[] =
643 { { &QCtype
, font_prop_validate_symbol
},
644 { &QCfoundry
, font_prop_validate_symbol
},
645 { &QCfamily
, font_prop_validate_symbol
},
646 { &QCadstyle
, font_prop_validate_symbol
},
647 { &QCregistry
, font_prop_validate_symbol
},
648 { &QCweight
, font_prop_validate_style
},
649 { &QCslant
, font_prop_validate_style
},
650 { &QCwidth
, font_prop_validate_style
},
651 { &QCsize
, font_prop_validate_non_neg
},
652 { &QCdpi
, font_prop_validate_non_neg
},
653 { &QCspacing
, font_prop_validate_spacing
},
654 { &QCavgwidth
, font_prop_validate_non_neg
},
655 /* The order of the above entries must match with enum
656 font_property_index. */
657 { &QClang
, font_prop_validate_symbol
},
658 { &QCscript
, font_prop_validate_symbol
},
659 { &QCotf
, font_prop_validate_otf
}
662 /* Size (number of elements) of the above table. */
663 #define FONT_PROPERTY_TABLE_SIZE \
664 ((sizeof font_property_table) / (sizeof *font_property_table))
666 /* Return an index number of font property KEY or -1 if KEY is not an
667 already known property. */
670 get_font_prop_index (key
)
675 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
676 if (EQ (key
, *font_property_table
[i
].key
))
681 /* Validate the font property. The property key is specified by the
682 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
683 signal an error. The value is VAL or the regularized one. */
686 font_prop_validate (idx
, prop
, val
)
688 Lisp_Object prop
, val
;
690 Lisp_Object validated
;
695 prop
= *font_property_table
[idx
].key
;
698 idx
= get_font_prop_index (prop
);
702 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
703 if (EQ (validated
, Qerror
))
704 signal_error ("invalid font property", Fcons (prop
, val
));
709 /* Store VAL as a value of extra font property PROP in FONT while
710 keeping the sorting order. Don't check the validity of VAL. */
713 font_put_extra (font
, prop
, val
)
714 Lisp_Object font
, prop
, val
;
716 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
717 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
721 Lisp_Object prev
= Qnil
;
724 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
725 prev
= extra
, extra
= XCDR (extra
);
728 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
730 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
736 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
741 /* Font name parser and unparser */
743 static int parse_matrix
P_ ((char *));
744 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
745 static int font_parse_name
P_ ((char *, Lisp_Object
));
747 /* An enumerator for each field of an XLFD font name. */
748 enum xlfd_field_index
767 /* An enumerator for mask bit corresponding to each XLFD field. */
770 XLFD_FOUNDRY_MASK
= 0x0001,
771 XLFD_FAMILY_MASK
= 0x0002,
772 XLFD_WEIGHT_MASK
= 0x0004,
773 XLFD_SLANT_MASK
= 0x0008,
774 XLFD_SWIDTH_MASK
= 0x0010,
775 XLFD_ADSTYLE_MASK
= 0x0020,
776 XLFD_PIXEL_MASK
= 0x0040,
777 XLFD_POINT_MASK
= 0x0080,
778 XLFD_RESX_MASK
= 0x0100,
779 XLFD_RESY_MASK
= 0x0200,
780 XLFD_SPACING_MASK
= 0x0400,
781 XLFD_AVGWIDTH_MASK
= 0x0800,
782 XLFD_REGISTRY_MASK
= 0x1000,
783 XLFD_ENCODING_MASK
= 0x2000
787 /* Parse P pointing the pixel/point size field of the form
788 `[A B C D]' which specifies a transformation matrix:
794 by which all glyphs of the font are transformed. The spec says
795 that scalar value N for the pixel/point size is equivalent to:
796 A = N * resx/resy, B = C = 0, D = N.
798 Return the scalar value N if the form is valid. Otherwise return
809 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
812 matrix
[i
] = - strtod (p
+ 1, &end
);
814 matrix
[i
] = strtod (p
, &end
);
817 return (i
== 4 ? (int) matrix
[3] : -1);
820 /* Expand a wildcard field in FIELD (the first N fields are filled) to
821 multiple fields to fill in all 14 XLFD fields while restring a
822 field position by its contents. */
825 font_expand_wildcards (field
, n
)
826 Lisp_Object field
[XLFD_LAST_INDEX
];
830 Lisp_Object tmp
[XLFD_LAST_INDEX
];
831 /* Array of information about where this element can go. Nth
832 element is for Nth element of FIELD. */
834 /* Minimum possible field. */
836 /* Maxinum possible field. */
838 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
840 } range
[XLFD_LAST_INDEX
];
842 int range_from
, range_to
;
845 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
846 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
847 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
848 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
849 | XLFD_AVGWIDTH_MASK)
850 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
852 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
853 field. The value is shifted to left one bit by one in the
855 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
856 range_mask
= (range_mask
<< 1) | 1;
858 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
859 position-based retriction for FIELD[I]. */
860 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
861 i
++, range_from
++, range_to
++, range_mask
<<= 1)
863 Lisp_Object val
= field
[i
];
869 range
[i
].from
= range_from
;
870 range
[i
].to
= range_to
;
871 range
[i
].mask
= range_mask
;
875 /* The triplet FROM, TO, and MASK is a value-based
876 retriction for FIELD[I]. */
882 int numeric
= XINT (val
);
885 from
= to
= XLFD_ENCODING_INDEX
,
886 mask
= XLFD_ENCODING_MASK
;
887 else if (numeric
== 0)
888 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
889 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
890 else if (numeric
<= 48)
891 from
= to
= XLFD_PIXEL_INDEX
,
892 mask
= XLFD_PIXEL_MASK
;
894 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
895 mask
= XLFD_LARGENUM_MASK
;
897 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
898 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
899 mask
= XLFD_NULL_MASK
;
901 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
904 Lisp_Object name
= SYMBOL_NAME (val
);
906 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
907 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
908 mask
= XLFD_REGENC_MASK
;
910 from
= to
= XLFD_ENCODING_INDEX
,
911 mask
= XLFD_ENCODING_MASK
;
913 else if (range_from
<= XLFD_WEIGHT_INDEX
914 && range_to
>= XLFD_WEIGHT_INDEX
915 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
916 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
917 else if (range_from
<= XLFD_SLANT_INDEX
918 && range_to
>= XLFD_SLANT_INDEX
919 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
920 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
921 else if (range_from
<= XLFD_SWIDTH_INDEX
922 && range_to
>= XLFD_SWIDTH_INDEX
923 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
924 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
927 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
928 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
930 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
931 mask
= XLFD_SYMBOL_MASK
;
934 /* Merge position-based and value-based restrictions. */
936 while (from
< range_from
)
937 mask
&= ~(1 << from
++);
938 while (from
< 14 && ! (mask
& (1 << from
)))
940 while (to
> range_to
)
941 mask
&= ~(1 << to
--);
942 while (to
>= 0 && ! (mask
& (1 << to
)))
946 range
[i
].from
= from
;
948 range
[i
].mask
= mask
;
950 if (from
> range_from
|| to
< range_to
)
952 /* The range is narrowed by value-based restrictions.
953 Reflect it to the other fields. */
955 /* Following fields should be after FROM. */
957 /* Preceding fields should be before TO. */
958 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
960 /* Check FROM for non-wildcard field. */
961 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
963 while (range
[j
].from
< from
)
964 range
[j
].mask
&= ~(1 << range
[j
].from
++);
965 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
967 range
[j
].from
= from
;
970 from
= range
[j
].from
;
971 if (range
[j
].to
> to
)
973 while (range
[j
].to
> to
)
974 range
[j
].mask
&= ~(1 << range
[j
].to
--);
975 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
988 /* Decide all fileds from restrictions in RANGE. */
989 for (i
= j
= 0; i
< n
; i
++)
991 if (j
< range
[i
].from
)
993 if (i
== 0 || ! NILP (tmp
[i
- 1]))
994 /* None of TMP[X] corresponds to Jth field. */
996 for (; j
< range
[i
].from
; j
++)
1001 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
1003 for (; j
< XLFD_LAST_INDEX
; j
++)
1005 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
1006 field
[XLFD_ENCODING_INDEX
]
1007 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1012 #ifdef ENABLE_CHECKING
1013 /* Match a 14-field XLFD pattern against a full XLFD font name. */
1015 font_match_xlfd (char *pattern
, char *name
)
1017 while (*pattern
&& *name
)
1019 if (*pattern
== *name
)
1021 else if (*pattern
== '*')
1022 if (*name
== pattern
[1])
1033 /* Make sure the font object matches the XLFD font name. */
1035 font_check_xlfd_parse (Lisp_Object font
, char *name
)
1037 char name_check
[256];
1038 font_unparse_xlfd (font
, 0, name_check
, 255);
1039 return font_match_xlfd (name_check
, name
);
1045 /* Parse NAME (null terminated) as XLFD and store information in FONT
1046 (font-spec or font-entity). Size property of FONT is set as
1048 specified XLFD fields FONT property
1049 --------------------- -------------
1050 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1051 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1052 POINT_SIZE POINT_SIZE/10 (Lisp float)
1054 If NAME is successfully parsed, return 0. Otherwise return -1.
1056 FONT is usually a font-spec, but when this function is called from
1057 X font backend driver, it is a font-entity. In that case, NAME is
1058 a fully specified XLFD. */
1061 font_parse_xlfd (name
, font
)
1065 int len
= strlen (name
);
1067 char *f
[XLFD_LAST_INDEX
+ 1];
1071 if (len
> 255 || !len
)
1072 /* Maximum XLFD name length is 255. */
1074 /* Accept "*-.." as a fully specified XLFD. */
1075 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1076 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1079 for (p
= name
+ i
; *p
; p
++)
1083 if (i
== XLFD_LAST_INDEX
)
1088 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1089 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1091 if (i
== XLFD_LAST_INDEX
)
1093 /* Fully specified XLFD. */
1096 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1097 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1098 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1099 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1101 val
= INTERN_FIELD_SYM (i
);
1104 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1106 ASET (font
, j
, make_number (n
));
1109 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1110 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1111 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1113 ASET (font
, FONT_REGISTRY_INDEX
,
1114 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1115 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1117 p
= f
[XLFD_PIXEL_INDEX
];
1118 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1119 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1122 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1124 ASET (font
, FONT_SIZE_INDEX
, val
);
1125 else if (FONT_ENTITY_P (font
))
1129 double point_size
= -1;
1131 font_assert (FONT_SPEC_P (font
));
1132 p
= f
[XLFD_POINT_INDEX
];
1134 point_size
= parse_matrix (p
);
1135 else if (isdigit (*p
))
1136 point_size
= atoi (p
), point_size
/= 10;
1137 if (point_size
>= 0)
1138 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1142 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1143 if (! NILP (val
) && ! INTEGERP (val
))
1145 ASET (font
, FONT_DPI_INDEX
, val
);
1146 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1149 val
= font_prop_validate_spacing (QCspacing
, val
);
1150 if (! INTEGERP (val
))
1152 ASET (font
, FONT_SPACING_INDEX
, val
);
1154 p
= f
[XLFD_AVGWIDTH_INDEX
];
1157 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1158 if (! NILP (val
) && ! INTEGERP (val
))
1160 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1164 int wild_card_found
= 0;
1165 Lisp_Object prop
[XLFD_LAST_INDEX
];
1167 if (FONT_ENTITY_P (font
))
1169 for (j
= 0; j
< i
; j
++)
1173 if (f
[j
][1] && f
[j
][1] != '-')
1176 wild_card_found
= 1;
1179 prop
[j
] = INTERN_FIELD (j
);
1181 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1183 if (! wild_card_found
)
1185 if (font_expand_wildcards (prop
, i
) < 0)
1188 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1189 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1190 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1191 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1192 if (! NILP (prop
[i
]))
1194 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1196 ASET (font
, j
, make_number (n
));
1198 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1199 val
= prop
[XLFD_REGISTRY_INDEX
];
1202 val
= prop
[XLFD_ENCODING_INDEX
];
1204 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1206 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1207 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1209 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1210 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1212 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1214 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1215 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1216 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1218 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1220 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1223 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1224 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1225 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1227 val
= font_prop_validate_spacing (QCspacing
,
1228 prop
[XLFD_SPACING_INDEX
]);
1229 if (! INTEGERP (val
))
1231 ASET (font
, FONT_SPACING_INDEX
, val
);
1233 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1234 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1240 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1241 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1242 0, use PIXEL_SIZE instead. */
1245 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1251 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1255 font_assert (FONTP (font
));
1257 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1260 if (i
== FONT_ADSTYLE_INDEX
)
1261 j
= XLFD_ADSTYLE_INDEX
;
1262 else if (i
== FONT_REGISTRY_INDEX
)
1263 j
= XLFD_REGISTRY_INDEX
;
1264 val
= AREF (font
, i
);
1267 if (j
== XLFD_REGISTRY_INDEX
)
1268 f
[j
] = "*-*", len
+= 4;
1270 f
[j
] = "*", len
+= 2;
1275 val
= SYMBOL_NAME (val
);
1276 if (j
== XLFD_REGISTRY_INDEX
1277 && ! strchr ((char *) SDATA (val
), '-'))
1279 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1280 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1282 f
[j
] = alloca (SBYTES (val
) + 3);
1283 sprintf (f
[j
], "%s-*", SDATA (val
));
1284 len
+= SBYTES (val
) + 3;
1288 f
[j
] = alloca (SBYTES (val
) + 4);
1289 sprintf (f
[j
], "%s*-*", SDATA (val
));
1290 len
+= SBYTES (val
) + 4;
1294 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1298 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1301 val
= font_style_symbolic (font
, i
, 0);
1303 f
[j
] = "*", len
+= 2;
1306 val
= SYMBOL_NAME (val
);
1307 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1311 val
= AREF (font
, FONT_SIZE_INDEX
);
1312 font_assert (NUMBERP (val
) || NILP (val
));
1320 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1321 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1324 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1326 else if (FLOATP (val
))
1328 i
= XFLOAT_DATA (val
) * 10;
1329 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1330 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1333 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1335 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1337 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1338 f
[XLFD_RESX_INDEX
] = alloca (22);
1339 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1343 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1344 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1346 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1348 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1349 : spacing
<= FONT_SPACING_DUAL
? "d"
1350 : spacing
<= FONT_SPACING_MONO
? "m"
1355 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1356 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1358 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1359 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
], "%ld",
1360 (long) XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1363 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1364 len
++; /* for terminating '\0'. */
1367 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1368 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1369 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1370 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1371 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1372 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1373 f
[XLFD_REGISTRY_INDEX
]);
1376 /* Parse NAME (null terminated) and store information in FONT
1377 (font-spec or font-entity). NAME is supplied in either the
1378 Fontconfig or GTK font name format. If NAME is successfully
1379 parsed, return 0. Otherwise return -1.
1381 The fontconfig format is
1383 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1387 FAMILY [PROPS...] [SIZE]
1389 This function tries to guess which format it is. */
1392 font_parse_fcname (name
, font
)
1397 char *size_beg
= NULL
, *size_end
= NULL
;
1398 char *props_beg
= NULL
, *family_end
= NULL
;
1399 int len
= strlen (name
);
1404 for (p
= name
; *p
; p
++)
1406 if (*p
== '\\' && p
[1])
1410 props_beg
= family_end
= p
;
1415 int decimal
= 0, size_found
= 1;
1416 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1419 if (*q
!= '.' || decimal
)
1438 Lisp_Object extra_props
= Qnil
;
1440 /* A fontconfig name with size and/or property data. */
1441 if (family_end
> name
)
1444 family
= font_intern_prop (name
, family_end
- name
, 1);
1445 ASET (font
, FONT_FAMILY_INDEX
, family
);
1449 double point_size
= strtod (size_beg
, &size_end
);
1450 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1451 if (*size_end
== ':' && size_end
[1])
1452 props_beg
= size_end
;
1456 /* Now parse ":KEY=VAL" patterns. */
1459 for (p
= props_beg
; *p
; p
= q
)
1461 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1464 /* Must be an enumerated value. */
1468 val
= font_intern_prop (p
, q
- p
, 1);
1470 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1472 if (PROP_MATCH ("light", 5)
1473 || PROP_MATCH ("medium", 6)
1474 || PROP_MATCH ("demibold", 8)
1475 || PROP_MATCH ("bold", 4)
1476 || PROP_MATCH ("black", 5))
1477 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1478 else if (PROP_MATCH ("roman", 5)
1479 || PROP_MATCH ("italic", 6)
1480 || PROP_MATCH ("oblique", 7))
1481 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1482 else if (PROP_MATCH ("charcell", 8))
1483 ASET (font
, FONT_SPACING_INDEX
,
1484 make_number (FONT_SPACING_CHARCELL
));
1485 else if (PROP_MATCH ("mono", 4))
1486 ASET (font
, FONT_SPACING_INDEX
,
1487 make_number (FONT_SPACING_MONO
));
1488 else if (PROP_MATCH ("proportional", 12))
1489 ASET (font
, FONT_SPACING_INDEX
,
1490 make_number (FONT_SPACING_PROPORTIONAL
));
1499 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1500 prop
= FONT_SIZE_INDEX
;
1503 key
= font_intern_prop (p
, q
- p
, 1);
1504 prop
= get_font_prop_index (key
);
1508 for (q
= p
; *q
&& *q
!= ':'; q
++);
1509 val
= font_intern_prop (p
, q
- p
, 0);
1511 if (prop
>= FONT_FOUNDRY_INDEX
1512 && prop
< FONT_EXTRA_INDEX
)
1513 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1516 extra_props
= nconc2 (extra_props
,
1517 Fcons (Fcons (key
, val
), Qnil
));
1524 if (! NILP (extra_props
))
1526 struct font_driver_list
*driver_list
= font_driver_list
;
1527 for ( ; driver_list
; driver_list
= driver_list
->next
)
1528 if (driver_list
->driver
->filter_properties
)
1529 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1535 /* Either a fontconfig-style name with no size and property
1536 data, or a GTK-style name. */
1538 int word_len
, prop_found
= 0;
1540 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1546 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1554 double point_size
= strtod (p
, &q
);
1555 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1560 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1561 if (*q
== '\\' && q
[1])
1565 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1567 if (PROP_MATCH ("Ultra-Light", 11))
1570 prop
= font_intern_prop ("ultra-light", 11, 1);
1571 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1573 else if (PROP_MATCH ("Light", 5))
1576 prop
= font_intern_prop ("light", 5, 1);
1577 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1579 else if (PROP_MATCH ("Book", 4))
1582 prop
= font_intern_prop ("book", 4, 1);
1583 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1585 else if (PROP_MATCH ("Medium", 6))
1588 prop
= font_intern_prop ("medium", 6, 1);
1589 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1591 else if (PROP_MATCH ("Semi-Bold", 9))
1594 prop
= font_intern_prop ("semi-bold", 9, 1);
1595 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1597 else if (PROP_MATCH ("Bold", 4))
1600 prop
= font_intern_prop ("bold", 4, 1);
1601 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1603 else if (PROP_MATCH ("Italic", 6))
1606 prop
= font_intern_prop ("italic", 4, 1);
1607 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1609 else if (PROP_MATCH ("Oblique", 7))
1612 prop
= font_intern_prop ("oblique", 7, 1);
1613 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1615 else if (PROP_MATCH ("Semi-Condensed", 14))
1618 prop
= font_intern_prop ("semi-condensed", 14, 1);
1619 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, prop
);
1621 else if (PROP_MATCH ("Condensed", 9))
1624 prop
= font_intern_prop ("condensed", 9, 1);
1625 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, prop
);
1629 return -1; /* Unknown property in GTK-style font name. */
1638 family
= font_intern_prop (name
, family_end
- name
, 1);
1639 ASET (font
, FONT_FAMILY_INDEX
, family
);
1646 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1647 NAME (NBYTES length), and return the name length. If
1648 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1651 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1657 Lisp_Object family
, foundry
;
1658 Lisp_Object tail
, val
;
1662 Lisp_Object styles
[3];
1663 char *style_names
[3] = { "weight", "slant", "width" };
1666 family
= AREF (font
, FONT_FAMILY_INDEX
);
1667 if (! NILP (family
))
1669 if (SYMBOLP (family
))
1671 family
= SYMBOL_NAME (family
);
1672 len
+= SBYTES (family
);
1678 val
= AREF (font
, FONT_SIZE_INDEX
);
1681 if (XINT (val
) != 0)
1682 pixel_size
= XINT (val
);
1684 len
+= 21; /* for ":pixelsize=NUM" */
1686 else if (FLOATP (val
))
1689 point_size
= (int) XFLOAT_DATA (val
);
1690 len
+= 11; /* for "-NUM" */
1693 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1694 if (! NILP (foundry
))
1696 if (SYMBOLP (foundry
))
1698 foundry
= SYMBOL_NAME (foundry
);
1699 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1705 for (i
= 0; i
< 3; i
++)
1707 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1708 if (! NILP (styles
[i
]))
1709 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1710 SDATA (SYMBOL_NAME (styles
[i
])));
1713 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1714 len
+= sprintf (work
, ":dpi=%ld", (long)XINT (AREF (font
, FONT_DPI_INDEX
)));
1715 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1716 len
+= strlen (":spacing=100");
1717 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1718 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1719 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1721 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1723 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1725 len
+= SBYTES (val
);
1726 else if (INTEGERP (val
))
1727 len
+= sprintf (work
, "%ld", (long) XINT (val
));
1728 else if (SYMBOLP (val
))
1729 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1735 if (! NILP (family
))
1736 p
+= sprintf (p
, "%s", SDATA (family
));
1740 p
+= sprintf (p
, "%d", point_size
);
1742 p
+= sprintf (p
, "-%d", point_size
);
1744 else if (pixel_size
> 0)
1745 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1746 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1747 p
+= sprintf (p
, ":foundry=%s",
1748 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1749 for (i
= 0; i
< 3; i
++)
1750 if (! NILP (styles
[i
]))
1751 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1752 SDATA (SYMBOL_NAME (styles
[i
])));
1753 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1754 p
+= sprintf (p
, ":dpi=%ld", (long) XINT (AREF (font
, FONT_DPI_INDEX
)));
1755 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1756 p
+= sprintf (p
, ":spacing=%ld",
1757 (long) XINT (AREF (font
, FONT_SPACING_INDEX
)));
1758 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1760 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1761 p
+= sprintf (p
, ":scalable=true");
1763 p
+= sprintf (p
, ":scalable=false");
1768 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1769 NAME (NBYTES length), and return the name length. F is the frame
1770 on which the font is displayed; it is used to calculate the point
1774 font_unparse_gtkname (font
, f
, name
, nbytes
)
1782 Lisp_Object family
, weight
, slant
, size
;
1783 int point_size
= -1;
1785 family
= AREF (font
, FONT_FAMILY_INDEX
);
1786 if (! NILP (family
))
1788 if (! SYMBOLP (family
))
1790 family
= SYMBOL_NAME (family
);
1791 len
+= SBYTES (family
);
1794 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1795 if (EQ (weight
, Qnormal
))
1797 else if (! NILP (weight
))
1799 weight
= SYMBOL_NAME (weight
);
1800 len
+= SBYTES (weight
);
1803 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1804 if (EQ (slant
, Qnormal
))
1806 else if (! NILP (slant
))
1808 slant
= SYMBOL_NAME (slant
);
1809 len
+= SBYTES (slant
);
1812 size
= AREF (font
, FONT_SIZE_INDEX
);
1813 /* Convert pixel size to point size. */
1814 if (INTEGERP (size
))
1816 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1818 if (INTEGERP (font_dpi
))
1819 dpi
= XINT (font_dpi
);
1822 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1825 else if (FLOATP (size
))
1827 point_size
= (int) XFLOAT_DATA (size
);
1834 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1836 if (! NILP (weight
))
1839 p
+= sprintf (p
, " %s", SDATA (weight
));
1840 q
[1] = toupper (q
[1]);
1846 p
+= sprintf (p
, " %s", SDATA (slant
));
1847 q
[1] = toupper (q
[1]);
1851 p
+= sprintf (p
, " %d", point_size
);
1856 /* Parse NAME (null terminated) and store information in FONT
1857 (font-spec or font-entity). If NAME is successfully parsed, return
1858 0. Otherwise return -1. */
1861 font_parse_name (name
, font
)
1865 if (name
[0] == '-' || index (name
, '*') || index (name
, '?'))
1866 return font_parse_xlfd (name
, font
);
1867 return font_parse_fcname (name
, font
);
1871 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1872 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1876 font_parse_family_registry (family
, registry
, font_spec
)
1877 Lisp_Object family
, registry
, font_spec
;
1883 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1885 CHECK_STRING (family
);
1886 len
= SBYTES (family
);
1887 p0
= (char *) SDATA (family
);
1888 p1
= index (p0
, '-');
1891 if ((*p0
!= '*' && p1
- p0
> 0)
1892 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1893 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1896 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1899 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1901 if (! NILP (registry
))
1903 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1904 CHECK_STRING (registry
);
1905 len
= SBYTES (registry
);
1906 p0
= (char *) SDATA (registry
);
1907 p1
= index (p0
, '-');
1910 if (SDATA (registry
)[len
- 1] == '*')
1911 registry
= concat2 (registry
, build_string ("-*"));
1913 registry
= concat2 (registry
, build_string ("*-*"));
1915 registry
= Fdowncase (registry
);
1916 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1921 /* This part (through the next ^L) is still experimental and not
1922 tested much. We may drastically change codes. */
1928 #define LGSTRING_HEADER_SIZE 6
1929 #define LGSTRING_GLYPH_SIZE 8
1932 check_gstring (gstring
)
1933 Lisp_Object gstring
;
1938 CHECK_VECTOR (gstring
);
1939 val
= AREF (gstring
, 0);
1941 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1943 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1944 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1945 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1946 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1947 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1948 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1949 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1950 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1951 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1952 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1953 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1955 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1957 val
= LGSTRING_GLYPH (gstring
, i
);
1959 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1961 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1963 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1964 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1965 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1966 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1967 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1968 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1969 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1970 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1972 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1974 if (ASIZE (val
) < 3)
1976 for (j
= 0; j
< 3; j
++)
1977 CHECK_NUMBER (AREF (val
, j
));
1982 error ("Invalid glyph-string format");
1987 check_otf_features (otf_features
)
1988 Lisp_Object otf_features
;
1992 CHECK_CONS (otf_features
);
1993 CHECK_SYMBOL (XCAR (otf_features
));
1994 otf_features
= XCDR (otf_features
);
1995 CHECK_CONS (otf_features
);
1996 CHECK_SYMBOL (XCAR (otf_features
));
1997 otf_features
= XCDR (otf_features
);
1998 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
2000 CHECK_SYMBOL (Fcar (val
));
2001 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
2002 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
2004 otf_features
= XCDR (otf_features
);
2005 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
2007 CHECK_SYMBOL (Fcar (val
));
2008 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
2009 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
2016 Lisp_Object otf_list
;
2019 otf_tag_symbol (tag
)
2024 OTF_tag_name (tag
, name
);
2025 return Fintern (make_unibyte_string (name
, 4), Qnil
);
2032 Lisp_Object val
= Fassoc (file
, otf_list
);
2036 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
2039 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
2040 val
= make_save_value (otf
, 0);
2041 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
2047 /* Return a list describing which scripts/languages FONT supports by
2048 which GSUB/GPOS features of OpenType tables. See the comment of
2049 (struct font_driver).otf_capability. */
2052 font_otf_capability (font
)
2056 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
2059 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
2062 for (i
= 0; i
< 2; i
++)
2064 OTF_GSUB_GPOS
*gsub_gpos
;
2065 Lisp_Object script_list
= Qnil
;
2068 if (OTF_get_features (otf
, i
== 0) < 0)
2070 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2071 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2073 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2074 Lisp_Object langsys_list
= Qnil
;
2075 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2078 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2080 OTF_LangSys
*langsys
;
2081 Lisp_Object feature_list
= Qnil
;
2082 Lisp_Object langsys_tag
;
2085 if (k
== script
->LangSysCount
)
2087 langsys
= &script
->DefaultLangSys
;
2092 langsys
= script
->LangSys
+ k
;
2094 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2096 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2098 OTF_Feature
*feature
2099 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2100 Lisp_Object feature_tag
2101 = otf_tag_symbol (feature
->FeatureTag
);
2103 feature_list
= Fcons (feature_tag
, feature_list
);
2105 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2108 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2113 XSETCAR (capability
, script_list
);
2115 XSETCDR (capability
, script_list
);
2121 /* Parse OTF features in SPEC and write a proper features spec string
2122 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2123 assured that the sufficient memory has already allocated for
2127 generate_otf_features (spec
, features
)
2137 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2143 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2148 else if (! asterisk
)
2150 val
= SYMBOL_NAME (val
);
2151 p
+= sprintf (p
, "%s", SDATA (val
));
2155 val
= SYMBOL_NAME (val
);
2156 p
+= sprintf (p
, "~%s", SDATA (val
));
2160 error ("OTF spec too long");
2164 font_otf_DeviceTable (device_table
)
2165 OTF_DeviceTable
*device_table
;
2167 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2169 return Fcons (make_number (len
),
2170 make_unibyte_string (device_table
->DeltaValue
, len
));
2174 font_otf_ValueRecord (value_format
, value_record
)
2176 OTF_ValueRecord
*value_record
;
2178 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2180 if (value_format
& OTF_XPlacement
)
2181 ASET (val
, 0, make_number (value_record
->XPlacement
));
2182 if (value_format
& OTF_YPlacement
)
2183 ASET (val
, 1, make_number (value_record
->YPlacement
));
2184 if (value_format
& OTF_XAdvance
)
2185 ASET (val
, 2, make_number (value_record
->XAdvance
));
2186 if (value_format
& OTF_YAdvance
)
2187 ASET (val
, 3, make_number (value_record
->YAdvance
));
2188 if (value_format
& OTF_XPlaDevice
)
2189 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2190 if (value_format
& OTF_YPlaDevice
)
2191 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2192 if (value_format
& OTF_XAdvDevice
)
2193 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2194 if (value_format
& OTF_YAdvDevice
)
2195 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2200 font_otf_Anchor (anchor
)
2205 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2206 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2207 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2208 if (anchor
->AnchorFormat
== 2)
2209 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2212 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2213 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2217 #endif /* HAVE_LIBOTF */
2223 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2224 static int font_compare
P_ ((const void *, const void *));
2225 static Lisp_Object font_sort_entities
P_ ((Lisp_Object
, Lisp_Object
,
2228 /* Return a rescaling ratio of FONT_ENTITY. */
2229 extern Lisp_Object Vface_font_rescale_alist
;
2232 font_rescale_ratio (font_entity
)
2233 Lisp_Object font_entity
;
2235 Lisp_Object tail
, elt
;
2236 Lisp_Object name
= Qnil
;
2238 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2241 if (FLOATP (XCDR (elt
)))
2243 if (STRINGP (XCAR (elt
)))
2246 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2247 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2248 return XFLOAT_DATA (XCDR (elt
));
2250 else if (FONT_SPEC_P (XCAR (elt
)))
2252 if (font_match_p (XCAR (elt
), font_entity
))
2253 return XFLOAT_DATA (XCDR (elt
));
2260 /* We sort fonts by scoring each of them against a specified
2261 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2262 the value is, the closer the font is to the font-spec.
2264 The lowest 2 bits of the score is used for driver type. The font
2265 available by the most preferred font driver is 0.
2267 Each 7-bit in the higher 28 bits are used for numeric properties
2268 WEIGHT, SLANT, WIDTH, and SIZE. */
2270 /* How many bits to shift to store the difference value of each font
2271 property in a score. Note that flots for FONT_TYPE_INDEX and
2272 FONT_REGISTRY_INDEX are not used. */
2273 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2275 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2276 The return value indicates how different ENTITY is compared with
2280 font_score (entity
, spec_prop
)
2281 Lisp_Object entity
, *spec_prop
;
2286 /* Score three style numeric fields. Maximum difference is 127. */
2287 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2288 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2290 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2295 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2298 /* Score the size. Maximum difference is 127. */
2299 i
= FONT_SIZE_INDEX
;
2300 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2301 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2303 /* We use the higher 6-bit for the actual size difference. The
2304 lowest bit is set if the DPI is different. */
2306 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2308 if (CONSP (Vface_font_rescale_alist
))
2309 pixel_size
*= font_rescale_ratio (entity
);
2310 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2314 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2315 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2317 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2318 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2320 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2327 /* Concatenate all elements of LIST into one vector. LIST is a list
2328 of font-entity vectors. */
2331 font_vconcat_entity_vectors (Lisp_Object list
)
2333 int nargs
= XINT (Flength (list
));
2334 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2337 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2338 args
[i
] = XCAR (list
);
2339 return Fvconcat (nargs
, args
);
2343 /* The structure for elements being sorted by qsort. */
2344 struct font_sort_data
2347 int font_driver_preference
;
2352 /* The comparison function for qsort. */
2355 font_compare (d1
, d2
)
2356 const void *d1
, *d2
;
2358 const struct font_sort_data
*data1
= d1
;
2359 const struct font_sort_data
*data2
= d2
;
2361 if (data1
->score
< data2
->score
)
2363 else if (data1
->score
> data2
->score
)
2365 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2369 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2370 If PREFER specifies a point-size, calculate the corresponding
2371 pixel-size from QCdpi property of PREFER or from the Y-resolution
2372 of FRAME before sorting.
2374 If BEST-ONLY is nonzero, return the best matching entity (that
2375 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2376 if BEST-ONLY is negative). Otherwise, return the sorted result as
2377 a single vector of font-entities.
2379 This function does no optimization for the case that the total
2380 number of elements is 1. The caller should avoid calling this in
2384 font_sort_entities (list
, prefer
, frame
, best_only
)
2385 Lisp_Object list
, prefer
, frame
;
2388 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2390 struct font_sort_data
*data
;
2391 unsigned best_score
;
2392 Lisp_Object best_entity
;
2393 struct frame
*f
= XFRAME (frame
);
2394 Lisp_Object tail
, vec
;
2397 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2398 prefer_prop
[i
] = AREF (prefer
, i
);
2399 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2400 prefer_prop
[FONT_SIZE_INDEX
]
2401 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2403 if (NILP (XCDR (list
)))
2405 /* What we have to take care of is this single vector. */
2407 maxlen
= ASIZE (vec
);
2411 /* We don't have to perform sort, so there's no need of creating
2412 a single vector. But, we must find the length of the longest
2415 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2416 if (maxlen
< ASIZE (XCAR (tail
)))
2417 maxlen
= ASIZE (XCAR (tail
));
2421 /* We have to create a single vector to sort it. */
2422 vec
= font_vconcat_entity_vectors (list
);
2423 maxlen
= ASIZE (vec
);
2426 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2427 best_score
= 0xFFFFFFFF;
2430 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2432 int font_driver_preference
= 0;
2433 Lisp_Object current_font_driver
;
2439 /* We are sure that the length of VEC > 0. */
2440 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2441 /* Score the elements. */
2442 for (i
= 0; i
< len
; i
++)
2444 data
[i
].entity
= AREF (vec
, i
);
2446 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2448 ? font_score (data
[i
].entity
, prefer_prop
)
2450 if (best_only
&& best_score
> data
[i
].score
)
2452 best_score
= data
[i
].score
;
2453 best_entity
= data
[i
].entity
;
2454 if (best_score
== 0)
2457 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2459 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2460 font_driver_preference
++;
2462 data
[i
].font_driver_preference
= font_driver_preference
;
2465 /* Sort if necessary. */
2468 qsort (data
, len
, sizeof *data
, font_compare
);
2469 for (i
= 0; i
< len
; i
++)
2470 ASET (vec
, i
, data
[i
].entity
);
2479 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2484 /* API of Font Service Layer. */
2486 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2487 sort_shift_bits. Finternal_set_font_selection_order calls this
2488 function with font_sort_order after setting up it. */
2491 font_update_sort_order (order
)
2496 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2498 int xlfd_idx
= order
[i
];
2500 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2501 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2502 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2503 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2504 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2505 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2507 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2512 font_check_otf_features (script
, langsys
, features
, table
)
2513 Lisp_Object script
, langsys
, features
, table
;
2518 table
= assq_no_quit (script
, table
);
2521 table
= XCDR (table
);
2522 if (! NILP (langsys
))
2524 table
= assq_no_quit (langsys
, table
);
2530 val
= assq_no_quit (Qnil
, table
);
2532 table
= XCAR (table
);
2536 table
= XCDR (table
);
2537 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2539 if (NILP (XCAR (features
)))
2544 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2550 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2553 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2555 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2557 script
= XCAR (spec
);
2561 langsys
= XCAR (spec
);
2572 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2573 XCAR (otf_capability
)))
2575 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2576 XCDR (otf_capability
)))
2583 /* Check if FONT (font-entity or font-object) matches with the font
2584 specification SPEC. */
2587 font_match_p (spec
, font
)
2588 Lisp_Object spec
, font
;
2590 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2591 Lisp_Object extra
, font_extra
;
2594 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2595 if (! NILP (AREF (spec
, i
))
2596 && ! NILP (AREF (font
, i
))
2597 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2599 props
= XFONT_SPEC (spec
)->props
;
2600 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2602 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2603 prop
[i
] = AREF (spec
, i
);
2604 prop
[FONT_SIZE_INDEX
]
2605 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2609 if (font_score (font
, props
) > 0)
2611 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2612 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2613 for (; CONSP (extra
); extra
= XCDR (extra
))
2615 Lisp_Object key
= XCAR (XCAR (extra
));
2616 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2618 if (EQ (key
, QClang
))
2620 val2
= assq_no_quit (key
, font_extra
);
2629 if (NILP (Fmemq (val
, val2
)))
2634 ? NILP (Fmemq (val
, XCDR (val2
)))
2638 else if (EQ (key
, QCscript
))
2640 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2646 /* All characters in the list must be supported. */
2647 for (; CONSP (val2
); val2
= XCDR (val2
))
2649 if (! NATNUMP (XCAR (val2
)))
2651 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2652 == FONT_INVALID_CODE
)
2656 else if (VECTORP (val2
))
2658 /* At most one character in the vector must be supported. */
2659 for (i
= 0; i
< ASIZE (val2
); i
++)
2661 if (! NATNUMP (AREF (val2
, i
)))
2663 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2664 != FONT_INVALID_CODE
)
2667 if (i
== ASIZE (val2
))
2672 else if (EQ (key
, QCotf
))
2676 if (! FONT_OBJECT_P (font
))
2678 fontp
= XFONT_OBJECT (font
);
2679 if (! fontp
->driver
->otf_capability
)
2681 val2
= fontp
->driver
->otf_capability (fontp
);
2682 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2693 Each font backend has the callback function get_cache, and it
2694 returns a cons cell of which cdr part can be freely used for
2695 caching fonts. The cons cell may be shared by multiple frames
2696 and/or multiple font drivers. So, we arrange the cdr part as this:
2698 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2700 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2701 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2702 cons (FONT-SPEC FONT-ENTITY ...). */
2704 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2705 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2706 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2707 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2708 struct font_driver
*));
2711 font_prepare_cache (f
, driver
)
2713 struct font_driver
*driver
;
2715 Lisp_Object cache
, val
;
2717 cache
= driver
->get_cache (f
);
2719 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2723 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2724 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2728 val
= XCDR (XCAR (val
));
2729 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2735 font_finish_cache (f
, driver
)
2737 struct font_driver
*driver
;
2739 Lisp_Object cache
, val
, tmp
;
2742 cache
= driver
->get_cache (f
);
2744 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2745 cache
= val
, val
= XCDR (val
);
2746 font_assert (! NILP (val
));
2747 tmp
= XCDR (XCAR (val
));
2748 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2749 if (XINT (XCAR (tmp
)) == 0)
2751 font_clear_cache (f
, XCAR (val
), driver
);
2752 XSETCDR (cache
, XCDR (val
));
2758 font_get_cache (f
, driver
)
2760 struct font_driver
*driver
;
2762 Lisp_Object val
= driver
->get_cache (f
);
2763 Lisp_Object type
= driver
->type
;
2765 font_assert (CONSP (val
));
2766 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2767 font_assert (CONSP (val
));
2768 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2769 val
= XCDR (XCAR (val
));
2773 static int num_fonts
;
2776 font_clear_cache (f
, cache
, driver
)
2779 struct font_driver
*driver
;
2781 Lisp_Object tail
, elt
;
2782 Lisp_Object tail2
, entity
;
2784 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2785 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2788 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2789 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2791 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2793 entity
= XCAR (tail2
);
2795 if (FONT_ENTITY_P (entity
)
2796 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2798 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2800 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2802 Lisp_Object val
= XCAR (objlist
);
2803 struct font
*font
= XFONT_OBJECT (val
);
2805 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2807 font_assert (font
&& driver
== font
->driver
);
2808 driver
->close (f
, font
);
2812 if (driver
->free_entity
)
2813 driver
->free_entity (entity
);
2818 XSETCDR (cache
, Qnil
);
2822 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2825 font_delete_unmatched (vec
, spec
, size
)
2826 Lisp_Object vec
, spec
;
2829 Lisp_Object entity
, val
;
2830 enum font_property_index prop
;
2833 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2835 entity
= AREF (vec
, i
);
2836 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2837 if (INTEGERP (AREF (spec
, prop
))
2838 && ((XINT (AREF (spec
, prop
)) >> 8)
2839 != (XINT (AREF (entity
, prop
)) >> 8)))
2840 prop
= FONT_SPEC_MAX
;
2841 if (prop
< FONT_SPEC_MAX
2843 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2845 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2848 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2849 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2850 prop
= FONT_SPEC_MAX
;
2852 if (prop
< FONT_SPEC_MAX
2853 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2854 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2855 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2856 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2857 prop
= FONT_SPEC_MAX
;
2858 if (prop
< FONT_SPEC_MAX
2859 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2860 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2861 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2862 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2863 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2864 prop
= FONT_SPEC_MAX
;
2865 if (prop
< FONT_SPEC_MAX
)
2866 val
= Fcons (entity
, val
);
2868 return (Fvconcat (1, &val
));
2872 /* Return a list of vectors of font-entities matching with SPEC on
2873 FRAME. Each elements in the list is a vector of entities from the
2874 same font-driver. */
2877 font_list_entities (frame
, spec
)
2878 Lisp_Object frame
, spec
;
2880 FRAME_PTR f
= XFRAME (frame
);
2881 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2882 Lisp_Object ftype
, val
;
2883 Lisp_Object list
= Qnil
;
2885 int need_filtering
= 0;
2888 font_assert (FONT_SPEC_P (spec
));
2890 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2891 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2892 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2893 size
= font_pixel_size (f
, spec
);
2897 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2898 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2899 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2900 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2902 ASET (scratch_font_spec
, i
, Qnil
);
2903 if (! NILP (AREF (spec
, i
)))
2905 if (i
== FONT_DPI_INDEX
)
2906 /* Skip FONT_SPACING_INDEX */
2909 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2910 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2912 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2914 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2916 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2918 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2919 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2926 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2930 val
= Fvconcat (1, &val
);
2931 copy
= Fcopy_font_spec (scratch_font_spec
);
2932 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2933 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2935 if (ASIZE (val
) > 0 && need_filtering
)
2936 val
= font_delete_unmatched (val
, spec
, size
);
2937 if (ASIZE (val
) > 0)
2938 list
= Fcons (val
, list
);
2941 list
= Fnreverse (list
);
2942 FONT_ADD_LOG ("list", spec
, list
);
2947 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2948 nil, is an array of face's attributes, which specifies preferred
2949 font-related attributes. */
2952 font_matching_entity (f
, attrs
, spec
)
2954 Lisp_Object
*attrs
, spec
;
2956 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2957 Lisp_Object ftype
, size
, entity
;
2959 Lisp_Object work
= Fcopy_font_spec (spec
);
2961 XSETFRAME (frame
, f
);
2962 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2963 size
= AREF (spec
, FONT_SIZE_INDEX
);
2966 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2967 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2968 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2969 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2972 for (; driver_list
; driver_list
= driver_list
->next
)
2974 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2976 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2979 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2980 entity
= assoc_no_quit (work
, XCDR (cache
));
2982 entity
= XCDR (entity
);
2985 entity
= driver_list
->driver
->match (frame
, work
);
2986 copy
= Fcopy_font_spec (work
);
2987 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2988 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2990 if (! NILP (entity
))
2993 FONT_ADD_LOG ("match", work
, entity
);
2998 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2999 opened font object. */
3002 font_open_entity (f
, entity
, pixel_size
)
3007 struct font_driver_list
*driver_list
;
3008 Lisp_Object objlist
, size
, val
, font_object
;
3010 int min_width
, height
;
3011 int scaled_pixel_size
;
3013 font_assert (FONT_ENTITY_P (entity
));
3014 size
= AREF (entity
, FONT_SIZE_INDEX
);
3015 if (XINT (size
) != 0)
3016 scaled_pixel_size
= pixel_size
= XINT (size
);
3017 else if (CONSP (Vface_font_rescale_alist
))
3018 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
3020 val
= AREF (entity
, FONT_TYPE_INDEX
);
3021 for (driver_list
= f
->font_driver_list
;
3022 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
3023 driver_list
= driver_list
->next
);
3027 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
3028 objlist
= XCDR (objlist
))
3030 Lisp_Object fn
= XCAR (objlist
);
3031 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
3032 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
3034 if (driver_list
->driver
->cached_font_ok
== NULL
3035 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
3040 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
3041 if (!NILP (font_object
))
3042 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3043 FONT_ADD_LOG ("open", entity
, font_object
);
3044 if (NILP (font_object
))
3046 ASET (entity
, FONT_OBJLIST_INDEX
,
3047 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
3048 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
3051 font
= XFONT_OBJECT (font_object
);
3052 min_width
= (font
->min_width
? font
->min_width
3053 : font
->average_width
? font
->average_width
3054 : font
->space_width
? font
->space_width
3056 height
= (font
->height
? font
->height
: 1);
3057 #ifdef HAVE_WINDOW_SYSTEM
3058 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
3059 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
3061 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
3062 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
3063 fonts_changed_p
= 1;
3067 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
3068 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
3069 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
3070 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
3078 /* Close FONT_OBJECT that is opened on frame F. */
3081 font_close_object (f
, font_object
)
3083 Lisp_Object font_object
;
3085 struct font
*font
= XFONT_OBJECT (font_object
);
3087 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
3088 /* Already closed. */
3090 FONT_ADD_LOG ("close", font_object
, Qnil
);
3091 font
->driver
->close (f
, font
);
3092 #ifdef HAVE_WINDOW_SYSTEM
3093 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
3094 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
3100 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
3101 FONT is a font-entity and it must be opened to check. */
3104 font_has_char (f
, font
, c
)
3111 if (FONT_ENTITY_P (font
))
3113 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
3114 struct font_driver_list
*driver_list
;
3116 for (driver_list
= f
->font_driver_list
;
3117 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
3118 driver_list
= driver_list
->next
);
3121 if (! driver_list
->driver
->has_char
)
3123 return driver_list
->driver
->has_char (font
, c
);
3126 font_assert (FONT_OBJECT_P (font
));
3127 fontp
= XFONT_OBJECT (font
);
3128 if (fontp
->driver
->has_char
)
3130 int result
= fontp
->driver
->has_char (font
, c
);
3135 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
3139 /* Return the glyph ID of FONT_OBJECT for character C. */
3142 font_encode_char (font_object
, c
)
3143 Lisp_Object font_object
;
3148 font_assert (FONT_OBJECT_P (font_object
));
3149 font
= XFONT_OBJECT (font_object
);
3150 return font
->driver
->encode_char (font
, c
);
3154 /* Return the name of FONT_OBJECT. */
3157 font_get_name (font_object
)
3158 Lisp_Object font_object
;
3160 font_assert (FONT_OBJECT_P (font_object
));
3161 return AREF (font_object
, FONT_NAME_INDEX
);
3165 /* Return the specification of FONT_OBJECT. */
3168 font_get_spec (font_object
)
3169 Lisp_Object font_object
;
3171 Lisp_Object spec
= font_make_spec ();
3174 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
3175 ASET (spec
, i
, AREF (font_object
, i
));
3176 ASET (spec
, FONT_SIZE_INDEX
,
3177 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
3182 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3183 could not be parsed by font_parse_name, return Qnil. */
3186 font_spec_from_name (font_name
)
3187 Lisp_Object font_name
;
3189 Lisp_Object spec
= Ffont_spec (0, NULL
);
3191 CHECK_STRING (font_name
);
3192 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3194 font_put_extra (spec
, QCname
, font_name
);
3195 font_put_extra (spec
, QCuser_spec
, font_name
);
3201 font_clear_prop (attrs
, prop
)
3203 enum font_property_index prop
;
3205 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3210 if (! NILP (Ffont_get (font
, QCname
)))
3212 font
= Fcopy_font_spec (font
);
3213 font_put_extra (font
, QCname
, Qnil
);
3216 if (NILP (AREF (font
, prop
))
3217 && prop
!= FONT_FAMILY_INDEX
3218 && prop
!= FONT_FOUNDRY_INDEX
3219 && prop
!= FONT_WIDTH_INDEX
3220 && prop
!= FONT_SIZE_INDEX
)
3222 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3223 font
= Fcopy_font_spec (font
);
3224 ASET (font
, prop
, Qnil
);
3225 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3227 if (prop
== FONT_FAMILY_INDEX
)
3229 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3230 /* If we are setting the font family, we must also clear
3231 FONT_WIDTH_INDEX to avoid rejecting families that lack
3232 support for some widths. */
3233 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3235 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3236 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3237 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3238 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3239 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3240 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3242 else if (prop
== FONT_SIZE_INDEX
)
3244 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3245 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3246 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3248 else if (prop
== FONT_WIDTH_INDEX
)
3249 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3250 attrs
[LFACE_FONT_INDEX
] = font
;
3254 font_update_lface (f
, attrs
)
3260 spec
= attrs
[LFACE_FONT_INDEX
];
3261 if (! FONT_SPEC_P (spec
))
3264 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3265 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3266 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3267 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3268 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3269 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3270 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3271 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);
3272 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3273 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3274 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3278 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3283 val
= Ffont_get (spec
, QCdpi
);
3286 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3288 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3290 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3292 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3293 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3299 /* Selecte a font from ENTITIES (list of font-entity vectors) that
3300 supports C and matches best with ATTRS and PIXEL_SIZE. */
3303 font_select_entity (frame
, entities
, attrs
, pixel_size
, c
)
3304 Lisp_Object frame
, entities
, *attrs
;
3307 Lisp_Object font_entity
;
3310 FRAME_PTR f
= XFRAME (frame
);
3312 if (NILP (XCDR (entities
))
3313 && ASIZE (XCAR (entities
)) == 1)
3315 font_entity
= AREF (XCAR (entities
), 0);
3317 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3322 /* Sort fonts by properties specified in ATTRS. */
3323 prefer
= scratch_font_prefer
;
3325 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3326 ASET (prefer
, i
, Qnil
);
3327 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3329 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3331 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3332 ASET (prefer
, i
, AREF (face_font
, i
));
3334 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3335 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3336 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3337 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3338 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3339 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3340 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3342 return font_sort_entities (entities
, prefer
, frame
, c
);
3345 /* Return a font-entity satisfying SPEC and best matching with face's
3346 font related attributes in ATTRS. C, if not negative, is a
3347 character that the entity must support. */
3350 font_find_for_lface (f
, attrs
, spec
, c
)
3357 Lisp_Object frame
, entities
, val
;
3358 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3362 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3363 if (NILP (registry
[0]))
3365 registry
[0] = DEFAULT_ENCODING
;
3366 registry
[1] = Qascii_0
;
3367 registry
[2] = null_vector
;
3370 registry
[1] = null_vector
;
3372 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3374 struct charset
*encoding
, *repertory
;
3376 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3377 &encoding
, &repertory
) < 0)
3380 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3382 else if (c
> encoding
->max_char
)
3386 work
= Fcopy_font_spec (spec
);
3387 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3388 XSETFRAME (frame
, f
);
3389 size
= AREF (spec
, FONT_SIZE_INDEX
);
3390 pixel_size
= font_pixel_size (f
, spec
);
3391 if (pixel_size
== 0)
3393 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3395 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3397 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3398 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3399 if (! NILP (foundry
[0]))
3400 foundry
[1] = null_vector
;
3401 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3403 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3404 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3406 foundry
[2] = null_vector
;
3409 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3411 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3412 if (! NILP (adstyle
[0]))
3413 adstyle
[1] = null_vector
;
3414 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3416 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3418 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3420 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3422 adstyle
[2] = null_vector
;
3425 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3428 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3431 val
= AREF (work
, FONT_FAMILY_INDEX
);
3432 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3434 val
= attrs
[LFACE_FAMILY_INDEX
];
3435 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3439 family
= alloca ((sizeof family
[0]) * 2);
3441 family
[1] = null_vector
; /* terminator. */
3446 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3447 /* Font family names are case-sensitive under NS. */
3455 if (! NILP (alters
))
3457 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3458 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3459 family
[i
] = XCAR (alters
);
3460 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3462 family
[i
] = null_vector
;
3466 family
= alloca ((sizeof family
[0]) * 3);
3469 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3471 family
[i
] = null_vector
;
3475 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3477 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3478 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3480 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3481 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3483 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3484 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3486 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3487 entities
= font_list_entities (frame
, work
);
3488 if (! NILP (entities
))
3490 val
= font_select_entity (frame
, entities
,
3491 attrs
, pixel_size
, c
);
3504 font_open_for_lface (f
, entity
, attrs
, spec
)
3512 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3513 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3514 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3515 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3516 size
= font_pixel_size (f
, spec
);
3520 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3521 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3524 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3525 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3526 if (INTEGERP (height
))
3529 abort(); /* We should never end up here. */
3533 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3537 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3538 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3542 return font_open_entity (f
, entity
, size
);
3546 /* Find a font satisfying SPEC and best matching with face's
3547 attributes in ATTRS on FRAME, and return the opened
3551 font_load_for_lface (f
, attrs
, spec
)
3553 Lisp_Object
*attrs
, spec
;
3555 Lisp_Object entity
, name
;
3557 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3560 /* No font is listed for SPEC, but each font-backend may have
3561 the different criteria about "font matching". So, try
3563 entity
= font_matching_entity (f
, attrs
, spec
);
3567 /* Don't loose the original name that was put in initially. We need
3568 it to re-apply the font when font parameters (like hinting or dpi) have
3570 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3573 name
= Ffont_get (spec
, QCuser_spec
);
3574 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3580 /* Make FACE on frame F ready to use the font opened for FACE. */
3583 font_prepare_for_face (f
, face
)
3587 if (face
->font
->driver
->prepare_face
)
3588 face
->font
->driver
->prepare_face (f
, face
);
3592 /* Make FACE on frame F stop using the font opened for FACE. */
3595 font_done_for_face (f
, face
)
3599 if (face
->font
->driver
->done_face
)
3600 face
->font
->driver
->done_face (f
, face
);
3605 /* Open a font matching with font-spec SPEC on frame F. If no proper
3606 font is found, return Qnil. */
3609 font_open_by_spec (f
, spec
)
3613 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3615 /* We set up the default font-related attributes of a face to prefer
3617 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3618 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3619 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3621 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3623 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3625 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3627 return font_load_for_lface (f
, attrs
, spec
);
3631 /* Open a font matching with NAME on frame F. If no proper font is
3632 found, return Qnil. */
3635 font_open_by_name (f
, name
)
3639 Lisp_Object args
[2];
3640 Lisp_Object spec
, ret
;
3643 args
[1] = make_unibyte_string (name
, strlen (name
));
3644 spec
= Ffont_spec (2, args
);
3645 ret
= font_open_by_spec (f
, spec
);
3646 /* Do not loose name originally put in. */
3648 font_put_extra (ret
, QCuser_spec
, args
[1]);
3654 /* Register font-driver DRIVER. This function is used in two ways.
3656 The first is with frame F non-NULL. In this case, make DRIVER
3657 available (but not yet activated) on F. All frame creaters
3658 (e.g. Fx_create_frame) must call this function at least once with
3659 an available font-driver.
3661 The second is with frame F NULL. In this case, DRIVER is globally
3662 registered in the variable `font_driver_list'. All font-driver
3663 implementations must call this function in its syms_of_XXXX
3664 (e.g. syms_of_xfont). */
3667 register_font_driver (driver
, f
)
3668 struct font_driver
*driver
;
3671 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3672 struct font_driver_list
*prev
, *list
;
3674 if (f
&& ! driver
->draw
)
3675 error ("Unusable font driver for a frame: %s",
3676 SDATA (SYMBOL_NAME (driver
->type
)));
3678 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3679 if (EQ (list
->driver
->type
, driver
->type
))
3680 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3682 list
= xmalloc (sizeof (struct font_driver_list
));
3684 list
->driver
= driver
;
3689 f
->font_driver_list
= list
;
3691 font_driver_list
= list
;
3697 free_font_driver_list (f
)
3700 struct font_driver_list
*list
, *next
;
3702 for (list
= f
->font_driver_list
; list
; list
= next
)
3707 f
->font_driver_list
= NULL
;
3711 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3712 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3713 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3715 A caller must free all realized faces if any in advance. The
3716 return value is a list of font backends actually made used on
3720 font_update_drivers (f
, new_drivers
)
3722 Lisp_Object new_drivers
;
3724 Lisp_Object active_drivers
= Qnil
;
3725 struct font_driver
*driver
;
3726 struct font_driver_list
*list
;
3728 /* At first, turn off non-requested drivers, and turn on requested
3730 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3732 driver
= list
->driver
;
3733 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3738 if (driver
->end_for_frame
)
3739 driver
->end_for_frame (f
);
3740 font_finish_cache (f
, driver
);
3745 if (! driver
->start_for_frame
3746 || driver
->start_for_frame (f
) == 0)
3748 font_prepare_cache (f
, driver
);
3755 if (NILP (new_drivers
))
3758 if (! EQ (new_drivers
, Qt
))
3760 /* Re-order the driver list according to new_drivers. */
3761 struct font_driver_list
**list_table
, **next
;
3765 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3766 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3768 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3769 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3772 list_table
[i
++] = list
;
3774 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3776 list_table
[i
++] = list
;
3777 list_table
[i
] = NULL
;
3779 next
= &f
->font_driver_list
;
3780 for (i
= 0; list_table
[i
]; i
++)
3782 *next
= list_table
[i
];
3783 next
= &(*next
)->next
;
3787 if (! f
->font_driver_list
->on
)
3788 { /* None of the drivers is enabled: enable them all.
3789 Happens if you set the list of drivers to (xft x) in your .emacs
3790 and then use it under w32 or ns. */
3791 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3793 struct font_driver
*driver
= list
->driver
;
3794 eassert (! list
->on
);
3795 if (! driver
->start_for_frame
3796 || driver
->start_for_frame (f
) == 0)
3798 font_prepare_cache (f
, driver
);
3805 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3807 active_drivers
= nconc2 (active_drivers
,
3808 Fcons (list
->driver
->type
, Qnil
));
3809 return active_drivers
;
3813 font_put_frame_data (f
, driver
, data
)
3815 struct font_driver
*driver
;
3818 struct font_data_list
*list
, *prev
;
3820 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3821 prev
= list
, list
= list
->next
)
3822 if (list
->driver
== driver
)
3829 prev
->next
= list
->next
;
3831 f
->font_data_list
= list
->next
;
3839 list
= xmalloc (sizeof (struct font_data_list
));
3840 list
->driver
= driver
;
3841 list
->next
= f
->font_data_list
;
3842 f
->font_data_list
= list
;
3850 font_get_frame_data (f
, driver
)
3852 struct font_driver
*driver
;
3854 struct font_data_list
*list
;
3856 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3857 if (list
->driver
== driver
)
3865 /* Return the font used to draw character C by FACE at buffer position
3866 POS in window W. If STRING is non-nil, it is a string containing C
3867 at index POS. If C is negative, get C from the current buffer or
3871 font_at (c
, pos
, face
, w
, string
)
3880 Lisp_Object font_object
;
3882 multibyte
= (NILP (string
)
3883 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3884 : STRING_MULTIBYTE (string
));
3891 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3893 c
= FETCH_CHAR (pos_byte
);
3896 c
= FETCH_BYTE (pos
);
3902 multibyte
= STRING_MULTIBYTE (string
);
3905 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3907 str
= SDATA (string
) + pos_byte
;
3908 c
= STRING_CHAR (str
);
3911 c
= SDATA (string
)[pos
];
3915 f
= XFRAME (w
->frame
);
3916 if (! FRAME_WINDOW_P (f
))
3923 if (STRINGP (string
))
3924 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3925 DEFAULT_FACE_ID
, 0);
3927 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3929 face
= FACE_FROM_ID (f
, face_id
);
3933 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3934 face
= FACE_FROM_ID (f
, face_id
);
3939 XSETFONT (font_object
, face
->font
);
3944 #ifdef HAVE_WINDOW_SYSTEM
3946 /* Check how many characters after POS (at most to *LIMIT) can be
3947 displayed by the same font on the window W. FACE, if non-NULL, is
3948 the face selected for the character at POS. If STRING is not nil,
3949 it is the string to check instead of the current buffer. In that
3950 case, FACE must be not NULL.
3952 The return value is the font-object for the character at POS.
3953 *LIMIT is set to the position where that font can't be used.
3955 It is assured that the current buffer (or STRING) is multibyte. */
3958 font_range (pos
, limit
, w
, face
, string
)
3959 EMACS_INT pos
, *limit
;
3964 EMACS_INT pos_byte
, ignore
;
3966 Lisp_Object font_object
= Qnil
;
3970 pos_byte
= CHAR_TO_BYTE (pos
);
3975 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3977 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3983 pos_byte
= string_char_to_byte (string
, pos
);
3986 while (pos
< *limit
)
3988 Lisp_Object category
;
3991 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3993 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3994 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3995 if (EQ (category
, QCf
)
3996 || CHAR_VARIATION_SELECTOR_P (c
))
3998 if (NILP (font_object
))
4000 font_object
= font_for_char (face
, c
, pos
- 1, string
);
4001 if (NILP (font_object
))
4005 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
4015 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
4016 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
4017 Return nil otherwise.
4018 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
4019 which kind of font it is. It must be one of `font-spec', `font-entity',
4021 (object
, extra_type
)
4022 Lisp_Object object
, extra_type
;
4024 if (NILP (extra_type
))
4025 return (FONTP (object
) ? Qt
: Qnil
);
4026 if (EQ (extra_type
, Qfont_spec
))
4027 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
4028 if (EQ (extra_type
, Qfont_entity
))
4029 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
4030 if (EQ (extra_type
, Qfont_object
))
4031 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
4032 wrong_type_argument (intern ("font-extra-type"), extra_type
);
4035 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
4036 doc
: /* Return a newly created font-spec with arguments as properties.
4038 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
4039 valid font property name listed below:
4041 `:family', `:weight', `:slant', `:width'
4043 They are the same as face attributes of the same name. See
4044 `set-face-attribute'.
4048 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
4052 VALUE must be a string or a symbol specifying the additional
4053 typographic style information of a font, e.g. ``sans''.
4057 VALUE must be a string or a symbol specifying the charset registry and
4058 encoding of a font, e.g. ``iso8859-1''.
4062 VALUE must be a non-negative integer or a floating point number
4063 specifying the font size. It specifies the font size in pixels (if
4064 VALUE is an integer), or in points (if VALUE is a float).
4068 VALUE must be a string of XLFD-style or fontconfig-style font name.
4072 VALUE must be a symbol representing a script that the font must
4073 support. It may be a symbol representing a subgroup of a script
4074 listed in the variable `script-representative-chars'.
4078 VALUE must be a symbol of two-letter ISO-639 language names,
4083 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
4084 required OpenType features.
4086 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
4087 LANGSYS-TAG: OpenType language system tag symbol,
4088 or nil for the default language system.
4089 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
4090 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
4092 GSUB and GPOS may contain `nil' element. In such a case, the font
4093 must not have any of the remaining elements.
4095 For instance, if the VALUE is `(thai nil nil (mark))', the font must
4096 be an OpenType font, and whose GPOS table of `thai' script's default
4097 language system must contain `mark' feature.
4099 usage: (font-spec ARGS...) */)
4104 Lisp_Object spec
= font_make_spec ();
4107 for (i
= 0; i
< nargs
; i
+= 2)
4109 Lisp_Object key
= args
[i
], val
;
4113 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
4116 if (EQ (key
, QCname
))
4119 font_parse_name ((char *) SDATA (val
), spec
);
4120 font_put_extra (spec
, key
, val
);
4124 int idx
= get_font_prop_index (key
);
4128 val
= font_prop_validate (idx
, Qnil
, val
);
4129 if (idx
< FONT_EXTRA_INDEX
)
4130 ASET (spec
, idx
, val
);
4132 font_put_extra (spec
, key
, val
);
4135 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
4141 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
4142 doc
: /* Return a copy of FONT as a font-spec. */)
4146 Lisp_Object new_spec
, tail
, prev
, extra
;
4150 new_spec
= font_make_spec ();
4151 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
4152 ASET (new_spec
, i
, AREF (font
, i
));
4153 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
4154 /* We must remove :font-entity property. */
4155 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
4156 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
4159 extra
= XCDR (extra
);
4161 XSETCDR (prev
, XCDR (tail
));
4164 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
4168 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
4169 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
4170 Every specified properties in FROM override the corresponding
4171 properties in TO. */)
4173 Lisp_Object from
, to
;
4175 Lisp_Object extra
, tail
;
4180 to
= Fcopy_font_spec (to
);
4181 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
4182 ASET (to
, i
, AREF (from
, i
));
4183 extra
= AREF (to
, FONT_EXTRA_INDEX
);
4184 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
4185 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
4187 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
4190 XSETCDR (slot
, XCDR (XCAR (tail
)));
4192 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
4194 ASET (to
, FONT_EXTRA_INDEX
, extra
);
4198 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
4199 doc
: /* Return the value of FONT's property KEY.
4200 FONT is a font-spec, a font-entity, or a font-object.
4201 KEY must be one of these symbols:
4202 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4203 :size, :name, :script
4204 See the documentation of `font-spec' for their meanings.
4205 If FONT is a font-entity or font-object, the value of :script may be
4206 a list of scripts that are supported by the font. */)
4208 Lisp_Object font
, key
;
4215 idx
= get_font_prop_index (key
);
4216 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4217 return font_style_symbolic (font
, idx
, 0);
4218 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4219 return AREF (font
, idx
);
4220 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
4223 #ifdef HAVE_WINDOW_SYSTEM
4225 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4226 doc
: /* Return a plist of face attributes generated by FONT.
4227 FONT is a font name, a font-spec, a font-entity, or a font-object.
4228 The return value is a list of the form
4230 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4232 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4233 compatible with `set-face-attribute'. Some of these key-attribute pairs
4234 may be omitted from the list if they are not specified by FONT.
4236 The optional argument FRAME specifies the frame that the face attributes
4237 are to be displayed on. If omitted, the selected frame is used. */)
4239 Lisp_Object font
, frame
;
4242 Lisp_Object plist
[10];
4247 frame
= selected_frame
;
4248 CHECK_LIVE_FRAME (frame
);
4253 int fontset
= fs_query_fontset (font
, 0);
4254 Lisp_Object name
= font
;
4256 font
= fontset_ascii (fontset
);
4257 font
= font_spec_from_name (name
);
4259 signal_error ("Invalid font name", name
);
4261 else if (! FONTP (font
))
4262 signal_error ("Invalid font object", font
);
4264 val
= AREF (font
, FONT_FAMILY_INDEX
);
4267 plist
[n
++] = QCfamily
;
4268 plist
[n
++] = SYMBOL_NAME (val
);
4271 val
= AREF (font
, FONT_SIZE_INDEX
);
4274 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4275 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4276 plist
[n
++] = QCheight
;
4277 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4279 else if (FLOATP (val
))
4281 plist
[n
++] = QCheight
;
4282 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4285 val
= FONT_WEIGHT_FOR_FACE (font
);
4288 plist
[n
++] = QCweight
;
4292 val
= FONT_SLANT_FOR_FACE (font
);
4295 plist
[n
++] = QCslant
;
4299 val
= FONT_WIDTH_FOR_FACE (font
);
4302 plist
[n
++] = QCwidth
;
4306 return Flist (n
, plist
);
4311 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4312 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
4313 (font_spec
, prop
, val
)
4314 Lisp_Object font_spec
, prop
, val
;
4318 CHECK_FONT_SPEC (font_spec
);
4319 idx
= get_font_prop_index (prop
);
4320 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4321 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
4323 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
4327 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4328 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4329 Optional 2nd argument FRAME specifies the target frame.
4330 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4331 Optional 4th argument PREFER, if non-nil, is a font-spec to
4332 control the order of the returned list. Fonts are sorted by
4333 how close they are to PREFER. */)
4334 (font_spec
, frame
, num
, prefer
)
4335 Lisp_Object font_spec
, frame
, num
, prefer
;
4337 Lisp_Object vec
, list
;
4341 frame
= selected_frame
;
4342 CHECK_LIVE_FRAME (frame
);
4343 CHECK_FONT_SPEC (font_spec
);
4351 if (! NILP (prefer
))
4352 CHECK_FONT_SPEC (prefer
);
4354 list
= font_list_entities (frame
, font_spec
);
4357 if (NILP (XCDR (list
))
4358 && ASIZE (XCAR (list
)) == 1)
4359 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4361 if (! NILP (prefer
))
4362 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4364 vec
= font_vconcat_entity_vectors (list
);
4365 if (n
== 0 || n
>= ASIZE (vec
))
4367 Lisp_Object args
[2];
4371 list
= Fappend (2, args
);
4375 for (list
= Qnil
, n
--; n
>= 0; n
--)
4376 list
= Fcons (AREF (vec
, n
), list
);
4381 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4382 doc
: /* List available font families on the current frame.
4383 Optional argument FRAME, if non-nil, specifies the target frame. */)
4388 struct font_driver_list
*driver_list
;
4392 frame
= selected_frame
;
4393 CHECK_LIVE_FRAME (frame
);
4396 for (driver_list
= f
->font_driver_list
; driver_list
;
4397 driver_list
= driver_list
->next
)
4398 if (driver_list
->driver
->list_family
)
4400 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4401 Lisp_Object tail
= list
;
4403 for (; CONSP (val
); val
= XCDR (val
))
4404 if (NILP (Fmemq (XCAR (val
), tail
))
4405 && SYMBOLP (XCAR (val
)))
4406 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4411 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4412 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4413 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4415 Lisp_Object font_spec
, frame
;
4417 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4424 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4425 doc
: /* Return XLFD name of FONT.
4426 FONT is a font-spec, font-entity, or font-object.
4427 If the name is too long for XLFD (maximum 255 chars), return nil.
4428 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4429 the consecutive wildcards are folded to one. */)
4430 (font
, fold_wildcards
)
4431 Lisp_Object font
, fold_wildcards
;
4438 if (FONT_OBJECT_P (font
))
4440 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4442 if (STRINGP (font_name
)
4443 && SDATA (font_name
)[0] == '-')
4445 if (NILP (fold_wildcards
))
4447 strcpy (name
, (char *) SDATA (font_name
));
4450 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4452 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4455 if (! NILP (fold_wildcards
))
4457 char *p0
= name
, *p1
;
4459 while ((p1
= strstr (p0
, "-*-*")))
4461 strcpy (p1
, p1
+ 2);
4466 return build_string (name
);
4469 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4470 doc
: /* Clear font cache. */)
4473 Lisp_Object list
, frame
;
4475 FOR_EACH_FRAME (list
, frame
)
4477 FRAME_PTR f
= XFRAME (frame
);
4478 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4480 for (; driver_list
; driver_list
= driver_list
->next
)
4481 if (driver_list
->on
)
4483 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4484 Lisp_Object val
, tmp
;
4488 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4490 font_assert (! NILP (val
));
4491 tmp
= XCDR (XCAR (val
));
4492 if (XINT (XCAR (tmp
)) == 0)
4494 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4495 XSETCDR (cache
, XCDR (val
));
4505 font_fill_lglyph_metrics (glyph
, font_object
)
4506 Lisp_Object glyph
, font_object
;
4508 struct font
*font
= XFONT_OBJECT (font_object
);
4510 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4511 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4512 struct font_metrics metrics
;
4514 LGLYPH_SET_CODE (glyph
, ecode
);
4516 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4517 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4518 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4519 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4520 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4521 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4525 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4526 doc
: /* Shape the glyph-string GSTRING.
4527 Shaping means substituting glyphs and/or adjusting positions of glyphs
4528 to get the correct visual image of character sequences set in the
4529 header of the glyph-string.
4531 If the shaping was successful, the value is GSTRING itself or a newly
4532 created glyph-string. Otherwise, the value is nil. */)
4534 Lisp_Object gstring
;
4537 Lisp_Object font_object
, n
, glyph
;
4540 if (! composition_gstring_p (gstring
))
4541 signal_error ("Invalid glyph-string: ", gstring
);
4542 if (! NILP (LGSTRING_ID (gstring
)))
4544 font_object
= LGSTRING_FONT (gstring
);
4545 CHECK_FONT_OBJECT (font_object
);
4546 font
= XFONT_OBJECT (font_object
);
4547 if (! font
->driver
->shape
)
4550 /* Try at most three times with larger gstring each time. */
4551 for (i
= 0; i
< 3; i
++)
4553 n
= font
->driver
->shape (gstring
);
4556 gstring
= larger_vector (gstring
,
4557 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4560 if (i
== 3 || XINT (n
) == 0)
4563 glyph
= LGSTRING_GLYPH (gstring
, 0);
4564 from
= LGLYPH_FROM (glyph
);
4565 to
= LGLYPH_TO (glyph
);
4566 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4568 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4572 if (NILP (LGLYPH_ADJUSTMENT (this)))
4577 glyph
= LGSTRING_GLYPH (gstring
, j
);
4578 LGLYPH_SET_FROM (glyph
, from
);
4579 LGLYPH_SET_TO (glyph
, to
);
4581 from
= LGLYPH_FROM (this);
4582 to
= LGLYPH_TO (this);
4587 if (from
> LGLYPH_FROM (this))
4588 from
= LGLYPH_FROM (this);
4589 if (to
< LGLYPH_TO (this))
4590 to
= LGLYPH_TO (this);
4596 glyph
= LGSTRING_GLYPH (gstring
, j
);
4597 LGLYPH_SET_FROM (glyph
, from
);
4598 LGLYPH_SET_TO (glyph
, to
);
4600 return composition_gstring_put_cache (gstring
, XINT (n
));
4603 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4605 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4606 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4608 VARIATION-SELECTOR is a chracter code of variation selection
4609 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4610 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4611 (font_object
, character
)
4612 Lisp_Object font_object
, character
;
4614 unsigned variations
[256];
4619 CHECK_FONT_OBJECT (font_object
);
4620 CHECK_CHARACTER (character
);
4621 font
= XFONT_OBJECT (font_object
);
4622 if (! font
->driver
->get_variation_glyphs
)
4624 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4628 for (i
= 0; i
< 255; i
++)
4632 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4633 /* Stops GCC whining about limited range of data type. */
4634 EMACS_INT var
= variations
[i
];
4636 if (var
> MOST_POSITIVE_FIXNUM
)
4637 code
= Fcons (make_number ((variations
[i
]) >> 16),
4638 make_number ((variations
[i
]) & 0xFFFF));
4640 code
= make_number (variations
[i
]);
4641 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4648 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4649 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4650 OTF-FEATURES specifies which features to apply in this format:
4651 (SCRIPT LANGSYS GSUB GPOS)
4653 SCRIPT is a symbol specifying a script tag of OpenType,
4654 LANGSYS is a symbol specifying a langsys tag of OpenType,
4655 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4657 If LANGYS is nil, the default langsys is selected.
4659 The features are applied in the order they appear in the list. The
4660 symbol `*' means to apply all available features not present in this
4661 list, and the remaining features are ignored. For instance, (vatu
4662 pstf * haln) is to apply vatu and pstf in this order, then to apply
4663 all available features other than vatu, pstf, and haln.
4665 The features are applied to the glyphs in the range FROM and TO of
4666 the glyph-string GSTRING-IN.
4668 If some feature is actually applicable, the resulting glyphs are
4669 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4670 this case, the value is the number of produced glyphs.
4672 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4675 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4676 produced in GSTRING-OUT, and the value is nil.
4678 See the documentation of `font-make-gstring' for the format of
4680 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4681 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4683 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4688 check_otf_features (otf_features
);
4689 CHECK_FONT_OBJECT (font_object
);
4690 font
= XFONT_OBJECT (font_object
);
4691 if (! font
->driver
->otf_drive
)
4692 error ("Font backend %s can't drive OpenType GSUB table",
4693 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4694 CHECK_CONS (otf_features
);
4695 CHECK_SYMBOL (XCAR (otf_features
));
4696 val
= XCDR (otf_features
);
4697 CHECK_SYMBOL (XCAR (val
));
4698 val
= XCDR (otf_features
);
4701 len
= check_gstring (gstring_in
);
4702 CHECK_VECTOR (gstring_out
);
4703 CHECK_NATNUM (from
);
4705 CHECK_NATNUM (index
);
4707 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4708 args_out_of_range_3 (from
, to
, make_number (len
));
4709 if (XINT (index
) >= ASIZE (gstring_out
))
4710 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4711 num
= font
->driver
->otf_drive (font
, otf_features
,
4712 gstring_in
, XINT (from
), XINT (to
),
4713 gstring_out
, XINT (index
), 0);
4716 return make_number (num
);
4719 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4721 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4722 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4724 (SCRIPT LANGSYS FEATURE ...)
4725 See the documentation of `font-drive-otf' for more detail.
4727 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4728 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4729 character code corresponding to the glyph or nil if there's no
4730 corresponding character. */)
4731 (font_object
, character
, otf_features
)
4732 Lisp_Object font_object
, character
, otf_features
;
4735 Lisp_Object gstring_in
, gstring_out
, g
;
4736 Lisp_Object alternates
;
4739 CHECK_FONT_GET_OBJECT (font_object
, font
);
4740 if (! font
->driver
->otf_drive
)
4741 error ("Font backend %s can't drive OpenType GSUB table",
4742 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4743 CHECK_CHARACTER (character
);
4744 CHECK_CONS (otf_features
);
4746 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4747 g
= LGSTRING_GLYPH (gstring_in
, 0);
4748 LGLYPH_SET_CHAR (g
, XINT (character
));
4749 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4750 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4751 gstring_out
, 0, 1)) < 0)
4752 gstring_out
= Ffont_make_gstring (font_object
,
4753 make_number (ASIZE (gstring_out
) * 2));
4755 for (i
= 0; i
< num
; i
++)
4757 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4758 int c
= LGLYPH_CHAR (g
);
4759 unsigned code
= LGLYPH_CODE (g
);
4761 alternates
= Fcons (Fcons (make_number (code
),
4762 c
> 0 ? make_number (c
) : Qnil
),
4765 return Fnreverse (alternates
);
4771 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4772 doc
: /* Open FONT-ENTITY. */)
4773 (font_entity
, size
, frame
)
4774 Lisp_Object font_entity
;
4780 CHECK_FONT_ENTITY (font_entity
);
4782 frame
= selected_frame
;
4783 CHECK_LIVE_FRAME (frame
);
4786 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4789 CHECK_NUMBER_OR_FLOAT (size
);
4791 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4793 isize
= XINT (size
);
4797 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4800 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4801 doc
: /* Close FONT-OBJECT. */)
4802 (font_object
, frame
)
4803 Lisp_Object font_object
, frame
;
4805 CHECK_FONT_OBJECT (font_object
);
4807 frame
= selected_frame
;
4808 CHECK_LIVE_FRAME (frame
);
4809 font_close_object (XFRAME (frame
), font_object
);
4813 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4814 doc
: /* Return information about FONT-OBJECT.
4815 The value is a vector:
4816 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4819 NAME is a string of the font name (or nil if the font backend doesn't
4822 FILENAME is a string of the font file (or nil if the font backend
4823 doesn't provide a file name).
4825 PIXEL-SIZE is a pixel size by which the font is opened.
4827 SIZE is a maximum advance width of the font in pixels.
4829 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4832 CAPABILITY is a list whose first element is a symbol representing the
4833 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4834 remaining elements describe the details of the font capability.
4836 If the font is OpenType font, the form of the list is
4837 \(opentype GSUB GPOS)
4838 where GSUB shows which "GSUB" features the font supports, and GPOS
4839 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4840 lists of the format:
4841 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4843 If the font is not OpenType font, currently the length of the form is
4846 SCRIPT is a symbol representing OpenType script tag.
4848 LANGSYS is a symbol representing OpenType langsys tag, or nil
4849 representing the default langsys.
4851 FEATURE is a symbol representing OpenType feature tag.
4853 If the font is not OpenType font, CAPABILITY is nil. */)
4855 Lisp_Object font_object
;
4860 CHECK_FONT_GET_OBJECT (font_object
, font
);
4862 val
= Fmake_vector (make_number (9), Qnil
);
4863 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4864 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4865 ASET (val
, 2, make_number (font
->pixel_size
));
4866 ASET (val
, 3, make_number (font
->max_width
));
4867 ASET (val
, 4, make_number (font
->ascent
));
4868 ASET (val
, 5, make_number (font
->descent
));
4869 ASET (val
, 6, make_number (font
->space_width
));
4870 ASET (val
, 7, make_number (font
->average_width
));
4871 if (font
->driver
->otf_capability
)
4872 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4876 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4877 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4878 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4879 (font_object
, string
)
4880 Lisp_Object font_object
, string
;
4886 CHECK_FONT_GET_OBJECT (font_object
, font
);
4887 CHECK_STRING (string
);
4888 len
= SCHARS (string
);
4889 vec
= Fmake_vector (make_number (len
), Qnil
);
4890 for (i
= 0; i
< len
; i
++)
4892 Lisp_Object ch
= Faref (string
, make_number (i
));
4897 struct font_metrics metrics
;
4899 cod
= code
= font
->driver
->encode_char (font
, c
);
4900 if (code
== FONT_INVALID_CODE
)
4902 val
= Fmake_vector (make_number (6), Qnil
);
4903 if (cod
<= MOST_POSITIVE_FIXNUM
)
4904 ASET (val
, 0, make_number (code
));
4906 ASET (val
, 0, Fcons (make_number (code
>> 16),
4907 make_number (code
& 0xFFFF)));
4908 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4909 ASET (val
, 1, make_number (metrics
.lbearing
));
4910 ASET (val
, 2, make_number (metrics
.rbearing
));
4911 ASET (val
, 3, make_number (metrics
.width
));
4912 ASET (val
, 4, make_number (metrics
.ascent
));
4913 ASET (val
, 5, make_number (metrics
.descent
));
4919 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4920 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4921 FONT is a font-spec, font-entity, or font-object. */)
4923 Lisp_Object spec
, font
;
4925 CHECK_FONT_SPEC (spec
);
4928 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4931 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4932 doc
: /* Return a font-object for displaying a character at POSITION.
4933 Optional second arg WINDOW, if non-nil, is a window displaying
4934 the current buffer. It defaults to the currently selected window. */)
4935 (position
, window
, string
)
4936 Lisp_Object position
, window
, string
;
4943 CHECK_NUMBER_COERCE_MARKER (position
);
4944 pos
= XINT (position
);
4945 if (pos
< BEGV
|| pos
>= ZV
)
4946 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4950 CHECK_NUMBER (position
);
4951 CHECK_STRING (string
);
4952 pos
= XINT (position
);
4953 if (pos
< 0 || pos
>= SCHARS (string
))
4954 args_out_of_range (string
, position
);
4957 window
= selected_window
;
4958 CHECK_LIVE_WINDOW (window
);
4959 w
= XWINDOW (window
);
4961 return font_at (-1, pos
, NULL
, w
, string
);
4965 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4966 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4967 The value is a number of glyphs drawn.
4968 Type C-l to recover what previously shown. */)
4969 (font_object
, string
)
4970 Lisp_Object font_object
, string
;
4972 Lisp_Object frame
= selected_frame
;
4973 FRAME_PTR f
= XFRAME (frame
);
4979 CHECK_FONT_GET_OBJECT (font_object
, font
);
4980 CHECK_STRING (string
);
4981 len
= SCHARS (string
);
4982 code
= alloca (sizeof (unsigned) * len
);
4983 for (i
= 0; i
< len
; i
++)
4985 Lisp_Object ch
= Faref (string
, make_number (i
));
4989 code
[i
] = font
->driver
->encode_char (font
, c
);
4990 if (code
[i
] == FONT_INVALID_CODE
)
4993 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4995 if (font
->driver
->prepare_face
)
4996 font
->driver
->prepare_face (f
, face
);
4997 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4998 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4999 if (font
->driver
->done_face
)
5000 font
->driver
->done_face (f
, face
);
5002 return make_number (len
);
5006 #endif /* FONT_DEBUG */
5008 #ifdef HAVE_WINDOW_SYSTEM
5010 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
5011 doc
: /* Return information about a font named NAME on frame FRAME.
5012 If FRAME is omitted or nil, use the selected frame.
5013 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
5014 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
5016 OPENED-NAME is the name used for opening the font,
5017 FULL-NAME is the full name of the font,
5018 SIZE is the pixelsize of the font,
5019 HEIGHT is the pixel-height of the font (i.e ascent + descent),
5020 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
5021 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
5022 how to compose characters.
5023 If the named font is not yet loaded, return nil. */)
5025 Lisp_Object name
, frame
;
5030 Lisp_Object font_object
;
5032 (*check_window_system_func
) ();
5035 CHECK_STRING (name
);
5037 frame
= selected_frame
;
5038 CHECK_LIVE_FRAME (frame
);
5043 int fontset
= fs_query_fontset (name
, 0);
5046 name
= fontset_ascii (fontset
);
5047 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
5049 else if (FONT_OBJECT_P (name
))
5051 else if (FONT_ENTITY_P (name
))
5052 font_object
= font_open_entity (f
, name
, 0);
5055 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5056 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
5058 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
5060 if (NILP (font_object
))
5062 font
= XFONT_OBJECT (font_object
);
5064 info
= Fmake_vector (make_number (7), Qnil
);
5065 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
5066 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
5067 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
5068 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
5069 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
5070 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
5071 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
5074 /* As font_object is still in FONT_OBJLIST of the entity, we can't
5075 close it now. Perhaps, we should manage font-objects
5076 by `reference-count'. */
5077 font_close_object (f
, font_object
);
5084 #define BUILD_STYLE_TABLE(TBL) \
5085 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
5088 build_style_table (entry
, nelement
)
5089 struct table_entry
*entry
;
5093 Lisp_Object table
, elt
;
5095 table
= Fmake_vector (make_number (nelement
), Qnil
);
5096 for (i
= 0; i
< nelement
; i
++)
5098 for (j
= 0; entry
[i
].names
[j
]; j
++);
5099 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
5100 ASET (elt
, 0, make_number (entry
[i
].numeric
));
5101 for (j
= 0; entry
[i
].names
[j
]; j
++)
5102 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
5103 ASET (table
, i
, elt
);
5108 Lisp_Object Vfont_log
;
5110 /* The deferred font-log data of the form [ACTION ARG RESULT].
5111 If ACTION is not nil, that is added to the log when font_add_log is
5112 called next time. At that time, ACTION is set back to nil. */
5113 static Lisp_Object Vfont_log_deferred
;
5115 /* Prepend the font-related logging data in Vfont_log if it is not
5116 `t'. ACTION describes a kind of font-related action (e.g. listing,
5117 opening), ARG is the argument for the action, and RESULT is the
5118 result of the action. */
5120 font_add_log (action
, arg
, result
)
5122 Lisp_Object arg
, result
;
5124 Lisp_Object tail
, val
;
5127 if (EQ (Vfont_log
, Qt
))
5129 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5131 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
5133 ASET (Vfont_log_deferred
, 0, Qnil
);
5134 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5135 AREF (Vfont_log_deferred
, 2));
5140 Lisp_Object tail
, elt
;
5141 Lisp_Object equalstr
= build_string ("=");
5143 val
= Ffont_xlfd_name (arg
, Qt
);
5144 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5148 if (EQ (XCAR (elt
), QCscript
)
5149 && SYMBOLP (XCDR (elt
)))
5150 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5151 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5152 else if (EQ (XCAR (elt
), QClang
)
5153 && SYMBOLP (XCDR (elt
)))
5154 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5155 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5156 else if (EQ (XCAR (elt
), QCotf
)
5157 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5158 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5160 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5166 && VECTORP (XCAR (result
))
5167 && ASIZE (XCAR (result
)) > 0
5168 && FONTP (AREF (XCAR (result
), 0)))
5169 result
= font_vconcat_entity_vectors (result
);
5172 val
= Ffont_xlfd_name (result
, Qt
);
5173 if (! FONT_SPEC_P (result
))
5174 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5175 build_string (":"), val
);
5178 else if (CONSP (result
))
5180 result
= Fcopy_sequence (result
);
5181 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5185 val
= Ffont_xlfd_name (val
, Qt
);
5186 XSETCAR (tail
, val
);
5189 else if (VECTORP (result
))
5191 result
= Fcopy_sequence (result
);
5192 for (i
= 0; i
< ASIZE (result
); i
++)
5194 val
= AREF (result
, i
);
5196 val
= Ffont_xlfd_name (val
, Qt
);
5197 ASET (result
, i
, val
);
5200 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5203 /* Record a font-related logging data to be added to Vfont_log when
5204 font_add_log is called next time. ACTION, ARG, RESULT are the same
5208 font_deferred_log (action
, arg
, result
)
5210 Lisp_Object arg
, result
;
5212 if (EQ (Vfont_log
, Qt
))
5214 ASET (Vfont_log_deferred
, 0, build_string (action
));
5215 ASET (Vfont_log_deferred
, 1, arg
);
5216 ASET (Vfont_log_deferred
, 2, result
);
5219 extern void syms_of_ftfont
P_ (());
5220 extern void syms_of_xfont
P_ (());
5221 extern void syms_of_xftfont
P_ (());
5222 extern void syms_of_ftxfont
P_ (());
5223 extern void syms_of_bdffont
P_ (());
5224 extern void syms_of_w32font
P_ (());
5225 extern void syms_of_atmfont
P_ (());
5226 extern void syms_of_nsfont
P_ (());
5231 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5232 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5233 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5234 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5235 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5236 /* Note that the other elements in sort_shift_bits are not used. */
5238 staticpro (&font_charset_alist
);
5239 font_charset_alist
= Qnil
;
5241 DEFSYM (Qopentype
, "opentype");
5243 DEFSYM (Qascii_0
, "ascii-0");
5244 DEFSYM (Qiso8859_1
, "iso8859-1");
5245 DEFSYM (Qiso10646_1
, "iso10646-1");
5246 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5247 DEFSYM (Qunicode_sip
, "unicode-sip");
5251 DEFSYM (QCotf
, ":otf");
5252 DEFSYM (QClang
, ":lang");
5253 DEFSYM (QCscript
, ":script");
5254 DEFSYM (QCantialias
, ":antialias");
5256 DEFSYM (QCfoundry
, ":foundry");
5257 DEFSYM (QCadstyle
, ":adstyle");
5258 DEFSYM (QCregistry
, ":registry");
5259 DEFSYM (QCspacing
, ":spacing");
5260 DEFSYM (QCdpi
, ":dpi");
5261 DEFSYM (QCscalable
, ":scalable");
5262 DEFSYM (QCavgwidth
, ":avgwidth");
5263 DEFSYM (QCfont_entity
, ":font-entity");
5264 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5274 DEFSYM (QCuser_spec
, "user-spec");
5276 staticpro (&null_vector
);
5277 null_vector
= Fmake_vector (make_number (0), Qnil
);
5279 staticpro (&scratch_font_spec
);
5280 scratch_font_spec
= Ffont_spec (0, NULL
);
5281 staticpro (&scratch_font_prefer
);
5282 scratch_font_prefer
= Ffont_spec (0, NULL
);
5284 staticpro (&Vfont_log_deferred
);
5285 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5289 staticpro (&otf_list
);
5291 #endif /* HAVE_LIBOTF */
5295 defsubr (&Sfont_spec
);
5296 defsubr (&Sfont_get
);
5297 #ifdef HAVE_WINDOW_SYSTEM
5298 defsubr (&Sfont_face_attributes
);
5300 defsubr (&Sfont_put
);
5301 defsubr (&Slist_fonts
);
5302 defsubr (&Sfont_family_list
);
5303 defsubr (&Sfind_font
);
5304 defsubr (&Sfont_xlfd_name
);
5305 defsubr (&Sclear_font_cache
);
5306 defsubr (&Sfont_shape_gstring
);
5307 defsubr (&Sfont_variation_glyphs
);
5309 defsubr (&Sfont_drive_otf
);
5310 defsubr (&Sfont_otf_alternates
);
5314 defsubr (&Sopen_font
);
5315 defsubr (&Sclose_font
);
5316 defsubr (&Squery_font
);
5317 defsubr (&Sget_font_glyphs
);
5318 defsubr (&Sfont_match_p
);
5319 defsubr (&Sfont_at
);
5321 defsubr (&Sdraw_string
);
5323 #endif /* FONT_DEBUG */
5324 #ifdef HAVE_WINDOW_SYSTEM
5325 defsubr (&Sfont_info
);
5328 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5330 Alist of fontname patterns vs the corresponding encoding and repertory info.
5331 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5332 where ENCODING is a charset or a char-table,
5333 and REPERTORY is a charset, a char-table, or nil.
5335 If ENCODING and REPERTORY are the same, the element can have the form
5336 \(REGEXP . ENCODING).
5338 ENCODING is for converting a character to a glyph code of the font.
5339 If ENCODING is a charset, encoding a character by the charset gives
5340 the corresponding glyph code. If ENCODING is a char-table, looking up
5341 the table by a character gives the corresponding glyph code.
5343 REPERTORY specifies a repertory of characters supported by the font.
5344 If REPERTORY is a charset, all characters beloging to the charset are
5345 supported. If REPERTORY is a char-table, all characters who have a
5346 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5347 gets the repertory information by an opened font and ENCODING. */);
5348 Vfont_encoding_alist
= Qnil
;
5350 /* FIXME: These 3 vars are not quite what they appear: setq on them
5351 won't have any effect other than disconnect them from the style
5352 table used by the font display code. So we make them read-only,
5353 to avoid this confusing situation. */
5355 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5356 doc
: /* Vector of valid font weight values.
5357 Each element has the form:
5358 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5359 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5360 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5361 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5363 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5364 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5365 See `font-weight-table' for the format of the vector. */);
5366 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5367 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5369 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5370 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5371 See `font-weight-table' for the format of the vector. */);
5372 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5373 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5375 staticpro (&font_style_table
);
5376 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5377 ASET (font_style_table
, 0, Vfont_weight_table
);
5378 ASET (font_style_table
, 1, Vfont_slant_table
);
5379 ASET (font_style_table
, 2, Vfont_width_table
);
5381 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5382 *Logging list of font related actions and results.
5383 The value t means to suppress the logging.
5384 The initial value is set to nil if the environment variable
5385 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5388 #ifdef HAVE_WINDOW_SYSTEM
5389 #ifdef HAVE_FREETYPE
5391 #ifdef HAVE_X_WINDOWS
5396 #endif /* HAVE_XFT */
5397 #endif /* HAVE_X_WINDOWS */
5398 #else /* not HAVE_FREETYPE */
5399 #ifdef HAVE_X_WINDOWS
5401 #endif /* HAVE_X_WINDOWS */
5402 #endif /* not HAVE_FREETYPE */
5405 #endif /* HAVE_BDFFONT */
5408 #endif /* WINDOWSNT */
5411 #endif /* HAVE_NS */
5412 #endif /* HAVE_WINDOW_SYSTEM */
5418 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
5421 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5422 (do not change this comment) */