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/>. */
34 #include "dispextern.h"
36 #include "character.h"
37 #include "composite.h"
43 #endif /* HAVE_X_WINDOWS */
47 #endif /* HAVE_NTGUI */
53 Lisp_Object Qfont_spec
, Qfont_entity
, Qfont_object
;
55 Lisp_Object Qopentype
;
57 /* Important character set strings. */
58 Lisp_Object Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
60 /* Special vector of zero length. This is repeatedly used by (struct
61 font_driver *)->list when a specified font is not found. */
62 static Lisp_Object null_vector
;
64 static Lisp_Object Vfont_weight_table
, Vfont_slant_table
, Vfont_width_table
;
66 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
67 static Lisp_Object font_style_table
;
69 /* Structure used for tables mapping weight, slant, and width numeric
70 values and their names. */
75 /* The first one is a valid name as a face attribute.
76 The second one (if any) is a typical name in XLFD field. */
81 /* Table of weight numeric values and their names. This table must be
82 sorted by numeric values in ascending order. */
84 static struct table_entry weight_table
[] =
87 { 20, { "ultra-light", "ultralight" }},
88 { 40, { "extra-light", "extralight" }},
90 { 75, { "semi-light", "semilight", "demilight", "book" }},
91 { 100, { "normal", "medium", "regular" }},
92 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
94 { 205, { "extra-bold", "extrabold" }},
95 { 210, { "ultra-bold", "ultrabold", "black" }}
98 /* Table of slant numeric values and their names. This table must be
99 sorted by numeric values in ascending order. */
101 static struct table_entry slant_table
[] =
103 { 0, { "reverse-oblique", "ro" }},
104 { 10, { "reverse-italic", "ri" }},
105 { 100, { "normal", "r" }},
106 { 200, { "italic" ,"i", "ot" }},
107 { 210, { "oblique", "o" }}
110 /* Table of width numeric values and their names. This table must be
111 sorted by numeric values in ascending order. */
113 static struct table_entry width_table
[] =
115 { 50, { "ultra-condensed", "ultracondensed" }},
116 { 63, { "extra-condensed", "extracondensed" }},
117 { 75, { "condensed", "compressed", "narrow" }},
118 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
119 { 100, { "normal", "medium", "regular" }},
120 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
121 { 125, { "expanded" }},
122 { 150, { "extra-expanded", "extraexpanded" }},
123 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
126 extern Lisp_Object Qnormal
;
128 /* Symbols representing keys of normal font properties. */
129 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
, QCsize
, QCname
;
130 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
;
131 /* Symbols representing keys of font extra info. */
132 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
133 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
134 /* Symbols representing values of font spacing property. */
135 Lisp_Object Qc
, Qm
, Qp
, Qd
;
137 Lisp_Object Vfont_encoding_alist
;
139 /* Alist of font registry symbol and the corresponding charsets
140 information. The information is retrieved from
141 Vfont_encoding_alist on demand.
143 Eash element has the form:
144 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
148 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
149 encodes a character code to a glyph code of a font, and
150 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
151 character is supported by a font.
153 The latter form means that the information for REGISTRY couldn't be
155 static Lisp_Object font_charset_alist
;
157 /* List of all font drivers. Each font-backend (XXXfont.c) calls
158 register_font_driver in syms_of_XXXfont to register its font-driver
160 static struct font_driver_list
*font_driver_list
;
164 /* Creaters of font-related Lisp object. */
169 Lisp_Object font_spec
;
170 struct font_spec
*spec
171 = ((struct font_spec
*)
172 allocate_pseudovector (VECSIZE (struct font_spec
),
173 FONT_SPEC_MAX
, PVEC_FONT
));
174 XSETFONT (font_spec
, spec
);
181 Lisp_Object font_entity
;
182 struct font_entity
*entity
183 = ((struct font_entity
*)
184 allocate_pseudovector (VECSIZE (struct font_entity
),
185 FONT_ENTITY_MAX
, PVEC_FONT
));
186 XSETFONT (font_entity
, entity
);
191 font_make_object (size
)
194 Lisp_Object font_object
;
196 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
197 XSETFONT (font_object
, font
);
204 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
205 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
206 static Lisp_Object font_matching_entity
P_ ((FRAME_PTR
, Lisp_Object
*,
209 /* Number of registered font drivers. */
210 static int num_font_drivers
;
213 /* Return a Lispy value of a font property value at STR and LEN bytes.
214 If STR is "*", it returns nil.
215 If all characters in STR are digits, it returns an integer.
216 Otherwise, it returns a symbol interned from STR. */
219 font_intern_prop (str
, len
)
227 if (len
== 1 && *str
== '*')
229 if (len
>=1 && isdigit (*str
))
231 for (i
= 1; i
< len
; i
++)
232 if (! isdigit (str
[i
]))
235 return make_number (atoi (str
));
238 /* The following code is copied from the function intern (in lread.c). */
240 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
241 obarray
= check_obarray (obarray
);
242 tem
= oblookup (obarray
, str
, len
, len
);
245 return Fintern (make_unibyte_string (str
, len
), obarray
);
248 /* Return a pixel size of font-spec SPEC on frame F. */
251 font_pixel_size (f
, spec
)
255 #ifdef HAVE_WINDOW_SYSTEM
256 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
265 font_assert (FLOATP (size
));
266 point_size
= XFLOAT_DATA (size
);
267 val
= AREF (spec
, FONT_DPI_INDEX
);
272 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
280 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
281 font vector. If VAL is not valid (i.e. not registered in
282 font_style_table), return -1 if NOERROR is zero, and return a
283 proper index if NOERROR is nonzero. In that case, register VAL in
284 font_style_table if VAL is a symbol, and return a closest index if
285 VAL is an integer. */
288 font_style_to_value (prop
, val
, noerror
)
289 enum font_property_index prop
;
293 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
294 int len
= ASIZE (table
);
300 Lisp_Object args
[2], elt
;
302 /* At first try exact match. */
303 for (i
= 0; i
< len
; i
++)
304 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
305 if (EQ (val
, AREF (AREF (table
, i
), j
)))
306 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
307 | (i
<< 4) | (j
- 1));
308 /* Try also with case-folding match. */
309 s
= SDATA (SYMBOL_NAME (val
));
310 for (i
= 0; i
< len
; i
++)
311 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
313 elt
= AREF (AREF (table
, i
), j
);
314 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
315 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
316 | (i
<< 4) | (j
- 1));
322 elt
= Fmake_vector (make_number (2), make_number (255));
325 args
[1] = Fmake_vector (make_number (1), elt
);
326 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
327 return (255 << 8) | (i
<< 4);
332 int numeric
= XINT (val
);
334 for (i
= 0, last_n
= -1; i
< len
; i
++)
336 int n
= XINT (AREF (AREF (table
, i
), 0));
339 return (n
<< 8) | (i
<< 4);
344 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
345 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
351 return ((last_n
<< 8) | ((i
- 1) << 4));
356 font_style_symbolic (font
, prop
, for_face
)
358 enum font_property_index prop
;
361 Lisp_Object val
= AREF (font
, prop
);
362 Lisp_Object table
, elt
;
367 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
368 i
= XINT (val
) & 0xFF;
369 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
370 elt
= AREF (table
, ((i
>> 4) & 0xF));
371 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
372 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
375 extern Lisp_Object Vface_alternative_font_family_alist
;
377 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
380 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
381 FONTNAME. ENCODING is a charset symbol that specifies the encoding
382 of the font. REPERTORY is a charset symbol or nil. */
385 find_font_encoding (fontname
)
386 Lisp_Object fontname
;
388 Lisp_Object tail
, elt
;
390 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
394 && STRINGP (XCAR (elt
))
395 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
396 && (SYMBOLP (XCDR (elt
))
397 ? CHARSETP (XCDR (elt
))
398 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
401 /* We don't know the encoding of this font. Let's assume `ascii'. */
405 /* Return encoding charset and repertory charset for REGISTRY in
406 ENCODING and REPERTORY correspondingly. If correct information for
407 REGISTRY is available, return 0. Otherwise return -1. */
410 font_registry_charsets (registry
, encoding
, repertory
)
411 Lisp_Object registry
;
412 struct charset
**encoding
, **repertory
;
415 int encoding_id
, repertory_id
;
417 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
423 encoding_id
= XINT (XCAR (val
));
424 repertory_id
= XINT (XCDR (val
));
428 val
= find_font_encoding (SYMBOL_NAME (registry
));
429 if (SYMBOLP (val
) && CHARSETP (val
))
431 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
433 else if (CONSP (val
))
435 if (! CHARSETP (XCAR (val
)))
437 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
438 if (NILP (XCDR (val
)))
442 if (! CHARSETP (XCDR (val
)))
444 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
449 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
451 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
455 *encoding
= CHARSET_FROM_ID (encoding_id
);
457 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
462 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
467 /* Font property value validaters. See the comment of
468 font_property_table for the meaning of the arguments. */
470 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
471 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
472 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
473 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
474 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
475 static int get_font_prop_index
P_ ((Lisp_Object
));
478 font_prop_validate_symbol (prop
, val
)
479 Lisp_Object prop
, val
;
482 val
= Fintern (val
, Qnil
);
485 else if (EQ (prop
, QCregistry
))
486 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
492 font_prop_validate_style (style
, val
)
493 Lisp_Object style
, val
;
495 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
496 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
503 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
507 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
509 if ((n
& 0xF) + 1 >= ASIZE (elt
))
511 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
515 else if (SYMBOLP (val
))
517 int n
= font_style_to_value (prop
, val
, 0);
519 val
= n
>= 0 ? make_number (n
) : Qerror
;
527 font_prop_validate_non_neg (prop
, val
)
528 Lisp_Object prop
, val
;
530 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
535 font_prop_validate_spacing (prop
, val
)
536 Lisp_Object prop
, val
;
538 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
540 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
542 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
544 if (spacing
== 'c' || spacing
== 'C')
545 return make_number (FONT_SPACING_CHARCELL
);
546 if (spacing
== 'm' || spacing
== 'M')
547 return make_number (FONT_SPACING_MONO
);
548 if (spacing
== 'p' || spacing
== 'P')
549 return make_number (FONT_SPACING_PROPORTIONAL
);
550 if (spacing
== 'd' || spacing
== 'D')
551 return make_number (FONT_SPACING_DUAL
);
557 font_prop_validate_otf (prop
, val
)
558 Lisp_Object prop
, val
;
560 Lisp_Object tail
, tmp
;
563 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
564 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
565 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
568 if (! SYMBOLP (XCAR (val
)))
573 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
575 for (i
= 0; i
< 2; i
++)
582 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
583 if (! SYMBOLP (XCAR (tmp
)))
591 /* Structure of known font property keys and validater of the
595 /* Pointer to the key symbol. */
597 /* Function to validate PROP's value VAL, or NULL if any value is
598 ok. The value is VAL or its regularized value if VAL is valid,
599 and Qerror if not. */
600 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
601 } font_property_table
[] =
602 { { &QCtype
, font_prop_validate_symbol
},
603 { &QCfoundry
, font_prop_validate_symbol
},
604 { &QCfamily
, font_prop_validate_symbol
},
605 { &QCadstyle
, font_prop_validate_symbol
},
606 { &QCregistry
, font_prop_validate_symbol
},
607 { &QCweight
, font_prop_validate_style
},
608 { &QCslant
, font_prop_validate_style
},
609 { &QCwidth
, font_prop_validate_style
},
610 { &QCsize
, font_prop_validate_non_neg
},
611 { &QCdpi
, font_prop_validate_non_neg
},
612 { &QCspacing
, font_prop_validate_spacing
},
613 { &QCavgwidth
, font_prop_validate_non_neg
},
614 /* The order of the above entries must match with enum
615 font_property_index. */
616 { &QClang
, font_prop_validate_symbol
},
617 { &QCscript
, font_prop_validate_symbol
},
618 { &QCotf
, font_prop_validate_otf
}
621 /* Size (number of elements) of the above table. */
622 #define FONT_PROPERTY_TABLE_SIZE \
623 ((sizeof font_property_table) / (sizeof *font_property_table))
625 /* Return an index number of font property KEY or -1 if KEY is not an
626 already known property. */
629 get_font_prop_index (key
)
634 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
635 if (EQ (key
, *font_property_table
[i
].key
))
640 /* Validate the font property. The property key is specified by the
641 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
642 signal an error. The value is VAL or the regularized one. */
645 font_prop_validate (idx
, prop
, val
)
647 Lisp_Object prop
, val
;
649 Lisp_Object validated
;
654 prop
= *font_property_table
[idx
].key
;
657 idx
= get_font_prop_index (prop
);
661 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
662 if (EQ (validated
, Qerror
))
663 signal_error ("invalid font property", Fcons (prop
, val
));
668 /* Store VAL as a value of extra font property PROP in FONT while
669 keeping the sorting order. Don't check the validity of VAL. */
672 font_put_extra (font
, prop
, val
)
673 Lisp_Object font
, prop
, val
;
675 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
676 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
680 Lisp_Object prev
= Qnil
;
683 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
684 prev
= extra
, extra
= XCDR (extra
);
686 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
688 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
696 /* Font name parser and unparser */
698 static int parse_matrix
P_ ((char *));
699 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
700 static int font_parse_name
P_ ((char *, Lisp_Object
));
702 /* An enumerator for each field of an XLFD font name. */
703 enum xlfd_field_index
722 /* An enumerator for mask bit corresponding to each XLFD field. */
725 XLFD_FOUNDRY_MASK
= 0x0001,
726 XLFD_FAMILY_MASK
= 0x0002,
727 XLFD_WEIGHT_MASK
= 0x0004,
728 XLFD_SLANT_MASK
= 0x0008,
729 XLFD_SWIDTH_MASK
= 0x0010,
730 XLFD_ADSTYLE_MASK
= 0x0020,
731 XLFD_PIXEL_MASK
= 0x0040,
732 XLFD_POINT_MASK
= 0x0080,
733 XLFD_RESX_MASK
= 0x0100,
734 XLFD_RESY_MASK
= 0x0200,
735 XLFD_SPACING_MASK
= 0x0400,
736 XLFD_AVGWIDTH_MASK
= 0x0800,
737 XLFD_REGISTRY_MASK
= 0x1000,
738 XLFD_ENCODING_MASK
= 0x2000
742 /* Parse P pointing the pixel/point size field of the form
743 `[A B C D]' which specifies a transformation matrix:
749 by which all glyphs of the font are transformed. The spec says
750 that scalar value N for the pixel/point size is equivalent to:
751 A = N * resx/resy, B = C = 0, D = N.
753 Return the scalar value N if the form is valid. Otherwise return
764 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
767 matrix
[i
] = - strtod (p
+ 1, &end
);
769 matrix
[i
] = strtod (p
, &end
);
772 return (i
== 4 ? (int) matrix
[3] : -1);
775 /* Expand a wildcard field in FIELD (the first N fields are filled) to
776 multiple fields to fill in all 14 XLFD fields while restring a
777 field position by its contents. */
780 font_expand_wildcards (field
, n
)
781 Lisp_Object field
[XLFD_LAST_INDEX
];
785 Lisp_Object tmp
[XLFD_LAST_INDEX
];
786 /* Array of information about where this element can go. Nth
787 element is for Nth element of FIELD. */
789 /* Minimum possible field. */
791 /* Maxinum possible field. */
793 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
795 } range
[XLFD_LAST_INDEX
];
797 int range_from
, range_to
;
800 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
801 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
802 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
803 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
804 | XLFD_AVGWIDTH_MASK)
805 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
807 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
808 field. The value is shifted to left one bit by one in the
810 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
811 range_mask
= (range_mask
<< 1) | 1;
813 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
814 position-based retriction for FIELD[I]. */
815 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
816 i
++, range_from
++, range_to
++, range_mask
<<= 1)
818 Lisp_Object val
= field
[i
];
824 range
[i
].from
= range_from
;
825 range
[i
].to
= range_to
;
826 range
[i
].mask
= range_mask
;
830 /* The triplet FROM, TO, and MASK is a value-based
831 retriction for FIELD[I]. */
837 int numeric
= XINT (val
);
840 from
= to
= XLFD_ENCODING_INDEX
,
841 mask
= XLFD_ENCODING_MASK
;
842 else if (numeric
== 0)
843 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
844 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
845 else if (numeric
<= 48)
846 from
= to
= XLFD_PIXEL_INDEX
,
847 mask
= XLFD_PIXEL_MASK
;
849 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
850 mask
= XLFD_LARGENUM_MASK
;
852 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
853 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
854 mask
= XLFD_NULL_MASK
;
856 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
859 Lisp_Object name
= SYMBOL_NAME (val
);
861 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
862 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
863 mask
= XLFD_REGENC_MASK
;
865 from
= to
= XLFD_ENCODING_INDEX
,
866 mask
= XLFD_ENCODING_MASK
;
868 else if (range_from
<= XLFD_WEIGHT_INDEX
869 && range_to
>= XLFD_WEIGHT_INDEX
870 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
871 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
872 else if (range_from
<= XLFD_SLANT_INDEX
873 && range_to
>= XLFD_SLANT_INDEX
874 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
875 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
876 else if (range_from
<= XLFD_SWIDTH_INDEX
877 && range_to
>= XLFD_SWIDTH_INDEX
878 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
879 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
882 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
883 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
885 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
886 mask
= XLFD_SYMBOL_MASK
;
889 /* Merge position-based and value-based restrictions. */
891 while (from
< range_from
)
892 mask
&= ~(1 << from
++);
893 while (from
< 14 && ! (mask
& (1 << from
)))
895 while (to
> range_to
)
896 mask
&= ~(1 << to
--);
897 while (to
>= 0 && ! (mask
& (1 << to
)))
901 range
[i
].from
= from
;
903 range
[i
].mask
= mask
;
905 if (from
> range_from
|| to
< range_to
)
907 /* The range is narrowed by value-based restrictions.
908 Reflect it to the other fields. */
910 /* Following fields should be after FROM. */
912 /* Preceding fields should be before TO. */
913 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
915 /* Check FROM for non-wildcard field. */
916 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
918 while (range
[j
].from
< from
)
919 range
[j
].mask
&= ~(1 << range
[j
].from
++);
920 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
922 range
[j
].from
= from
;
925 from
= range
[j
].from
;
926 if (range
[j
].to
> to
)
928 while (range
[j
].to
> to
)
929 range
[j
].mask
&= ~(1 << range
[j
].to
--);
930 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
943 /* Decide all fileds from restrictions in RANGE. */
944 for (i
= j
= 0; i
< n
; i
++)
946 if (j
< range
[i
].from
)
948 if (i
== 0 || ! NILP (tmp
[i
- 1]))
949 /* None of TMP[X] corresponds to Jth field. */
951 for (; j
< range
[i
].from
; j
++)
956 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
958 for (; j
< XLFD_LAST_INDEX
; j
++)
960 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
961 field
[XLFD_ENCODING_INDEX
]
962 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
967 #ifdef ENABLE_CHECKING
968 /* Match a 14-field XLFD pattern against a full XLFD font name. */
970 font_match_xlfd (char *pattern
, char *name
)
972 while (*pattern
&& *name
)
974 if (*pattern
== *name
)
976 else if (*pattern
== '*')
977 if (*name
== pattern
[1])
988 /* Make sure the font object matches the XLFD font name. */
990 font_check_xlfd_parse (Lisp_Object font
, char *name
)
992 char name_check
[256];
993 font_unparse_xlfd (font
, 0, name_check
, 255);
994 return font_match_xlfd (name_check
, name
);
1000 /* Parse NAME (null terminated) as XLFD and store information in FONT
1001 (font-spec or font-entity). Size property of FONT is set as
1003 specified XLFD fields FONT property
1004 --------------------- -------------
1005 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1006 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1007 POINT_SIZE POINT_SIZE/10 (Lisp float)
1009 If NAME is successfully parsed, return 0. Otherwise return -1.
1011 FONT is usually a font-spec, but when this function is called from
1012 X font backend driver, it is a font-entity. In that case, NAME is
1013 a fully specified XLFD. */
1016 font_parse_xlfd (name
, font
)
1020 int len
= strlen (name
);
1022 char *f
[XLFD_LAST_INDEX
+ 1];
1027 /* Maximum XLFD name length is 255. */
1029 /* Accept "*-.." as a fully specified XLFD. */
1030 if (name
[0] == '*' && name
[1] == '-')
1031 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1034 for (p
= name
+ i
; *p
; p
++)
1038 if (i
== XLFD_LAST_INDEX
)
1043 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N])
1045 if (i
== XLFD_LAST_INDEX
)
1047 /* Fully specified XLFD. */
1050 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD (XLFD_FOUNDRY_INDEX
));
1051 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD (XLFD_FAMILY_INDEX
));
1052 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1053 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1055 val
= INTERN_FIELD (i
);
1058 if ((n
= font_style_to_value (j
, INTERN_FIELD (i
), 0)) < 0)
1060 ASET (font
, j
, make_number (n
));
1063 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD (XLFD_ADSTYLE_INDEX
));
1064 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1065 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1067 ASET (font
, FONT_REGISTRY_INDEX
,
1068 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1069 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
]));
1070 p
= f
[XLFD_PIXEL_INDEX
];
1071 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1072 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1075 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1077 ASET (font
, FONT_SIZE_INDEX
, val
);
1080 double point_size
= -1;
1082 font_assert (FONT_SPEC_P (font
));
1083 p
= f
[XLFD_POINT_INDEX
];
1085 point_size
= parse_matrix (p
);
1086 else if (isdigit (*p
))
1087 point_size
= atoi (p
), point_size
/= 10;
1088 if (point_size
>= 0)
1089 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1093 ASET (font
, FONT_DPI_INDEX
, INTERN_FIELD (XLFD_RESY_INDEX
));
1094 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1097 val
= font_prop_validate_spacing (QCspacing
, val
);
1098 if (! INTEGERP (val
))
1100 ASET (font
, FONT_SPACING_INDEX
, val
);
1102 p
= f
[XLFD_AVGWIDTH_INDEX
];
1105 ASET (font
, FONT_AVGWIDTH_INDEX
,
1106 font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
));
1110 int wild_card_found
= 0;
1111 Lisp_Object prop
[XLFD_LAST_INDEX
];
1113 if (FONT_ENTITY_P (font
))
1115 for (j
= 0; j
< i
; j
++)
1119 if (f
[j
][1] && f
[j
][1] != '-')
1122 wild_card_found
= 1;
1125 prop
[j
] = INTERN_FIELD (j
);
1127 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
]);
1129 if (! wild_card_found
)
1131 if (font_expand_wildcards (prop
, i
) < 0)
1134 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1135 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1136 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1137 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1138 if (! NILP (prop
[i
]))
1140 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1142 ASET (font
, j
, make_number (n
));
1144 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1145 val
= prop
[XLFD_REGISTRY_INDEX
];
1148 val
= prop
[XLFD_ENCODING_INDEX
];
1150 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1152 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1153 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1155 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1156 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1158 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1160 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1161 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1162 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1164 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1166 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1169 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1170 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1171 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1173 val
= font_prop_validate_spacing (QCspacing
,
1174 prop
[XLFD_SPACING_INDEX
]);
1175 if (! INTEGERP (val
))
1177 ASET (font
, FONT_SPACING_INDEX
, val
);
1179 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1180 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1186 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1187 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1188 0, use PIXEL_SIZE instead. */
1191 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1197 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1201 font_assert (FONTP (font
));
1203 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1206 if (i
== FONT_ADSTYLE_INDEX
)
1207 j
= XLFD_ADSTYLE_INDEX
;
1208 else if (i
== FONT_REGISTRY_INDEX
)
1209 j
= XLFD_REGISTRY_INDEX
;
1210 val
= AREF (font
, i
);
1213 if (j
== XLFD_REGISTRY_INDEX
)
1214 f
[j
] = "*-*", len
+= 4;
1216 f
[j
] = "*", len
+= 2;
1221 val
= SYMBOL_NAME (val
);
1222 if (j
== XLFD_REGISTRY_INDEX
1223 && ! strchr ((char *) SDATA (val
), '-'))
1225 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1226 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1228 f
[j
] = alloca (SBYTES (val
) + 3);
1229 sprintf (f
[j
], "%s-*", SDATA (val
));
1230 len
+= SBYTES (val
) + 3;
1234 f
[j
] = alloca (SBYTES (val
) + 4);
1235 sprintf (f
[j
], "%s*-*", SDATA (val
));
1236 len
+= SBYTES (val
) + 4;
1240 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1244 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1247 val
= font_style_symbolic (font
, i
, 0);
1249 f
[j
] = "*", len
+= 2;
1252 val
= SYMBOL_NAME (val
);
1253 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1257 val
= AREF (font
, FONT_SIZE_INDEX
);
1258 font_assert (NUMBERP (val
) || NILP (val
));
1266 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1267 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1270 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1272 else if (FLOATP (val
))
1274 i
= XFLOAT_DATA (val
) * 10;
1275 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1276 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1279 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1281 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1283 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1284 f
[XLFD_RESX_INDEX
] = alloca (22);
1285 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1289 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1290 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1292 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1294 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1295 : spacing
<= FONT_SPACING_DUAL
? "d"
1296 : spacing
<= FONT_SPACING_MONO
? "m"
1301 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1302 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1304 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1305 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
],
1306 "%d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1309 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1310 len
++; /* for terminating '\0'. */
1313 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1314 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1315 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1316 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1317 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1318 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1319 f
[XLFD_REGISTRY_INDEX
]);
1322 /* Parse NAME (null terminated) as Fonconfig's name format and store
1323 information in FONT (font-spec or font-entity). If NAME is
1324 successfully parsed, return 0. Otherwise return -1. */
1327 font_parse_fcname (name
, font
)
1332 int len
= strlen (name
);
1337 /* It is assured that (name[0] && name[0] != '-'). */
1345 for (p0
= name
+ 1; *p0
&& (*p0
!= '-' && *p0
!= ':'); p0
++)
1346 if (*p0
== '\\' && p0
[1])
1348 family
= font_intern_prop (name
, p0
- name
);
1351 if (! isdigit (p0
[1]))
1353 point_size
= strtod (p0
+ 1, &p1
);
1354 if (*p1
&& *p1
!= ':')
1356 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1359 ASET (font
, FONT_FAMILY_INDEX
, family
);
1363 copy
= alloca (len
+ 1);
1368 /* Now parse ":KEY=VAL" patterns. Store known keys and values in
1369 extra, copy unknown ones to COPY. It is stored in extra slot by
1370 the key QCfc_unknown_spec. */
1373 Lisp_Object key
, val
;
1376 for (p1
= p0
+ 1; *p1
&& *p1
!= '=' && *p1
!= ':'; p1
++);
1379 /* Must be an enumerated value. */
1380 val
= font_intern_prop (p0
+ 1, p1
- p0
- 1);
1381 if (memcmp (p0
+ 1, "light", 5) == 0
1382 || memcmp (p0
+ 1, "medium", 6) == 0
1383 || memcmp (p0
+ 1, "demibold", 8) == 0
1384 || memcmp (p0
+ 1, "bold", 4) == 0
1385 || memcmp (p0
+ 1, "black", 5) == 0)
1386 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1387 else if (memcmp (p0
+ 1, "roman", 5) == 0
1388 || memcmp (p0
+ 1, "italic", 6) == 0
1389 || memcmp (p0
+ 1, "oblique", 7) == 0)
1390 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1391 else if (memcmp (p0
+ 1, "charcell", 8) == 0
1392 || memcmp (p0
+ 1, "mono", 4) == 0
1393 || memcmp (p0
+ 1, "proportional", 12) == 0)
1395 int spacing
= (p0
[1] == 'c' ? FONT_SPACING_CHARCELL
1396 : p0
[1] == 'm' ? FONT_SPACING_MONO
1397 : FONT_SPACING_PROPORTIONAL
);
1398 ASET (font
, FONT_SPACING_INDEX
, make_number (spacing
));
1403 bcopy (p0
, copy
, p1
- p0
);
1411 if (memcmp (p0
+ 1, "pixelsize=", 10) == 0)
1412 prop
= FONT_SIZE_INDEX
;
1415 key
= font_intern_prop (p0
, p1
- p0
);
1416 prop
= get_font_prop_index (key
);
1419 for (p1
= p0
; *p1
&& *p1
!= ':'; p1
++);
1420 val
= font_intern_prop (p0
, p1
- p0
);
1423 if (prop
>= FONT_FOUNDRY_INDEX
&& prop
< FONT_EXTRA_INDEX
)
1424 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1426 Ffont_put (font
, key
, val
);
1428 bcopy (keyhead
, copy
, p1
- keyhead
);
1429 copy
+= p1
- keyhead
;
1435 font_put_extra (font
, QCfc_unknown_spec
,
1436 make_unibyte_string (name
, copy
- name
));
1441 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1442 NAME (NBYTES length), and return the name length. If
1443 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1446 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1452 Lisp_Object tail
, val
;
1457 Lisp_Object styles
[3];
1458 char *style_names
[3] = { "weight", "slant", "width" };
1461 val
= AREF (font
, FONT_FAMILY_INDEX
);
1463 len
+= SBYTES (val
);
1465 val
= AREF (font
, FONT_SIZE_INDEX
);
1468 if (XINT (val
) != 0)
1469 pixel_size
= XINT (val
);
1471 len
+= 21; /* for ":pixelsize=NUM" */
1473 else if (FLOATP (val
))
1476 point_size
= (int) XFLOAT_DATA (val
);
1477 len
+= 11; /* for "-NUM" */
1480 val
= AREF (font
, FONT_FOUNDRY_INDEX
);
1482 /* ":foundry=NAME" */
1483 len
+= 9 + SBYTES (val
);
1485 for (i
= 0; i
< 3; i
++)
1487 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1488 if (! NILP (styles
[i
]))
1489 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1490 SDATA (SYMBOL_NAME (styles
[i
])));
1493 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1494 len
+= sprintf (work
, ":dpi=%d", dpi
);
1495 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1496 len
+= strlen (":spacing=100");
1497 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1498 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1499 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1501 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1503 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1505 len
+= SBYTES (val
);
1506 else if (INTEGERP (val
))
1507 len
+= sprintf (work
, "%d", XINT (val
));
1508 else if (SYMBOLP (val
))
1509 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1515 if (! NILP (AREF (font
, FONT_FAMILY_INDEX
)))
1516 p
+= sprintf(p
, "%s", SDATA (SYMBOL_NAME (AREF (font
, FONT_FAMILY_INDEX
))));
1520 p
+= sprintf (p
, "%d", point_size
);
1522 p
+= sprintf (p
, "-%d", point_size
);
1524 else if (pixel_size
> 0)
1525 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1526 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1527 p
+= sprintf (p
, ":foundry=%s",
1528 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1529 for (i
= 0; i
< 3; i
++)
1530 if (! NILP (styles
[i
]))
1531 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1532 SDATA (SYMBOL_NAME (styles
[i
])));
1533 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1534 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1535 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1536 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1537 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1539 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1540 p
+= sprintf (p
, ":scalable=true");
1542 p
+= sprintf (p
, ":scalable=false");
1547 /* Parse NAME (null terminated) and store information in FONT
1548 (font-spec or font-entity). If NAME is successfully parsed, return
1549 0. Otherwise return -1. */
1552 font_parse_name (name
, font
)
1556 if (name
[0] == '-' || index (name
, '*'))
1557 return font_parse_xlfd (name
, font
);
1558 return font_parse_fcname (name
, font
);
1562 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1563 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1567 font_parse_family_registry (family
, registry
, font_spec
)
1568 Lisp_Object family
, registry
, font_spec
;
1574 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1576 CHECK_STRING (family
);
1577 len
= SBYTES (family
);
1578 p0
= (char *) SDATA (family
);
1579 p1
= index (p0
, '-');
1582 if ((*p0
!= '*' || p1
- p0
> 1)
1583 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1584 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
));
1587 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
));
1590 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1592 if (! NILP (registry
))
1594 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1595 CHECK_STRING (registry
);
1596 len
= SBYTES (registry
);
1597 p0
= (char *) SDATA (registry
);
1598 p1
= index (p0
, '-');
1601 if (SDATA (registry
)[len
- 1] == '*')
1602 registry
= concat2 (registry
, build_string ("-*"));
1604 registry
= concat2 (registry
, build_string ("*-*"));
1606 registry
= Fdowncase (registry
);
1607 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1612 /* This part (through the next ^L) is still experimental and not
1613 tested much. We may drastically change codes. */
1619 #define LGSTRING_HEADER_SIZE 6
1620 #define LGSTRING_GLYPH_SIZE 8
1623 check_gstring (gstring
)
1624 Lisp_Object gstring
;
1629 CHECK_VECTOR (gstring
);
1630 val
= AREF (gstring
, 0);
1632 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1634 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1635 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1636 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1637 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1638 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1639 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1640 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1641 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1642 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1643 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1644 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1646 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1648 val
= LGSTRING_GLYPH (gstring
, i
);
1650 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1652 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1654 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1655 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1656 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1657 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1658 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1659 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1660 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1661 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1663 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1665 if (ASIZE (val
) < 3)
1667 for (j
= 0; j
< 3; j
++)
1668 CHECK_NUMBER (AREF (val
, j
));
1673 error ("Invalid glyph-string format");
1678 check_otf_features (otf_features
)
1679 Lisp_Object otf_features
;
1683 CHECK_CONS (otf_features
);
1684 CHECK_SYMBOL (XCAR (otf_features
));
1685 otf_features
= XCDR (otf_features
);
1686 CHECK_CONS (otf_features
);
1687 CHECK_SYMBOL (XCAR (otf_features
));
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 GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1695 otf_features
= XCDR (otf_features
);
1696 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1698 CHECK_SYMBOL (Fcar (val
));
1699 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1700 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1707 Lisp_Object otf_list
;
1710 otf_tag_symbol (tag
)
1715 OTF_tag_name (tag
, name
);
1716 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1723 Lisp_Object val
= Fassoc (file
, otf_list
);
1727 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1730 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1731 val
= make_save_value (otf
, 0);
1732 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1738 /* Return a list describing which scripts/languages FONT supports by
1739 which GSUB/GPOS features of OpenType tables. See the comment of
1740 (struct font_driver).otf_capability. */
1743 font_otf_capability (font
)
1747 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1750 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1753 for (i
= 0; i
< 2; i
++)
1755 OTF_GSUB_GPOS
*gsub_gpos
;
1756 Lisp_Object script_list
= Qnil
;
1759 if (OTF_get_features (otf
, i
== 0) < 0)
1761 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1762 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1764 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1765 Lisp_Object langsys_list
= Qnil
;
1766 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1769 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1771 OTF_LangSys
*langsys
;
1772 Lisp_Object feature_list
= Qnil
;
1773 Lisp_Object langsys_tag
;
1776 if (k
== script
->LangSysCount
)
1778 langsys
= &script
->DefaultLangSys
;
1783 langsys
= script
->LangSys
+ k
;
1785 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1787 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1789 OTF_Feature
*feature
1790 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1791 Lisp_Object feature_tag
1792 = otf_tag_symbol (feature
->FeatureTag
);
1794 feature_list
= Fcons (feature_tag
, feature_list
);
1796 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1799 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1804 XSETCAR (capability
, script_list
);
1806 XSETCDR (capability
, script_list
);
1812 /* Parse OTF features in SPEC and write a proper features spec string
1813 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1814 assured that the sufficient memory has already allocated for
1818 generate_otf_features (spec
, features
)
1828 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1834 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1839 else if (! asterisk
)
1841 val
= SYMBOL_NAME (val
);
1842 p
+= sprintf (p
, "%s", SDATA (val
));
1846 val
= SYMBOL_NAME (val
);
1847 p
+= sprintf (p
, "~%s", SDATA (val
));
1851 error ("OTF spec too long");
1855 font_otf_DeviceTable (device_table
)
1856 OTF_DeviceTable
*device_table
;
1858 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1860 return Fcons (make_number (len
),
1861 make_unibyte_string (device_table
->DeltaValue
, len
));
1865 font_otf_ValueRecord (value_format
, value_record
)
1867 OTF_ValueRecord
*value_record
;
1869 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1871 if (value_format
& OTF_XPlacement
)
1872 ASET (val
, 0, make_number (value_record
->XPlacement
));
1873 if (value_format
& OTF_YPlacement
)
1874 ASET (val
, 1, make_number (value_record
->YPlacement
));
1875 if (value_format
& OTF_XAdvance
)
1876 ASET (val
, 2, make_number (value_record
->XAdvance
));
1877 if (value_format
& OTF_YAdvance
)
1878 ASET (val
, 3, make_number (value_record
->YAdvance
));
1879 if (value_format
& OTF_XPlaDevice
)
1880 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1881 if (value_format
& OTF_YPlaDevice
)
1882 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1883 if (value_format
& OTF_XAdvDevice
)
1884 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
1885 if (value_format
& OTF_YAdvDevice
)
1886 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
1891 font_otf_Anchor (anchor
)
1896 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
1897 ASET (val
, 0, make_number (anchor
->XCoordinate
));
1898 ASET (val
, 1, make_number (anchor
->YCoordinate
));
1899 if (anchor
->AnchorFormat
== 2)
1900 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
1903 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
1904 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
1908 #endif /* HAVE_LIBOTF */
1911 /* G-string (glyph string) handler */
1913 /* G-string is a vector of the form [HEADER GLYPH ...].
1914 See the docstring of `font-make-gstring' for more detail. */
1917 font_prepare_composition (cmp
, f
)
1918 struct composition
*cmp
;
1922 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
1923 cmp
->hash_index
* 2);
1925 cmp
->font
= XFONT_OBJECT (LGSTRING_FONT (gstring
));
1926 cmp
->glyph_len
= LGSTRING_LENGTH (gstring
);
1927 cmp
->pixel_width
= LGSTRING_WIDTH (gstring
);
1928 cmp
->lbearing
= LGSTRING_LBEARING (gstring
);
1929 cmp
->rbearing
= LGSTRING_RBEARING (gstring
);
1930 cmp
->ascent
= LGSTRING_ASCENT (gstring
);
1931 cmp
->descent
= LGSTRING_DESCENT (gstring
);
1932 cmp
->width
= cmp
->pixel_width
/ FRAME_COLUMN_WIDTH (f
);
1933 if (cmp
->width
== 0)
1942 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*, Lisp_Object
));
1943 static int font_compare
P_ ((const void *, const void *));
1944 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
1945 Lisp_Object
, Lisp_Object
,
1948 /* We sort fonts by scoring each of them against a specified
1949 font-spec. The score value is 32 bit (`unsigned'), and the smaller
1950 the value is, the closer the font is to the font-spec.
1952 The highest 2 bits of the score is used for FAMILY. The exact
1953 match is 0, match with one of face-font-family-alternatives is
1956 The next 2 bits of the score is used for the atomic properties
1957 FOUNDRY and ADSTYLE respectively.
1959 Each 7-bit in the lower 28 bits are used for numeric properties
1960 WEIGHT, SLANT, WIDTH, and SIZE. */
1962 /* How many bits to shift to store the difference value of each font
1963 property in a score. Note that flots for FONT_TYPE_INDEX and
1964 FONT_REGISTRY_INDEX are not used. */
1965 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
1967 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
1968 The return value indicates how different ENTITY is compared with
1971 ALTERNATE_FAMILIES, if non-nil, is a pre-calculated list of
1972 alternate family names for AREF (SPEC_PROP, FONT_FAMILY_INDEX). */
1975 font_score (entity
, spec_prop
, alternate_families
)
1976 Lisp_Object entity
, *spec_prop
;
1977 Lisp_Object alternate_families
;
1982 /* Score three atomic fields. Maximum difference is 1 (family is 3). */
1983 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_ADSTYLE_INDEX
; i
++)
1984 if (i
!= FONT_REGISTRY_INDEX
1985 && ! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
1987 Lisp_Object entity_str
= SYMBOL_NAME (AREF (entity
, i
));
1988 Lisp_Object spec_str
= SYMBOL_NAME (spec_prop
[i
]);
1990 if (xstrcasecmp (SDATA (spec_str
), SDATA (entity_str
)))
1992 if (i
== FONT_FAMILY_INDEX
&& CONSP (alternate_families
))
1996 for (j
= 1; CONSP (alternate_families
);
1997 j
++, alternate_families
= XCDR (alternate_families
))
1999 spec_str
= XCAR (alternate_families
);
2000 if (xstrcasecmp (SDATA (spec_str
), SDATA (entity_str
)) == 0)
2005 score
|= j
<< sort_shift_bits
[i
];
2008 score
|= 1 << sort_shift_bits
[i
];
2012 /* Score three style numeric fields. Maximum difference is 127. */
2013 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2014 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2016 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2020 /* This is to prefer the exact symbol style. */
2022 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2025 /* Score the size. Maximum difference is 127. */
2026 i
= FONT_SIZE_INDEX
;
2027 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
])
2028 && XINT (AREF (entity
, i
)) > 0)
2030 /* We use the higher 6-bit for the actual size difference. The
2031 lowest bit is set if the DPI is different. */
2032 int diff
= XINT (spec_prop
[i
]) - XINT (AREF (entity
, i
));
2037 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2038 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2040 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2047 /* The comparison function for qsort. */
2050 font_compare (d1
, d2
)
2051 const void *d1
, *d2
;
2053 return (*(unsigned *) d1
- *(unsigned *) d2
);
2057 /* The structure for elements being sorted by qsort. */
2058 struct font_sort_data
2065 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2066 If PREFER specifies a point-size, calculate the corresponding
2067 pixel-size from QCdpi property of PREFER or from the Y-resolution
2068 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
2069 get the font-entities in VEC.
2071 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2072 return the sorted VEC. */
2075 font_sort_entites (vec
, prefer
, frame
, spec
, best_only
)
2076 Lisp_Object vec
, prefer
, frame
, spec
;
2079 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2081 struct font_sort_data
*data
;
2082 Lisp_Object alternate_families
= Qnil
;
2083 unsigned best_score
;
2084 Lisp_Object best_entity
;
2089 return best_only
? AREF (vec
, 0) : vec
;
2091 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_DPI_INDEX
; i
++)
2092 prefer_prop
[i
] = AREF (prefer
, i
);
2096 /* A font driver may return a font that has a property value
2097 different from the value specified in SPEC if the driver
2098 thinks they are the same. That happens, for instance, such a
2099 generic family name as "serif" is specified. So, to ignore
2100 such a difference, for all properties specified in SPEC, set
2101 the corresponding properties in PREFER_PROP to nil. */
2102 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2103 if (! NILP (AREF (spec
, i
)))
2104 prefer_prop
[i
] = Qnil
;
2107 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2108 prefer_prop
[FONT_SIZE_INDEX
]
2109 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2110 if (! NILP (prefer_prop
[FONT_FAMILY_INDEX
]))
2113 = Fassoc_string (prefer_prop
[FONT_FAMILY_INDEX
],
2114 Vface_alternative_font_family_alist
, Qt
);
2115 if (CONSP (alternate_families
))
2116 alternate_families
= XCDR (alternate_families
);
2119 /* Scoring and sorting. */
2120 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2121 best_score
= 0xFFFFFFFF;
2123 for (i
= 0; i
< len
; i
++)
2125 data
[i
].entity
= AREF (vec
, i
);
2126 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
,
2127 alternate_families
);
2128 if (best_only
&& best_score
> data
[i
].score
)
2130 best_score
= data
[i
].score
;
2131 best_entity
= data
[i
].entity
;
2132 if (best_score
== 0)
2136 if (NILP (best_entity
))
2138 qsort (data
, len
, sizeof *data
, font_compare
);
2139 for (i
= 0; i
< len
; i
++)
2140 ASET (vec
, i
, data
[i
].entity
);
2146 font_add_log ("sort-by", prefer
, vec
);
2151 /* API of Font Service Layer. */
2153 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2154 sort_shift_bits. Finternal_set_font_selection_order calls this
2155 function with font_sort_order after setting up it. */
2158 font_update_sort_order (order
)
2163 for (i
= 0, shift_bits
= 21; i
< 4; i
++, shift_bits
-= 7)
2165 int xlfd_idx
= order
[i
];
2167 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2168 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2169 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2170 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2171 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2172 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2174 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2179 /* Check if ENTITY matches with the font specification SPEC. */
2182 font_match_p (spec
, entity
)
2183 Lisp_Object spec
, entity
;
2185 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2186 Lisp_Object alternate_families
= Qnil
;
2189 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2190 prefer_prop
[i
] = AREF (spec
, i
);
2191 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2192 prefer_prop
[FONT_SIZE_INDEX
]
2193 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2194 if (! NILP (prefer_prop
[FONT_FAMILY_INDEX
]))
2197 = Fassoc_string (prefer_prop
[FONT_FAMILY_INDEX
],
2198 Vface_alternative_font_family_alist
, Qt
);
2199 if (CONSP (alternate_families
))
2200 alternate_families
= XCDR (alternate_families
);
2203 return (font_score (entity
, prefer_prop
, alternate_families
) == 0);
2207 /* CHeck a lispy font object corresponding to FONT. */
2210 font_check_object (font
)
2213 Lisp_Object tail
, elt
;
2215 for (tail
= font
->props
[FONT_OBJLIST_INDEX
]; CONSP (tail
);
2219 if (font
== XFONT_OBJECT (elt
))
2229 Each font backend has the callback function get_cache, and it
2230 returns a cons cell of which cdr part can be freely used for
2231 caching fonts. The cons cell may be shared by multiple frames
2232 and/or multiple font drivers. So, we arrange the cdr part as this:
2234 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2236 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2237 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2238 cons (FONT-SPEC FONT-ENTITY ...). */
2240 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2241 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2242 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2243 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2244 struct font_driver
*));
2247 font_prepare_cache (f
, driver
)
2249 struct font_driver
*driver
;
2251 Lisp_Object cache
, val
;
2253 cache
= driver
->get_cache (f
);
2255 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2259 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2260 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2264 val
= XCDR (XCAR (val
));
2265 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2271 font_finish_cache (f
, driver
)
2273 struct font_driver
*driver
;
2275 Lisp_Object cache
, val
, tmp
;
2278 cache
= driver
->get_cache (f
);
2280 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2281 cache
= val
, val
= XCDR (val
);
2282 font_assert (! NILP (val
));
2283 tmp
= XCDR (XCAR (val
));
2284 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2285 if (XINT (XCAR (tmp
)) == 0)
2287 font_clear_cache (f
, XCAR (val
), driver
);
2288 XSETCDR (cache
, XCDR (val
));
2294 font_get_cache (f
, driver
)
2296 struct font_driver
*driver
;
2298 Lisp_Object val
= driver
->get_cache (f
);
2299 Lisp_Object type
= driver
->type
;
2301 font_assert (CONSP (val
));
2302 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2303 font_assert (CONSP (val
));
2304 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2305 val
= XCDR (XCAR (val
));
2309 static int num_fonts
;
2312 font_clear_cache (f
, cache
, driver
)
2315 struct font_driver
*driver
;
2317 Lisp_Object tail
, elt
;
2319 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2320 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2323 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)) && VECTORP (XCDR (elt
)))
2325 Lisp_Object vec
= XCDR (elt
);
2328 for (i
= 0; i
< ASIZE (vec
); i
++)
2330 Lisp_Object entity
= AREF (vec
, i
);
2332 if (EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2334 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2336 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2338 Lisp_Object val
= XCAR (objlist
);
2339 struct font
*font
= XFONT_OBJECT (val
);
2341 font_assert (font
&& driver
== font
->driver
);
2342 driver
->close (f
, font
);
2345 if (driver
->free_entity
)
2346 driver
->free_entity (entity
);
2351 XSETCDR (cache
, Qnil
);
2355 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2358 font_delete_unmatched (list
, spec
, size
)
2359 Lisp_Object list
, spec
;
2362 Lisp_Object entity
, val
;
2363 enum font_property_index prop
;
2365 for (val
= Qnil
; CONSP (list
); list
= XCDR (list
))
2367 entity
= XCAR (list
);
2368 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2369 if (INTEGERP (AREF (spec
, prop
))
2370 && ((XINT (AREF (spec
, prop
)) >> 8)
2371 != (XINT (AREF (entity
, prop
)) >> 8)))
2372 prop
= FONT_SPEC_MAX
;
2373 if (prop
++ <= FONT_SIZE_INDEX
2375 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2377 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2380 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2381 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2382 prop
= FONT_SPEC_MAX
;
2384 if (prop
< FONT_SPEC_MAX
)
2385 val
= Fcons (entity
, val
);
2391 /* Return a vector of font-entities matching with SPEC on FRAME. */
2394 font_list_entities (frame
, spec
)
2395 Lisp_Object frame
, spec
;
2397 FRAME_PTR f
= XFRAME (frame
);
2398 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2399 Lisp_Object ftype
, family
, alternate_familes
, val
;
2402 int need_filtering
= 0;
2406 font_assert (FONT_SPEC_P (spec
));
2408 family
= AREF (spec
, FONT_FAMILY_INDEX
);
2410 alternate_familes
= Qnil
;
2413 alternate_familes
= Fassoc_string (family
,
2414 Vface_alternative_font_family_alist
,
2416 if (! NILP (alternate_familes
))
2417 alternate_familes
= XCDR (alternate_familes
);
2418 n_family
+= XINT (Flength (alternate_familes
));
2421 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2422 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2423 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2424 size
= font_pixel_size (f
, spec
);
2428 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2429 for (i
= 1; i
<= FONT_REGISTRY_INDEX
; i
++)
2430 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2431 for (i
= FONT_DPI_INDEX
; i
< FONT_EXTRA_INDEX
; i
+= 2)
2433 ASET (scratch_font_spec
, i
, Qnil
);
2434 if (! NILP (AREF (spec
, i
)))
2437 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
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
;
2451 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2452 ASET (scratch_font_spec
, FONT_FAMILY_INDEX
, family
);
2455 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2462 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2463 copy
= Fcopy_font_spec (scratch_font_spec
);
2464 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2465 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2467 if (! NILP (val
) && need_filtering
)
2468 val
= font_delete_unmatched (val
, spec
, size
);
2476 ASET (scratch_font_spec
, FONT_FAMILY_INDEX
,
2477 Fintern (XCAR (tail
), Qnil
));
2482 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2483 font_add_log ("list", spec
, val
);
2488 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2489 nil, is an array of face's attributes, which specifies preferred
2490 font-related attributes. */
2493 font_matching_entity (f
, attrs
, spec
)
2495 Lisp_Object
*attrs
, spec
;
2497 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2498 Lisp_Object ftype
, size
, entity
;
2501 XSETFRAME (frame
, f
);
2502 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2503 size
= AREF (spec
, FONT_SIZE_INDEX
);
2505 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2507 for (; driver_list
; driver_list
= driver_list
->next
)
2509 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2511 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2514 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2515 entity
= assoc_no_quit (spec
, XCDR (cache
));
2517 entity
= XCDR (entity
);
2520 entity
= driver_list
->driver
->match (frame
, spec
);
2521 copy
= Fcopy_font_spec (spec
);
2522 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2523 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2525 if (! NILP (entity
))
2528 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2529 ASET (spec
, FONT_SIZE_INDEX
, size
);
2530 font_add_log ("match", spec
, entity
);
2535 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2536 opened font object. */
2539 font_open_entity (f
, entity
, pixel_size
)
2544 struct font_driver_list
*driver_list
;
2545 Lisp_Object objlist
, size
, val
, font_object
;
2549 font_assert (FONT_ENTITY_P (entity
));
2550 size
= AREF (entity
, FONT_SIZE_INDEX
);
2551 if (XINT (size
) != 0)
2552 pixel_size
= XINT (size
);
2554 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2555 objlist
= XCDR (objlist
))
2556 if (XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2557 return XCAR (objlist
);
2559 val
= AREF (entity
, FONT_TYPE_INDEX
);
2560 for (driver_list
= f
->font_driver_list
;
2561 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2562 driver_list
= driver_list
->next
);
2566 font_object
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2567 font_add_log ("open", entity
, font_object
);
2568 if (NILP (font_object
))
2570 ASET (entity
, FONT_OBJLIST_INDEX
,
2571 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2572 ASET (font_object
, FONT_OBJLIST_INDEX
, AREF (entity
, FONT_OBJLIST_INDEX
));
2575 font
= XFONT_OBJECT (font_object
);
2576 min_width
= (font
->min_width
? font
->min_width
2577 : font
->average_width
? font
->average_width
2578 : font
->space_width
? font
->space_width
2580 #ifdef HAVE_WINDOW_SYSTEM
2581 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2582 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2584 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2585 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
;
2586 fonts_changed_p
= 1;
2590 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2591 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2592 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > font
->height
)
2593 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
, fonts_changed_p
= 1;
2601 /* Close FONT_OBJECT that is opened on frame F. */
2604 font_close_object (f
, font_object
)
2606 Lisp_Object font_object
;
2608 struct font
*font
= XFONT_OBJECT (font_object
);
2609 Lisp_Object objlist
;
2610 Lisp_Object tail
, prev
= Qnil
;
2612 objlist
= AREF (font_object
, FONT_OBJLIST_INDEX
);
2613 for (prev
= Qnil
, tail
= objlist
; CONSP (tail
);
2614 prev
= tail
, tail
= XCDR (tail
))
2615 if (EQ (font_object
, XCAR (tail
)))
2617 font_add_log ("close", font_object
, Qnil
);
2618 font
->driver
->close (f
, font
);
2619 #ifdef HAVE_WINDOW_SYSTEM
2620 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2621 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2624 ASET (font_object
, FONT_OBJLIST_INDEX
, XCDR (objlist
));
2626 XSETCDR (prev
, XCDR (objlist
));
2634 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2635 FONT is a font-entity and it must be opened to check. */
2638 font_has_char (f
, font
, c
)
2645 if (FONT_ENTITY_P (font
))
2647 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2648 struct font_driver_list
*driver_list
;
2650 for (driver_list
= f
->font_driver_list
;
2651 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2652 driver_list
= driver_list
->next
);
2655 if (! driver_list
->driver
->has_char
)
2657 return driver_list
->driver
->has_char (font
, c
);
2660 font_assert (FONT_OBJECT_P (font
));
2661 fontp
= XFONT_OBJECT (font
);
2662 if (fontp
->driver
->has_char
)
2664 int result
= fontp
->driver
->has_char (font
, c
);
2669 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2673 /* Return the glyph ID of FONT_OBJECT for character C. */
2676 font_encode_char (font_object
, c
)
2677 Lisp_Object font_object
;
2682 font_assert (FONT_OBJECT_P (font_object
));
2683 font
= XFONT_OBJECT (font_object
);
2684 return font
->driver
->encode_char (font
, c
);
2688 /* Return the name of FONT_OBJECT. */
2691 font_get_name (font_object
)
2692 Lisp_Object font_object
;
2694 font_assert (FONT_OBJECT_P (font_object
));
2695 return AREF (font_object
, FONT_NAME_INDEX
);
2699 /* Return the specification of FONT_OBJECT. */
2702 font_get_spec (font_object
)
2703 Lisp_Object font_object
;
2705 Lisp_Object spec
= font_make_spec ();
2708 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2709 ASET (spec
, i
, AREF (font_object
, i
));
2710 ASET (spec
, FONT_SIZE_INDEX
,
2711 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2716 font_spec_from_name (font_name
)
2717 Lisp_Object font_name
;
2719 Lisp_Object args
[2];
2722 args
[1] = font_name
;
2723 return Ffont_spec (2, args
);
2728 font_clear_prop (attrs
, prop
)
2730 enum font_property_index prop
;
2732 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2736 if (NILP (AREF (font
, prop
))
2737 && prop
!= FONT_FAMILY_INDEX
&& prop
!= FONT_FAMILY_INDEX
)
2739 font
= Fcopy_font_spec (font
);
2740 ASET (font
, prop
, Qnil
);
2741 if (prop
== FONT_FAMILY_INDEX
)
2743 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
2744 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
2745 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
2746 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2747 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2748 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2750 else if (prop
== FONT_SIZE_INDEX
)
2752 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2753 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2754 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2756 attrs
[LFACE_FONT_INDEX
] = font
;
2760 font_update_lface (f
, attrs
)
2766 spec
= attrs
[LFACE_FONT_INDEX
];
2767 if (! FONT_SPEC_P (spec
))
2770 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
))
2771 || ! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2775 if (NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
2776 family
= AREF (spec
, FONT_FAMILY_INDEX
);
2777 else if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2778 family
= concat2 (SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
)),
2779 build_string ("-*"));
2781 family
= concat3 (SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
)),
2783 SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
)));
2784 attrs
[LFACE_FAMILY_INDEX
] = family
;
2786 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
2787 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
2788 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
2789 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);;
2790 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
2791 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
2792 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
2796 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2801 val
= Ffont_get (spec
, QCdpi
);
2804 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
2807 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2808 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
2809 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
2814 /* Return a font-entity satisfying SPEC and best matching with face's
2815 font related attributes in ATTRS. C, if not negative, is a
2816 character that the entity must support. */
2819 font_find_for_lface (f
, attrs
, spec
, c
)
2825 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
2832 Lisp_Object registry
= AREF (spec
, FONT_REGISTRY_INDEX
);
2833 struct charset
*encoding
, *repertory
;
2835 if (font_registry_charsets (registry
, &encoding
, &repertory
) < 0)
2839 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
2841 /* Any font of this registry support C. So, let's
2842 suppress the further checking. */
2845 else if (c
> encoding
->max_char
)
2849 XSETFRAME (frame
, f
);
2850 size
= AREF (spec
, FONT_SIZE_INDEX
);
2851 pixel_size
= font_pixel_size (f
, spec
);
2852 if (pixel_size
== 0)
2854 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
2856 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
2858 ASET (spec
, FONT_SIZE_INDEX
, Qnil
);
2859 entities
= font_list_entities (frame
, spec
);
2860 ASET (spec
, FONT_SIZE_INDEX
, size
);
2861 if (ASIZE (entities
) == 0)
2863 if (ASIZE (entities
) == 1)
2866 return AREF (entities
, 0);
2870 /* Sort fonts by properties specified in LFACE. */
2871 Lisp_Object prefer
= scratch_font_prefer
;
2873 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
2874 ASET (prefer
, i
, AREF (spec
, i
));
2875 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
2877 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
2879 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
2880 if (NILP (AREF (prefer
, i
)))
2881 ASET (prefer
, i
, AREF (face_font
, i
));
2883 if (NILP (AREF (prefer
, FONT_FAMILY_INDEX
)))
2884 font_parse_family_registry (attrs
[LFACE_FAMILY_INDEX
], Qnil
, prefer
);
2885 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
2886 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2887 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
2888 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2889 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
2890 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2891 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2892 ASET (spec
, FONT_SIZE_INDEX
, Qnil
);
2893 entities
= font_sort_entites (entities
, prefer
, frame
, spec
, c
< 0);
2894 ASET (spec
, FONT_SIZE_INDEX
, size
);
2899 for (i
= 0; i
< ASIZE (entities
); i
++)
2903 val
= AREF (entities
, i
);
2906 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
2907 if (! EQ (AREF (val
, j
), props
[j
]))
2909 if (j
> FONT_REGISTRY_INDEX
)
2912 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
2913 props
[j
] = AREF (val
, j
);
2914 result
= font_has_char (f
, val
, c
);
2919 val
= font_open_for_lface (f
, val
, attrs
, spec
);
2922 result
= font_has_char (f
, val
, c
);
2923 font_close_object (f
, val
);
2925 return AREF (entities
, i
);
2932 font_open_for_lface (f
, entity
, attrs
, spec
)
2940 if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
2941 size
= font_pixel_size (f
, spec
);
2944 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
2947 size
= POINT_TO_PIXEL (pt
, f
->resy
);
2949 return font_open_entity (f
, entity
, size
);
2953 /* Find a font satisfying SPEC and best matching with face's
2954 attributes in ATTRS on FRAME, and return the opened
2958 font_load_for_lface (f
, attrs
, spec
)
2960 Lisp_Object
*attrs
, spec
;
2964 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
2967 /* No font is listed for SPEC, but each font-backend may have
2968 the different criteria about "font matching". So, try
2970 entity
= font_matching_entity (f
, attrs
, spec
);
2974 return font_open_for_lface (f
, entity
, attrs
, spec
);
2978 /* Make FACE on frame F ready to use the font opened for FACE. */
2981 font_prepare_for_face (f
, face
)
2985 if (face
->font
->driver
->prepare_face
)
2986 face
->font
->driver
->prepare_face (f
, face
);
2990 /* Make FACE on frame F stop using the font opened for FACE. */
2993 font_done_for_face (f
, face
)
2997 if (face
->font
->driver
->done_face
)
2998 face
->font
->driver
->done_face (f
, face
);
3003 /* Open a font best matching with NAME on frame F. If no proper font
3004 is found, return Qnil. */
3007 font_open_by_name (f
, name
)
3011 Lisp_Object args
[2];
3012 Lisp_Object spec
, prefer
, size
, entity
, entity_list
;
3017 XSETFRAME (frame
, f
);
3020 args
[1] = make_unibyte_string (name
, strlen (name
));
3021 spec
= Ffont_spec (2, args
);
3022 prefer
= scratch_font_prefer
;
3023 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
3025 ASET (prefer
, i
, AREF (spec
, i
));
3026 if (NILP (AREF (prefer
, i
))
3027 && i
>= FONT_WEIGHT_INDEX
&& i
<= FONT_WIDTH_INDEX
)
3028 FONT_SET_STYLE (prefer
, i
, make_number (100));
3030 size
= AREF (spec
, FONT_SIZE_INDEX
);
3035 if (INTEGERP (size
))
3036 pixel_size
= XINT (size
);
3037 else /* FLOATP (size) */
3039 double pt
= XFLOAT_DATA (size
);
3041 pixel_size
= POINT_TO_PIXEL (pt
, f
->resy
);
3043 if (pixel_size
== 0)
3044 ASET (spec
, FONT_SIZE_INDEX
, Qnil
);
3046 if (pixel_size
== 0)
3048 pixel_size
= POINT_TO_PIXEL (12.0, f
->resy
);
3049 size
= make_number (pixel_size
);
3050 ASET (prefer
, FONT_SIZE_INDEX
, size
);
3052 if (NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3053 ASET (spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
3055 entity_list
= Flist_fonts (spec
, frame
, make_number (1), prefer
);
3056 if (NILP (entity_list
))
3057 entity
= font_matching_entity (f
, NULL
, spec
);
3059 entity
= XCAR (entity_list
);
3060 return (NILP (entity
)
3062 : font_open_entity (f
, entity
, pixel_size
));
3066 /* Register font-driver DRIVER. This function is used in two ways.
3068 The first is with frame F non-NULL. In this case, make DRIVER
3069 available (but not yet activated) on F. All frame creaters
3070 (e.g. Fx_create_frame) must call this function at least once with
3071 an available font-driver.
3073 The second is with frame F NULL. In this case, DRIVER is globally
3074 registered in the variable `font_driver_list'. All font-driver
3075 implementations must call this function in its syms_of_XXXX
3076 (e.g. syms_of_xfont). */
3079 register_font_driver (driver
, f
)
3080 struct font_driver
*driver
;
3083 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3084 struct font_driver_list
*prev
, *list
;
3086 if (f
&& ! driver
->draw
)
3087 error ("Unusable font driver for a frame: %s",
3088 SDATA (SYMBOL_NAME (driver
->type
)));
3090 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3091 if (EQ (list
->driver
->type
, driver
->type
))
3092 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3094 list
= malloc (sizeof (struct font_driver_list
));
3096 list
->driver
= driver
;
3101 f
->font_driver_list
= list
;
3103 font_driver_list
= list
;
3109 /* Free font-driver list on frame F. It doesn't free font-drivers
3113 free_font_driver_list (f
)
3116 while (f
->font_driver_list
)
3118 struct font_driver_list
*next
= f
->font_driver_list
->next
;
3120 free (f
->font_driver_list
);
3121 f
->font_driver_list
= next
;
3126 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3127 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3128 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3130 A caller must free all realized faces if any in advance. The
3131 return value is a list of font backends actually made used on
3135 font_update_drivers (f
, new_drivers
)
3137 Lisp_Object new_drivers
;
3139 Lisp_Object active_drivers
= Qnil
;
3140 struct font_driver_list
*list
;
3142 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3145 if (! EQ (new_drivers
, Qt
)
3146 && NILP (Fmemq (list
->driver
->type
, new_drivers
)))
3148 if (list
->driver
->end_for_frame
)
3149 list
->driver
->end_for_frame (f
);
3150 font_finish_cache (f
, list
->driver
);
3156 if (EQ (new_drivers
, Qt
)
3157 || ! NILP (Fmemq (list
->driver
->type
, new_drivers
)))
3159 if (! list
->driver
->start_for_frame
3160 || list
->driver
->start_for_frame (f
) == 0)
3162 font_prepare_cache (f
, list
->driver
);
3164 active_drivers
= nconc2 (active_drivers
,
3165 Fcons (list
->driver
->type
, Qnil
));
3170 return active_drivers
;
3174 font_put_frame_data (f
, driver
, data
)
3176 struct font_driver
*driver
;
3179 struct font_data_list
*list
, *prev
;
3181 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3182 prev
= list
, list
= list
->next
)
3183 if (list
->driver
== driver
)
3190 prev
->next
= list
->next
;
3192 f
->font_data_list
= list
->next
;
3200 list
= malloc (sizeof (struct font_data_list
));
3203 list
->driver
= driver
;
3204 list
->next
= f
->font_data_list
;
3205 f
->font_data_list
= list
;
3213 font_get_frame_data (f
, driver
)
3215 struct font_driver
*driver
;
3217 struct font_data_list
*list
;
3219 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3220 if (list
->driver
== driver
)
3228 /* Return the font used to draw character C by FACE at buffer position
3229 POS in window W. If STRING is non-nil, it is a string containing C
3230 at index POS. If C is negative, get C from the current buffer or
3234 font_at (c
, pos
, face
, w
, string
)
3243 Lisp_Object font_object
;
3249 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3252 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3254 c
= FETCH_CHAR (pos_byte
);
3257 c
= FETCH_BYTE (pos
);
3263 multibyte
= STRING_MULTIBYTE (string
);
3266 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3268 str
= SDATA (string
) + pos_byte
;
3269 c
= STRING_CHAR (str
, 0);
3272 c
= SDATA (string
)[pos
];
3276 f
= XFRAME (w
->frame
);
3277 if (! FRAME_WINDOW_P (f
))
3284 if (STRINGP (string
))
3285 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3286 DEFAULT_FACE_ID
, 0);
3288 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3290 face
= FACE_FROM_ID (f
, face_id
);
3294 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3295 face
= FACE_FROM_ID (f
, face_id
);
3300 font_assert (font_check_object ((struct font
*) face
->font
));
3301 XSETFONT (font_object
, face
->font
);
3306 /* Check how many characters after POS (at most to LIMIT) can be
3307 displayed by the same font. FACE is the face selected for the
3308 character as POS on frame F. STRING, if not nil, is the string to
3309 check instead of the current buffer.
3311 The return value is the position of the character that is displayed
3312 by the differnt font than that of the character as POS. */
3315 font_range (pos
, limit
, face
, f
, string
)
3316 EMACS_INT pos
, limit
;
3329 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3330 pos_byte
= CHAR_TO_BYTE (pos
);
3334 multibyte
= STRING_MULTIBYTE (string
);
3335 pos_byte
= string_char_to_byte (string
, pos
);
3339 /* All unibyte character are displayed by the same font. */
3347 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3349 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3350 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3351 face
= FACE_FROM_ID (f
, face_id
);
3358 else if (font
!= face
->font
)
3370 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3371 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3372 Return nil otherwise.
3373 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3374 which kind of font it is. It must be one of `font-spec', `font-entity',
3376 (object
, extra_type
)
3377 Lisp_Object object
, extra_type
;
3379 if (NILP (extra_type
))
3380 return (FONTP (object
) ? Qt
: Qnil
);
3381 if (EQ (extra_type
, Qfont_spec
))
3382 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3383 if (EQ (extra_type
, Qfont_entity
))
3384 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3385 if (EQ (extra_type
, Qfont_object
))
3386 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3387 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3390 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3391 doc
: /* Return a newly created font-spec with arguments as properties.
3393 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3394 valid font property name listed below:
3396 `:family', `:weight', `:slant', `:width'
3398 They are the same as face attributes of the same name. See
3399 `set-face-attribute'.
3403 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3407 VALUE must be a string or a symbol specifying the additional
3408 typographic style information of a font, e.g. ``sans''.
3412 VALUE must be a string or a symbol specifying the charset registry and
3413 encoding of a font, e.g. ``iso8859-1''.
3417 VALUE must be a non-negative integer or a floating point number
3418 specifying the font size. It specifies the font size in pixels
3419 (if VALUE is an integer), or in points (if VALUE is a float).
3420 usage: (font-spec ARGS ...) */)
3425 Lisp_Object spec
= font_make_spec ();
3428 for (i
= 0; i
< nargs
; i
+= 2)
3430 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3432 if (EQ (key
, QCname
))
3435 font_parse_name ((char *) SDATA (val
), spec
);
3436 font_put_extra (spec
, key
, val
);
3440 int idx
= get_font_prop_index (key
);
3444 val
= font_prop_validate (idx
, Qnil
, val
);
3445 if (idx
< FONT_EXTRA_INDEX
)
3446 ASET (spec
, idx
, val
);
3448 font_put_extra (spec
, key
, val
);
3451 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3457 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3458 doc
: /* Return a copy of FONT as a font-spec. */)
3462 Lisp_Object new_spec
, tail
, extra
;
3466 new_spec
= font_make_spec ();
3467 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3468 ASET (new_spec
, i
, AREF (font
, i
));
3470 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3472 if (! EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3473 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3475 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3479 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3480 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3481 Every specified properties in FROM override the corresponding
3482 properties in TO. */)
3484 Lisp_Object from
, to
;
3486 Lisp_Object extra
, tail
;
3491 to
= Fcopy_font_spec (to
);
3492 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3493 ASET (to
, i
, AREF (from
, i
));
3494 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3495 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3496 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3498 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3501 XSETCDR (slot
, XCDR (XCAR (tail
)));
3503 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3505 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3509 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3510 doc
: /* Return the value of FONT's property KEY.
3511 FONT is a font-spec, a font-entity, or a font-object. */)
3513 Lisp_Object font
, key
;
3520 idx
= get_font_prop_index (key
);
3521 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3522 return AREF (font
, idx
);
3523 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3527 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3528 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
3529 (font_spec
, prop
, val
)
3530 Lisp_Object font_spec
, prop
, val
;
3534 CHECK_FONT_SPEC (font_spec
);
3535 idx
= get_font_prop_index (prop
);
3536 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3538 if (idx
== FONT_FAMILY_INDEX
3540 font_parse_family_registry (val
, Qnil
, font_spec
);
3542 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
3545 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
3549 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3550 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3551 Optional 2nd argument FRAME specifies the target frame.
3552 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3553 Optional 4th argument PREFER, if non-nil, is a font-spec to
3554 control the order of the returned list. Fonts are sorted by
3555 how close they are to PREFER. */)
3556 (font_spec
, frame
, num
, prefer
)
3557 Lisp_Object font_spec
, frame
, num
, prefer
;
3559 Lisp_Object vec
, list
, tail
;
3563 frame
= selected_frame
;
3564 CHECK_LIVE_FRAME (frame
);
3565 CHECK_FONT_SPEC (font_spec
);
3573 if (! NILP (prefer
))
3574 CHECK_FONT_SPEC (prefer
);
3576 vec
= font_list_entities (frame
, font_spec
);
3581 return Fcons (AREF (vec
, 0), Qnil
);
3583 if (! NILP (prefer
))
3584 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
, 0);
3586 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3587 if (n
== 0 || n
> len
)
3589 for (i
= 1; i
< n
; i
++)
3591 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3593 XSETCDR (tail
, val
);
3599 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
3600 doc
: /* List available font families on the current frame.
3601 Optional argument FRAME, if non-nil, specifies the target frame. */)
3606 struct font_driver_list
*driver_list
;
3610 frame
= selected_frame
;
3611 CHECK_LIVE_FRAME (frame
);
3614 for (driver_list
= f
->font_driver_list
; driver_list
;
3615 driver_list
= driver_list
->next
)
3616 if (driver_list
->driver
->list_family
)
3618 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3624 Lisp_Object tail
= list
;
3626 for (; CONSP (val
); val
= XCDR (val
))
3627 if (NILP (Fmemq (XCAR (val
), tail
)))
3628 list
= Fcons (XCAR (val
), list
);
3634 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3635 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3636 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3638 Lisp_Object font_spec
, frame
;
3640 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3647 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
3648 doc
: /* Return XLFD name of FONT.
3649 FONT is a font-spec, font-entity, or font-object.
3650 If the name is too long for XLFD (maximum 255 chars), return nil.
3651 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
3652 the consecutive wildcards are folded to one. */)
3653 (font
, fold_wildcards
)
3654 Lisp_Object font
, fold_wildcards
;
3661 if (FONT_OBJECT_P (font
))
3663 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
3665 if (STRINGP (font_name
)
3666 && SDATA (font_name
)[0] == '-')
3668 if (NILP (fold_wildcards
))
3670 strcpy (name
, (char *) SDATA (font_name
));
3673 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
3675 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3678 if (! NILP (fold_wildcards
))
3680 char *p0
= name
, *p1
;
3682 while ((p1
= strstr (p0
, "-*-*")))
3684 strcpy (p1
, p1
+ 2);
3689 return build_string (name
);
3692 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3693 doc
: /* Clear font cache. */)
3696 Lisp_Object list
, frame
;
3698 FOR_EACH_FRAME (list
, frame
)
3700 FRAME_PTR f
= XFRAME (frame
);
3701 struct font_driver_list
*driver_list
= f
->font_driver_list
;
3703 for (; driver_list
; driver_list
= driver_list
->next
)
3704 if (driver_list
->on
)
3706 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
3711 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
3713 font_assert (! NILP (val
));
3714 val
= XCDR (XCAR (val
));
3715 if (XINT (XCAR (val
)) == 0)
3717 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
3718 XSETCDR (cache
, XCDR (val
));
3726 /* The following three functions are still experimental. */
3728 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
3729 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
3730 FONT-OBJECT may be nil if it is not yet known.
3732 G-string is sequence of glyphs of a specific font,
3733 and is a vector of this form:
3734 [ HEADER GLYPH ... ]
3735 HEADER is a vector of this form:
3736 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
3738 FONT-OBJECT is a font-object for all glyphs in the g-string,
3739 WIDTH thru DESCENT are the metrics (in pixels) of the whole G-string.
3740 GLYPH is a vector of this form:
3741 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
3742 [ [X-OFF Y-OFF WADJUST] | nil] ]
3744 FROM-IDX and TO-IDX are used internally and should not be touched.
3745 C is the character of the glyph.
3746 CODE is the glyph-code of C in FONT-OBJECT.
3747 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
3748 X-OFF and Y-OFF are offests to the base position for the glyph.
3749 WADJUST is the adjustment to the normal width of the glyph. */)
3751 Lisp_Object font_object
, num
;
3753 Lisp_Object gstring
, g
;
3757 if (! NILP (font_object
))
3758 CHECK_FONT_OBJECT (font_object
);
3761 len
= XINT (num
) + 1;
3762 gstring
= Fmake_vector (make_number (len
), Qnil
);
3763 g
= Fmake_vector (make_number (6), Qnil
);
3764 ASET (g
, 0, font_object
);
3765 ASET (gstring
, 0, g
);
3766 for (i
= 1; i
< len
; i
++)
3767 ASET (gstring
, i
, Fmake_vector (make_number (10), Qnil
));
3771 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
3772 doc
: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
3773 START and END specify the region to extract characters.
3774 If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
3775 where to extract characters.
3776 FONT-OBJECT may be nil if GSTRING already contains one. */)
3777 (gstring
, font_object
, start
, end
, object
)
3778 Lisp_Object gstring
, font_object
, start
, end
, object
;
3784 CHECK_VECTOR (gstring
);
3785 if (NILP (font_object
))
3786 font_object
= LGSTRING_FONT (gstring
);
3787 font
= XFONT_OBJECT (font_object
);
3789 if (STRINGP (object
))
3791 const unsigned char *p
;
3793 CHECK_NATNUM (start
);
3795 if (XINT (start
) > XINT (end
)
3796 || XINT (end
) > ASIZE (object
)
3797 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3798 args_out_of_range_3 (object
, start
, end
);
3800 len
= XINT (end
) - XINT (start
);
3801 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
3802 for (i
= 0; i
< len
; i
++)
3804 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3805 /* Shut up GCC warning in comparison with
3806 MOST_POSITIVE_FIXNUM below. */
3809 c
= STRING_CHAR_ADVANCE (p
);
3810 cod
= code
= font
->driver
->encode_char (font
, c
);
3811 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
3813 LGLYPH_SET_FROM (g
, i
);
3814 LGLYPH_SET_TO (g
, i
);
3815 LGLYPH_SET_CHAR (g
, c
);
3816 LGLYPH_SET_CODE (g
, code
);
3823 if (! NILP (object
))
3824 Fset_buffer (object
);
3825 validate_region (&start
, &end
);
3826 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3827 args_out_of_range (start
, end
);
3828 len
= XINT (end
) - XINT (start
);
3830 pos_byte
= CHAR_TO_BYTE (pos
);
3831 for (i
= 0; i
< len
; i
++)
3833 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3834 /* Shut up GCC warning in comparison with
3835 MOST_POSITIVE_FIXNUM below. */
3838 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
3839 cod
= code
= font
->driver
->encode_char (font
, c
);
3840 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
3842 LGLYPH_SET_FROM (g
, i
);
3843 LGLYPH_SET_TO (g
, i
);
3844 LGLYPH_SET_CHAR (g
, c
);
3845 LGLYPH_SET_CODE (g
, code
);
3848 for (; i
< LGSTRING_LENGTH (gstring
); i
++)
3849 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
3853 DEFUN ("font-shape-text", Ffont_shape_text
, Sfont_shape_text
, 3, 4, 0,
3854 doc
: /* Shape text between FROM and TO by FONT-OBJECT.
3855 If optional 4th argument STRING is non-nil, it is a string to shape,
3856 and FROM and TO are indices to the string.
3857 The value is the end position of the text that can be shaped by
3859 (from
, to
, font_object
, string
)
3860 Lisp_Object from
, to
, font_object
, string
;
3863 struct font_metrics metrics
;
3864 EMACS_INT start
, end
;
3865 Lisp_Object gstring
, n
;
3868 if (! FONT_OBJECT_P (font_object
))
3870 font
= XFONT_OBJECT (font_object
);
3871 if (! font
->driver
->shape
)
3876 validate_region (&from
, &to
);
3877 start
= XFASTINT (from
);
3878 end
= XFASTINT (to
);
3879 modify_region (current_buffer
, start
, end
, 0);
3883 CHECK_STRING (string
);
3884 start
= XINT (from
);
3886 if (start
< 0 || start
> end
|| end
> SCHARS (string
))
3887 args_out_of_range_3 (string
, from
, to
);
3891 gstring
= Ffont_make_gstring (font_object
, make_number (len
));
3892 Ffont_fill_gstring (gstring
, font_object
, from
, to
, string
);
3894 /* Try at most three times with larger gstring each time. */
3895 for (i
= 0; i
< 3; i
++)
3897 Lisp_Object args
[2];
3899 n
= font
->driver
->shape (gstring
);
3903 args
[1] = Fmake_vector (make_number (len
), Qnil
);
3904 gstring
= Fvconcat (2, args
);
3906 if (! INTEGERP (n
) || XINT (n
) == 0)
3910 for (i
= 0; i
< len
;)
3913 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3914 EMACS_INT this_from
= LGLYPH_FROM (g
);
3915 EMACS_INT this_to
= LGLYPH_TO (g
) + 1;
3917 int need_composition
= 0;
3919 metrics
.lbearing
= LGLYPH_LBEARING (g
);
3920 metrics
.rbearing
= LGLYPH_RBEARING (g
);
3921 metrics
.ascent
= LGLYPH_ASCENT (g
);
3922 metrics
.descent
= LGLYPH_DESCENT (g
);
3923 if (NILP (LGLYPH_ADJUSTMENT (g
)))
3925 metrics
.width
= LGLYPH_WIDTH (g
);
3926 if (LGLYPH_CHAR (g
) == 0 || metrics
.width
== 0)
3927 need_composition
= 1;
3931 metrics
.width
= LGLYPH_WADJUST (g
);
3932 metrics
.lbearing
+= LGLYPH_XOFF (g
);
3933 metrics
.rbearing
+= LGLYPH_XOFF (g
);
3934 metrics
.ascent
-= LGLYPH_YOFF (g
);
3935 metrics
.descent
+= LGLYPH_YOFF (g
);
3936 need_composition
= 1;
3938 for (j
= i
+ 1; j
< len
; j
++)
3942 g
= LGSTRING_GLYPH (gstring
, j
);
3943 if (this_from
!= LGLYPH_FROM (g
))
3945 need_composition
= 1;
3946 x
= metrics
.width
+ LGLYPH_LBEARING (g
) + LGLYPH_XOFF (g
);
3947 if (metrics
.lbearing
> x
)
3948 metrics
.lbearing
= x
;
3949 x
= metrics
.width
+ LGLYPH_RBEARING (g
) + LGLYPH_XOFF (g
);
3950 if (metrics
.rbearing
< x
)
3951 metrics
.rbearing
= x
;
3952 x
= LGLYPH_ASCENT (g
) - LGLYPH_YOFF (g
);
3953 if (metrics
.ascent
< x
)
3955 x
= LGLYPH_DESCENT (g
) - LGLYPH_YOFF (g
);
3956 if (metrics
.descent
< x
)
3957 metrics
.descent
= x
;
3958 if (NILP (LGLYPH_ADJUSTMENT (g
)))
3959 metrics
.width
+= LGLYPH_WIDTH (g
);
3961 metrics
.width
+= LGLYPH_WADJUST (g
);
3964 if (need_composition
)
3966 gstr
= Ffont_make_gstring (font_object
, make_number (j
- i
));
3967 LGSTRING_SET_WIDTH (gstr
, metrics
.width
);
3968 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
3969 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
);
3970 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
3971 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
3972 for (k
= i
; i
< j
; i
++)
3974 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3976 LGLYPH_SET_FROM (g
, LGLYPH_FROM (g
) - this_from
);
3977 LGLYPH_SET_TO (g
, LGLYPH_TO (g
) - this_from
);
3978 LGSTRING_SET_GLYPH (gstr
, i
- k
, LGSTRING_GLYPH (gstring
, i
));
3980 from
= make_number (start
+ this_from
);
3981 to
= make_number (start
+ this_to
);
3983 Fcompose_region_internal (from
, to
, gstr
, Qnil
);
3985 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 */
4356 #ifdef HAVE_WINDOW_SYSTEM
4358 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4359 doc
: /* Return information about a font named NAME on frame FRAME.
4360 If FRAME is omitted or nil, use the selected frame.
4361 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4362 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4364 OPENED-NAME is the name used for opening the font,
4365 FULL-NAME is the full name of the font,
4366 SIZE is the maximum bound width of the font,
4367 HEIGHT is the height of the font,
4368 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4369 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4370 how to compose characters.
4371 If the named font is not yet loaded, return nil. */)
4373 Lisp_Object name
, frame
;
4378 Lisp_Object font_object
;
4380 (*check_window_system_func
) ();
4383 CHECK_STRING (name
);
4385 frame
= selected_frame
;
4386 CHECK_LIVE_FRAME (frame
);
4391 int fontset
= fs_query_fontset (name
, 0);
4394 name
= fontset_ascii (fontset
);
4395 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4397 else if (FONT_OBJECT_P (name
))
4399 else if (FONT_ENTITY_P (name
))
4400 font_object
= font_open_entity (f
, name
, 0);
4403 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4404 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4406 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4408 if (NILP (font_object
))
4410 font
= XFONT_OBJECT (font_object
);
4412 info
= Fmake_vector (make_number (7), Qnil
);
4413 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4414 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4415 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4416 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4417 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4418 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4419 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4422 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4423 close it now. Perhaps, we should manage font-objects
4424 by `reference-count'. */
4425 font_close_object (f
, font_object
);
4432 #define BUILD_STYLE_TABLE(TBL) \
4433 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4436 build_style_table (entry
, nelement
)
4437 struct table_entry
*entry
;
4441 Lisp_Object table
, elt
;
4443 table
= Fmake_vector (make_number (nelement
), Qnil
);
4444 for (i
= 0; i
< nelement
; i
++)
4446 for (j
= 0; entry
[i
].names
[j
]; j
++);
4447 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4448 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4449 for (j
= 0; entry
[i
].names
[j
]; j
++)
4450 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4451 ASET (table
, i
, elt
);
4456 static Lisp_Object Vfont_log
;
4457 static int font_log_env_checked
;
4460 font_add_log (action
, arg
, result
)
4462 Lisp_Object arg
, result
;
4464 Lisp_Object tail
, val
;
4467 if (! font_log_env_checked
)
4469 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
4470 font_log_env_checked
= 1;
4472 if (EQ (Vfont_log
, Qt
))
4475 arg
= Ffont_xlfd_name (arg
, Qt
);
4477 result
= Ffont_xlfd_name (result
, Qt
);
4478 else if (CONSP (result
))
4480 result
= Fcopy_sequence (result
);
4481 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4485 val
= Ffont_xlfd_name (val
, Qt
);
4486 XSETCAR (tail
, val
);
4489 else if (VECTORP (result
))
4491 result
= Fcopy_sequence (result
);
4492 for (i
= 0; i
< ASIZE (result
); i
++)
4494 val
= AREF (result
, i
);
4496 val
= Ffont_xlfd_name (val
, Qt
);
4497 ASET (result
, i
, val
);
4500 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4503 extern void syms_of_ftfont
P_ (());
4504 extern void syms_of_xfont
P_ (());
4505 extern void syms_of_xftfont
P_ (());
4506 extern void syms_of_ftxfont
P_ (());
4507 extern void syms_of_bdffont
P_ (());
4508 extern void syms_of_w32font
P_ (());
4509 extern void syms_of_atmfont
P_ (());
4514 sort_shift_bits
[FONT_SLANT_INDEX
] = 0;
4515 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 7;
4516 sort_shift_bits
[FONT_SIZE_INDEX
] = 14;
4517 sort_shift_bits
[FONT_WIDTH_INDEX
] = 21;
4518 sort_shift_bits
[FONT_ADSTYLE_INDEX
] = 28;
4519 sort_shift_bits
[FONT_FOUNDRY_INDEX
] = 29;
4520 sort_shift_bits
[FONT_FAMILY_INDEX
] = 30;
4521 /* Note that sort_shift_bits[FONT_SORT_TYPE] and
4522 sort_shift_bits[FONT_SORT_REGISTRY] are never used. */
4524 staticpro (&font_charset_alist
);
4525 font_charset_alist
= Qnil
;
4527 DEFSYM (Qfont_spec
, "font-spec");
4528 DEFSYM (Qfont_entity
, "font-entity");
4529 DEFSYM (Qfont_object
, "font-object");
4531 DEFSYM (Qopentype
, "opentype");
4533 DEFSYM (Qiso8859_1
, "iso8859-1");
4534 DEFSYM (Qiso10646_1
, "iso10646-1");
4535 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4536 DEFSYM (Qunicode_sip
, "unicode-sip");
4538 DEFSYM (QCotf
, ":otf");
4539 DEFSYM (QClang
, ":lang");
4540 DEFSYM (QCscript
, ":script");
4541 DEFSYM (QCantialias
, ":antialias");
4543 DEFSYM (QCfoundry
, ":foundry");
4544 DEFSYM (QCadstyle
, ":adstyle");
4545 DEFSYM (QCregistry
, ":registry");
4546 DEFSYM (QCspacing
, ":spacing");
4547 DEFSYM (QCdpi
, ":dpi");
4548 DEFSYM (QCscalable
, ":scalable");
4549 DEFSYM (QCavgwidth
, ":avgwidth");
4550 DEFSYM (QCfont_entity
, ":font-entity");
4551 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
4558 staticpro (&null_vector
);
4559 null_vector
= Fmake_vector (make_number (0), Qnil
);
4561 staticpro (&scratch_font_spec
);
4562 scratch_font_spec
= Ffont_spec (0, NULL
);
4563 staticpro (&scratch_font_prefer
);
4564 scratch_font_prefer
= Ffont_spec (0, NULL
);
4568 staticpro (&otf_list
);
4570 #endif /* HAVE_LIBOTF */
4574 defsubr (&Sfont_spec
);
4575 defsubr (&Sfont_get
);
4576 defsubr (&Sfont_put
);
4577 defsubr (&Slist_fonts
);
4578 defsubr (&Sfont_family_list
);
4579 defsubr (&Sfind_font
);
4580 defsubr (&Sfont_xlfd_name
);
4581 defsubr (&Sclear_font_cache
);
4582 defsubr (&Sfont_make_gstring
);
4583 defsubr (&Sfont_fill_gstring
);
4584 defsubr (&Sfont_shape_text
);
4586 defsubr (&Sfont_drive_otf
);
4587 defsubr (&Sfont_otf_alternates
);
4591 defsubr (&Sopen_font
);
4592 defsubr (&Sclose_font
);
4593 defsubr (&Squery_font
);
4594 defsubr (&Sget_font_glyphs
);
4595 defsubr (&Sfont_match_p
);
4596 defsubr (&Sfont_at
);
4598 defsubr (&Sdraw_string
);
4600 #endif /* FONT_DEBUG */
4601 #ifdef HAVE_WINDOW_SYSTEM
4602 defsubr (&Sfont_info
);
4605 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
4607 Alist of fontname patterns vs the corresponding encoding and repertory info.
4608 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
4609 where ENCODING is a charset or a char-table,
4610 and REPERTORY is a charset, a char-table, or nil.
4612 If ENCODING and REPERTORY are the same, the element can have the form
4613 \(REGEXP . ENCODING).
4615 ENCODING is for converting a character to a glyph code of the font.
4616 If ENCODING is a charset, encoding a character by the charset gives
4617 the corresponding glyph code. If ENCODING is a char-table, looking up
4618 the table by a character gives the corresponding glyph code.
4620 REPERTORY specifies a repertory of characters supported by the font.
4621 If REPERTORY is a charset, all characters beloging to the charset are
4622 supported. If REPERTORY is a char-table, all characters who have a
4623 non-nil value in the table are supported. If REPERTORY is nil, Emacs
4624 gets the repertory information by an opened font and ENCODING. */);
4625 Vfont_encoding_alist
= Qnil
;
4627 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
4628 doc
: /* Vector of valid font weight values.
4629 Each element has the form:
4630 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
4631 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symobls. */);
4632 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
4634 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
4635 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
4636 See `font-weight_table' for the format of the vector. */);
4637 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
4639 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
4640 doc
: /* Alist of font width symbols vs the corresponding numeric values.
4641 See `font-weight_table' for the format of the vector. */);
4642 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
4644 staticpro (&font_style_table
);
4645 font_style_table
= Fmake_vector (make_number (3), Qnil
);
4646 ASET (font_style_table
, 0, Vfont_weight_table
);
4647 ASET (font_style_table
, 1, Vfont_slant_table
);
4648 ASET (font_style_table
, 2, Vfont_width_table
);
4650 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
4651 *Logging list of font related actions and results.
4652 The value t means to suppress the logging.
4653 The initial value is set to nil if the environment variable
4654 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
4657 #ifdef HAVE_WINDOW_SYSTEM
4658 #ifdef HAVE_FREETYPE
4660 #ifdef HAVE_X_WINDOWS
4665 #endif /* HAVE_XFT */
4666 #endif /* HAVE_X_WINDOWS */
4667 #else /* not HAVE_FREETYPE */
4668 #ifdef HAVE_X_WINDOWS
4670 #endif /* HAVE_X_WINDOWS */
4671 #endif /* not HAVE_FREETYPE */
4674 #endif /* HAVE_BDFFONT */
4677 #endif /* WINDOWSNT */
4681 #endif /* HAVE_WINDOW_SYSTEM */
4684 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
4685 (do not change this comment) */