1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
3 Copyright (C) 2006, 2007, 2008
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/>. */
35 #include "dispextern.h"
37 #include "character.h"
38 #include "composite.h"
44 #endif /* HAVE_X_WINDOWS */
48 #endif /* HAVE_NTGUI */
54 Lisp_Object Qfont_spec
, Qfont_entity
, Qfont_object
;
56 Lisp_Object Qopentype
;
58 /* Important character set strings. */
59 Lisp_Object Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
61 /* Special vector of zero length. This is repeatedly used by (struct
62 font_driver *)->list when a specified font is not found. */
63 static Lisp_Object null_vector
;
65 static Lisp_Object Vfont_weight_table
, Vfont_slant_table
, Vfont_width_table
;
67 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
68 static Lisp_Object font_style_table
;
70 /* Structure used for tables mapping weight, slant, and width numeric
71 values and their names. */
76 /* The first one is a valid name as a face attribute.
77 The second one (if any) is a typical name in XLFD field. */
82 /* Table of weight numeric values and their names. This table must be
83 sorted by numeric values in ascending order. */
85 static struct table_entry weight_table
[] =
88 { 20, { "ultra-light", "ultralight" }},
89 { 40, { "extra-light", "extralight" }},
91 { 75, { "semi-light", "semilight", "demilight", "book" }},
92 { 100, { "normal", "medium", "regular" }},
93 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
95 { 205, { "extra-bold", "extrabold" }},
96 { 210, { "ultra-bold", "ultrabold", "black" }}
99 /* Table of slant numeric values and their names. This table must be
100 sorted by numeric values in ascending order. */
102 static struct table_entry slant_table
[] =
104 { 0, { "reverse-oblique", "ro" }},
105 { 10, { "reverse-italic", "ri" }},
106 { 100, { "normal", "r" }},
107 { 200, { "italic" ,"i", "ot" }},
108 { 210, { "oblique", "o" }}
111 /* Table of width numeric values and their names. This table must be
112 sorted by numeric values in ascending order. */
114 static struct table_entry width_table
[] =
116 { 50, { "ultra-condensed", "ultracondensed" }},
117 { 63, { "extra-condensed", "extracondensed" }},
118 { 75, { "condensed", "compressed", "narrow" }},
119 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
120 { 100, { "normal", "medium", "regular" }},
121 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
122 { 125, { "expanded" }},
123 { 150, { "extra-expanded", "extraexpanded" }},
124 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
127 extern Lisp_Object Qnormal
;
129 /* Symbols representing keys of normal font properties. */
130 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
, QCsize
, QCname
;
131 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
;
132 /* Symbols representing keys of font extra info. */
133 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
134 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
135 /* Symbols representing values of font spacing property. */
136 Lisp_Object Qc
, Qm
, Qp
, Qd
;
138 Lisp_Object Vfont_encoding_alist
;
140 /* Alist of font registry symbol and the corresponding charsets
141 information. The information is retrieved from
142 Vfont_encoding_alist on demand.
144 Eash element has the form:
145 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
149 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
150 encodes a character code to a glyph code of a font, and
151 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
152 character is supported by a font.
154 The latter form means that the information for REGISTRY couldn't be
156 static Lisp_Object font_charset_alist
;
158 /* List of all font drivers. Each font-backend (XXXfont.c) calls
159 register_font_driver in syms_of_XXXfont to register its font-driver
161 static struct font_driver_list
*font_driver_list
;
165 /* Creaters of font-related Lisp object. */
170 Lisp_Object font_spec
;
171 struct font_spec
*spec
172 = ((struct font_spec
*)
173 allocate_pseudovector (VECSIZE (struct font_spec
),
174 FONT_SPEC_MAX
, PVEC_FONT
));
175 XSETFONT (font_spec
, spec
);
182 Lisp_Object font_entity
;
183 struct font_entity
*entity
184 = ((struct font_entity
*)
185 allocate_pseudovector (VECSIZE (struct font_entity
),
186 FONT_ENTITY_MAX
, PVEC_FONT
));
187 XSETFONT (font_entity
, entity
);
192 font_make_object (size
)
195 Lisp_Object font_object
;
197 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
198 XSETFONT (font_object
, font
);
205 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
206 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
207 static Lisp_Object font_matching_entity
P_ ((FRAME_PTR
, Lisp_Object
*,
210 /* Number of registered font drivers. */
211 static int num_font_drivers
;
214 /* Return a Lispy value of a font property value at STR and LEN bytes.
215 If STR is "*", it returns nil.
216 If all characters in STR are digits, it returns an integer.
217 Otherwise, it returns a symbol interned from STR. */
220 font_intern_prop (str
, len
)
228 if (len
== 1 && *str
== '*')
230 if (len
>=1 && isdigit (*str
))
232 for (i
= 1; i
< len
; i
++)
233 if (! isdigit (str
[i
]))
236 return make_number (atoi (str
));
239 /* The following code is copied from the function intern (in lread.c). */
241 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
242 obarray
= check_obarray (obarray
);
243 tem
= oblookup (obarray
, str
, len
, len
);
246 return Fintern (make_unibyte_string (str
, len
), obarray
);
249 /* Return a pixel size of font-spec SPEC on frame F. */
252 font_pixel_size (f
, spec
)
256 #ifdef HAVE_WINDOW_SYSTEM
257 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
266 font_assert (FLOATP (size
));
267 point_size
= XFLOAT_DATA (size
);
268 val
= AREF (spec
, FONT_DPI_INDEX
);
270 dpi
= XINT (XCDR (val
));
273 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
281 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
282 font vector. If VAL is not valid (i.e. not registered in
283 font_style_table), return -1 if NOERROR is zero, and return a
284 proper index if NOERROR is nonzero. In that case, register VAL in
285 font_style_table if VAL is a symbol, and return a closest index if
286 VAL is an integer. */
289 font_style_to_value (prop
, val
, noerror
)
290 enum font_property_index prop
;
294 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
295 int len
= ASIZE (table
);
301 Lisp_Object args
[2], elt
;
303 /* At first try exact match. */
304 for (i
= 0; i
< len
; i
++)
305 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
306 if (EQ (val
, AREF (AREF (table
, i
), j
)))
307 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
308 | (i
<< 4) | (j
- 1));
309 /* Try also with case-folding match. */
310 s
= (char *) SDATA (SYMBOL_NAME (val
));
311 for (i
= 0; i
< len
; i
++)
312 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
314 elt
= AREF (AREF (table
, i
), j
);
315 if (strcasecmp (s
, (char *) SDATA (SYMBOL_NAME (elt
))) == 0)
316 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
317 | (i
<< 4) | (j
- 1));
323 elt
= Fmake_vector (make_number (2), make_number (255));
326 args
[1] = Fmake_vector (make_number (1), elt
);
327 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
328 return (255 << 8) | (i
<< 4);
333 int numeric
= XINT (val
);
335 for (i
= 0, last_n
= -1; i
< len
; i
++)
337 int n
= XINT (AREF (AREF (table
, i
), 0));
340 return (n
<< 8) | (i
<< 4);
345 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
346 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
352 return ((last_n
<< 8) | ((i
- 1) << 4));
357 font_style_symbolic (font
, prop
, for_face
)
359 enum font_property_index prop
;
362 Lisp_Object val
= AREF (font
, prop
);
363 Lisp_Object table
, elt
;
368 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
369 i
= XINT (val
) & 0xFF;
370 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
371 elt
= AREF (table
, ((i
>> 4) & 0xF));
372 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
373 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
376 extern Lisp_Object Vface_alternative_font_family_alist
;
378 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
381 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
382 FONTNAME. ENCODING is a charset symbol that specifies the encoding
383 of the font. REPERTORY is a charset symbol or nil. */
386 find_font_encoding (fontname
)
387 Lisp_Object fontname
;
389 Lisp_Object tail
, elt
;
391 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
395 && STRINGP (XCAR (elt
))
396 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
397 && (SYMBOLP (XCDR (elt
))
398 ? CHARSETP (XCDR (elt
))
399 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
402 /* We don't know the encoding of this font. Let's assume `ascii'. */
406 /* Return encoding charset and repertory charset for REGISTRY in
407 ENCODING and REPERTORY correspondingly. If correct information for
408 REGISTRY is available, return 0. Otherwise return -1. */
411 font_registry_charsets (registry
, encoding
, repertory
)
412 Lisp_Object registry
;
413 struct charset
**encoding
, **repertory
;
416 int encoding_id
, repertory_id
;
418 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
424 encoding_id
= XINT (XCAR (val
));
425 repertory_id
= XINT (XCDR (val
));
429 val
= find_font_encoding (SYMBOL_NAME (registry
));
430 if (SYMBOLP (val
) && CHARSETP (val
))
432 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
434 else if (CONSP (val
))
436 if (! CHARSETP (XCAR (val
)))
438 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
439 if (NILP (XCDR (val
)))
443 if (! CHARSETP (XCDR (val
)))
445 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
450 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
452 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
456 *encoding
= CHARSET_FROM_ID (encoding_id
);
458 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
463 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
468 /* Font property value validaters. See the comment of
469 font_property_table for the meaning of the arguments. */
471 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
472 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
473 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
474 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
475 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
476 static int get_font_prop_index
P_ ((Lisp_Object
));
479 font_prop_validate_symbol (prop
, val
)
480 Lisp_Object prop
, val
;
483 val
= Fintern (val
, Qnil
);
486 else if (EQ (prop
, QCregistry
))
487 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
493 font_prop_validate_style (style
, val
)
494 Lisp_Object style
, val
;
496 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
497 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
504 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
508 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
510 if ((n
& 0xF) + 1 >= ASIZE (elt
))
512 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
516 else if (SYMBOLP (val
))
518 int n
= font_style_to_value (prop
, val
, 0);
520 val
= n
>= 0 ? make_number (n
) : Qerror
;
528 font_prop_validate_non_neg (prop
, val
)
529 Lisp_Object prop
, val
;
531 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
536 font_prop_validate_spacing (prop
, val
)
537 Lisp_Object prop
, val
;
539 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
542 return make_number (FONT_SPACING_CHARCELL
);
544 return make_number (FONT_SPACING_MONO
);
546 return make_number (FONT_SPACING_PROPORTIONAL
);
548 return make_number (FONT_SPACING_DUAL
);
553 font_prop_validate_otf (prop
, val
)
554 Lisp_Object prop
, val
;
556 Lisp_Object tail
, tmp
;
559 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
560 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
561 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
564 if (! SYMBOLP (XCAR (val
)))
569 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
571 for (i
= 0; i
< 2; i
++)
578 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
579 if (! SYMBOLP (XCAR (tmp
)))
587 /* Structure of known font property keys and validater of the
591 /* Pointer to the key symbol. */
593 /* Function to validate PROP's value VAL, or NULL if any value is
594 ok. The value is VAL or its regularized value if VAL is valid,
595 and Qerror if not. */
596 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
597 } font_property_table
[] =
598 { { &QCtype
, font_prop_validate_symbol
},
599 { &QCfoundry
, font_prop_validate_symbol
},
600 { &QCfamily
, font_prop_validate_symbol
},
601 { &QCadstyle
, font_prop_validate_symbol
},
602 { &QCregistry
, font_prop_validate_symbol
},
603 { &QCweight
, font_prop_validate_style
},
604 { &QCslant
, font_prop_validate_style
},
605 { &QCwidth
, font_prop_validate_style
},
606 { &QCsize
, font_prop_validate_non_neg
},
607 { &QCdpi
, font_prop_validate_non_neg
},
608 { &QCspacing
, font_prop_validate_spacing
},
609 { &QCavgwidth
, font_prop_validate_non_neg
},
610 /* The order of the above entries must match with enum
611 font_property_index. */
612 { &QClang
, font_prop_validate_symbol
},
613 { &QCscript
, font_prop_validate_symbol
},
614 { &QCotf
, font_prop_validate_otf
}
617 /* Size (number of elements) of the above table. */
618 #define FONT_PROPERTY_TABLE_SIZE \
619 ((sizeof font_property_table) / (sizeof *font_property_table))
621 /* Return an index number of font property KEY or -1 if KEY is not an
622 already known property. */
625 get_font_prop_index (key
)
630 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
631 if (EQ (key
, *font_property_table
[i
].key
))
636 /* Validate the font property. The property key is specified by the
637 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
638 signal an error. The value is VAL or the regularized one. */
641 font_prop_validate (idx
, prop
, val
)
643 Lisp_Object prop
, val
;
645 Lisp_Object validated
;
650 prop
= *font_property_table
[idx
].key
;
653 idx
= get_font_prop_index (prop
);
657 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
658 if (EQ (validated
, Qerror
))
659 signal_error ("invalid font property", Fcons (prop
, val
));
664 /* Store VAL as a value of extra font property PROP in FONT while
665 keeping the sorting order. Don't check the validity of VAL. */
668 font_put_extra (font
, prop
, val
)
669 Lisp_Object font
, prop
, val
;
671 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
672 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
676 Lisp_Object prev
= Qnil
;
679 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
680 prev
= extra
, extra
= XCDR (extra
);
682 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
684 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
692 /* Font name parser and unparser */
694 static int parse_matrix
P_ ((char *));
695 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
696 static int font_parse_name
P_ ((char *, Lisp_Object
));
698 /* An enumerator for each field of an XLFD font name. */
699 enum xlfd_field_index
718 /* An enumerator for mask bit corresponding to each XLFD field. */
721 XLFD_FOUNDRY_MASK
= 0x0001,
722 XLFD_FAMILY_MASK
= 0x0002,
723 XLFD_WEIGHT_MASK
= 0x0004,
724 XLFD_SLANT_MASK
= 0x0008,
725 XLFD_SWIDTH_MASK
= 0x0010,
726 XLFD_ADSTYLE_MASK
= 0x0020,
727 XLFD_PIXEL_MASK
= 0x0040,
728 XLFD_POINT_MASK
= 0x0080,
729 XLFD_RESX_MASK
= 0x0100,
730 XLFD_RESY_MASK
= 0x0200,
731 XLFD_SPACING_MASK
= 0x0400,
732 XLFD_AVGWIDTH_MASK
= 0x0800,
733 XLFD_REGISTRY_MASK
= 0x1000,
734 XLFD_ENCODING_MASK
= 0x2000
738 /* Parse P pointing the pixel/point size field of the form
739 `[A B C D]' which specifies a transformation matrix:
745 by which all glyphs of the font are transformed. The spec says
746 that scalar value N for the pixel/point size is equivalent to:
747 A = N * resx/resy, B = C = 0, D = N.
749 Return the scalar value N if the form is valid. Otherwise return
760 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
763 matrix
[i
] = - strtod (p
+ 1, &end
);
765 matrix
[i
] = strtod (p
, &end
);
768 return (i
== 4 ? (int) matrix
[3] : -1);
771 /* Expand a wildcard field in FIELD (the first N fields are filled) to
772 multiple fields to fill in all 14 XLFD fields while restring a
773 field position by its contents. */
776 font_expand_wildcards (field
, n
)
777 Lisp_Object field
[XLFD_LAST_INDEX
];
781 Lisp_Object tmp
[XLFD_LAST_INDEX
];
782 /* Array of information about where this element can go. Nth
783 element is for Nth element of FIELD. */
785 /* Minimum possible field. */
787 /* Maxinum possible field. */
789 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
791 } range
[XLFD_LAST_INDEX
];
793 int range_from
, range_to
;
796 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
797 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
798 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
799 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
800 | XLFD_AVGWIDTH_MASK)
801 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
803 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
804 field. The value is shifted to left one bit by one in the
806 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
807 range_mask
= (range_mask
<< 1) | 1;
809 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
810 position-based retriction for FIELD[I]. */
811 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
812 i
++, range_from
++, range_to
++, range_mask
<<= 1)
814 Lisp_Object val
= field
[i
];
820 range
[i
].from
= range_from
;
821 range
[i
].to
= range_to
;
822 range
[i
].mask
= range_mask
;
826 /* The triplet FROM, TO, and MASK is a value-based
827 retriction for FIELD[I]. */
833 int numeric
= XINT (val
);
836 from
= to
= XLFD_ENCODING_INDEX
,
837 mask
= XLFD_ENCODING_MASK
;
838 else if (numeric
== 0)
839 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
840 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
841 else if (numeric
<= 48)
842 from
= to
= XLFD_PIXEL_INDEX
,
843 mask
= XLFD_PIXEL_MASK
;
845 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
846 mask
= XLFD_LARGENUM_MASK
;
848 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
849 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
850 mask
= XLFD_NULL_MASK
;
852 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
855 Lisp_Object name
= SYMBOL_NAME (val
);
857 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
858 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
859 mask
= XLFD_REGENC_MASK
;
861 from
= to
= XLFD_ENCODING_INDEX
,
862 mask
= XLFD_ENCODING_MASK
;
864 else if (range_from
<= XLFD_WEIGHT_INDEX
865 && range_to
>= XLFD_WEIGHT_INDEX
866 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
867 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
868 else if (range_from
<= XLFD_SLANT_INDEX
869 && range_to
>= XLFD_SLANT_INDEX
870 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
871 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
872 else if (range_from
<= XLFD_SWIDTH_INDEX
873 && range_to
>= XLFD_SWIDTH_INDEX
874 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
875 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
878 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
879 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
881 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
882 mask
= XLFD_SYMBOL_MASK
;
885 /* Merge position-based and value-based restrictions. */
887 while (from
< range_from
)
888 mask
&= ~(1 << from
++);
889 while (from
< 14 && ! (mask
& (1 << from
)))
891 while (to
> range_to
)
892 mask
&= ~(1 << to
--);
893 while (to
>= 0 && ! (mask
& (1 << to
)))
897 range
[i
].from
= from
;
899 range
[i
].mask
= mask
;
901 if (from
> range_from
|| to
< range_to
)
903 /* The range is narrowed by value-based restrictions.
904 Reflect it to the other fields. */
906 /* Following fields should be after FROM. */
908 /* Preceding fields should be before TO. */
909 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
911 /* Check FROM for non-wildcard field. */
912 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
914 while (range
[j
].from
< from
)
915 range
[j
].mask
&= ~(1 << range
[j
].from
++);
916 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
918 range
[j
].from
= from
;
921 from
= range
[j
].from
;
922 if (range
[j
].to
> to
)
924 while (range
[j
].to
> to
)
925 range
[j
].mask
&= ~(1 << range
[j
].to
--);
926 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
939 /* Decide all fileds from restrictions in RANGE. */
940 for (i
= j
= 0; i
< n
; i
++)
942 if (j
< range
[i
].from
)
944 if (i
== 0 || ! NILP (tmp
[i
- 1]))
945 /* None of TMP[X] corresponds to Jth field. */
947 for (; j
< range
[i
].from
; j
++)
952 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
954 for (; j
< XLFD_LAST_INDEX
; j
++)
956 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
957 field
[XLFD_ENCODING_INDEX
]
958 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
963 #ifdef ENABLE_CHECKING
964 /* Match a 14-field XLFD pattern against a full XLFD font name. */
966 font_match_xlfd (char *pattern
, char *name
)
968 while (*pattern
&& *name
)
970 if (*pattern
== *name
)
972 else if (*pattern
== '*')
973 if (*name
== pattern
[1])
984 /* Make sure the font object matches the XLFD font name. */
986 font_check_xlfd_parse (Lisp_Object font
, char *name
)
988 char name_check
[256];
989 font_unparse_xlfd (font
, 0, name_check
, 255);
990 return font_match_xlfd (name_check
, name
);
996 /* Parse NAME (null terminated) as XLFD and store information in FONT
997 (font-spec or font-entity). Size property of FONT is set as
999 specified XLFD fields FONT property
1000 --------------------- -------------
1001 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1002 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1003 POINT_SIZE POINT_SIZE/10 (Lisp float)
1005 If NAME is successfully parsed, return 0. Otherwise return -1.
1007 FONT is usually a font-spec, but when this function is called from
1008 X font backend driver, it is a font-entity. In that case, NAME is
1009 a fully specified XLFD. */
1012 font_parse_xlfd (name
, font
)
1016 int len
= strlen (name
);
1018 char *f
[XLFD_LAST_INDEX
+ 1];
1023 /* Maximum XLFD name length is 255. */
1025 /* Accept "*-.." as a fully specified XLFD. */
1026 if (name
[0] == '*' && name
[1] == '-')
1027 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1030 for (p
= name
+ i
; *p
; p
++)
1034 if (i
== XLFD_LAST_INDEX
)
1039 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N])
1041 if (i
== XLFD_LAST_INDEX
)
1043 /* Fully specified XLFD. */
1046 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD (XLFD_FOUNDRY_INDEX
));
1047 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD (XLFD_FAMILY_INDEX
));
1048 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1049 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1051 val
= INTERN_FIELD (i
);
1054 if ((n
= font_style_to_value (j
, INTERN_FIELD (i
), 0)) < 0)
1056 ASET (font
, j
, make_number (n
));
1059 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD (XLFD_ADSTYLE_INDEX
));
1060 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1061 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1063 ASET (font
, FONT_REGISTRY_INDEX
,
1064 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1065 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
]));
1066 p
= f
[XLFD_PIXEL_INDEX
];
1067 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1068 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1071 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1073 ASET (font
, FONT_SIZE_INDEX
, val
);
1076 double point_size
= -1;
1078 font_assert (FONT_SPEC_P (font
));
1079 p
= f
[XLFD_POINT_INDEX
];
1081 point_size
= parse_matrix (p
);
1082 else if (isdigit (*p
))
1083 point_size
= atoi (p
), point_size
/= 10;
1084 if (point_size
>= 0)
1085 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1089 ASET (font
, FONT_DPI_INDEX
, INTERN_FIELD (XLFD_RESY_INDEX
));
1090 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1093 val
= font_prop_validate_spacing (QCspacing
, val
);
1094 if (! INTEGERP (val
))
1096 ASET (font
, FONT_SPACING_INDEX
, val
);
1098 p
= f
[XLFD_AVGWIDTH_INDEX
];
1101 ASET (font
, FONT_AVGWIDTH_INDEX
,
1102 font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
));
1106 int wild_card_found
= 0;
1107 Lisp_Object prop
[XLFD_LAST_INDEX
];
1109 if (FONT_ENTITY_P (font
))
1111 for (j
= 0; j
< i
; j
++)
1115 if (f
[j
][1] && f
[j
][1] != '-')
1118 wild_card_found
= 1;
1121 prop
[j
] = INTERN_FIELD (j
);
1123 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
]);
1125 if (! wild_card_found
)
1127 if (font_expand_wildcards (prop
, i
) < 0)
1130 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1131 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1132 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1133 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1134 if (! NILP (prop
[i
]))
1136 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1138 ASET (font
, j
, make_number (n
));
1140 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1141 val
= prop
[XLFD_REGISTRY_INDEX
];
1144 val
= prop
[XLFD_ENCODING_INDEX
];
1146 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1148 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1149 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1151 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1152 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1154 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1156 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1157 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1158 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1160 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1162 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1165 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1166 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1167 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1169 val
= font_prop_validate_spacing (QCspacing
,
1170 prop
[XLFD_SPACING_INDEX
]);
1171 if (! INTEGERP (val
))
1173 ASET (font
, FONT_SPACING_INDEX
, val
);
1175 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1176 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1182 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1183 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1184 0, use PIXEL_SIZE instead. */
1187 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1193 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1197 font_assert (FONTP (font
));
1199 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1202 if (i
== FONT_ADSTYLE_INDEX
)
1203 j
= XLFD_ADSTYLE_INDEX
;
1204 else if (i
== FONT_REGISTRY_INDEX
)
1205 j
= XLFD_REGISTRY_INDEX
;
1206 val
= AREF (font
, i
);
1209 if (j
== XLFD_REGISTRY_INDEX
)
1210 f
[j
] = "*-*", len
+= 4;
1212 f
[j
] = "*", len
+= 2;
1217 val
= SYMBOL_NAME (val
);
1218 if (j
== XLFD_REGISTRY_INDEX
1219 && ! strchr ((char *) SDATA (val
), '-'))
1221 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1222 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1224 f
[j
] = alloca (SBYTES (val
) + 3);
1225 sprintf (f
[j
], "%s-*", SDATA (val
));
1226 len
+= SBYTES (val
) + 3;
1230 f
[j
] = alloca (SBYTES (val
) + 4);
1231 sprintf (f
[j
], "%s*-*", SDATA (val
));
1232 len
+= SBYTES (val
) + 4;
1236 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1240 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1243 val
= font_style_symbolic (font
, i
, 0);
1245 f
[j
] = "*", len
+= 2;
1248 val
= SYMBOL_NAME (val
);
1249 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1253 val
= AREF (font
, FONT_SIZE_INDEX
);
1254 font_assert (NUMBERP (val
) || NILP (val
));
1262 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1263 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1266 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1268 else if (FLOATP (val
))
1270 i
= XFLOAT_DATA (val
) * 10;
1271 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1272 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1275 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1277 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1279 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1280 f
[XLFD_RESX_INDEX
] = alloca (22);
1281 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1285 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1286 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1288 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1290 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1291 : spacing
<= FONT_SPACING_DUAL
? "d"
1292 : spacing
<= FONT_SPACING_MONO
? "m"
1297 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1298 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1300 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1301 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
],
1302 "%d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1305 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1306 len
++; /* for terminating '\0'. */
1309 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1310 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1311 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1312 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1313 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1314 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1315 f
[XLFD_REGISTRY_INDEX
]);
1318 /* Parse NAME (null terminated) as Fonconfig's name format and store
1319 information in FONT (font-spec or font-entity). If NAME is
1320 successfully parsed, return 0. Otherwise return -1. */
1323 font_parse_fcname (name
, font
)
1328 int len
= strlen (name
);
1333 /* It is assured that (name[0] && name[0] != '-'). */
1341 for (p0
= name
+ 1; *p0
&& (*p0
!= '-' && *p0
!= ':'); p0
++)
1342 if (*p0
== '\\' && p0
[1])
1344 family
= font_intern_prop (name
, p0
- name
);
1347 if (! isdigit (p0
[1]))
1349 point_size
= strtod (p0
+ 1, &p1
);
1350 if (*p1
&& *p1
!= ':')
1352 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1355 ASET (font
, FONT_FAMILY_INDEX
, family
);
1359 copy
= alloca (len
+ 1);
1364 /* Now parse ":KEY=VAL" patterns. Store known keys and values in
1365 extra, copy unknown ones to COPY. It is stored in extra slot by
1366 the key QCfc_unknown_spec. */
1369 Lisp_Object key
, val
;
1372 for (p1
= p0
+ 1; *p1
&& *p1
!= '=' && *p1
!= ':'; p1
++);
1375 /* Must be an enumerated value. */
1376 val
= font_intern_prop (p0
+ 1, p1
- p0
- 1);
1377 if (memcmp (p0
+ 1, "light", 5) == 0
1378 || memcmp (p0
+ 1, "medium", 6) == 0
1379 || memcmp (p0
+ 1, "demibold", 8) == 0
1380 || memcmp (p0
+ 1, "bold", 4) == 0
1381 || memcmp (p0
+ 1, "black", 5) == 0)
1382 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1383 else if (memcmp (p0
+ 1, "roman", 5) == 0
1384 || memcmp (p0
+ 1, "italic", 6) == 0
1385 || memcmp (p0
+ 1, "oblique", 7) == 0)
1386 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1387 else if (memcmp (p0
+ 1, "charcell", 8) == 0
1388 || memcmp (p0
+ 1, "mono", 4) == 0
1389 || memcmp (p0
+ 1, "proportional", 12) == 0)
1391 int spacing
= (p0
[1] == 'c' ? FONT_SPACING_CHARCELL
1392 : p0
[1] == 'm' ? FONT_SPACING_MONO
1393 : FONT_SPACING_PROPORTIONAL
);
1394 ASET (font
, FONT_SPACING_INDEX
, make_number (spacing
));
1399 bcopy (p0
, copy
, p1
- p0
);
1405 if (memcmp (p0
+ 1, "pixelsize=", 10) == 0)
1406 prop
= FONT_SIZE_INDEX
;
1409 key
= font_intern_prop (p0
, p1
- p0
);
1410 prop
= get_font_prop_index (key
);
1413 for (p1
= p0
; *p1
&& *p1
!= ':'; p1
++);
1414 val
= font_intern_prop (p0
, p1
- p0
);
1417 if (prop
>= FONT_FOUNDRY_INDEX
&& prop
< FONT_EXTRA_INDEX
)
1418 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1420 Ffont_put (font
, key
, val
);
1422 bcopy (p0
- 1, copy
, p1
- p0
+ 1);
1423 copy
+= p1
- p0
+ 1;
1429 font_put_extra (font
, QCfc_unknown_spec
,
1430 make_unibyte_string (name
, copy
- name
));
1435 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1436 NAME (NBYTES length), and return the name length. If
1437 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1440 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1446 Lisp_Object tail
, val
;
1451 Lisp_Object styles
[3];
1452 char *style_names
[3] = { "weight", "slant", "width" };
1455 val
= AREF (font
, FONT_FAMILY_INDEX
);
1457 len
+= SBYTES (val
);
1459 val
= AREF (font
, FONT_SIZE_INDEX
);
1462 if (XINT (val
) != 0)
1463 pixel_size
= XINT (val
);
1465 len
+= 21; /* for ":pixelsize=NUM" */
1467 else if (FLOATP (val
))
1470 point_size
= (int) XFLOAT_DATA (val
);
1471 len
+= 11; /* for "-NUM" */
1474 val
= AREF (font
, FONT_FOUNDRY_INDEX
);
1476 /* ":foundry=NAME" */
1477 len
+= 9 + SBYTES (val
);
1479 for (i
= 0; i
< 3; i
++)
1481 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1482 if (! NILP (styles
[i
]))
1483 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1484 SDATA (SYMBOL_NAME (styles
[i
])));
1487 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1488 len
+= sprintf (work
, ":dpi=%d", dpi
);
1489 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1490 len
+= strlen (":spacing=100");
1491 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1492 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1493 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1495 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1497 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1499 len
+= SBYTES (val
);
1500 else if (INTEGERP (val
))
1501 len
+= sprintf (work
, "%d", XINT (val
));
1502 else if (SYMBOLP (val
))
1503 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1509 if (! NILP (AREF (font
, FONT_FAMILY_INDEX
)))
1510 p
+= sprintf(p
, "%s", SDATA (SYMBOL_NAME (AREF (font
, FONT_FAMILY_INDEX
))));
1514 p
+= sprintf (p
, "%d", point_size
);
1516 p
+= sprintf (p
, "-%d", point_size
);
1518 else if (pixel_size
> 0)
1519 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1520 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1521 p
+= sprintf (p
, ":foundry=%s",
1522 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1523 for (i
= 0; i
< 3; i
++)
1524 if (! NILP (styles
[i
]))
1525 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1526 SDATA (SYMBOL_NAME (styles
[i
])));
1527 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1528 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1529 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1530 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1531 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1533 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1534 p
+= sprintf (p
, ":scalable=true");
1536 p
+= sprintf (p
, ":scalable=false");
1541 /* Parse NAME (null terminated) and store information in FONT
1542 (font-spec or font-entity). If NAME is successfully parsed, return
1543 0. Otherwise return -1. */
1546 font_parse_name (name
, font
)
1550 if (name
[0] == '-' || index (name
, '*'))
1551 return font_parse_xlfd (name
, font
);
1552 return font_parse_fcname (name
, font
);
1556 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1557 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1561 font_parse_family_registry (family
, registry
, font_spec
)
1562 Lisp_Object family
, registry
, font_spec
;
1568 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1570 CHECK_STRING (family
);
1571 len
= SBYTES (family
);
1572 p0
= (char *) SDATA (family
);
1573 p1
= index (p0
, '-');
1576 if ((*p0
!= '*' || p1
- p0
> 1)
1577 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1578 ASET (font_spec
, FONT_FOUNDRY_INDEX
,
1579 font_intern_prop (p0
, p1
- p0
));
1582 ASET (font_spec
, FONT_FAMILY_INDEX
, font_intern_prop (p1
, len
));
1585 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1587 if (! NILP (registry
))
1589 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1590 CHECK_STRING (registry
);
1591 len
= SBYTES (registry
);
1592 p0
= (char *) SDATA (registry
);
1593 p1
= index (p0
, '-');
1596 if (SDATA (registry
)[len
- 1] == '*')
1597 registry
= concat2 (registry
, build_string ("-*"));
1599 registry
= concat2 (registry
, build_string ("*-*"));
1601 registry
= Fdowncase (registry
);
1602 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1607 /* This part (through the next ^L) is still experimental and not
1608 tested much. We may drastically change codes. */
1612 #define LGSTRING_HEADER_SIZE 6
1613 #define LGSTRING_GLYPH_SIZE 8
1616 check_gstring (gstring
)
1617 Lisp_Object gstring
;
1622 CHECK_VECTOR (gstring
);
1623 val
= AREF (gstring
, 0);
1625 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1627 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1628 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1629 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1630 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1631 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1632 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1633 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1634 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1635 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1636 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1637 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1639 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1641 val
= LGSTRING_GLYPH (gstring
, i
);
1643 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1645 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1647 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1648 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1649 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1650 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1651 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1652 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1653 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1654 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1656 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1658 if (ASIZE (val
) < 3)
1660 for (j
= 0; j
< 3; j
++)
1661 CHECK_NUMBER (AREF (val
, j
));
1666 error ("Invalid glyph-string format");
1671 check_otf_features (otf_features
)
1672 Lisp_Object otf_features
;
1676 CHECK_CONS (otf_features
);
1677 CHECK_SYMBOL (XCAR (otf_features
));
1678 otf_features
= XCDR (otf_features
);
1679 CHECK_CONS (otf_features
);
1680 CHECK_SYMBOL (XCAR (otf_features
));
1681 otf_features
= XCDR (otf_features
);
1682 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1684 CHECK_SYMBOL (Fcar (val
));
1685 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1686 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1688 otf_features
= XCDR (otf_features
);
1689 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1691 CHECK_SYMBOL (Fcar (val
));
1692 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1693 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1700 Lisp_Object otf_list
;
1703 otf_tag_symbol (tag
)
1708 OTF_tag_name (tag
, name
);
1709 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1716 Lisp_Object val
= Fassoc (file
, otf_list
);
1720 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1723 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1724 val
= make_save_value (otf
, 0);
1725 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1731 /* Return a list describing which scripts/languages FONT supports by
1732 which GSUB/GPOS features of OpenType tables. See the comment of
1733 (struct font_driver).otf_capability. */
1736 font_otf_capability (font
)
1740 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1743 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1746 for (i
= 0; i
< 2; i
++)
1748 OTF_GSUB_GPOS
*gsub_gpos
;
1749 Lisp_Object script_list
= Qnil
;
1752 if (OTF_get_features (otf
, i
== 0) < 0)
1754 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1755 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1757 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1758 Lisp_Object langsys_list
= Qnil
;
1759 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1762 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1764 OTF_LangSys
*langsys
;
1765 Lisp_Object feature_list
= Qnil
;
1766 Lisp_Object langsys_tag
;
1769 if (k
== script
->LangSysCount
)
1771 langsys
= &script
->DefaultLangSys
;
1776 langsys
= script
->LangSys
+ k
;
1778 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1780 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1782 OTF_Feature
*feature
1783 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1784 Lisp_Object feature_tag
1785 = otf_tag_symbol (feature
->FeatureTag
);
1787 feature_list
= Fcons (feature_tag
, feature_list
);
1789 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1792 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1797 XSETCAR (capability
, script_list
);
1799 XSETCDR (capability
, script_list
);
1805 /* Parse OTF features in SPEC and write a proper features spec string
1806 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1807 assured that the sufficient memory has already allocated for
1811 generate_otf_features (spec
, features
)
1821 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1827 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1832 else if (! asterisk
)
1834 val
= SYMBOL_NAME (val
);
1835 p
+= sprintf (p
, "%s", SDATA (val
));
1839 val
= SYMBOL_NAME (val
);
1840 p
+= sprintf (p
, "~%s", SDATA (val
));
1844 error ("OTF spec too long");
1849 font_otf_DeviceTable (device_table
)
1850 OTF_DeviceTable
*device_table
;
1852 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1854 return Fcons (make_number (len
),
1855 make_unibyte_string (device_table
->DeltaValue
, len
));
1859 font_otf_ValueRecord (value_format
, value_record
)
1861 OTF_ValueRecord
*value_record
;
1863 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1865 if (value_format
& OTF_XPlacement
)
1866 ASET (val
, 0, make_number (value_record
->XPlacement
));
1867 if (value_format
& OTF_YPlacement
)
1868 ASET (val
, 1, make_number (value_record
->YPlacement
));
1869 if (value_format
& OTF_XAdvance
)
1870 ASET (val
, 2, make_number (value_record
->XAdvance
));
1871 if (value_format
& OTF_YAdvance
)
1872 ASET (val
, 3, make_number (value_record
->YAdvance
));
1873 if (value_format
& OTF_XPlaDevice
)
1874 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1875 if (value_format
& OTF_YPlaDevice
)
1876 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1877 if (value_format
& OTF_XAdvDevice
)
1878 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
1879 if (value_format
& OTF_YAdvDevice
)
1880 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
1885 font_otf_Anchor (anchor
)
1890 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
1891 ASET (val
, 0, make_number (anchor
->XCoordinate
));
1892 ASET (val
, 1, make_number (anchor
->YCoordinate
));
1893 if (anchor
->AnchorFormat
== 2)
1894 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
1897 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
1898 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
1903 #endif /* HAVE_LIBOTF */
1905 /* G-string (glyph string) handler */
1907 /* G-string is a vector of the form [HEADER GLYPH ...].
1908 See the docstring of `font-make-gstring' for more detail. */
1911 font_prepare_composition (cmp
, f
)
1912 struct composition
*cmp
;
1916 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
1917 cmp
->hash_index
* 2);
1919 cmp
->font
= XFONT_OBJECT (LGSTRING_FONT (gstring
));
1920 cmp
->glyph_len
= LGSTRING_LENGTH (gstring
);
1921 cmp
->pixel_width
= LGSTRING_WIDTH (gstring
);
1922 cmp
->lbearing
= LGSTRING_LBEARING (gstring
);
1923 cmp
->rbearing
= LGSTRING_RBEARING (gstring
);
1924 cmp
->ascent
= LGSTRING_ASCENT (gstring
);
1925 cmp
->descent
= LGSTRING_DESCENT (gstring
);
1926 cmp
->width
= cmp
->pixel_width
/ FRAME_COLUMN_WIDTH (f
);
1927 if (cmp
->width
== 0)
1936 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*, Lisp_Object
));
1937 static int font_compare
P_ ((const void *, const void *));
1938 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
1939 Lisp_Object
, Lisp_Object
,
1942 /* We sort fonts by scoring each of them against a specified
1943 font-spec. The score value is 32 bit (`unsigned'), and the smaller
1944 the value is, the closer the font is to the font-spec.
1946 The highest 2 bits of the score is used for FAMILY. The exact
1947 match is 0, match with one of face-font-family-alternatives is
1950 The next 2 bits of the score is used for the atomic properties
1951 FOUNDRY and ADSTYLE respectively.
1953 Each 7-bit in the lower 28 bits are used for numeric properties
1954 WEIGHT, SLANT, WIDTH, and SIZE. */
1956 /* How many bits to shift to store the difference value of each font
1957 property in a score. Note that flots for FONT_TYPE_INDEX and
1958 FONT_REGISTRY_INDEX are not used. */
1959 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
1961 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
1962 The return value indicates how different ENTITY is compared with
1965 ALTERNATE_FAMILIES, if non-nil, is a pre-calculated list of
1966 alternate family names for AREF (SPEC_PROP, FONT_FAMILY_INDEX). */
1969 font_score (entity
, spec_prop
, alternate_families
)
1970 Lisp_Object entity
, *spec_prop
;
1971 Lisp_Object alternate_families
;
1976 /* Score three atomic fields. Maximum difference is 1 (family is 3). */
1977 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_ADSTYLE_INDEX
; i
++)
1978 if (i
!= FONT_REGISTRY_INDEX
1979 && ! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
1981 Lisp_Object entity_str
= SYMBOL_NAME (AREF (entity
, i
));
1982 Lisp_Object spec_str
= SYMBOL_NAME (spec_prop
[i
]);
1984 if (strcasecmp ((char *) SDATA (spec_str
), (char *) SDATA (entity_str
)))
1986 if (i
== FONT_FAMILY_INDEX
&& CONSP (alternate_families
))
1990 for (j
= 1; CONSP (alternate_families
);
1991 j
++, alternate_families
= XCDR (alternate_families
))
1993 spec_str
= XCAR (alternate_families
);
1994 if (strcasecmp ((char *) SDATA (spec_str
),
1995 (char *) SDATA (entity_str
)) == 0)
2001 score
|= j
<< sort_shift_bits
[i
];
2004 score
|= 1 << sort_shift_bits
[i
];
2008 /* Score three style numeric fields. Maximum difference is 127. */
2009 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2010 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2012 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2016 /* This is to prefer the exact symbol style. */
2018 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2021 /* Score the size. Maximum difference is 127. */
2022 i
= FONT_SIZE_INDEX
;
2023 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
])
2024 && XINT (AREF (entity
, i
)) > 0)
2026 /* We use the higher 6-bit for the actual size difference. The
2027 lowest bit is set if the DPI is different. */
2028 int diff
= XINT (spec_prop
[i
]) - XINT (AREF (entity
, i
));
2033 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2034 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2036 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2043 /* The comparison function for qsort. */
2046 font_compare (d1
, d2
)
2047 const void *d1
, *d2
;
2049 return (*(unsigned *) d1
- *(unsigned *) d2
);
2053 /* The structure for elements being sorted by qsort. */
2054 struct font_sort_data
2061 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2062 If PREFER specifies a point-size, calculate the corresponding
2063 pixel-size from QCdpi property of PREFER or from the Y-resolution
2064 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
2065 get the font-entities in VEC.
2067 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2068 return the sorted VEC. */
2071 font_sort_entites (vec
, prefer
, frame
, spec
, best_only
)
2072 Lisp_Object vec
, prefer
, frame
, spec
;
2075 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2077 struct font_sort_data
*data
;
2078 Lisp_Object alternate_families
= Qnil
;
2079 unsigned best_score
;
2080 Lisp_Object best_entity
;
2085 return best_only
? AREF (vec
, 0) : vec
;
2087 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_DPI_INDEX
; i
++)
2088 prefer_prop
[i
] = AREF (prefer
, i
);
2092 /* A font driver may return a font that has a property value
2093 different from the value specified in SPEC if the driver
2094 thinks they are the same. That happens, for instance, such a
2095 generic family name as "serif" is specified. So, to ignore
2096 such a difference, for all properties specified in SPEC, set
2097 the corresponding properties in PREFER_PROP to nil. */
2098 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2099 if (! NILP (AREF (spec
, i
)))
2100 prefer_prop
[i
] = Qnil
;
2103 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2104 prefer_prop
[FONT_SIZE_INDEX
]
2105 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2106 if (! NILP (prefer_prop
[FONT_FAMILY_INDEX
]))
2109 = Fassoc_string (prefer_prop
[FONT_FAMILY_INDEX
],
2110 Vface_alternative_font_family_alist
, Qt
);
2111 if (CONSP (alternate_families
))
2112 alternate_families
= XCDR (alternate_families
);
2115 /* Scoring and sorting. */
2116 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2117 best_score
= 0xFFFFFFFF;
2119 for (i
= 0; i
< len
; i
++)
2121 data
[i
].entity
= AREF (vec
, i
);
2122 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
,
2123 alternate_families
);
2124 if (best_only
&& best_score
> data
[i
].score
)
2126 best_score
= data
[i
].score
;
2127 best_entity
= data
[i
].entity
;
2128 if (best_score
== 0)
2132 if (NILP (best_entity
))
2134 qsort (data
, len
, sizeof *data
, font_compare
);
2135 for (i
= 0; i
< len
; i
++)
2136 ASET (vec
, i
, data
[i
].entity
);
2142 font_add_log ("sort-by", prefer
, vec
);
2147 /* API of Font Service Layer. */
2149 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2150 sort_shift_bits. Finternal_set_font_selection_order calls this
2151 function with font_sort_order after setting up it. */
2154 font_update_sort_order (order
)
2159 for (i
= 0, shift_bits
= 21; i
< 4; i
++, shift_bits
-= 7)
2161 int xlfd_idx
= order
[i
];
2163 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2164 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2165 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2166 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2167 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2168 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2170 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2175 /* Check if ENTITY matches with the font specification SPEC. */
2178 font_match_p (spec
, entity
)
2179 Lisp_Object spec
, entity
;
2181 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2182 Lisp_Object alternate_families
= Qnil
;
2185 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2186 prefer_prop
[i
] = AREF (spec
, i
);
2187 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2188 prefer_prop
[FONT_SIZE_INDEX
]
2189 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2190 if (! NILP (prefer_prop
[FONT_FAMILY_INDEX
]))
2193 = Fassoc_string (prefer_prop
[FONT_FAMILY_INDEX
],
2194 Vface_alternative_font_family_alist
, Qt
);
2195 if (CONSP (alternate_families
))
2196 alternate_families
= XCDR (alternate_families
);
2199 return (font_score (entity
, prefer_prop
, alternate_families
) == 0);
2203 /* CHeck a lispy font object corresponding to FONT. */
2206 font_check_object (font
)
2209 Lisp_Object tail
, elt
;
2211 for (tail
= font
->props
[FONT_OBJLIST_INDEX
]; CONSP (tail
);
2215 if (font
== XFONT_OBJECT (elt
))
2225 Each font backend has the callback function get_cache, and it
2226 returns a cons cell of which cdr part can be freely used for
2227 caching fonts. The cons cell may be shared by multiple frames
2228 and/or multiple font drivers. So, we arrange the cdr part as this:
2230 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2232 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2233 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2234 cons (FONT-SPEC FONT-ENTITY ...). */
2236 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2237 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2238 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2239 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2240 struct font_driver
*));
2243 font_prepare_cache (f
, driver
)
2245 struct font_driver
*driver
;
2247 Lisp_Object cache
, val
;
2249 cache
= driver
->get_cache (f
);
2251 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2255 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2256 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2260 val
= XCDR (XCAR (val
));
2261 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2267 font_finish_cache (f
, driver
)
2269 struct font_driver
*driver
;
2271 Lisp_Object cache
, val
, tmp
;
2274 cache
= driver
->get_cache (f
);
2276 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2277 cache
= val
, val
= XCDR (val
);
2278 font_assert (! NILP (val
));
2279 tmp
= XCDR (XCAR (val
));
2280 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2281 if (XINT (XCAR (tmp
)) == 0)
2283 font_clear_cache (f
, XCAR (val
), driver
);
2284 XSETCDR (cache
, XCDR (val
));
2290 font_get_cache (f
, driver
)
2292 struct font_driver
*driver
;
2294 Lisp_Object val
= driver
->get_cache (f
);
2295 Lisp_Object type
= driver
->type
;
2297 font_assert (CONSP (val
));
2298 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2299 font_assert (CONSP (val
));
2300 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2301 val
= XCDR (XCAR (val
));
2305 static int num_fonts
;
2308 font_clear_cache (f
, cache
, driver
)
2311 struct font_driver
*driver
;
2313 Lisp_Object tail
, elt
;
2315 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2316 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2319 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)) && VECTORP (XCDR (elt
)))
2321 Lisp_Object vec
= XCDR (elt
);
2324 for (i
= 0; i
< ASIZE (vec
); i
++)
2326 Lisp_Object entity
= AREF (vec
, i
);
2328 if (EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2330 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2332 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2334 Lisp_Object val
= XCAR (objlist
);
2335 struct font
*font
= XFONT_OBJECT (val
);
2337 font_assert (font
&& driver
== font
->driver
);
2338 driver
->close (f
, font
);
2341 if (driver
->free_entity
)
2342 driver
->free_entity (entity
);
2347 XSETCDR (cache
, Qnil
);
2351 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2354 font_delete_unmatched (list
, spec
, size
)
2355 Lisp_Object list
, spec
;
2358 Lisp_Object entity
, val
;
2359 enum font_property_index prop
;
2361 for (val
= Qnil
; CONSP (list
); list
= XCDR (list
))
2363 entity
= XCAR (list
);
2364 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2365 if (INTEGERP (AREF (spec
, prop
))
2366 && ((XINT (AREF (spec
, prop
)) >> 8)
2367 != (XINT (AREF (entity
, prop
)) >> 8)))
2368 prop
= FONT_SPEC_MAX
;
2369 if (prop
++ <= FONT_SIZE_INDEX
2371 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2373 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2376 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2377 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2378 prop
= FONT_SPEC_MAX
;
2380 if (prop
< FONT_SPEC_MAX
2381 && INTEGERP (AREF (spec
, FONT_SPACING_INDEX
))
2382 && ! EQ (AREF (spec
, FONT_SPACING_INDEX
),
2383 AREF (entity
, FONT_SPACING_INDEX
)))
2384 prop
= FONT_SPEC_MAX
;
2385 if (prop
< FONT_SPEC_MAX
)
2386 val
= Fcons (entity
, val
);
2392 /* Return a vector of font-entities matching with SPEC on FRAME. */
2395 font_list_entities (frame
, spec
)
2396 Lisp_Object frame
, spec
;
2398 FRAME_PTR f
= XFRAME (frame
);
2399 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2400 Lisp_Object ftype
, family
, alternate_familes
, val
;
2403 int need_filtering
= 0;
2407 font_assert (FONT_SPEC_P (spec
));
2409 family
= AREF (spec
, FONT_FAMILY_INDEX
);
2411 alternate_familes
= Qnil
;
2414 alternate_familes
= Fassoc_string (family
,
2415 Vface_alternative_font_family_alist
,
2417 if (! NILP (alternate_familes
))
2418 alternate_familes
= XCDR (alternate_familes
);
2419 n_family
+= XINT (Flength (alternate_familes
));
2422 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2423 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2424 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2425 size
= font_pixel_size (f
, spec
);
2429 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2430 for (i
= 1; i
<= FONT_REGISTRY_INDEX
; i
++)
2431 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2432 for (; i
< FONT_EXTRA_INDEX
; i
++)
2434 ASET (scratch_font_spec
, i
, Qnil
);
2435 if (! NILP (AREF (spec
, i
)))
2438 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2440 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
* n_family
);
2444 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2446 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2448 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2449 Lisp_Object tail
= alternate_familes
;
2453 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2460 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2461 copy
= Fcopy_font_spec (scratch_font_spec
);
2462 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2464 if (! NILP (val
) && need_filtering
)
2465 val
= font_delete_unmatched (val
, spec
, size
);
2473 ASET (scratch_font_spec
, FONT_FAMILY_INDEX
,
2474 Fintern (XCAR (tail
), Qnil
));
2479 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2480 font_add_log ("list", spec
, val
);
2485 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2486 nil, is an array of face's attributes, which specifies preferred
2487 font-related attributes. */
2490 font_matching_entity (f
, attrs
, spec
)
2492 Lisp_Object
*attrs
, spec
;
2494 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2495 Lisp_Object ftype
, size
, entity
;
2498 XSETFRAME (frame
, f
);
2499 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2500 size
= AREF (spec
, FONT_SIZE_INDEX
);
2502 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2504 for (; driver_list
; driver_list
= driver_list
->next
)
2506 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2508 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2511 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2512 entity
= assoc_no_quit (spec
, XCDR (cache
));
2514 entity
= XCDR (entity
);
2517 entity
= driver_list
->driver
->match (frame
, spec
);
2518 copy
= Fcopy_font_spec (spec
);
2519 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2520 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2522 if (! NILP (entity
))
2525 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2526 ASET (spec
, FONT_SIZE_INDEX
, size
);
2527 font_add_log ("match", spec
, entity
);
2532 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2533 opened font object. */
2536 font_open_entity (f
, entity
, pixel_size
)
2541 struct font_driver_list
*driver_list
;
2542 Lisp_Object objlist
, size
, val
, font_object
;
2546 font_assert (FONT_ENTITY_P (entity
));
2547 size
= AREF (entity
, FONT_SIZE_INDEX
);
2548 if (XINT (size
) != 0)
2549 pixel_size
= XINT (size
);
2551 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2552 objlist
= XCDR (objlist
))
2553 if (XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2554 return XCAR (objlist
);
2556 val
= AREF (entity
, FONT_TYPE_INDEX
);
2557 for (driver_list
= f
->font_driver_list
;
2558 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2559 driver_list
= driver_list
->next
);
2563 font_object
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2564 font_add_log ("open", entity
, font_object
);
2565 if (NILP (font_object
))
2567 ASET (entity
, FONT_OBJLIST_INDEX
,
2568 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2569 ASET (font_object
, FONT_OBJLIST_INDEX
, AREF (entity
, FONT_OBJLIST_INDEX
));
2572 font
= XFONT_OBJECT (font_object
);
2573 min_width
= (font
->min_width
? font
->min_width
2574 : font
->average_width
? font
->average_width
2575 : font
->space_width
? font
->space_width
2577 #ifdef HAVE_WINDOW_SYSTEM
2578 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2579 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2581 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2582 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
;
2583 fonts_changed_p
= 1;
2587 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2588 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2589 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > font
->height
)
2590 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
, fonts_changed_p
= 1;
2598 /* Close FONT_OBJECT that is opened on frame F. */
2601 font_close_object (f
, font_object
)
2603 Lisp_Object font_object
;
2605 struct font
*font
= XFONT_OBJECT (font_object
);
2606 Lisp_Object objlist
;
2607 Lisp_Object tail
, prev
= Qnil
;
2609 objlist
= AREF (font_object
, FONT_OBJLIST_INDEX
);
2610 for (prev
= Qnil
, tail
= objlist
; CONSP (tail
);
2611 prev
= tail
, tail
= XCDR (tail
))
2612 if (EQ (font_object
, XCAR (tail
)))
2614 font_add_log ("close", font_object
, Qnil
);
2615 font
->driver
->close (f
, font
);
2616 #ifdef HAVE_WINDOW_SYSTEM
2617 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2618 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2621 ASET (font_object
, FONT_OBJLIST_INDEX
, XCDR (objlist
));
2623 XSETCDR (prev
, XCDR (objlist
));
2631 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2632 FONT is a font-entity and it must be opened to check. */
2635 font_has_char (f
, font
, c
)
2642 if (FONT_ENTITY_P (font
))
2644 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2645 struct font_driver_list
*driver_list
;
2647 for (driver_list
= f
->font_driver_list
;
2648 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2649 driver_list
= driver_list
->next
);
2652 if (! driver_list
->driver
->has_char
)
2654 return driver_list
->driver
->has_char (font
, c
);
2657 font_assert (FONT_OBJECT_P (font
));
2658 fontp
= XFONT_OBJECT (font
);
2659 if (fontp
->driver
->has_char
)
2661 int result
= fontp
->driver
->has_char (font
, c
);
2666 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2670 /* Return the glyph ID of FONT_OBJECT for character C. */
2673 font_encode_char (font_object
, c
)
2674 Lisp_Object font_object
;
2679 font_assert (FONT_OBJECT_P (font_object
));
2680 font
= XFONT_OBJECT (font_object
);
2681 return font
->driver
->encode_char (font
, c
);
2685 /* Return the name of FONT_OBJECT. */
2688 font_get_name (font_object
)
2689 Lisp_Object font_object
;
2691 font_assert (FONT_OBJECT_P (font_object
));
2692 return AREF (font_object
, FONT_NAME_INDEX
);
2696 /* Return the specification of FONT_OBJECT. */
2699 font_get_spec (font_object
)
2700 Lisp_Object font_object
;
2702 Lisp_Object spec
= font_make_spec ();
2705 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2706 ASET (spec
, i
, AREF (font_object
, i
));
2707 ASET (spec
, FONT_SIZE_INDEX
,
2708 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2713 font_spec_from_name (font_name
)
2714 Lisp_Object font_name
;
2716 Lisp_Object args
[2];
2719 args
[1] = font_name
;
2720 return Ffont_spec (2, args
);
2725 font_clear_prop (attrs
, prop
)
2727 enum font_property_index prop
;
2729 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2733 if (NILP (AREF (font
, prop
))
2734 && prop
!= FONT_FAMILY_INDEX
&& prop
!= FONT_FAMILY_INDEX
)
2736 font
= Fcopy_font_spec (font
);
2737 ASET (font
, prop
, Qnil
);
2738 if (prop
== FONT_FAMILY_INDEX
)
2740 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
2741 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
2742 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
2743 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2744 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2745 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2747 else if (prop
== FONT_SIZE_INDEX
)
2749 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2750 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2751 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2753 attrs
[LFACE_FONT_INDEX
] = font
;
2757 font_update_lface (f
, attrs
)
2763 spec
= attrs
[LFACE_FONT_INDEX
];
2764 if (! FONT_SPEC_P (spec
))
2767 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
))
2768 || ! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2772 if (NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
2773 family
= AREF (spec
, FONT_FAMILY_INDEX
);
2774 else if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2775 family
= concat2 (SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
)),
2776 build_string ("-*"));
2778 family
= concat3 (SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
)),
2780 SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
)));
2781 attrs
[LFACE_FAMILY_INDEX
] = family
;
2783 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
2784 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
2785 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
2786 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);;
2787 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
2788 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
2789 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
2793 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2798 val
= Ffont_get (spec
, QCdpi
);
2801 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
2804 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2805 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
2806 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
2811 /* Return a font-entity satisfying SPEC and best matching with face's
2812 font related attributes in ATTRS. C, if not negative, is a
2813 character that the entity must support. */
2816 font_find_for_lface (f
, attrs
, spec
, c
)
2822 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
2828 Lisp_Object registry
= AREF (spec
, FONT_REGISTRY_INDEX
);
2829 struct charset
*encoding
, *repertory
;
2831 if (font_registry_charsets (registry
, &encoding
, &repertory
) < 0)
2835 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
2837 /* Any font of this registry support C. So, let's
2838 suppress the further checking. */
2841 else if (c
> encoding
->max_char
)
2845 XSETFRAME (frame
, f
);
2846 size
= AREF (spec
, FONT_SIZE_INDEX
);
2847 ASET (spec
, FONT_SIZE_INDEX
, Qnil
);
2848 entities
= font_list_entities (frame
, spec
);
2849 ASET (spec
, FONT_SIZE_INDEX
, size
);
2850 if (ASIZE (entities
) == 0)
2852 if (ASIZE (entities
) == 1)
2855 return AREF (entities
, 0);
2859 /* Sort fonts by properties specified in LFACE. */
2860 Lisp_Object prefer
= scratch_font_prefer
;
2862 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
2863 ASET (prefer
, i
, AREF (spec
, i
));
2864 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
2866 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
2868 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
2869 if (NILP (AREF (prefer
, i
)))
2870 ASET (prefer
, i
, AREF (face_font
, i
));
2872 if (NILP (AREF (prefer
, FONT_FAMILY_INDEX
)))
2873 font_parse_family_registry (attrs
[LFACE_FAMILY_INDEX
], Qnil
, prefer
);
2874 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
2875 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2876 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
2877 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2878 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
2879 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2880 if (INTEGERP (size
))
2881 ASET (prefer
, FONT_SIZE_INDEX
, size
);
2882 else if (FLOATP (size
))
2883 ASET (prefer
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2886 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
2887 int pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
2888 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2890 ASET (spec
, FONT_SIZE_INDEX
, Qnil
);
2891 entities
= font_sort_entites (entities
, prefer
, frame
, spec
, c
< 0);
2892 ASET (spec
, FONT_SIZE_INDEX
, size
);
2897 for (i
= 0; i
< ASIZE (entities
); i
++)
2901 val
= AREF (entities
, i
);
2904 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
2905 if (! EQ (AREF (val
, j
), props
[j
]))
2907 if (j
> FONT_REGISTRY_INDEX
)
2910 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
2911 props
[j
] = AREF (val
, j
);
2912 result
= font_has_char (f
, val
, c
);
2917 val
= font_open_for_lface (f
, val
, attrs
, spec
);
2920 result
= font_has_char (f
, val
, c
);
2921 font_close_object (f
, val
);
2923 return AREF (entities
, i
);
2930 font_open_for_lface (f
, entity
, attrs
, spec
)
2938 if (FONT_SPEC_P (spec
) && INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2939 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2942 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
2945 size
= POINT_TO_PIXEL (pt
, f
->resy
);
2947 return font_open_entity (f
, entity
, size
);
2951 /* Find a font satisfying SPEC and best matching with face's
2952 attributes in ATTRS on FRAME, and return the opened
2956 font_load_for_lface (f
, attrs
, spec
)
2958 Lisp_Object
*attrs
, spec
;
2962 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
2965 /* No font is listed for SPEC, but each font-backend may have
2966 the different criteria about "font matching". So, try
2968 entity
= font_matching_entity (f
, attrs
, spec
);
2972 return font_open_for_lface (f
, entity
, attrs
, spec
);
2976 /* Make FACE on frame F ready to use the font opened for FACE. */
2979 font_prepare_for_face (f
, face
)
2983 if (face
->font
->driver
->prepare_face
)
2984 face
->font
->driver
->prepare_face (f
, face
);
2988 /* Make FACE on frame F stop using the font opened for FACE. */
2991 font_done_for_face (f
, face
)
2995 if (face
->font
->driver
->done_face
)
2996 face
->font
->driver
->done_face (f
, face
);
3001 /* Open a font best matching with NAME on frame F. If no proper font
3002 is found, return Qnil. */
3005 font_open_by_name (f
, name
)
3009 Lisp_Object args
[2];
3010 Lisp_Object spec
, prefer
, size
, entity
, entity_list
;
3015 XSETFRAME (frame
, f
);
3018 args
[1] = make_unibyte_string (name
, strlen (name
));
3019 spec
= Ffont_spec (2, args
);
3020 prefer
= scratch_font_prefer
;
3021 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
3023 ASET (prefer
, i
, AREF (spec
, i
));
3024 if (NILP (AREF (prefer
, i
))
3025 && i
>= FONT_WEIGHT_INDEX
&& i
<= FONT_WIDTH_INDEX
)
3026 FONT_SET_STYLE (prefer
, i
, make_number (100));
3028 size
= AREF (spec
, FONT_SIZE_INDEX
);
3033 if (INTEGERP (size
))
3034 pixel_size
= XINT (size
);
3035 else /* FLOATP (size) */
3037 double pt
= XFLOAT_DATA (size
);
3039 pixel_size
= POINT_TO_PIXEL (pt
, f
->resy
);
3041 if (pixel_size
== 0)
3042 ASET (spec
, FONT_SIZE_INDEX
, Qnil
);
3044 if (pixel_size
== 0)
3046 pixel_size
= POINT_TO_PIXEL (12.0, f
->resy
);
3047 size
= make_number (pixel_size
);
3048 ASET (prefer
, FONT_SIZE_INDEX
, size
);
3050 if (NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3051 ASET (spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
3053 entity_list
= Flist_fonts (spec
, frame
, make_number (1), prefer
);
3054 if (NILP (entity_list
))
3055 entity
= font_matching_entity (f
, NULL
, spec
);
3057 entity
= XCAR (entity_list
);
3058 return (NILP (entity
)
3060 : font_open_entity (f
, entity
, pixel_size
));
3064 /* Register font-driver DRIVER. This function is used in two ways.
3066 The first is with frame F non-NULL. In this case, make DRIVER
3067 available (but not yet activated) on F. All frame creaters
3068 (e.g. Fx_create_frame) must call this function at least once with
3069 an available font-driver.
3071 The second is with frame F NULL. In this case, DRIVER is globally
3072 registered in the variable `font_driver_list'. All font-driver
3073 implementations must call this function in its syms_of_XXXX
3074 (e.g. syms_of_xfont). */
3077 register_font_driver (driver
, f
)
3078 struct font_driver
*driver
;
3081 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3082 struct font_driver_list
*prev
, *list
;
3084 if (f
&& ! driver
->draw
)
3085 error ("Unusable font driver for a frame: %s",
3086 SDATA (SYMBOL_NAME (driver
->type
)));
3088 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3089 if (EQ (list
->driver
->type
, driver
->type
))
3090 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3092 list
= malloc (sizeof (struct font_driver_list
));
3094 list
->driver
= driver
;
3099 f
->font_driver_list
= list
;
3101 font_driver_list
= list
;
3106 /* Free font-driver list on frame F. It doesn't free font-drivers
3110 free_font_driver_list (f
)
3113 while (f
->font_driver_list
)
3115 struct font_driver_list
*next
= f
->font_driver_list
->next
;
3117 free (f
->font_driver_list
);
3118 f
->font_driver_list
= next
;
3123 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3124 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3125 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3127 A caller must free all realized faces if any in advance. The
3128 return value is a list of font backends actually made used on
3132 font_update_drivers (f
, new_drivers
)
3134 Lisp_Object new_drivers
;
3136 Lisp_Object active_drivers
= Qnil
;
3137 struct font_driver_list
*list
;
3139 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3142 if (! EQ (new_drivers
, Qt
)
3143 && NILP (Fmemq (list
->driver
->type
, new_drivers
)))
3145 if (list
->driver
->end_for_frame
)
3146 list
->driver
->end_for_frame (f
);
3147 font_finish_cache (f
, list
->driver
);
3153 if (EQ (new_drivers
, Qt
)
3154 || ! NILP (Fmemq (list
->driver
->type
, new_drivers
)))
3156 if (! list
->driver
->start_for_frame
3157 || list
->driver
->start_for_frame (f
) == 0)
3159 font_prepare_cache (f
, list
->driver
);
3161 active_drivers
= nconc2 (active_drivers
,
3162 Fcons (list
->driver
->type
, Qnil
));
3167 return active_drivers
;
3171 font_put_frame_data (f
, driver
, data
)
3173 struct font_driver
*driver
;
3176 struct font_data_list
*list
, *prev
;
3178 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3179 prev
= list
, list
= list
->next
)
3180 if (list
->driver
== driver
)
3187 prev
->next
= list
->next
;
3189 f
->font_data_list
= list
->next
;
3197 list
= malloc (sizeof (struct font_data_list
));
3200 list
->driver
= driver
;
3201 list
->next
= f
->font_data_list
;
3202 f
->font_data_list
= list
;
3210 font_get_frame_data (f
, driver
)
3212 struct font_driver
*driver
;
3214 struct font_data_list
*list
;
3216 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3217 if (list
->driver
== driver
)
3225 /* Return the font used to draw character C by FACE at buffer position
3226 POS in window W. If STRING is non-nil, it is a string containing C
3227 at index POS. If C is negative, get C from the current buffer or
3231 font_at (c
, pos
, face
, w
, string
)
3240 Lisp_Object font_object
;
3246 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3249 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3251 c
= FETCH_CHAR (pos_byte
);
3254 c
= FETCH_BYTE (pos
);
3260 multibyte
= STRING_MULTIBYTE (string
);
3263 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3265 str
= SDATA (string
) + pos_byte
;
3266 c
= STRING_CHAR (str
, 0);
3269 c
= SDATA (string
)[pos
];
3273 f
= XFRAME (w
->frame
);
3274 if (! FRAME_WINDOW_P (f
))
3281 if (STRINGP (string
))
3282 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3283 DEFAULT_FACE_ID
, 0);
3285 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3287 face
= FACE_FROM_ID (f
, face_id
);
3291 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3292 face
= FACE_FROM_ID (f
, face_id
);
3297 font_assert (font_check_object ((struct font
*) face
->font
));
3298 XSETFONT (font_object
, face
->font
);
3303 /* Check how many characters after POS (at most to LIMIT) can be
3304 displayed by the same font. FACE is the face selected for the
3305 character as POS on frame F. STRING, if not nil, is the string to
3306 check instead of the current buffer.
3308 The return value is the position of the character that is displayed
3309 by the differnt font than that of the character as POS. */
3312 font_range (pos
, limit
, face
, f
, string
)
3313 EMACS_INT pos
, limit
;
3326 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3327 pos_byte
= CHAR_TO_BYTE (pos
);
3331 multibyte
= STRING_MULTIBYTE (string
);
3332 pos_byte
= string_char_to_byte (string
, pos
);
3336 /* All unibyte character are displayed by the same font. */
3344 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3346 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3347 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3348 face
= FACE_FROM_ID (f
, face_id
);
3355 else if (font
!= face
->font
)
3367 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3368 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3369 Return nil otherwise.
3370 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3371 which kind of font it is. It must be one of `font-spec', `font-entity',
3373 (object
, extra_type
)
3374 Lisp_Object object
, extra_type
;
3376 if (NILP (extra_type
))
3377 return (FONTP (object
) ? Qt
: Qnil
);
3378 if (EQ (extra_type
, Qfont_spec
))
3379 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3380 if (EQ (extra_type
, Qfont_entity
))
3381 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3382 if (EQ (extra_type
, Qfont_object
))
3383 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3384 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3387 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3388 doc
: /* Return a newly created font-spec with arguments as properties.
3390 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3391 valid font property name listed below:
3393 `:family', `:weight', `:slant', `:width'
3395 They are the same as face attributes of the same name. See
3396 `set-face-attribute'.
3400 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3404 VALUE must be a string or a symbol specifying the additional
3405 typographic style information of a font, e.g. ``sans''.
3409 VALUE must be a string or a symbol specifying the charset registry and
3410 encoding of a font, e.g. ``iso8859-1''.
3414 VALUE must be a non-negative integer or a floating point number
3415 specifying the font size. It specifies the font size in pixels
3416 (if VALUE is an integer), or in points (if VALUE is a float).
3417 usage: (font-spec ARGS ...) */)
3422 Lisp_Object spec
= font_make_spec ();
3425 for (i
= 0; i
< nargs
; i
+= 2)
3427 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3429 if (EQ (key
, QCname
))
3432 font_parse_name ((char *) SDATA (val
), spec
);
3433 font_put_extra (spec
, key
, val
);
3435 else if (EQ (key
, QCfamily
))
3438 font_parse_family_registry (val
, Qnil
, spec
);
3442 int idx
= get_font_prop_index (key
);
3446 val
= font_prop_validate (idx
, Qnil
, val
);
3447 if (idx
< FONT_EXTRA_INDEX
)
3448 ASET (spec
, idx
, val
);
3450 font_put_extra (spec
, key
, val
);
3453 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3459 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3460 doc
: /* Return a copy of FONT as a font-spec. */)
3464 Lisp_Object new_spec
, tail
, extra
;
3468 new_spec
= font_make_spec ();
3469 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3470 ASET (new_spec
, i
, AREF (font
, i
));
3472 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3474 if (! EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3475 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3477 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3481 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3482 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3483 Every specified properties in FROM override the corresponding
3484 properties in TO. */)
3486 Lisp_Object from
, to
;
3488 Lisp_Object extra
, tail
;
3493 to
= Fcopy_font_spec (to
);
3494 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3495 ASET (to
, i
, AREF (from
, i
));
3496 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3497 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3498 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3500 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3503 XSETCDR (slot
, XCDR (XCAR (tail
)));
3505 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3507 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3511 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3512 doc
: /* Return the value of FONT's property KEY.
3513 FONT is a font-spec, a font-entity, or a font-object. */)
3515 Lisp_Object font
, key
;
3522 idx
= get_font_prop_index (key
);
3523 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3524 return AREF (font
, idx
);
3525 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3529 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3530 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
3531 (font_spec
, prop
, val
)
3532 Lisp_Object font_spec
, prop
, val
;
3536 CHECK_FONT_SPEC (font_spec
);
3537 idx
= get_font_prop_index (prop
);
3538 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3540 if (idx
== FONT_FAMILY_INDEX
3542 font_parse_family_registry (val
, Qnil
, font_spec
);
3544 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
3547 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
3551 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3552 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3553 Optional 2nd argument FRAME specifies the target frame.
3554 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3555 Optional 4th argument PREFER, if non-nil, is a font-spec to
3556 control the order of the returned list. Fonts are sorted by
3557 how close they are to PREFER. */)
3558 (font_spec
, frame
, num
, prefer
)
3559 Lisp_Object font_spec
, frame
, num
, prefer
;
3561 Lisp_Object vec
, list
, tail
;
3565 frame
= selected_frame
;
3566 CHECK_LIVE_FRAME (frame
);
3567 CHECK_FONT_SPEC (font_spec
);
3575 if (! NILP (prefer
))
3576 CHECK_FONT_SPEC (prefer
);
3578 vec
= font_list_entities (frame
, font_spec
);
3583 return Fcons (AREF (vec
, 0), Qnil
);
3585 if (! NILP (prefer
))
3586 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
, 0);
3588 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3589 if (n
== 0 || n
> len
)
3591 for (i
= 1; i
< n
; i
++)
3593 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3595 XSETCDR (tail
, val
);
3601 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
3602 doc
: /* List available font families on the current frame.
3603 Optional argument FRAME, if non-nil, specifies the target frame. */)
3608 struct font_driver_list
*driver_list
;
3612 frame
= selected_frame
;
3613 CHECK_LIVE_FRAME (frame
);
3616 for (driver_list
= f
->font_driver_list
; driver_list
;
3617 driver_list
= driver_list
->next
)
3618 if (driver_list
->driver
->list_family
)
3620 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3626 Lisp_Object tail
= list
;
3628 for (; CONSP (val
); val
= XCDR (val
))
3629 if (NILP (Fmemq (XCAR (val
), tail
)))
3630 list
= Fcons (XCAR (val
), list
);
3636 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3637 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3638 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3640 Lisp_Object font_spec
, frame
;
3642 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3649 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
3650 doc
: /* Return XLFD name of FONT.
3651 FONT is a font-spec, font-entity, or font-object.
3652 If the name is too long for XLFD (maximum 255 chars), return nil.
3653 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
3654 the consecutive wildcards are folded to one. */)
3655 (font
, fold_wildcards
)
3656 Lisp_Object font
, fold_wildcards
;
3663 if (FONT_OBJECT_P (font
))
3665 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
3667 if (STRINGP (font_name
)
3668 && SDATA (font_name
)[0] == '-')
3670 if (NILP (fold_wildcards
))
3672 strcpy (name
, (char *) SDATA (font_name
));
3675 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
3677 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3680 if (! NILP (fold_wildcards
))
3682 char *p0
= name
, *p1
;
3684 while ((p1
= strstr (p0
, "-*-*")))
3686 strcpy (p1
, p1
+ 2);
3691 return build_string (name
);
3694 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3695 doc
: /* Clear font cache. */)
3698 Lisp_Object list
, frame
;
3700 FOR_EACH_FRAME (list
, frame
)
3702 FRAME_PTR f
= XFRAME (frame
);
3703 struct font_driver_list
*driver_list
= f
->font_driver_list
;
3705 for (; driver_list
; driver_list
= driver_list
->next
)
3706 if (driver_list
->on
)
3708 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
3713 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
3715 font_assert (! NILP (val
));
3716 val
= XCDR (XCAR (val
));
3717 if (XINT (XCAR (val
)) == 0)
3719 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
3720 XSETCDR (cache
, XCDR (val
));
3728 /* The following three functions are still experimental. */
3730 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
3731 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
3732 FONT-OBJECT may be nil if it is not yet known.
3734 G-string is sequence of glyphs of a specific font,
3735 and is a vector of this form:
3736 [ HEADER GLYPH ... ]
3737 HEADER is a vector of this form:
3738 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
3740 FONT-OBJECT is a font-object for all glyphs in the g-string,
3741 WIDTH thru DESCENT are the metrics (in pixels) of the whole G-string.
3742 GLYPH is a vector of this form:
3743 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
3744 [ [X-OFF Y-OFF WADJUST] | nil] ]
3746 FROM-IDX and TO-IDX are used internally and should not be touched.
3747 C is the character of the glyph.
3748 CODE is the glyph-code of C in FONT-OBJECT.
3749 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
3750 X-OFF and Y-OFF are offests to the base position for the glyph.
3751 WADJUST is the adjustment to the normal width of the glyph. */)
3753 Lisp_Object font_object
, num
;
3755 Lisp_Object gstring
, g
;
3759 if (! NILP (font_object
))
3760 CHECK_FONT_OBJECT (font_object
);
3763 len
= XINT (num
) + 1;
3764 gstring
= Fmake_vector (make_number (len
), Qnil
);
3765 g
= Fmake_vector (make_number (6), Qnil
);
3766 ASET (g
, 0, font_object
);
3767 ASET (gstring
, 0, g
);
3768 for (i
= 1; i
< len
; i
++)
3769 ASET (gstring
, i
, Fmake_vector (make_number (10), Qnil
));
3773 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
3774 doc
: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
3775 START and END specify the region to extract characters.
3776 If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
3777 where to extract characters.
3778 FONT-OBJECT may be nil if GSTRING already contains one. */)
3779 (gstring
, font_object
, start
, end
, object
)
3780 Lisp_Object gstring
, font_object
, start
, end
, object
;
3786 CHECK_VECTOR (gstring
);
3787 if (NILP (font_object
))
3788 font_object
= LGSTRING_FONT (gstring
);
3789 font
= XFONT_OBJECT (font_object
);
3791 if (STRINGP (object
))
3793 const unsigned char *p
;
3795 CHECK_NATNUM (start
);
3797 if (XINT (start
) > XINT (end
)
3798 || XINT (end
) > ASIZE (object
)
3799 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3800 args_out_of_range_3 (object
, start
, end
);
3802 len
= XINT (end
) - XINT (start
);
3803 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
3804 for (i
= 0; i
< len
; i
++)
3806 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3807 /* Shut up GCC warning in comparison with
3808 MOST_POSITIVE_FIXNUM below. */
3811 c
= STRING_CHAR_ADVANCE (p
);
3812 cod
= code
= font
->driver
->encode_char (font
, c
);
3813 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
3815 LGLYPH_SET_FROM (g
, i
);
3816 LGLYPH_SET_TO (g
, i
);
3817 LGLYPH_SET_CHAR (g
, c
);
3818 LGLYPH_SET_CODE (g
, code
);
3825 if (! NILP (object
))
3826 Fset_buffer (object
);
3827 validate_region (&start
, &end
);
3828 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3829 args_out_of_range (start
, end
);
3830 len
= XINT (end
) - XINT (start
);
3832 pos_byte
= CHAR_TO_BYTE (pos
);
3833 for (i
= 0; i
< len
; i
++)
3835 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3836 /* Shut up GCC warning in comparison with
3837 MOST_POSITIVE_FIXNUM below. */
3840 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
3841 cod
= code
= font
->driver
->encode_char (font
, c
);
3842 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
3844 LGLYPH_SET_FROM (g
, i
);
3845 LGLYPH_SET_TO (g
, i
);
3846 LGLYPH_SET_CHAR (g
, c
);
3847 LGLYPH_SET_CODE (g
, code
);
3850 for (; i
< LGSTRING_LENGTH (gstring
); i
++)
3851 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
3855 DEFUN ("font-shape-text", Ffont_shape_text
, Sfont_shape_text
, 3, 4, 0,
3856 doc
: /* Shape text between FROM and TO by FONT-OBJECT.
3857 If optional 4th argument STRING is non-nil, it is a string to shape,
3858 and FROM and TO are indices to the string.
3859 The value is the end position of the text that can be shaped by
3861 (from
, to
, font_object
, string
)
3862 Lisp_Object from
, to
, font_object
, string
;
3865 struct font_metrics metrics
;
3866 EMACS_INT start
, end
;
3867 Lisp_Object gstring
, n
;
3870 if (! FONT_OBJECT_P (font_object
))
3872 font
= XFONT_OBJECT (font_object
);
3873 if (! font
->driver
->shape
)
3878 validate_region (&from
, &to
);
3879 start
= XFASTINT (from
);
3880 end
= XFASTINT (to
);
3881 modify_region (current_buffer
, start
, end
, 0);
3885 CHECK_STRING (string
);
3886 start
= XINT (from
);
3888 if (start
< 0 || start
> end
|| end
> SCHARS (string
))
3889 args_out_of_range_3 (string
, from
, to
);
3893 gstring
= Ffont_make_gstring (font_object
, make_number (len
));
3894 Ffont_fill_gstring (gstring
, font_object
, from
, to
, string
);
3896 /* Try at most three times with larger gstring each time. */
3897 for (i
= 0; i
< 3; i
++)
3899 Lisp_Object args
[2];
3901 n
= font
->driver
->shape (gstring
);
3905 args
[1] = Fmake_vector (make_number (len
), Qnil
);
3906 gstring
= Fvconcat (2, args
);
3908 if (! INTEGERP (n
) || XINT (n
) == 0)
3912 for (i
= 0; i
< len
;)
3915 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3916 EMACS_INT this_from
= LGLYPH_FROM (g
);
3917 EMACS_INT this_to
= LGLYPH_TO (g
) + 1;
3919 int need_composition
= 0;
3921 metrics
.lbearing
= LGLYPH_LBEARING (g
);
3922 metrics
.rbearing
= LGLYPH_RBEARING (g
);
3923 metrics
.ascent
= LGLYPH_ASCENT (g
);
3924 metrics
.descent
= LGLYPH_DESCENT (g
);
3925 if (NILP (LGLYPH_ADJUSTMENT (g
)))
3927 metrics
.width
= LGLYPH_WIDTH (g
);
3928 if (LGLYPH_CHAR (g
) == 0 || metrics
.width
== 0)
3929 need_composition
= 1;
3933 metrics
.width
= LGLYPH_WADJUST (g
);
3934 metrics
.lbearing
+= LGLYPH_XOFF (g
);
3935 metrics
.rbearing
+= LGLYPH_XOFF (g
);
3936 metrics
.ascent
-= LGLYPH_YOFF (g
);
3937 metrics
.descent
+= LGLYPH_YOFF (g
);
3938 need_composition
= 1;
3940 for (j
= i
+ 1; j
< len
; j
++)
3944 g
= LGSTRING_GLYPH (gstring
, j
);
3945 if (this_from
!= LGLYPH_FROM (g
))
3947 need_composition
= 1;
3948 x
= metrics
.width
+ LGLYPH_LBEARING (g
) + LGLYPH_XOFF (g
);
3949 if (metrics
.lbearing
> x
)
3950 metrics
.lbearing
= x
;
3951 x
= metrics
.width
+ LGLYPH_RBEARING (g
) + LGLYPH_XOFF (g
);
3952 if (metrics
.rbearing
< x
)
3953 metrics
.rbearing
= x
;
3954 x
= LGLYPH_ASCENT (g
) - LGLYPH_YOFF (g
);
3955 if (metrics
.ascent
< x
)
3957 x
= LGLYPH_DESCENT (g
) - LGLYPH_YOFF (g
);
3958 if (metrics
.descent
< x
)
3959 metrics
.descent
= x
;
3960 if (NILP (LGLYPH_ADJUSTMENT (g
)))
3961 metrics
.width
+= LGLYPH_WIDTH (g
);
3963 metrics
.width
+= LGLYPH_WADJUST (g
);
3966 if (need_composition
)
3968 gstr
= Ffont_make_gstring (font_object
, make_number (j
- i
));
3969 LGSTRING_SET_WIDTH (gstr
, metrics
.width
);
3970 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
3971 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
);
3972 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
3973 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
3974 for (k
= i
; i
< j
; i
++)
3976 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3978 LGLYPH_SET_FROM (g
, LGLYPH_FROM (g
) - this_from
);
3979 LGLYPH_SET_TO (g
, LGLYPH_TO (g
) - this_from
);
3980 LGSTRING_SET_GLYPH (gstr
, i
- k
, LGSTRING_GLYPH (gstring
, i
));
3982 from
= make_number (start
+ this_from
);
3983 to
= make_number (start
+ this_to
);
3985 Fcompose_region_internal (from
, to
, gstr
, Qnil
);
3987 Fcompose_string_internal (string
, from
, to
, gstr
, Qnil
);
3996 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
3997 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
3998 OTF-FEATURES specifies which features to apply in this format:
3999 (SCRIPT LANGSYS GSUB GPOS)
4001 SCRIPT is a symbol specifying a script tag of OpenType,
4002 LANGSYS is a symbol specifying a langsys tag of OpenType,
4003 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4005 If LANGYS is nil, the default langsys is selected.
4007 The features are applied in the order they appear in the list. The
4008 symbol `*' means to apply all available features not present in this
4009 list, and the remaining features are ignored. For instance, (vatu
4010 pstf * haln) is to apply vatu and pstf in this order, then to apply
4011 all available features other than vatu, pstf, and haln.
4013 The features are applied to the glyphs in the range FROM and TO of
4014 the glyph-string GSTRING-IN.
4016 If some feature is actually applicable, the resulting glyphs are
4017 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4018 this case, the value is the number of produced glyphs.
4020 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4023 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4024 produced in GSTRING-OUT, and the value is nil.
4026 See the documentation of `font-make-gstring' for the format of
4028 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4029 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4031 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4036 check_otf_features (otf_features
);
4037 CHECK_FONT_OBJECT (font_object
);
4038 font
= XFONT_OBJECT (font_object
);
4039 if (! font
->driver
->otf_drive
)
4040 error ("Font backend %s can't drive OpenType GSUB table",
4041 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4042 CHECK_CONS (otf_features
);
4043 CHECK_SYMBOL (XCAR (otf_features
));
4044 val
= XCDR (otf_features
);
4045 CHECK_SYMBOL (XCAR (val
));
4046 val
= XCDR (otf_features
);
4049 len
= check_gstring (gstring_in
);
4050 CHECK_VECTOR (gstring_out
);
4051 CHECK_NATNUM (from
);
4053 CHECK_NATNUM (index
);
4055 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4056 args_out_of_range_3 (from
, to
, make_number (len
));
4057 if (XINT (index
) >= ASIZE (gstring_out
))
4058 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4059 num
= font
->driver
->otf_drive (font
, otf_features
,
4060 gstring_in
, XINT (from
), XINT (to
),
4061 gstring_out
, XINT (index
), 0);
4064 return make_number (num
);
4067 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4069 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4070 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4072 (SCRIPT LANGSYS FEATURE ...)
4073 See the documentation of `font-drive-otf' for more detail.
4075 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4076 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4077 character code corresponding to the glyph or nil if there's no
4078 corresponding character. */)
4079 (font_object
, character
, otf_features
)
4080 Lisp_Object font_object
, character
, otf_features
;
4083 Lisp_Object gstring_in
, gstring_out
, g
;
4084 Lisp_Object alternates
;
4087 CHECK_FONT_GET_OBJECT (font_object
, font
);
4088 if (! font
->driver
->otf_drive
)
4089 error ("Font backend %s can't drive OpenType GSUB table",
4090 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4091 CHECK_CHARACTER (character
);
4092 CHECK_CONS (otf_features
);
4094 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4095 g
= LGSTRING_GLYPH (gstring_in
, 0);
4096 LGLYPH_SET_CHAR (g
, XINT (character
));
4097 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4098 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4099 gstring_out
, 0, 1)) < 0)
4100 gstring_out
= Ffont_make_gstring (font_object
,
4101 make_number (ASIZE (gstring_out
) * 2));
4103 for (i
= 0; i
< num
; i
++)
4105 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4106 int c
= LGLYPH_CHAR (g
);
4107 unsigned code
= LGLYPH_CODE (g
);
4109 alternates
= Fcons (Fcons (make_number (code
),
4110 c
> 0 ? make_number (c
) : Qnil
),
4113 return Fnreverse (alternates
);
4119 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4120 doc
: /* Open FONT-ENTITY. */)
4121 (font_entity
, size
, frame
)
4122 Lisp_Object font_entity
;
4128 CHECK_FONT_ENTITY (font_entity
);
4130 frame
= selected_frame
;
4131 CHECK_LIVE_FRAME (frame
);
4134 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4137 CHECK_NUMBER_OR_FLOAT (size
);
4139 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
4141 isize
= XINT (size
);
4145 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4148 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4149 doc
: /* Close FONT-OBJECT. */)
4150 (font_object
, frame
)
4151 Lisp_Object font_object
, frame
;
4153 CHECK_FONT_OBJECT (font_object
);
4155 frame
= selected_frame
;
4156 CHECK_LIVE_FRAME (frame
);
4157 font_close_object (XFRAME (frame
), font_object
);
4161 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4162 doc
: /* Return information about FONT-OBJECT.
4163 The value is a vector:
4164 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4167 NAME is a string of the font name (or nil if the font backend doesn't
4170 FILENAME is a string of the font file (or nil if the font backend
4171 doesn't provide a file name).
4173 PIXEL-SIZE is a pixel size by which the font is opened.
4175 SIZE is a maximum advance width of the font in pixels.
4177 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4180 CAPABILITY is a list whose first element is a symbol representing the
4181 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4182 remaining elements describe the details of the font capability.
4184 If the font is OpenType font, the form of the list is
4185 \(opentype GSUB GPOS)
4186 where GSUB shows which "GSUB" features the font supports, and GPOS
4187 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4188 lists of the format:
4189 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4191 If the font is not OpenType font, currently the length of the form is
4194 SCRIPT is a symbol representing OpenType script tag.
4196 LANGSYS is a symbol representing OpenType langsys tag, or nil
4197 representing the default langsys.
4199 FEATURE is a symbol representing OpenType feature tag.
4201 If the font is not OpenType font, CAPABILITY is nil. */)
4203 Lisp_Object font_object
;
4208 CHECK_FONT_GET_OBJECT (font_object
, font
);
4210 val
= Fmake_vector (make_number (9), Qnil
);
4211 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4212 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4213 ASET (val
, 2, make_number (font
->pixel_size
));
4214 ASET (val
, 3, make_number (font
->max_width
));
4215 ASET (val
, 4, make_number (font
->ascent
));
4216 ASET (val
, 5, make_number (font
->descent
));
4217 ASET (val
, 6, make_number (font
->space_width
));
4218 ASET (val
, 7, make_number (font
->average_width
));
4219 if (font
->driver
->otf_capability
)
4220 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4224 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4225 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4226 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4227 (font_object
, string
)
4228 Lisp_Object font_object
, string
;
4234 CHECK_FONT_GET_OBJECT (font_object
, font
);
4235 CHECK_STRING (string
);
4236 len
= SCHARS (string
);
4237 vec
= Fmake_vector (make_number (len
), Qnil
);
4238 for (i
= 0; i
< len
; i
++)
4240 Lisp_Object ch
= Faref (string
, make_number (i
));
4245 struct font_metrics metrics
;
4247 cod
= code
= font
->driver
->encode_char (font
, c
);
4248 if (code
== FONT_INVALID_CODE
)
4250 val
= Fmake_vector (make_number (6), Qnil
);
4251 if (cod
<= MOST_POSITIVE_FIXNUM
)
4252 ASET (val
, 0, make_number (code
));
4254 ASET (val
, 0, Fcons (make_number (code
>> 16),
4255 make_number (code
& 0xFFFF)));
4256 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4257 ASET (val
, 1, make_number (metrics
.lbearing
));
4258 ASET (val
, 2, make_number (metrics
.rbearing
));
4259 ASET (val
, 3, make_number (metrics
.width
));
4260 ASET (val
, 4, make_number (metrics
.ascent
));
4261 ASET (val
, 5, make_number (metrics
.descent
));
4267 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4268 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4269 FONT is a font-spec, font-entity, or font-object. */)
4271 Lisp_Object spec
, font
;
4273 CHECK_FONT_SPEC (spec
);
4276 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4279 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4280 doc
: /* Return a font-object for displaying a character at POSITION.
4281 Optional second arg WINDOW, if non-nil, is a window displaying
4282 the current buffer. It defaults to the currently selected window. */)
4283 (position
, window
, string
)
4284 Lisp_Object position
, window
, string
;
4291 CHECK_NUMBER_COERCE_MARKER (position
);
4292 pos
= XINT (position
);
4293 if (pos
< BEGV
|| pos
>= ZV
)
4294 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4298 CHECK_NUMBER (position
);
4299 CHECK_STRING (string
);
4300 pos
= XINT (position
);
4301 if (pos
< 0 || pos
>= SCHARS (string
))
4302 args_out_of_range (string
, position
);
4305 window
= selected_window
;
4306 CHECK_LIVE_WINDOW (window
);
4307 w
= XWINDOW (window
);
4309 return font_at (-1, pos
, NULL
, w
, string
);
4313 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4314 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4315 The value is a number of glyphs drawn.
4316 Type C-l to recover what previously shown. */)
4317 (font_object
, string
)
4318 Lisp_Object font_object
, string
;
4320 Lisp_Object frame
= selected_frame
;
4321 FRAME_PTR f
= XFRAME (frame
);
4327 CHECK_FONT_GET_OBJECT (font_object
, font
);
4328 CHECK_STRING (string
);
4329 len
= SCHARS (string
);
4330 code
= alloca (sizeof (unsigned) * len
);
4331 for (i
= 0; i
< len
; i
++)
4333 Lisp_Object ch
= Faref (string
, make_number (i
));
4337 code
[i
] = font
->driver
->encode_char (font
, c
);
4338 if (code
[i
] == FONT_INVALID_CODE
)
4341 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4343 if (font
->driver
->prepare_face
)
4344 font
->driver
->prepare_face (f
, face
);
4345 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4346 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4347 if (font
->driver
->done_face
)
4348 font
->driver
->done_face (f
, face
);
4350 return make_number (len
);
4354 #endif /* FONT_DEBUG */
4357 #define BUILD_STYLE_TABLE(TBL) \
4358 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4361 build_style_table (entry
, nelement
)
4362 struct table_entry
*entry
;
4366 Lisp_Object table
, elt
;
4368 table
= Fmake_vector (make_number (nelement
), Qnil
);
4369 for (i
= 0; i
< nelement
; i
++)
4371 for (j
= 0; entry
[i
].names
[j
]; j
++);
4372 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4373 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4374 for (j
= 0; entry
[i
].names
[j
]; j
++)
4375 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4376 ASET (table
, i
, elt
);
4381 static Lisp_Object Vfont_log
;
4382 static int font_log_env_checked
;
4385 font_add_log (action
, arg
, result
)
4387 Lisp_Object arg
, result
;
4389 Lisp_Object tail
, val
;
4392 if (! font_log_env_checked
)
4394 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
4395 font_log_env_checked
= 1;
4397 if (EQ (Vfont_log
, Qt
))
4400 arg
= Ffont_xlfd_name (arg
, Qt
);
4402 result
= Ffont_xlfd_name (result
, Qt
);
4403 else if (CONSP (result
))
4405 result
= Fcopy_sequence (result
);
4406 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4410 val
= Ffont_xlfd_name (val
, Qt
);
4411 XSETCAR (tail
, val
);
4414 else if (VECTORP (result
))
4416 result
= Fcopy_sequence (result
);
4417 for (i
= 0; i
< ASIZE (result
); i
++)
4419 val
= AREF (result
, i
);
4421 val
= Ffont_xlfd_name (val
, Qt
);
4422 ASET (result
, i
, val
);
4425 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4428 extern void syms_of_ftfont
P_ (());
4429 extern void syms_of_xfont
P_ (());
4430 extern void syms_of_xftfont
P_ (());
4431 extern void syms_of_ftxfont
P_ (());
4432 extern void syms_of_bdffont
P_ (());
4433 extern void syms_of_w32font
P_ (());
4434 extern void syms_of_atmfont
P_ (());
4439 sort_shift_bits
[FONT_SLANT_INDEX
] = 0;
4440 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 7;
4441 sort_shift_bits
[FONT_SIZE_INDEX
] = 14;
4442 sort_shift_bits
[FONT_WIDTH_INDEX
] = 21;
4443 sort_shift_bits
[FONT_ADSTYLE_INDEX
] = 28;
4444 sort_shift_bits
[FONT_FOUNDRY_INDEX
] = 29;
4445 sort_shift_bits
[FONT_FAMILY_INDEX
] = 30;
4446 /* Note that sort_shift_bits[FONT_SORT_TYPE] and
4447 sort_shift_bits[FONT_SORT_REGISTRY] are never used. */
4449 staticpro (&font_charset_alist
);
4450 font_charset_alist
= Qnil
;
4452 DEFSYM (Qfont_spec
, "font-spec");
4453 DEFSYM (Qfont_entity
, "font-entity");
4454 DEFSYM (Qfont_object
, "font-object");
4456 DEFSYM (Qopentype
, "opentype");
4458 DEFSYM (Qiso8859_1
, "iso8859-1");
4459 DEFSYM (Qiso10646_1
, "iso10646-1");
4460 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4461 DEFSYM (Qunicode_sip
, "unicode-sip");
4463 DEFSYM (QCotf
, ":otf");
4464 DEFSYM (QClang
, ":lang");
4465 DEFSYM (QCscript
, ":script");
4466 DEFSYM (QCantialias
, ":antialias");
4468 DEFSYM (QCfoundry
, ":foundry");
4469 DEFSYM (QCadstyle
, ":adstyle");
4470 DEFSYM (QCregistry
, ":registry");
4471 DEFSYM (QCspacing
, ":spacing");
4472 DEFSYM (QCdpi
, ":dpi");
4473 DEFSYM (QCscalable
, ":scalable");
4474 DEFSYM (QCavgwidth
, ":avgwidth");
4475 DEFSYM (QCfont_entity
, ":font-entity");
4476 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
4483 staticpro (&null_vector
);
4484 null_vector
= Fmake_vector (make_number (0), Qnil
);
4486 staticpro (&scratch_font_spec
);
4487 scratch_font_spec
= Ffont_spec (0, NULL
);
4488 staticpro (&scratch_font_prefer
);
4489 scratch_font_prefer
= Ffont_spec (0, NULL
);
4492 staticpro (&otf_list
);
4497 defsubr (&Sfont_spec
);
4498 defsubr (&Sfont_get
);
4499 defsubr (&Sfont_put
);
4500 defsubr (&Slist_fonts
);
4501 defsubr (&Sfont_family_list
);
4502 defsubr (&Sfind_font
);
4503 defsubr (&Sfont_xlfd_name
);
4504 defsubr (&Sclear_font_cache
);
4505 defsubr (&Sfont_make_gstring
);
4506 defsubr (&Sfont_fill_gstring
);
4507 defsubr (&Sfont_shape_text
);
4508 defsubr (&Sfont_drive_otf
);
4509 defsubr (&Sfont_otf_alternates
);
4512 defsubr (&Sopen_font
);
4513 defsubr (&Sclose_font
);
4514 defsubr (&Squery_font
);
4515 defsubr (&Sget_font_glyphs
);
4516 defsubr (&Sfont_match_p
);
4517 defsubr (&Sfont_at
);
4519 defsubr (&Sdraw_string
);
4521 #endif /* FONT_DEBUG */
4523 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
4525 Alist of fontname patterns vs the corresponding encoding and repertory info.
4526 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
4527 where ENCODING is a charset or a char-table,
4528 and REPERTORY is a charset, a char-table, or nil.
4530 If ENCODING and REPERTORY are the same, the element can have the form
4531 \(REGEXP . ENCODING).
4533 ENCODING is for converting a character to a glyph code of the font.
4534 If ENCODING is a charset, encoding a character by the charset gives
4535 the corresponding glyph code. If ENCODING is a char-table, looking up
4536 the table by a character gives the corresponding glyph code.
4538 REPERTORY specifies a repertory of characters supported by the font.
4539 If REPERTORY is a charset, all characters beloging to the charset are
4540 supported. If REPERTORY is a char-table, all characters who have a
4541 non-nil value in the table are supported. If REPERTORY is nil, Emacs
4542 gets the repertory information by an opened font and ENCODING. */);
4543 Vfont_encoding_alist
= Qnil
;
4545 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
4546 doc
: /* Vector of valid font weight values.
4547 Each element has the form:
4548 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
4549 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symobls. */);
4550 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
4552 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
4553 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
4554 See `font-weight_table' for the format of the vector. */);
4555 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
4557 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
4558 doc
: /* Alist of font width symbols vs the corresponding numeric values.
4559 See `font-weight_table' for the format of the vector. */);
4560 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
4562 staticpro (&font_style_table
);
4563 font_style_table
= Fmake_vector (make_number (3), Qnil
);
4564 ASET (font_style_table
, 0, Vfont_weight_table
);
4565 ASET (font_style_table
, 1, Vfont_slant_table
);
4566 ASET (font_style_table
, 2, Vfont_width_table
);
4568 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
4569 *Logging list of font related actions and results.
4570 The value t means to suppress the logging.
4571 The initial value is set to nil if the environment variable
4572 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
4575 #ifdef HAVE_WINDOW_SYSTEM
4576 #ifdef HAVE_FREETYPE
4578 #ifdef HAVE_X_WINDOWS
4583 #endif /* HAVE_XFT */
4584 #endif /* HAVE_X_WINDOWS */
4585 #else /* not HAVE_FREETYPE */
4586 #ifdef HAVE_X_WINDOWS
4588 #endif /* HAVE_X_WINDOWS */
4589 #endif /* not HAVE_FREETYPE */
4592 #endif /* HAVE_BDFFONT */
4595 #endif /* WINDOWSNT */
4599 #endif /* HAVE_WINDOW_SYSTEM */
4602 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
4603 (do not change this comment) */