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
))
541 return make_number (FONT_SPACING_CHARCELL
);
543 return make_number (FONT_SPACING_MONO
);
545 return make_number (FONT_SPACING_PROPORTIONAL
);
547 return make_number (FONT_SPACING_DUAL
);
552 font_prop_validate_otf (prop
, val
)
553 Lisp_Object prop
, val
;
555 Lisp_Object tail
, tmp
;
558 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
559 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
560 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
563 if (! SYMBOLP (XCAR (val
)))
568 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
570 for (i
= 0; i
< 2; i
++)
577 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
578 if (! SYMBOLP (XCAR (tmp
)))
586 /* Structure of known font property keys and validater of the
590 /* Pointer to the key symbol. */
592 /* Function to validate PROP's value VAL, or NULL if any value is
593 ok. The value is VAL or its regularized value if VAL is valid,
594 and Qerror if not. */
595 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
596 } font_property_table
[] =
597 { { &QCtype
, font_prop_validate_symbol
},
598 { &QCfoundry
, font_prop_validate_symbol
},
599 { &QCfamily
, font_prop_validate_symbol
},
600 { &QCadstyle
, font_prop_validate_symbol
},
601 { &QCregistry
, font_prop_validate_symbol
},
602 { &QCweight
, font_prop_validate_style
},
603 { &QCslant
, font_prop_validate_style
},
604 { &QCwidth
, font_prop_validate_style
},
605 { &QCsize
, font_prop_validate_non_neg
},
606 { &QCdpi
, font_prop_validate_non_neg
},
607 { &QCspacing
, font_prop_validate_spacing
},
608 { &QCavgwidth
, font_prop_validate_non_neg
},
609 /* The order of the above entries must match with enum
610 font_property_index. */
611 { &QClang
, font_prop_validate_symbol
},
612 { &QCscript
, font_prop_validate_symbol
},
613 { &QCotf
, font_prop_validate_otf
}
616 /* Size (number of elements) of the above table. */
617 #define FONT_PROPERTY_TABLE_SIZE \
618 ((sizeof font_property_table) / (sizeof *font_property_table))
620 /* Return an index number of font property KEY or -1 if KEY is not an
621 already known property. */
624 get_font_prop_index (key
)
629 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
630 if (EQ (key
, *font_property_table
[i
].key
))
635 /* Validate the font property. The property key is specified by the
636 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
637 signal an error. The value is VAL or the regularized one. */
640 font_prop_validate (idx
, prop
, val
)
642 Lisp_Object prop
, val
;
644 Lisp_Object validated
;
649 prop
= *font_property_table
[idx
].key
;
652 idx
= get_font_prop_index (prop
);
656 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
657 if (EQ (validated
, Qerror
))
658 signal_error ("invalid font property", Fcons (prop
, val
));
663 /* Store VAL as a value of extra font property PROP in FONT while
664 keeping the sorting order. Don't check the validity of VAL. */
667 font_put_extra (font
, prop
, val
)
668 Lisp_Object font
, prop
, val
;
670 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
671 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
675 Lisp_Object prev
= Qnil
;
678 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
679 prev
= extra
, extra
= XCDR (extra
);
681 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
683 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
691 /* Font name parser and unparser */
693 static int parse_matrix
P_ ((char *));
694 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
695 static int font_parse_name
P_ ((char *, Lisp_Object
));
697 /* An enumerator for each field of an XLFD font name. */
698 enum xlfd_field_index
717 /* An enumerator for mask bit corresponding to each XLFD field. */
720 XLFD_FOUNDRY_MASK
= 0x0001,
721 XLFD_FAMILY_MASK
= 0x0002,
722 XLFD_WEIGHT_MASK
= 0x0004,
723 XLFD_SLANT_MASK
= 0x0008,
724 XLFD_SWIDTH_MASK
= 0x0010,
725 XLFD_ADSTYLE_MASK
= 0x0020,
726 XLFD_PIXEL_MASK
= 0x0040,
727 XLFD_POINT_MASK
= 0x0080,
728 XLFD_RESX_MASK
= 0x0100,
729 XLFD_RESY_MASK
= 0x0200,
730 XLFD_SPACING_MASK
= 0x0400,
731 XLFD_AVGWIDTH_MASK
= 0x0800,
732 XLFD_REGISTRY_MASK
= 0x1000,
733 XLFD_ENCODING_MASK
= 0x2000
737 /* Parse P pointing the pixel/point size field of the form
738 `[A B C D]' which specifies a transformation matrix:
744 by which all glyphs of the font are transformed. The spec says
745 that scalar value N for the pixel/point size is equivalent to:
746 A = N * resx/resy, B = C = 0, D = N.
748 Return the scalar value N if the form is valid. Otherwise return
759 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
762 matrix
[i
] = - strtod (p
+ 1, &end
);
764 matrix
[i
] = strtod (p
, &end
);
767 return (i
== 4 ? (int) matrix
[3] : -1);
770 /* Expand a wildcard field in FIELD (the first N fields are filled) to
771 multiple fields to fill in all 14 XLFD fields while restring a
772 field position by its contents. */
775 font_expand_wildcards (field
, n
)
776 Lisp_Object field
[XLFD_LAST_INDEX
];
780 Lisp_Object tmp
[XLFD_LAST_INDEX
];
781 /* Array of information about where this element can go. Nth
782 element is for Nth element of FIELD. */
784 /* Minimum possible field. */
786 /* Maxinum possible field. */
788 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
790 } range
[XLFD_LAST_INDEX
];
792 int range_from
, range_to
;
795 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
796 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
797 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
798 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
799 | XLFD_AVGWIDTH_MASK)
800 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
802 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
803 field. The value is shifted to left one bit by one in the
805 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
806 range_mask
= (range_mask
<< 1) | 1;
808 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
809 position-based retriction for FIELD[I]. */
810 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
811 i
++, range_from
++, range_to
++, range_mask
<<= 1)
813 Lisp_Object val
= field
[i
];
819 range
[i
].from
= range_from
;
820 range
[i
].to
= range_to
;
821 range
[i
].mask
= range_mask
;
825 /* The triplet FROM, TO, and MASK is a value-based
826 retriction for FIELD[I]. */
832 int numeric
= XINT (val
);
835 from
= to
= XLFD_ENCODING_INDEX
,
836 mask
= XLFD_ENCODING_MASK
;
837 else if (numeric
== 0)
838 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
839 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
840 else if (numeric
<= 48)
841 from
= to
= XLFD_PIXEL_INDEX
,
842 mask
= XLFD_PIXEL_MASK
;
844 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
845 mask
= XLFD_LARGENUM_MASK
;
847 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
848 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
849 mask
= XLFD_NULL_MASK
;
851 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
854 Lisp_Object name
= SYMBOL_NAME (val
);
856 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
857 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
858 mask
= XLFD_REGENC_MASK
;
860 from
= to
= XLFD_ENCODING_INDEX
,
861 mask
= XLFD_ENCODING_MASK
;
863 else if (range_from
<= XLFD_WEIGHT_INDEX
864 && range_to
>= XLFD_WEIGHT_INDEX
865 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
866 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
867 else if (range_from
<= XLFD_SLANT_INDEX
868 && range_to
>= XLFD_SLANT_INDEX
869 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
870 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
871 else if (range_from
<= XLFD_SWIDTH_INDEX
872 && range_to
>= XLFD_SWIDTH_INDEX
873 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
874 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
877 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
878 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
880 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
881 mask
= XLFD_SYMBOL_MASK
;
884 /* Merge position-based and value-based restrictions. */
886 while (from
< range_from
)
887 mask
&= ~(1 << from
++);
888 while (from
< 14 && ! (mask
& (1 << from
)))
890 while (to
> range_to
)
891 mask
&= ~(1 << to
--);
892 while (to
>= 0 && ! (mask
& (1 << to
)))
896 range
[i
].from
= from
;
898 range
[i
].mask
= mask
;
900 if (from
> range_from
|| to
< range_to
)
902 /* The range is narrowed by value-based restrictions.
903 Reflect it to the other fields. */
905 /* Following fields should be after FROM. */
907 /* Preceding fields should be before TO. */
908 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
910 /* Check FROM for non-wildcard field. */
911 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
913 while (range
[j
].from
< from
)
914 range
[j
].mask
&= ~(1 << range
[j
].from
++);
915 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
917 range
[j
].from
= from
;
920 from
= range
[j
].from
;
921 if (range
[j
].to
> to
)
923 while (range
[j
].to
> to
)
924 range
[j
].mask
&= ~(1 << range
[j
].to
--);
925 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
938 /* Decide all fileds from restrictions in RANGE. */
939 for (i
= j
= 0; i
< n
; i
++)
941 if (j
< range
[i
].from
)
943 if (i
== 0 || ! NILP (tmp
[i
- 1]))
944 /* None of TMP[X] corresponds to Jth field. */
946 for (; j
< range
[i
].from
; j
++)
951 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
953 for (; j
< XLFD_LAST_INDEX
; j
++)
955 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
956 field
[XLFD_ENCODING_INDEX
]
957 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
962 #ifdef ENABLE_CHECKING
963 /* Match a 14-field XLFD pattern against a full XLFD font name. */
965 font_match_xlfd (char *pattern
, char *name
)
967 while (*pattern
&& *name
)
969 if (*pattern
== *name
)
971 else if (*pattern
== '*')
972 if (*name
== pattern
[1])
983 /* Make sure the font object matches the XLFD font name. */
985 font_check_xlfd_parse (Lisp_Object font
, char *name
)
987 char name_check
[256];
988 font_unparse_xlfd (font
, 0, name_check
, 255);
989 return font_match_xlfd (name_check
, name
);
995 /* Parse NAME (null terminated) as XLFD and store information in FONT
996 (font-spec or font-entity). Size property of FONT is set as
998 specified XLFD fields FONT property
999 --------------------- -------------
1000 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1001 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1002 POINT_SIZE POINT_SIZE/10 (Lisp float)
1004 If NAME is successfully parsed, return 0. Otherwise return -1.
1006 FONT is usually a font-spec, but when this function is called from
1007 X font backend driver, it is a font-entity. In that case, NAME is
1008 a fully specified XLFD. */
1011 font_parse_xlfd (name
, font
)
1015 int len
= strlen (name
);
1017 char *f
[XLFD_LAST_INDEX
+ 1];
1022 /* Maximum XLFD name length is 255. */
1024 /* Accept "*-.." as a fully specified XLFD. */
1025 if (name
[0] == '*' && name
[1] == '-')
1026 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1029 for (p
= name
+ i
; *p
; p
++)
1033 if (i
== XLFD_LAST_INDEX
)
1038 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N])
1040 if (i
== XLFD_LAST_INDEX
)
1042 /* Fully specified XLFD. */
1045 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD (XLFD_FOUNDRY_INDEX
));
1046 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD (XLFD_FAMILY_INDEX
));
1047 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1048 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1050 val
= INTERN_FIELD (i
);
1053 if ((n
= font_style_to_value (j
, INTERN_FIELD (i
), 0)) < 0)
1055 ASET (font
, j
, make_number (n
));
1058 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD (XLFD_ADSTYLE_INDEX
));
1059 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1060 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1062 ASET (font
, FONT_REGISTRY_INDEX
,
1063 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1064 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
]));
1065 p
= f
[XLFD_PIXEL_INDEX
];
1066 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1067 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1070 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1072 ASET (font
, FONT_SIZE_INDEX
, val
);
1075 double point_size
= -1;
1077 font_assert (FONT_SPEC_P (font
));
1078 p
= f
[XLFD_POINT_INDEX
];
1080 point_size
= parse_matrix (p
);
1081 else if (isdigit (*p
))
1082 point_size
= atoi (p
), point_size
/= 10;
1083 if (point_size
>= 0)
1084 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1088 ASET (font
, FONT_DPI_INDEX
, INTERN_FIELD (XLFD_RESY_INDEX
));
1089 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1092 val
= font_prop_validate_spacing (QCspacing
, val
);
1093 if (! INTEGERP (val
))
1095 ASET (font
, FONT_SPACING_INDEX
, val
);
1097 p
= f
[XLFD_AVGWIDTH_INDEX
];
1100 ASET (font
, FONT_AVGWIDTH_INDEX
,
1101 font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
));
1105 int wild_card_found
= 0;
1106 Lisp_Object prop
[XLFD_LAST_INDEX
];
1108 if (FONT_ENTITY_P (font
))
1110 for (j
= 0; j
< i
; j
++)
1114 if (f
[j
][1] && f
[j
][1] != '-')
1117 wild_card_found
= 1;
1120 prop
[j
] = INTERN_FIELD (j
);
1122 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
]);
1124 if (! wild_card_found
)
1126 if (font_expand_wildcards (prop
, i
) < 0)
1129 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1130 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1131 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1132 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1133 if (! NILP (prop
[i
]))
1135 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1137 ASET (font
, j
, make_number (n
));
1139 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1140 val
= prop
[XLFD_REGISTRY_INDEX
];
1143 val
= prop
[XLFD_ENCODING_INDEX
];
1145 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1147 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1148 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1150 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1151 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1153 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1155 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1156 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1157 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1159 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1161 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1164 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1165 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1166 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1168 val
= font_prop_validate_spacing (QCspacing
,
1169 prop
[XLFD_SPACING_INDEX
]);
1170 if (! INTEGERP (val
))
1172 ASET (font
, FONT_SPACING_INDEX
, val
);
1174 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1175 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1181 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1182 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1183 0, use PIXEL_SIZE instead. */
1186 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1192 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1196 font_assert (FONTP (font
));
1198 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1201 if (i
== FONT_ADSTYLE_INDEX
)
1202 j
= XLFD_ADSTYLE_INDEX
;
1203 else if (i
== FONT_REGISTRY_INDEX
)
1204 j
= XLFD_REGISTRY_INDEX
;
1205 val
= AREF (font
, i
);
1208 if (j
== XLFD_REGISTRY_INDEX
)
1209 f
[j
] = "*-*", len
+= 4;
1211 f
[j
] = "*", len
+= 2;
1216 val
= SYMBOL_NAME (val
);
1217 if (j
== XLFD_REGISTRY_INDEX
1218 && ! strchr ((char *) SDATA (val
), '-'))
1220 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1221 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1223 f
[j
] = alloca (SBYTES (val
) + 3);
1224 sprintf (f
[j
], "%s-*", SDATA (val
));
1225 len
+= SBYTES (val
) + 3;
1229 f
[j
] = alloca (SBYTES (val
) + 4);
1230 sprintf (f
[j
], "%s*-*", SDATA (val
));
1231 len
+= SBYTES (val
) + 4;
1235 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1239 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1242 val
= font_style_symbolic (font
, i
, 0);
1244 f
[j
] = "*", len
+= 2;
1247 val
= SYMBOL_NAME (val
);
1248 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1252 val
= AREF (font
, FONT_SIZE_INDEX
);
1253 font_assert (NUMBERP (val
) || NILP (val
));
1261 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1262 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1265 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1267 else if (FLOATP (val
))
1269 i
= XFLOAT_DATA (val
) * 10;
1270 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1271 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1274 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1276 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1278 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1279 f
[XLFD_RESX_INDEX
] = alloca (22);
1280 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1284 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1285 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1287 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1289 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1290 : spacing
<= FONT_SPACING_DUAL
? "d"
1291 : spacing
<= FONT_SPACING_MONO
? "m"
1296 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1297 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1299 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1300 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
],
1301 "%d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1304 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1305 len
++; /* for terminating '\0'. */
1308 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1309 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1310 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1311 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1312 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1313 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1314 f
[XLFD_REGISTRY_INDEX
]);
1317 /* Parse NAME (null terminated) as Fonconfig's name format and store
1318 information in FONT (font-spec or font-entity). If NAME is
1319 successfully parsed, return 0. Otherwise return -1. */
1322 font_parse_fcname (name
, font
)
1327 int len
= strlen (name
);
1332 /* It is assured that (name[0] && name[0] != '-'). */
1340 for (p0
= name
+ 1; *p0
&& (*p0
!= '-' && *p0
!= ':'); p0
++)
1341 if (*p0
== '\\' && p0
[1])
1343 family
= font_intern_prop (name
, p0
- name
);
1346 if (! isdigit (p0
[1]))
1348 point_size
= strtod (p0
+ 1, &p1
);
1349 if (*p1
&& *p1
!= ':')
1351 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1354 ASET (font
, FONT_FAMILY_INDEX
, family
);
1358 copy
= alloca (len
+ 1);
1363 /* Now parse ":KEY=VAL" patterns. Store known keys and values in
1364 extra, copy unknown ones to COPY. It is stored in extra slot by
1365 the key QCfc_unknown_spec. */
1368 Lisp_Object key
, val
;
1371 for (p1
= p0
+ 1; *p1
&& *p1
!= '=' && *p1
!= ':'; p1
++);
1374 /* Must be an enumerated value. */
1375 val
= font_intern_prop (p0
+ 1, p1
- p0
- 1);
1376 if (memcmp (p0
+ 1, "light", 5) == 0
1377 || memcmp (p0
+ 1, "medium", 6) == 0
1378 || memcmp (p0
+ 1, "demibold", 8) == 0
1379 || memcmp (p0
+ 1, "bold", 4) == 0
1380 || memcmp (p0
+ 1, "black", 5) == 0)
1381 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1382 else if (memcmp (p0
+ 1, "roman", 5) == 0
1383 || memcmp (p0
+ 1, "italic", 6) == 0
1384 || memcmp (p0
+ 1, "oblique", 7) == 0)
1385 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1386 else if (memcmp (p0
+ 1, "charcell", 8) == 0
1387 || memcmp (p0
+ 1, "mono", 4) == 0
1388 || memcmp (p0
+ 1, "proportional", 12) == 0)
1390 int spacing
= (p0
[1] == 'c' ? FONT_SPACING_CHARCELL
1391 : p0
[1] == 'm' ? FONT_SPACING_MONO
1392 : FONT_SPACING_PROPORTIONAL
);
1393 ASET (font
, FONT_SPACING_INDEX
, make_number (spacing
));
1398 bcopy (p0
, copy
, p1
- p0
);
1404 if (memcmp (p0
+ 1, "pixelsize=", 10) == 0)
1405 prop
= FONT_SIZE_INDEX
;
1408 key
= font_intern_prop (p0
, p1
- p0
);
1409 prop
= get_font_prop_index (key
);
1412 for (p1
= p0
; *p1
&& *p1
!= ':'; p1
++);
1413 val
= font_intern_prop (p0
, p1
- p0
);
1416 if (prop
>= FONT_FOUNDRY_INDEX
&& prop
< FONT_EXTRA_INDEX
)
1417 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1419 Ffont_put (font
, key
, val
);
1421 bcopy (p0
- 1, copy
, p1
- p0
+ 1);
1422 copy
+= p1
- p0
+ 1;
1428 font_put_extra (font
, QCfc_unknown_spec
,
1429 make_unibyte_string (name
, copy
- name
));
1434 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1435 NAME (NBYTES length), and return the name length. If
1436 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1439 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1445 Lisp_Object tail
, val
;
1450 Lisp_Object styles
[3];
1451 char *style_names
[3] = { "weight", "slant", "width" };
1454 val
= AREF (font
, FONT_FAMILY_INDEX
);
1456 len
+= SBYTES (val
);
1458 val
= AREF (font
, FONT_SIZE_INDEX
);
1461 if (XINT (val
) != 0)
1462 pixel_size
= XINT (val
);
1464 len
+= 21; /* for ":pixelsize=NUM" */
1466 else if (FLOATP (val
))
1469 point_size
= (int) XFLOAT_DATA (val
);
1470 len
+= 11; /* for "-NUM" */
1473 val
= AREF (font
, FONT_FOUNDRY_INDEX
);
1475 /* ":foundry=NAME" */
1476 len
+= 9 + SBYTES (val
);
1478 for (i
= 0; i
< 3; i
++)
1480 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1481 if (! NILP (styles
[i
]))
1482 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1483 SDATA (SYMBOL_NAME (styles
[i
])));
1486 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1487 len
+= sprintf (work
, ":dpi=%d", dpi
);
1488 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1489 len
+= strlen (":spacing=100");
1490 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1491 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1492 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1494 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1496 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1498 len
+= SBYTES (val
);
1499 else if (INTEGERP (val
))
1500 len
+= sprintf (work
, "%d", XINT (val
));
1501 else if (SYMBOLP (val
))
1502 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1508 if (! NILP (AREF (font
, FONT_FAMILY_INDEX
)))
1509 p
+= sprintf(p
, "%s", SDATA (SYMBOL_NAME (AREF (font
, FONT_FAMILY_INDEX
))));
1513 p
+= sprintf (p
, "%d", point_size
);
1515 p
+= sprintf (p
, "-%d", point_size
);
1517 else if (pixel_size
> 0)
1518 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1519 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1520 p
+= sprintf (p
, ":foundry=%s",
1521 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1522 for (i
= 0; i
< 3; i
++)
1523 if (! NILP (styles
[i
]))
1524 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1525 SDATA (SYMBOL_NAME (styles
[i
])));
1526 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1527 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1528 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1529 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1530 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1532 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1533 p
+= sprintf (p
, ":scalable=true");
1535 p
+= sprintf (p
, ":scalable=false");
1540 /* Parse NAME (null terminated) and store information in FONT
1541 (font-spec or font-entity). If NAME is successfully parsed, return
1542 0. Otherwise return -1. */
1545 font_parse_name (name
, font
)
1549 if (name
[0] == '-' || index (name
, '*'))
1550 return font_parse_xlfd (name
, font
);
1551 return font_parse_fcname (name
, font
);
1555 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1556 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1560 font_parse_family_registry (family
, registry
, font_spec
)
1561 Lisp_Object family
, registry
, font_spec
;
1567 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1569 CHECK_STRING (family
);
1570 len
= SBYTES (family
);
1571 p0
= (char *) SDATA (family
);
1572 p1
= index (p0
, '-');
1575 if ((*p0
!= '*' || p1
- p0
> 1)
1576 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1577 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
));
1580 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
));
1583 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1585 if (! NILP (registry
))
1587 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1588 CHECK_STRING (registry
);
1589 len
= SBYTES (registry
);
1590 p0
= (char *) SDATA (registry
);
1591 p1
= index (p0
, '-');
1594 if (SDATA (registry
)[len
- 1] == '*')
1595 registry
= concat2 (registry
, build_string ("-*"));
1597 registry
= concat2 (registry
, build_string ("*-*"));
1599 registry
= Fdowncase (registry
);
1600 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1605 /* This part (through the next ^L) is still experimental and not
1606 tested much. We may drastically change codes. */
1612 #define LGSTRING_HEADER_SIZE 6
1613 #define LGSTRING_GLYPH_SIZE 8
1616 check_gstring (gstring
)
1617 Lisp_Object gstring
;
1622 CHECK_VECTOR (gstring
);
1623 val
= AREF (gstring
, 0);
1625 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1627 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1628 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1629 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1630 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1631 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1632 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1633 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1634 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1635 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1636 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1637 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1639 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1641 val
= LGSTRING_GLYPH (gstring
, i
);
1643 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1645 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1647 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1648 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1649 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1650 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1651 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1652 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1653 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1654 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1656 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1658 if (ASIZE (val
) < 3)
1660 for (j
= 0; j
< 3; j
++)
1661 CHECK_NUMBER (AREF (val
, j
));
1666 error ("Invalid glyph-string format");
1671 check_otf_features (otf_features
)
1672 Lisp_Object otf_features
;
1676 CHECK_CONS (otf_features
);
1677 CHECK_SYMBOL (XCAR (otf_features
));
1678 otf_features
= XCDR (otf_features
);
1679 CHECK_CONS (otf_features
);
1680 CHECK_SYMBOL (XCAR (otf_features
));
1681 otf_features
= XCDR (otf_features
);
1682 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1684 CHECK_SYMBOL (Fcar (val
));
1685 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1686 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1688 otf_features
= XCDR (otf_features
);
1689 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1691 CHECK_SYMBOL (Fcar (val
));
1692 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1693 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1700 Lisp_Object otf_list
;
1703 otf_tag_symbol (tag
)
1708 OTF_tag_name (tag
, name
);
1709 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1716 Lisp_Object val
= Fassoc (file
, otf_list
);
1720 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1723 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1724 val
= make_save_value (otf
, 0);
1725 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1731 /* Return a list describing which scripts/languages FONT supports by
1732 which GSUB/GPOS features of OpenType tables. See the comment of
1733 (struct font_driver).otf_capability. */
1736 font_otf_capability (font
)
1740 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1743 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1746 for (i
= 0; i
< 2; i
++)
1748 OTF_GSUB_GPOS
*gsub_gpos
;
1749 Lisp_Object script_list
= Qnil
;
1752 if (OTF_get_features (otf
, i
== 0) < 0)
1754 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1755 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1757 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1758 Lisp_Object langsys_list
= Qnil
;
1759 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1762 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1764 OTF_LangSys
*langsys
;
1765 Lisp_Object feature_list
= Qnil
;
1766 Lisp_Object langsys_tag
;
1769 if (k
== script
->LangSysCount
)
1771 langsys
= &script
->DefaultLangSys
;
1776 langsys
= script
->LangSys
+ k
;
1778 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1780 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1782 OTF_Feature
*feature
1783 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1784 Lisp_Object feature_tag
1785 = otf_tag_symbol (feature
->FeatureTag
);
1787 feature_list
= Fcons (feature_tag
, feature_list
);
1789 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1792 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1797 XSETCAR (capability
, script_list
);
1799 XSETCDR (capability
, script_list
);
1805 /* Parse OTF features in SPEC and write a proper features spec string
1806 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1807 assured that the sufficient memory has already allocated for
1811 generate_otf_features (spec
, features
)
1821 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1827 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1832 else if (! asterisk
)
1834 val
= SYMBOL_NAME (val
);
1835 p
+= sprintf (p
, "%s", SDATA (val
));
1839 val
= SYMBOL_NAME (val
);
1840 p
+= sprintf (p
, "~%s", SDATA (val
));
1844 error ("OTF spec too long");
1848 font_otf_DeviceTable (device_table
)
1849 OTF_DeviceTable
*device_table
;
1851 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1853 return Fcons (make_number (len
),
1854 make_unibyte_string (device_table
->DeltaValue
, len
));
1858 font_otf_ValueRecord (value_format
, value_record
)
1860 OTF_ValueRecord
*value_record
;
1862 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1864 if (value_format
& OTF_XPlacement
)
1865 ASET (val
, 0, make_number (value_record
->XPlacement
));
1866 if (value_format
& OTF_YPlacement
)
1867 ASET (val
, 1, make_number (value_record
->YPlacement
));
1868 if (value_format
& OTF_XAdvance
)
1869 ASET (val
, 2, make_number (value_record
->XAdvance
));
1870 if (value_format
& OTF_YAdvance
)
1871 ASET (val
, 3, make_number (value_record
->YAdvance
));
1872 if (value_format
& OTF_XPlaDevice
)
1873 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1874 if (value_format
& OTF_YPlaDevice
)
1875 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1876 if (value_format
& OTF_XAdvDevice
)
1877 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
1878 if (value_format
& OTF_YAdvDevice
)
1879 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
1884 font_otf_Anchor (anchor
)
1889 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
1890 ASET (val
, 0, make_number (anchor
->XCoordinate
));
1891 ASET (val
, 1, make_number (anchor
->YCoordinate
));
1892 if (anchor
->AnchorFormat
== 2)
1893 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
1896 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
1897 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
1901 #endif /* HAVE_LIBOTF */
1904 /* G-string (glyph string) handler */
1906 /* G-string is a vector of the form [HEADER GLYPH ...].
1907 See the docstring of `font-make-gstring' for more detail. */
1910 font_prepare_composition (cmp
, f
)
1911 struct composition
*cmp
;
1915 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
1916 cmp
->hash_index
* 2);
1918 cmp
->font
= XFONT_OBJECT (LGSTRING_FONT (gstring
));
1919 cmp
->glyph_len
= LGSTRING_LENGTH (gstring
);
1920 cmp
->pixel_width
= LGSTRING_WIDTH (gstring
);
1921 cmp
->lbearing
= LGSTRING_LBEARING (gstring
);
1922 cmp
->rbearing
= LGSTRING_RBEARING (gstring
);
1923 cmp
->ascent
= LGSTRING_ASCENT (gstring
);
1924 cmp
->descent
= LGSTRING_DESCENT (gstring
);
1925 cmp
->width
= cmp
->pixel_width
/ FRAME_COLUMN_WIDTH (f
);
1926 if (cmp
->width
== 0)
1935 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*, Lisp_Object
));
1936 static int font_compare
P_ ((const void *, const void *));
1937 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
1938 Lisp_Object
, Lisp_Object
,
1941 /* We sort fonts by scoring each of them against a specified
1942 font-spec. The score value is 32 bit (`unsigned'), and the smaller
1943 the value is, the closer the font is to the font-spec.
1945 The highest 2 bits of the score is used for FAMILY. The exact
1946 match is 0, match with one of face-font-family-alternatives is
1949 The next 2 bits of the score is used for the atomic properties
1950 FOUNDRY and ADSTYLE respectively.
1952 Each 7-bit in the lower 28 bits are used for numeric properties
1953 WEIGHT, SLANT, WIDTH, and SIZE. */
1955 /* How many bits to shift to store the difference value of each font
1956 property in a score. Note that flots for FONT_TYPE_INDEX and
1957 FONT_REGISTRY_INDEX are not used. */
1958 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
1960 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
1961 The return value indicates how different ENTITY is compared with
1964 ALTERNATE_FAMILIES, if non-nil, is a pre-calculated list of
1965 alternate family names for AREF (SPEC_PROP, FONT_FAMILY_INDEX). */
1968 font_score (entity
, spec_prop
, alternate_families
)
1969 Lisp_Object entity
, *spec_prop
;
1970 Lisp_Object alternate_families
;
1975 /* Score three atomic fields. Maximum difference is 1 (family is 3). */
1976 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_ADSTYLE_INDEX
; i
++)
1977 if (i
!= FONT_REGISTRY_INDEX
1978 && ! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
1980 Lisp_Object entity_str
= SYMBOL_NAME (AREF (entity
, i
));
1981 Lisp_Object spec_str
= SYMBOL_NAME (spec_prop
[i
]);
1983 if (xstrcasecmp (SDATA (spec_str
), SDATA (entity_str
)))
1985 if (i
== FONT_FAMILY_INDEX
&& CONSP (alternate_families
))
1989 for (j
= 1; CONSP (alternate_families
);
1990 j
++, alternate_families
= XCDR (alternate_families
))
1992 spec_str
= XCAR (alternate_families
);
1993 if (xstrcasecmp (SDATA (spec_str
), SDATA (entity_str
)) == 0)
1998 score
|= j
<< sort_shift_bits
[i
];
2001 score
|= 1 << sort_shift_bits
[i
];
2005 /* Score three style numeric fields. Maximum difference is 127. */
2006 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2007 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2009 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2013 /* This is to prefer the exact symbol style. */
2015 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2018 /* Score the size. Maximum difference is 127. */
2019 i
= FONT_SIZE_INDEX
;
2020 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
])
2021 && XINT (AREF (entity
, i
)) > 0)
2023 /* We use the higher 6-bit for the actual size difference. The
2024 lowest bit is set if the DPI is different. */
2025 int diff
= XINT (spec_prop
[i
]) - XINT (AREF (entity
, i
));
2030 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2031 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2033 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2040 /* The comparison function for qsort. */
2043 font_compare (d1
, d2
)
2044 const void *d1
, *d2
;
2046 return (*(unsigned *) d1
- *(unsigned *) d2
);
2050 /* The structure for elements being sorted by qsort. */
2051 struct font_sort_data
2058 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2059 If PREFER specifies a point-size, calculate the corresponding
2060 pixel-size from QCdpi property of PREFER or from the Y-resolution
2061 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
2062 get the font-entities in VEC.
2064 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2065 return the sorted VEC. */
2068 font_sort_entites (vec
, prefer
, frame
, spec
, best_only
)
2069 Lisp_Object vec
, prefer
, frame
, spec
;
2072 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2074 struct font_sort_data
*data
;
2075 Lisp_Object alternate_families
= Qnil
;
2076 unsigned best_score
;
2077 Lisp_Object best_entity
;
2082 return best_only
? AREF (vec
, 0) : vec
;
2084 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_DPI_INDEX
; i
++)
2085 prefer_prop
[i
] = AREF (prefer
, i
);
2089 /* A font driver may return a font that has a property value
2090 different from the value specified in SPEC if the driver
2091 thinks they are the same. That happens, for instance, such a
2092 generic family name as "serif" is specified. So, to ignore
2093 such a difference, for all properties specified in SPEC, set
2094 the corresponding properties in PREFER_PROP to nil. */
2095 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2096 if (! NILP (AREF (spec
, i
)))
2097 prefer_prop
[i
] = Qnil
;
2100 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2101 prefer_prop
[FONT_SIZE_INDEX
]
2102 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2103 if (! NILP (prefer_prop
[FONT_FAMILY_INDEX
]))
2106 = Fassoc_string (prefer_prop
[FONT_FAMILY_INDEX
],
2107 Vface_alternative_font_family_alist
, Qt
);
2108 if (CONSP (alternate_families
))
2109 alternate_families
= XCDR (alternate_families
);
2112 /* Scoring and sorting. */
2113 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2114 best_score
= 0xFFFFFFFF;
2116 for (i
= 0; i
< len
; i
++)
2118 data
[i
].entity
= AREF (vec
, i
);
2119 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
,
2120 alternate_families
);
2121 if (best_only
&& best_score
> data
[i
].score
)
2123 best_score
= data
[i
].score
;
2124 best_entity
= data
[i
].entity
;
2125 if (best_score
== 0)
2129 if (NILP (best_entity
))
2131 qsort (data
, len
, sizeof *data
, font_compare
);
2132 for (i
= 0; i
< len
; i
++)
2133 ASET (vec
, i
, data
[i
].entity
);
2139 font_add_log ("sort-by", prefer
, vec
);
2144 /* API of Font Service Layer. */
2146 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2147 sort_shift_bits. Finternal_set_font_selection_order calls this
2148 function with font_sort_order after setting up it. */
2151 font_update_sort_order (order
)
2156 for (i
= 0, shift_bits
= 21; i
< 4; i
++, shift_bits
-= 7)
2158 int xlfd_idx
= order
[i
];
2160 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2161 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2162 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2163 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2164 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2165 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2167 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2172 /* Check if ENTITY matches with the font specification SPEC. */
2175 font_match_p (spec
, entity
)
2176 Lisp_Object spec
, entity
;
2178 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2179 Lisp_Object alternate_families
= Qnil
;
2182 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2183 prefer_prop
[i
] = AREF (spec
, i
);
2184 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2185 prefer_prop
[FONT_SIZE_INDEX
]
2186 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2187 if (! NILP (prefer_prop
[FONT_FAMILY_INDEX
]))
2190 = Fassoc_string (prefer_prop
[FONT_FAMILY_INDEX
],
2191 Vface_alternative_font_family_alist
, Qt
);
2192 if (CONSP (alternate_families
))
2193 alternate_families
= XCDR (alternate_families
);
2196 return (font_score (entity
, prefer_prop
, alternate_families
) == 0);
2200 /* CHeck a lispy font object corresponding to FONT. */
2203 font_check_object (font
)
2206 Lisp_Object tail
, elt
;
2208 for (tail
= font
->props
[FONT_OBJLIST_INDEX
]; CONSP (tail
);
2212 if (font
== XFONT_OBJECT (elt
))
2222 Each font backend has the callback function get_cache, and it
2223 returns a cons cell of which cdr part can be freely used for
2224 caching fonts. The cons cell may be shared by multiple frames
2225 and/or multiple font drivers. So, we arrange the cdr part as this:
2227 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2229 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2230 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2231 cons (FONT-SPEC FONT-ENTITY ...). */
2233 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2234 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2235 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2236 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2237 struct font_driver
*));
2240 font_prepare_cache (f
, driver
)
2242 struct font_driver
*driver
;
2244 Lisp_Object cache
, val
;
2246 cache
= driver
->get_cache (f
);
2248 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2252 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2253 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2257 val
= XCDR (XCAR (val
));
2258 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2264 font_finish_cache (f
, driver
)
2266 struct font_driver
*driver
;
2268 Lisp_Object cache
, val
, tmp
;
2271 cache
= driver
->get_cache (f
);
2273 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2274 cache
= val
, val
= XCDR (val
);
2275 font_assert (! NILP (val
));
2276 tmp
= XCDR (XCAR (val
));
2277 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2278 if (XINT (XCAR (tmp
)) == 0)
2280 font_clear_cache (f
, XCAR (val
), driver
);
2281 XSETCDR (cache
, XCDR (val
));
2287 font_get_cache (f
, driver
)
2289 struct font_driver
*driver
;
2291 Lisp_Object val
= driver
->get_cache (f
);
2292 Lisp_Object type
= driver
->type
;
2294 font_assert (CONSP (val
));
2295 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2296 font_assert (CONSP (val
));
2297 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2298 val
= XCDR (XCAR (val
));
2302 static int num_fonts
;
2305 font_clear_cache (f
, cache
, driver
)
2308 struct font_driver
*driver
;
2310 Lisp_Object tail
, elt
;
2312 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2313 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2316 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)) && VECTORP (XCDR (elt
)))
2318 Lisp_Object vec
= XCDR (elt
);
2321 for (i
= 0; i
< ASIZE (vec
); i
++)
2323 Lisp_Object entity
= AREF (vec
, i
);
2325 if (EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2327 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2329 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2331 Lisp_Object val
= XCAR (objlist
);
2332 struct font
*font
= XFONT_OBJECT (val
);
2334 font_assert (font
&& driver
== font
->driver
);
2335 driver
->close (f
, font
);
2338 if (driver
->free_entity
)
2339 driver
->free_entity (entity
);
2344 XSETCDR (cache
, Qnil
);
2348 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2351 font_delete_unmatched (list
, spec
, size
)
2352 Lisp_Object list
, spec
;
2355 Lisp_Object entity
, val
;
2356 enum font_property_index prop
;
2358 for (val
= Qnil
; CONSP (list
); list
= XCDR (list
))
2360 entity
= XCAR (list
);
2361 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2362 if (INTEGERP (AREF (spec
, prop
))
2363 && ((XINT (AREF (spec
, prop
)) >> 8)
2364 != (XINT (AREF (entity
, prop
)) >> 8)))
2365 prop
= FONT_SPEC_MAX
;
2366 if (prop
++ <= FONT_SIZE_INDEX
2368 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2370 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2373 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2374 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2375 prop
= FONT_SPEC_MAX
;
2377 if (prop
< FONT_SPEC_MAX
)
2378 val
= Fcons (entity
, val
);
2384 /* Return a vector of font-entities matching with SPEC on FRAME. */
2387 font_list_entities (frame
, spec
)
2388 Lisp_Object frame
, spec
;
2390 FRAME_PTR f
= XFRAME (frame
);
2391 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2392 Lisp_Object ftype
, family
, alternate_familes
, val
;
2395 int need_filtering
= 0;
2399 font_assert (FONT_SPEC_P (spec
));
2401 family
= AREF (spec
, FONT_FAMILY_INDEX
);
2403 alternate_familes
= Qnil
;
2406 alternate_familes
= Fassoc_string (family
,
2407 Vface_alternative_font_family_alist
,
2409 if (! NILP (alternate_familes
))
2410 alternate_familes
= XCDR (alternate_familes
);
2411 n_family
+= XINT (Flength (alternate_familes
));
2414 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2415 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2416 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2417 size
= font_pixel_size (f
, spec
);
2421 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2422 for (i
= 1; i
<= FONT_REGISTRY_INDEX
; i
++)
2423 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2424 for (i
= FONT_DPI_INDEX
; i
< FONT_EXTRA_INDEX
; i
+= 2)
2426 ASET (scratch_font_spec
, i
, Qnil
);
2427 if (! NILP (AREF (spec
, i
)))
2430 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2431 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2433 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
* n_family
);
2437 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2439 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2441 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2442 Lisp_Object tail
= alternate_familes
;
2444 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2445 ASET (scratch_font_spec
, FONT_FAMILY_INDEX
, family
);
2448 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2455 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2456 copy
= Fcopy_font_spec (scratch_font_spec
);
2457 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2458 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2460 if (! NILP (val
) && need_filtering
)
2461 val
= font_delete_unmatched (val
, spec
, size
);
2469 ASET (scratch_font_spec
, FONT_FAMILY_INDEX
,
2470 Fintern (XCAR (tail
), Qnil
));
2475 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2476 font_add_log ("list", spec
, val
);
2481 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2482 nil, is an array of face's attributes, which specifies preferred
2483 font-related attributes. */
2486 font_matching_entity (f
, attrs
, spec
)
2488 Lisp_Object
*attrs
, spec
;
2490 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2491 Lisp_Object ftype
, size
, entity
;
2494 XSETFRAME (frame
, f
);
2495 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2496 size
= AREF (spec
, FONT_SIZE_INDEX
);
2498 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2500 for (; driver_list
; driver_list
= driver_list
->next
)
2502 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2504 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2507 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2508 entity
= assoc_no_quit (spec
, XCDR (cache
));
2510 entity
= XCDR (entity
);
2513 entity
= driver_list
->driver
->match (frame
, spec
);
2514 copy
= Fcopy_font_spec (spec
);
2515 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2516 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2518 if (! NILP (entity
))
2521 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2522 ASET (spec
, FONT_SIZE_INDEX
, size
);
2523 font_add_log ("match", spec
, entity
);
2528 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2529 opened font object. */
2532 font_open_entity (f
, entity
, pixel_size
)
2537 struct font_driver_list
*driver_list
;
2538 Lisp_Object objlist
, size
, val
, font_object
;
2542 font_assert (FONT_ENTITY_P (entity
));
2543 size
= AREF (entity
, FONT_SIZE_INDEX
);
2544 if (XINT (size
) != 0)
2545 pixel_size
= XINT (size
);
2547 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2548 objlist
= XCDR (objlist
))
2549 if (XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2550 return XCAR (objlist
);
2552 val
= AREF (entity
, FONT_TYPE_INDEX
);
2553 for (driver_list
= f
->font_driver_list
;
2554 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2555 driver_list
= driver_list
->next
);
2559 font_object
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2560 font_add_log ("open", entity
, font_object
);
2561 if (NILP (font_object
))
2563 ASET (entity
, FONT_OBJLIST_INDEX
,
2564 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2565 ASET (font_object
, FONT_OBJLIST_INDEX
, AREF (entity
, FONT_OBJLIST_INDEX
));
2568 font
= XFONT_OBJECT (font_object
);
2569 min_width
= (font
->min_width
? font
->min_width
2570 : font
->average_width
? font
->average_width
2571 : font
->space_width
? font
->space_width
2573 #ifdef HAVE_WINDOW_SYSTEM
2574 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2575 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2577 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2578 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
;
2579 fonts_changed_p
= 1;
2583 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2584 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2585 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > font
->height
)
2586 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
, fonts_changed_p
= 1;
2594 /* Close FONT_OBJECT that is opened on frame F. */
2597 font_close_object (f
, font_object
)
2599 Lisp_Object font_object
;
2601 struct font
*font
= XFONT_OBJECT (font_object
);
2602 Lisp_Object objlist
;
2603 Lisp_Object tail
, prev
= Qnil
;
2605 objlist
= AREF (font_object
, FONT_OBJLIST_INDEX
);
2606 for (prev
= Qnil
, tail
= objlist
; CONSP (tail
);
2607 prev
= tail
, tail
= XCDR (tail
))
2608 if (EQ (font_object
, XCAR (tail
)))
2610 font_add_log ("close", font_object
, Qnil
);
2611 font
->driver
->close (f
, font
);
2612 #ifdef HAVE_WINDOW_SYSTEM
2613 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2614 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2617 ASET (font_object
, FONT_OBJLIST_INDEX
, XCDR (objlist
));
2619 XSETCDR (prev
, XCDR (objlist
));
2627 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2628 FONT is a font-entity and it must be opened to check. */
2631 font_has_char (f
, font
, c
)
2638 if (FONT_ENTITY_P (font
))
2640 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2641 struct font_driver_list
*driver_list
;
2643 for (driver_list
= f
->font_driver_list
;
2644 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2645 driver_list
= driver_list
->next
);
2648 if (! driver_list
->driver
->has_char
)
2650 return driver_list
->driver
->has_char (font
, c
);
2653 font_assert (FONT_OBJECT_P (font
));
2654 fontp
= XFONT_OBJECT (font
);
2655 if (fontp
->driver
->has_char
)
2657 int result
= fontp
->driver
->has_char (font
, c
);
2662 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2666 /* Return the glyph ID of FONT_OBJECT for character C. */
2669 font_encode_char (font_object
, c
)
2670 Lisp_Object font_object
;
2675 font_assert (FONT_OBJECT_P (font_object
));
2676 font
= XFONT_OBJECT (font_object
);
2677 return font
->driver
->encode_char (font
, c
);
2681 /* Return the name of FONT_OBJECT. */
2684 font_get_name (font_object
)
2685 Lisp_Object font_object
;
2687 font_assert (FONT_OBJECT_P (font_object
));
2688 return AREF (font_object
, FONT_NAME_INDEX
);
2692 /* Return the specification of FONT_OBJECT. */
2695 font_get_spec (font_object
)
2696 Lisp_Object font_object
;
2698 Lisp_Object spec
= font_make_spec ();
2701 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2702 ASET (spec
, i
, AREF (font_object
, i
));
2703 ASET (spec
, FONT_SIZE_INDEX
,
2704 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2709 font_spec_from_name (font_name
)
2710 Lisp_Object font_name
;
2712 Lisp_Object args
[2];
2715 args
[1] = font_name
;
2716 return Ffont_spec (2, args
);
2721 font_clear_prop (attrs
, prop
)
2723 enum font_property_index prop
;
2725 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2729 if (NILP (AREF (font
, prop
))
2730 && prop
!= FONT_FAMILY_INDEX
&& prop
!= FONT_FAMILY_INDEX
)
2732 font
= Fcopy_font_spec (font
);
2733 ASET (font
, prop
, Qnil
);
2734 if (prop
== FONT_FAMILY_INDEX
)
2736 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
2737 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
2738 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
2739 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2740 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2741 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2743 else if (prop
== FONT_SIZE_INDEX
)
2745 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2746 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2747 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2749 attrs
[LFACE_FONT_INDEX
] = font
;
2753 font_update_lface (f
, attrs
)
2759 spec
= attrs
[LFACE_FONT_INDEX
];
2760 if (! FONT_SPEC_P (spec
))
2763 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
))
2764 || ! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2768 if (NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
2769 family
= AREF (spec
, FONT_FAMILY_INDEX
);
2770 else if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2771 family
= concat2 (SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
)),
2772 build_string ("-*"));
2774 family
= concat3 (SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
)),
2776 SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
)));
2777 attrs
[LFACE_FAMILY_INDEX
] = family
;
2779 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
2780 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
2781 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
2782 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);;
2783 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
2784 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
2785 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
2789 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2794 val
= Ffont_get (spec
, QCdpi
);
2797 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
2800 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2801 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
2802 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
2807 /* Return a font-entity satisfying SPEC and best matching with face's
2808 font related attributes in ATTRS. C, if not negative, is a
2809 character that the entity must support. */
2812 font_find_for_lface (f
, attrs
, spec
, c
)
2818 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
2825 Lisp_Object registry
= AREF (spec
, FONT_REGISTRY_INDEX
);
2826 struct charset
*encoding
, *repertory
;
2828 if (font_registry_charsets (registry
, &encoding
, &repertory
) < 0)
2832 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
2834 /* Any font of this registry support C. So, let's
2835 suppress the further checking. */
2838 else if (c
> encoding
->max_char
)
2842 XSETFRAME (frame
, f
);
2843 size
= AREF (spec
, FONT_SIZE_INDEX
);
2844 pixel_size
= font_pixel_size (f
, spec
);
2845 if (pixel_size
== 0)
2847 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
2849 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
2851 ASET (spec
, FONT_SIZE_INDEX
, Qnil
);
2852 entities
= font_list_entities (frame
, spec
);
2853 ASET (spec
, FONT_SIZE_INDEX
, size
);
2854 if (ASIZE (entities
) == 0)
2856 if (ASIZE (entities
) == 1)
2859 return AREF (entities
, 0);
2863 /* Sort fonts by properties specified in LFACE. */
2864 Lisp_Object prefer
= scratch_font_prefer
;
2866 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
2867 ASET (prefer
, i
, AREF (spec
, i
));
2868 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
2870 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
2872 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
2873 if (NILP (AREF (prefer
, i
)))
2874 ASET (prefer
, i
, AREF (face_font
, i
));
2876 if (NILP (AREF (prefer
, FONT_FAMILY_INDEX
)))
2877 font_parse_family_registry (attrs
[LFACE_FAMILY_INDEX
], Qnil
, prefer
);
2878 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
2879 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2880 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
2881 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2882 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
2883 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2884 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2885 ASET (spec
, FONT_SIZE_INDEX
, Qnil
);
2886 entities
= font_sort_entites (entities
, prefer
, frame
, spec
, c
< 0);
2887 ASET (spec
, FONT_SIZE_INDEX
, size
);
2892 for (i
= 0; i
< ASIZE (entities
); i
++)
2896 val
= AREF (entities
, i
);
2899 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
2900 if (! EQ (AREF (val
, j
), props
[j
]))
2902 if (j
> FONT_REGISTRY_INDEX
)
2905 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
2906 props
[j
] = AREF (val
, j
);
2907 result
= font_has_char (f
, val
, c
);
2912 val
= font_open_for_lface (f
, val
, attrs
, spec
);
2915 result
= font_has_char (f
, val
, c
);
2916 font_close_object (f
, val
);
2918 return AREF (entities
, i
);
2925 font_open_for_lface (f
, entity
, attrs
, spec
)
2933 if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
2934 size
= font_pixel_size (f
, spec
);
2937 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
2940 size
= POINT_TO_PIXEL (pt
, f
->resy
);
2942 return font_open_entity (f
, entity
, size
);
2946 /* Find a font satisfying SPEC and best matching with face's
2947 attributes in ATTRS on FRAME, and return the opened
2951 font_load_for_lface (f
, attrs
, spec
)
2953 Lisp_Object
*attrs
, spec
;
2957 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
2960 /* No font is listed for SPEC, but each font-backend may have
2961 the different criteria about "font matching". So, try
2963 entity
= font_matching_entity (f
, attrs
, spec
);
2967 return font_open_for_lface (f
, entity
, attrs
, spec
);
2971 /* Make FACE on frame F ready to use the font opened for FACE. */
2974 font_prepare_for_face (f
, face
)
2978 if (face
->font
->driver
->prepare_face
)
2979 face
->font
->driver
->prepare_face (f
, face
);
2983 /* Make FACE on frame F stop using the font opened for FACE. */
2986 font_done_for_face (f
, face
)
2990 if (face
->font
->driver
->done_face
)
2991 face
->font
->driver
->done_face (f
, face
);
2996 /* Open a font best matching with NAME on frame F. If no proper font
2997 is found, return Qnil. */
3000 font_open_by_name (f
, name
)
3004 Lisp_Object args
[2];
3005 Lisp_Object spec
, prefer
, size
, entity
, entity_list
;
3010 XSETFRAME (frame
, f
);
3013 args
[1] = make_unibyte_string (name
, strlen (name
));
3014 spec
= Ffont_spec (2, args
);
3015 prefer
= scratch_font_prefer
;
3016 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
3018 ASET (prefer
, i
, AREF (spec
, i
));
3019 if (NILP (AREF (prefer
, i
))
3020 && i
>= FONT_WEIGHT_INDEX
&& i
<= FONT_WIDTH_INDEX
)
3021 FONT_SET_STYLE (prefer
, i
, make_number (100));
3023 size
= AREF (spec
, FONT_SIZE_INDEX
);
3028 if (INTEGERP (size
))
3029 pixel_size
= XINT (size
);
3030 else /* FLOATP (size) */
3032 double pt
= XFLOAT_DATA (size
);
3034 pixel_size
= POINT_TO_PIXEL (pt
, f
->resy
);
3036 if (pixel_size
== 0)
3037 ASET (spec
, FONT_SIZE_INDEX
, Qnil
);
3039 if (pixel_size
== 0)
3041 pixel_size
= POINT_TO_PIXEL (12.0, f
->resy
);
3042 size
= make_number (pixel_size
);
3043 ASET (prefer
, FONT_SIZE_INDEX
, size
);
3045 if (NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3046 ASET (spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
3048 entity_list
= Flist_fonts (spec
, frame
, make_number (1), prefer
);
3049 if (NILP (entity_list
))
3050 entity
= font_matching_entity (f
, NULL
, spec
);
3052 entity
= XCAR (entity_list
);
3053 return (NILP (entity
)
3055 : font_open_entity (f
, entity
, pixel_size
));
3059 /* Register font-driver DRIVER. This function is used in two ways.
3061 The first is with frame F non-NULL. In this case, make DRIVER
3062 available (but not yet activated) on F. All frame creaters
3063 (e.g. Fx_create_frame) must call this function at least once with
3064 an available font-driver.
3066 The second is with frame F NULL. In this case, DRIVER is globally
3067 registered in the variable `font_driver_list'. All font-driver
3068 implementations must call this function in its syms_of_XXXX
3069 (e.g. syms_of_xfont). */
3072 register_font_driver (driver
, f
)
3073 struct font_driver
*driver
;
3076 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3077 struct font_driver_list
*prev
, *list
;
3079 if (f
&& ! driver
->draw
)
3080 error ("Unusable font driver for a frame: %s",
3081 SDATA (SYMBOL_NAME (driver
->type
)));
3083 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3084 if (EQ (list
->driver
->type
, driver
->type
))
3085 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3087 list
= malloc (sizeof (struct font_driver_list
));
3089 list
->driver
= driver
;
3094 f
->font_driver_list
= list
;
3096 font_driver_list
= list
;
3102 /* Free font-driver list on frame F. It doesn't free font-drivers
3106 free_font_driver_list (f
)
3109 while (f
->font_driver_list
)
3111 struct font_driver_list
*next
= f
->font_driver_list
->next
;
3113 free (f
->font_driver_list
);
3114 f
->font_driver_list
= next
;
3119 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3120 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3121 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3123 A caller must free all realized faces if any in advance. The
3124 return value is a list of font backends actually made used on
3128 font_update_drivers (f
, new_drivers
)
3130 Lisp_Object new_drivers
;
3132 Lisp_Object active_drivers
= Qnil
;
3133 struct font_driver_list
*list
;
3135 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3138 if (! EQ (new_drivers
, Qt
)
3139 && NILP (Fmemq (list
->driver
->type
, new_drivers
)))
3141 if (list
->driver
->end_for_frame
)
3142 list
->driver
->end_for_frame (f
);
3143 font_finish_cache (f
, list
->driver
);
3149 if (EQ (new_drivers
, Qt
)
3150 || ! NILP (Fmemq (list
->driver
->type
, new_drivers
)))
3152 if (! list
->driver
->start_for_frame
3153 || list
->driver
->start_for_frame (f
) == 0)
3155 font_prepare_cache (f
, list
->driver
);
3157 active_drivers
= nconc2 (active_drivers
,
3158 Fcons (list
->driver
->type
, Qnil
));
3163 return active_drivers
;
3167 font_put_frame_data (f
, driver
, data
)
3169 struct font_driver
*driver
;
3172 struct font_data_list
*list
, *prev
;
3174 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3175 prev
= list
, list
= list
->next
)
3176 if (list
->driver
== driver
)
3183 prev
->next
= list
->next
;
3185 f
->font_data_list
= list
->next
;
3193 list
= malloc (sizeof (struct font_data_list
));
3196 list
->driver
= driver
;
3197 list
->next
= f
->font_data_list
;
3198 f
->font_data_list
= list
;
3206 font_get_frame_data (f
, driver
)
3208 struct font_driver
*driver
;
3210 struct font_data_list
*list
;
3212 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3213 if (list
->driver
== driver
)
3221 /* Return the font used to draw character C by FACE at buffer position
3222 POS in window W. If STRING is non-nil, it is a string containing C
3223 at index POS. If C is negative, get C from the current buffer or
3227 font_at (c
, pos
, face
, w
, string
)
3236 Lisp_Object font_object
;
3242 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3245 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3247 c
= FETCH_CHAR (pos_byte
);
3250 c
= FETCH_BYTE (pos
);
3256 multibyte
= STRING_MULTIBYTE (string
);
3259 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3261 str
= SDATA (string
) + pos_byte
;
3262 c
= STRING_CHAR (str
, 0);
3265 c
= SDATA (string
)[pos
];
3269 f
= XFRAME (w
->frame
);
3270 if (! FRAME_WINDOW_P (f
))
3277 if (STRINGP (string
))
3278 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3279 DEFAULT_FACE_ID
, 0);
3281 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3283 face
= FACE_FROM_ID (f
, face_id
);
3287 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3288 face
= FACE_FROM_ID (f
, face_id
);
3293 font_assert (font_check_object ((struct font
*) face
->font
));
3294 XSETFONT (font_object
, face
->font
);
3299 /* Check how many characters after POS (at most to LIMIT) can be
3300 displayed by the same font. FACE is the face selected for the
3301 character as POS on frame F. STRING, if not nil, is the string to
3302 check instead of the current buffer.
3304 The return value is the position of the character that is displayed
3305 by the differnt font than that of the character as POS. */
3308 font_range (pos
, limit
, face
, f
, string
)
3309 EMACS_INT pos
, limit
;
3322 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3323 pos_byte
= CHAR_TO_BYTE (pos
);
3327 multibyte
= STRING_MULTIBYTE (string
);
3328 pos_byte
= string_char_to_byte (string
, pos
);
3332 /* All unibyte character are displayed by the same font. */
3340 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3342 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3343 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3344 face
= FACE_FROM_ID (f
, face_id
);
3351 else if (font
!= face
->font
)
3363 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3364 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3365 Return nil otherwise.
3366 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3367 which kind of font it is. It must be one of `font-spec', `font-entity',
3369 (object
, extra_type
)
3370 Lisp_Object object
, extra_type
;
3372 if (NILP (extra_type
))
3373 return (FONTP (object
) ? Qt
: Qnil
);
3374 if (EQ (extra_type
, Qfont_spec
))
3375 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3376 if (EQ (extra_type
, Qfont_entity
))
3377 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3378 if (EQ (extra_type
, Qfont_object
))
3379 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3380 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3383 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3384 doc
: /* Return a newly created font-spec with arguments as properties.
3386 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3387 valid font property name listed below:
3389 `:family', `:weight', `:slant', `:width'
3391 They are the same as face attributes of the same name. See
3392 `set-face-attribute'.
3396 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3400 VALUE must be a string or a symbol specifying the additional
3401 typographic style information of a font, e.g. ``sans''.
3405 VALUE must be a string or a symbol specifying the charset registry and
3406 encoding of a font, e.g. ``iso8859-1''.
3410 VALUE must be a non-negative integer or a floating point number
3411 specifying the font size. It specifies the font size in pixels
3412 (if VALUE is an integer), or in points (if VALUE is a float).
3413 usage: (font-spec ARGS ...) */)
3418 Lisp_Object spec
= font_make_spec ();
3421 for (i
= 0; i
< nargs
; i
+= 2)
3423 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3425 if (EQ (key
, QCname
))
3428 font_parse_name ((char *) SDATA (val
), spec
);
3429 font_put_extra (spec
, key
, val
);
3431 else if (EQ (key
, QCfamily
))
3434 font_parse_family_registry (val
, Qnil
, spec
);
3438 int idx
= get_font_prop_index (key
);
3442 val
= font_prop_validate (idx
, Qnil
, val
);
3443 if (idx
< FONT_EXTRA_INDEX
)
3444 ASET (spec
, idx
, val
);
3446 font_put_extra (spec
, key
, val
);
3449 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3455 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3456 doc
: /* Return a copy of FONT as a font-spec. */)
3460 Lisp_Object new_spec
, tail
, extra
;
3464 new_spec
= font_make_spec ();
3465 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3466 ASET (new_spec
, i
, AREF (font
, i
));
3468 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3470 if (! EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3471 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3473 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3477 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3478 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3479 Every specified properties in FROM override the corresponding
3480 properties in TO. */)
3482 Lisp_Object from
, to
;
3484 Lisp_Object extra
, tail
;
3489 to
= Fcopy_font_spec (to
);
3490 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3491 ASET (to
, i
, AREF (from
, i
));
3492 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3493 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3494 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3496 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3499 XSETCDR (slot
, XCDR (XCAR (tail
)));
3501 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3503 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3507 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3508 doc
: /* Return the value of FONT's property KEY.
3509 FONT is a font-spec, a font-entity, or a font-object. */)
3511 Lisp_Object font
, key
;
3518 idx
= get_font_prop_index (key
);
3519 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3520 return AREF (font
, idx
);
3521 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3525 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3526 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
3527 (font_spec
, prop
, val
)
3528 Lisp_Object font_spec
, prop
, val
;
3532 CHECK_FONT_SPEC (font_spec
);
3533 idx
= get_font_prop_index (prop
);
3534 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3536 if (idx
== FONT_FAMILY_INDEX
3538 font_parse_family_registry (val
, Qnil
, font_spec
);
3540 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
3543 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
3547 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3548 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3549 Optional 2nd argument FRAME specifies the target frame.
3550 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3551 Optional 4th argument PREFER, if non-nil, is a font-spec to
3552 control the order of the returned list. Fonts are sorted by
3553 how close they are to PREFER. */)
3554 (font_spec
, frame
, num
, prefer
)
3555 Lisp_Object font_spec
, frame
, num
, prefer
;
3557 Lisp_Object vec
, list
, tail
;
3561 frame
= selected_frame
;
3562 CHECK_LIVE_FRAME (frame
);
3563 CHECK_FONT_SPEC (font_spec
);
3571 if (! NILP (prefer
))
3572 CHECK_FONT_SPEC (prefer
);
3574 vec
= font_list_entities (frame
, font_spec
);
3579 return Fcons (AREF (vec
, 0), Qnil
);
3581 if (! NILP (prefer
))
3582 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
, 0);
3584 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3585 if (n
== 0 || n
> len
)
3587 for (i
= 1; i
< n
; i
++)
3589 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3591 XSETCDR (tail
, val
);
3597 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
3598 doc
: /* List available font families on the current frame.
3599 Optional argument FRAME, if non-nil, specifies the target frame. */)
3604 struct font_driver_list
*driver_list
;
3608 frame
= selected_frame
;
3609 CHECK_LIVE_FRAME (frame
);
3612 for (driver_list
= f
->font_driver_list
; driver_list
;
3613 driver_list
= driver_list
->next
)
3614 if (driver_list
->driver
->list_family
)
3616 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3622 Lisp_Object tail
= list
;
3624 for (; CONSP (val
); val
= XCDR (val
))
3625 if (NILP (Fmemq (XCAR (val
), tail
)))
3626 list
= Fcons (XCAR (val
), list
);
3632 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3633 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3634 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3636 Lisp_Object font_spec
, frame
;
3638 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3645 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
3646 doc
: /* Return XLFD name of FONT.
3647 FONT is a font-spec, font-entity, or font-object.
3648 If the name is too long for XLFD (maximum 255 chars), return nil.
3649 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
3650 the consecutive wildcards are folded to one. */)
3651 (font
, fold_wildcards
)
3652 Lisp_Object font
, fold_wildcards
;
3659 if (FONT_OBJECT_P (font
))
3661 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
3663 if (STRINGP (font_name
)
3664 && SDATA (font_name
)[0] == '-')
3666 if (NILP (fold_wildcards
))
3668 strcpy (name
, (char *) SDATA (font_name
));
3671 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
3673 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3676 if (! NILP (fold_wildcards
))
3678 char *p0
= name
, *p1
;
3680 while ((p1
= strstr (p0
, "-*-*")))
3682 strcpy (p1
, p1
+ 2);
3687 return build_string (name
);
3690 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3691 doc
: /* Clear font cache. */)
3694 Lisp_Object list
, frame
;
3696 FOR_EACH_FRAME (list
, frame
)
3698 FRAME_PTR f
= XFRAME (frame
);
3699 struct font_driver_list
*driver_list
= f
->font_driver_list
;
3701 for (; driver_list
; driver_list
= driver_list
->next
)
3702 if (driver_list
->on
)
3704 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
3709 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
3711 font_assert (! NILP (val
));
3712 val
= XCDR (XCAR (val
));
3713 if (XINT (XCAR (val
)) == 0)
3715 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
3716 XSETCDR (cache
, XCDR (val
));
3724 /* The following three functions are still experimental. */
3726 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
3727 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
3728 FONT-OBJECT may be nil if it is not yet known.
3730 G-string is sequence of glyphs of a specific font,
3731 and is a vector of this form:
3732 [ HEADER GLYPH ... ]
3733 HEADER is a vector of this form:
3734 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
3736 FONT-OBJECT is a font-object for all glyphs in the g-string,
3737 WIDTH thru DESCENT are the metrics (in pixels) of the whole G-string.
3738 GLYPH is a vector of this form:
3739 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
3740 [ [X-OFF Y-OFF WADJUST] | nil] ]
3742 FROM-IDX and TO-IDX are used internally and should not be touched.
3743 C is the character of the glyph.
3744 CODE is the glyph-code of C in FONT-OBJECT.
3745 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
3746 X-OFF and Y-OFF are offests to the base position for the glyph.
3747 WADJUST is the adjustment to the normal width of the glyph. */)
3749 Lisp_Object font_object
, num
;
3751 Lisp_Object gstring
, g
;
3755 if (! NILP (font_object
))
3756 CHECK_FONT_OBJECT (font_object
);
3759 len
= XINT (num
) + 1;
3760 gstring
= Fmake_vector (make_number (len
), Qnil
);
3761 g
= Fmake_vector (make_number (6), Qnil
);
3762 ASET (g
, 0, font_object
);
3763 ASET (gstring
, 0, g
);
3764 for (i
= 1; i
< len
; i
++)
3765 ASET (gstring
, i
, Fmake_vector (make_number (10), Qnil
));
3769 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
3770 doc
: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
3771 START and END specify the region to extract characters.
3772 If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
3773 where to extract characters.
3774 FONT-OBJECT may be nil if GSTRING already contains one. */)
3775 (gstring
, font_object
, start
, end
, object
)
3776 Lisp_Object gstring
, font_object
, start
, end
, object
;
3782 CHECK_VECTOR (gstring
);
3783 if (NILP (font_object
))
3784 font_object
= LGSTRING_FONT (gstring
);
3785 font
= XFONT_OBJECT (font_object
);
3787 if (STRINGP (object
))
3789 const unsigned char *p
;
3791 CHECK_NATNUM (start
);
3793 if (XINT (start
) > XINT (end
)
3794 || XINT (end
) > ASIZE (object
)
3795 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3796 args_out_of_range_3 (object
, start
, end
);
3798 len
= XINT (end
) - XINT (start
);
3799 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
3800 for (i
= 0; i
< len
; i
++)
3802 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3803 /* Shut up GCC warning in comparison with
3804 MOST_POSITIVE_FIXNUM below. */
3807 c
= STRING_CHAR_ADVANCE (p
);
3808 cod
= code
= font
->driver
->encode_char (font
, c
);
3809 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
3811 LGLYPH_SET_FROM (g
, i
);
3812 LGLYPH_SET_TO (g
, i
);
3813 LGLYPH_SET_CHAR (g
, c
);
3814 LGLYPH_SET_CODE (g
, code
);
3821 if (! NILP (object
))
3822 Fset_buffer (object
);
3823 validate_region (&start
, &end
);
3824 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3825 args_out_of_range (start
, end
);
3826 len
= XINT (end
) - XINT (start
);
3828 pos_byte
= CHAR_TO_BYTE (pos
);
3829 for (i
= 0; i
< len
; i
++)
3831 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3832 /* Shut up GCC warning in comparison with
3833 MOST_POSITIVE_FIXNUM below. */
3836 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
3837 cod
= code
= font
->driver
->encode_char (font
, c
);
3838 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
3840 LGLYPH_SET_FROM (g
, i
);
3841 LGLYPH_SET_TO (g
, i
);
3842 LGLYPH_SET_CHAR (g
, c
);
3843 LGLYPH_SET_CODE (g
, code
);
3846 for (; i
< LGSTRING_LENGTH (gstring
); i
++)
3847 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
3851 DEFUN ("font-shape-text", Ffont_shape_text
, Sfont_shape_text
, 3, 4, 0,
3852 doc
: /* Shape text between FROM and TO by FONT-OBJECT.
3853 If optional 4th argument STRING is non-nil, it is a string to shape,
3854 and FROM and TO are indices to the string.
3855 The value is the end position of the text that can be shaped by
3857 (from
, to
, font_object
, string
)
3858 Lisp_Object from
, to
, font_object
, string
;
3861 struct font_metrics metrics
;
3862 EMACS_INT start
, end
;
3863 Lisp_Object gstring
, n
;
3866 if (! FONT_OBJECT_P (font_object
))
3868 font
= XFONT_OBJECT (font_object
);
3869 if (! font
->driver
->shape
)
3874 validate_region (&from
, &to
);
3875 start
= XFASTINT (from
);
3876 end
= XFASTINT (to
);
3877 modify_region (current_buffer
, start
, end
, 0);
3881 CHECK_STRING (string
);
3882 start
= XINT (from
);
3884 if (start
< 0 || start
> end
|| end
> SCHARS (string
))
3885 args_out_of_range_3 (string
, from
, to
);
3889 gstring
= Ffont_make_gstring (font_object
, make_number (len
));
3890 Ffont_fill_gstring (gstring
, font_object
, from
, to
, string
);
3892 /* Try at most three times with larger gstring each time. */
3893 for (i
= 0; i
< 3; i
++)
3895 Lisp_Object args
[2];
3897 n
= font
->driver
->shape (gstring
);
3901 args
[1] = Fmake_vector (make_number (len
), Qnil
);
3902 gstring
= Fvconcat (2, args
);
3904 if (! INTEGERP (n
) || XINT (n
) == 0)
3908 for (i
= 0; i
< len
;)
3911 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3912 EMACS_INT this_from
= LGLYPH_FROM (g
);
3913 EMACS_INT this_to
= LGLYPH_TO (g
) + 1;
3915 int need_composition
= 0;
3917 metrics
.lbearing
= LGLYPH_LBEARING (g
);
3918 metrics
.rbearing
= LGLYPH_RBEARING (g
);
3919 metrics
.ascent
= LGLYPH_ASCENT (g
);
3920 metrics
.descent
= LGLYPH_DESCENT (g
);
3921 if (NILP (LGLYPH_ADJUSTMENT (g
)))
3923 metrics
.width
= LGLYPH_WIDTH (g
);
3924 if (LGLYPH_CHAR (g
) == 0 || metrics
.width
== 0)
3925 need_composition
= 1;
3929 metrics
.width
= LGLYPH_WADJUST (g
);
3930 metrics
.lbearing
+= LGLYPH_XOFF (g
);
3931 metrics
.rbearing
+= LGLYPH_XOFF (g
);
3932 metrics
.ascent
-= LGLYPH_YOFF (g
);
3933 metrics
.descent
+= LGLYPH_YOFF (g
);
3934 need_composition
= 1;
3936 for (j
= i
+ 1; j
< len
; j
++)
3940 g
= LGSTRING_GLYPH (gstring
, j
);
3941 if (this_from
!= LGLYPH_FROM (g
))
3943 need_composition
= 1;
3944 x
= metrics
.width
+ LGLYPH_LBEARING (g
) + LGLYPH_XOFF (g
);
3945 if (metrics
.lbearing
> x
)
3946 metrics
.lbearing
= x
;
3947 x
= metrics
.width
+ LGLYPH_RBEARING (g
) + LGLYPH_XOFF (g
);
3948 if (metrics
.rbearing
< x
)
3949 metrics
.rbearing
= x
;
3950 x
= LGLYPH_ASCENT (g
) - LGLYPH_YOFF (g
);
3951 if (metrics
.ascent
< x
)
3953 x
= LGLYPH_DESCENT (g
) - LGLYPH_YOFF (g
);
3954 if (metrics
.descent
< x
)
3955 metrics
.descent
= x
;
3956 if (NILP (LGLYPH_ADJUSTMENT (g
)))
3957 metrics
.width
+= LGLYPH_WIDTH (g
);
3959 metrics
.width
+= LGLYPH_WADJUST (g
);
3962 if (need_composition
)
3964 gstr
= Ffont_make_gstring (font_object
, make_number (j
- i
));
3965 LGSTRING_SET_WIDTH (gstr
, metrics
.width
);
3966 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
3967 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
);
3968 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
3969 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
3970 for (k
= i
; i
< j
; i
++)
3972 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3974 LGLYPH_SET_FROM (g
, LGLYPH_FROM (g
) - this_from
);
3975 LGLYPH_SET_TO (g
, LGLYPH_TO (g
) - this_from
);
3976 LGSTRING_SET_GLYPH (gstr
, i
- k
, LGSTRING_GLYPH (gstring
, i
));
3978 from
= make_number (start
+ this_from
);
3979 to
= make_number (start
+ this_to
);
3981 Fcompose_region_internal (from
, to
, gstr
, Qnil
);
3983 Fcompose_string_internal (string
, from
, to
, gstr
, Qnil
);
3994 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
3995 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
3996 OTF-FEATURES specifies which features to apply in this format:
3997 (SCRIPT LANGSYS GSUB GPOS)
3999 SCRIPT is a symbol specifying a script tag of OpenType,
4000 LANGSYS is a symbol specifying a langsys tag of OpenType,
4001 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4003 If LANGYS is nil, the default langsys is selected.
4005 The features are applied in the order they appear in the list. The
4006 symbol `*' means to apply all available features not present in this
4007 list, and the remaining features are ignored. For instance, (vatu
4008 pstf * haln) is to apply vatu and pstf in this order, then to apply
4009 all available features other than vatu, pstf, and haln.
4011 The features are applied to the glyphs in the range FROM and TO of
4012 the glyph-string GSTRING-IN.
4014 If some feature is actually applicable, the resulting glyphs are
4015 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4016 this case, the value is the number of produced glyphs.
4018 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4021 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4022 produced in GSTRING-OUT, and the value is nil.
4024 See the documentation of `font-make-gstring' for the format of
4026 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4027 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4029 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4034 check_otf_features (otf_features
);
4035 CHECK_FONT_OBJECT (font_object
);
4036 font
= XFONT_OBJECT (font_object
);
4037 if (! font
->driver
->otf_drive
)
4038 error ("Font backend %s can't drive OpenType GSUB table",
4039 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4040 CHECK_CONS (otf_features
);
4041 CHECK_SYMBOL (XCAR (otf_features
));
4042 val
= XCDR (otf_features
);
4043 CHECK_SYMBOL (XCAR (val
));
4044 val
= XCDR (otf_features
);
4047 len
= check_gstring (gstring_in
);
4048 CHECK_VECTOR (gstring_out
);
4049 CHECK_NATNUM (from
);
4051 CHECK_NATNUM (index
);
4053 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4054 args_out_of_range_3 (from
, to
, make_number (len
));
4055 if (XINT (index
) >= ASIZE (gstring_out
))
4056 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4057 num
= font
->driver
->otf_drive (font
, otf_features
,
4058 gstring_in
, XINT (from
), XINT (to
),
4059 gstring_out
, XINT (index
), 0);
4062 return make_number (num
);
4065 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4067 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4068 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4070 (SCRIPT LANGSYS FEATURE ...)
4071 See the documentation of `font-drive-otf' for more detail.
4073 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4074 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4075 character code corresponding to the glyph or nil if there's no
4076 corresponding character. */)
4077 (font_object
, character
, otf_features
)
4078 Lisp_Object font_object
, character
, otf_features
;
4081 Lisp_Object gstring_in
, gstring_out
, g
;
4082 Lisp_Object alternates
;
4085 CHECK_FONT_GET_OBJECT (font_object
, font
);
4086 if (! font
->driver
->otf_drive
)
4087 error ("Font backend %s can't drive OpenType GSUB table",
4088 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4089 CHECK_CHARACTER (character
);
4090 CHECK_CONS (otf_features
);
4092 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4093 g
= LGSTRING_GLYPH (gstring_in
, 0);
4094 LGLYPH_SET_CHAR (g
, XINT (character
));
4095 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4096 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4097 gstring_out
, 0, 1)) < 0)
4098 gstring_out
= Ffont_make_gstring (font_object
,
4099 make_number (ASIZE (gstring_out
) * 2));
4101 for (i
= 0; i
< num
; i
++)
4103 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4104 int c
= LGLYPH_CHAR (g
);
4105 unsigned code
= LGLYPH_CODE (g
);
4107 alternates
= Fcons (Fcons (make_number (code
),
4108 c
> 0 ? make_number (c
) : Qnil
),
4111 return Fnreverse (alternates
);
4117 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4118 doc
: /* Open FONT-ENTITY. */)
4119 (font_entity
, size
, frame
)
4120 Lisp_Object font_entity
;
4126 CHECK_FONT_ENTITY (font_entity
);
4128 frame
= selected_frame
;
4129 CHECK_LIVE_FRAME (frame
);
4132 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4135 CHECK_NUMBER_OR_FLOAT (size
);
4137 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
4139 isize
= XINT (size
);
4143 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4146 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4147 doc
: /* Close FONT-OBJECT. */)
4148 (font_object
, frame
)
4149 Lisp_Object font_object
, frame
;
4151 CHECK_FONT_OBJECT (font_object
);
4153 frame
= selected_frame
;
4154 CHECK_LIVE_FRAME (frame
);
4155 font_close_object (XFRAME (frame
), font_object
);
4159 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4160 doc
: /* Return information about FONT-OBJECT.
4161 The value is a vector:
4162 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4165 NAME is a string of the font name (or nil if the font backend doesn't
4168 FILENAME is a string of the font file (or nil if the font backend
4169 doesn't provide a file name).
4171 PIXEL-SIZE is a pixel size by which the font is opened.
4173 SIZE is a maximum advance width of the font in pixels.
4175 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4178 CAPABILITY is a list whose first element is a symbol representing the
4179 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4180 remaining elements describe the details of the font capability.
4182 If the font is OpenType font, the form of the list is
4183 \(opentype GSUB GPOS)
4184 where GSUB shows which "GSUB" features the font supports, and GPOS
4185 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4186 lists of the format:
4187 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4189 If the font is not OpenType font, currently the length of the form is
4192 SCRIPT is a symbol representing OpenType script tag.
4194 LANGSYS is a symbol representing OpenType langsys tag, or nil
4195 representing the default langsys.
4197 FEATURE is a symbol representing OpenType feature tag.
4199 If the font is not OpenType font, CAPABILITY is nil. */)
4201 Lisp_Object font_object
;
4206 CHECK_FONT_GET_OBJECT (font_object
, font
);
4208 val
= Fmake_vector (make_number (9), Qnil
);
4209 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4210 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4211 ASET (val
, 2, make_number (font
->pixel_size
));
4212 ASET (val
, 3, make_number (font
->max_width
));
4213 ASET (val
, 4, make_number (font
->ascent
));
4214 ASET (val
, 5, make_number (font
->descent
));
4215 ASET (val
, 6, make_number (font
->space_width
));
4216 ASET (val
, 7, make_number (font
->average_width
));
4217 if (font
->driver
->otf_capability
)
4218 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4222 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4223 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4224 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4225 (font_object
, string
)
4226 Lisp_Object font_object
, string
;
4232 CHECK_FONT_GET_OBJECT (font_object
, font
);
4233 CHECK_STRING (string
);
4234 len
= SCHARS (string
);
4235 vec
= Fmake_vector (make_number (len
), Qnil
);
4236 for (i
= 0; i
< len
; i
++)
4238 Lisp_Object ch
= Faref (string
, make_number (i
));
4243 struct font_metrics metrics
;
4245 cod
= code
= font
->driver
->encode_char (font
, c
);
4246 if (code
== FONT_INVALID_CODE
)
4248 val
= Fmake_vector (make_number (6), Qnil
);
4249 if (cod
<= MOST_POSITIVE_FIXNUM
)
4250 ASET (val
, 0, make_number (code
));
4252 ASET (val
, 0, Fcons (make_number (code
>> 16),
4253 make_number (code
& 0xFFFF)));
4254 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4255 ASET (val
, 1, make_number (metrics
.lbearing
));
4256 ASET (val
, 2, make_number (metrics
.rbearing
));
4257 ASET (val
, 3, make_number (metrics
.width
));
4258 ASET (val
, 4, make_number (metrics
.ascent
));
4259 ASET (val
, 5, make_number (metrics
.descent
));
4265 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4266 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4267 FONT is a font-spec, font-entity, or font-object. */)
4269 Lisp_Object spec
, font
;
4271 CHECK_FONT_SPEC (spec
);
4274 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4277 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4278 doc
: /* Return a font-object for displaying a character at POSITION.
4279 Optional second arg WINDOW, if non-nil, is a window displaying
4280 the current buffer. It defaults to the currently selected window. */)
4281 (position
, window
, string
)
4282 Lisp_Object position
, window
, string
;
4289 CHECK_NUMBER_COERCE_MARKER (position
);
4290 pos
= XINT (position
);
4291 if (pos
< BEGV
|| pos
>= ZV
)
4292 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4296 CHECK_NUMBER (position
);
4297 CHECK_STRING (string
);
4298 pos
= XINT (position
);
4299 if (pos
< 0 || pos
>= SCHARS (string
))
4300 args_out_of_range (string
, position
);
4303 window
= selected_window
;
4304 CHECK_LIVE_WINDOW (window
);
4305 w
= XWINDOW (window
);
4307 return font_at (-1, pos
, NULL
, w
, string
);
4311 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4312 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4313 The value is a number of glyphs drawn.
4314 Type C-l to recover what previously shown. */)
4315 (font_object
, string
)
4316 Lisp_Object font_object
, string
;
4318 Lisp_Object frame
= selected_frame
;
4319 FRAME_PTR f
= XFRAME (frame
);
4325 CHECK_FONT_GET_OBJECT (font_object
, font
);
4326 CHECK_STRING (string
);
4327 len
= SCHARS (string
);
4328 code
= alloca (sizeof (unsigned) * len
);
4329 for (i
= 0; i
< len
; i
++)
4331 Lisp_Object ch
= Faref (string
, make_number (i
));
4335 code
[i
] = font
->driver
->encode_char (font
, c
);
4336 if (code
[i
] == FONT_INVALID_CODE
)
4339 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4341 if (font
->driver
->prepare_face
)
4342 font
->driver
->prepare_face (f
, face
);
4343 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4344 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4345 if (font
->driver
->done_face
)
4346 font
->driver
->done_face (f
, face
);
4348 return make_number (len
);
4352 #endif /* FONT_DEBUG */
4354 #ifdef HAVE_WINDOW_SYSTEM
4356 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4357 doc
: /* Return information about a font named NAME on frame FRAME.
4358 If FRAME is omitted or nil, use the selected frame.
4359 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4360 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4362 OPENED-NAME is the name used for opening the font,
4363 FULL-NAME is the full name of the font,
4364 SIZE is the maximum bound width of the font,
4365 HEIGHT is the height of the font,
4366 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4367 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4368 how to compose characters.
4369 If the named font is not yet loaded, return nil. */)
4371 Lisp_Object name
, frame
;
4376 Lisp_Object font_object
;
4378 (*check_window_system_func
) ();
4381 CHECK_STRING (name
);
4383 frame
= selected_frame
;
4384 CHECK_LIVE_FRAME (frame
);
4389 int fontset
= fs_query_fontset (name
, 0);
4392 name
= fontset_ascii (fontset
);
4393 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4395 else if (FONT_OBJECT_P (name
))
4397 else if (FONT_ENTITY_P (name
))
4398 font_object
= font_open_entity (f
, name
, 0);
4401 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4402 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4404 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4406 if (NILP (font_object
))
4408 font
= XFONT_OBJECT (font_object
);
4410 info
= Fmake_vector (make_number (7), Qnil
);
4411 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4412 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4413 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4414 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4415 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4416 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4417 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4420 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4421 close it now. Perhaps, we should manage font-objects
4422 by `reference-count'. */
4423 font_close_object (f
, font_object
);
4430 #define BUILD_STYLE_TABLE(TBL) \
4431 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4434 build_style_table (entry
, nelement
)
4435 struct table_entry
*entry
;
4439 Lisp_Object table
, elt
;
4441 table
= Fmake_vector (make_number (nelement
), Qnil
);
4442 for (i
= 0; i
< nelement
; i
++)
4444 for (j
= 0; entry
[i
].names
[j
]; j
++);
4445 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4446 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4447 for (j
= 0; entry
[i
].names
[j
]; j
++)
4448 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4449 ASET (table
, i
, elt
);
4454 static Lisp_Object Vfont_log
;
4455 static int font_log_env_checked
;
4458 font_add_log (action
, arg
, result
)
4460 Lisp_Object arg
, result
;
4462 Lisp_Object tail
, val
;
4465 if (! font_log_env_checked
)
4467 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
4468 font_log_env_checked
= 1;
4470 if (EQ (Vfont_log
, Qt
))
4473 arg
= Ffont_xlfd_name (arg
, Qt
);
4475 result
= Ffont_xlfd_name (result
, Qt
);
4476 else if (CONSP (result
))
4478 result
= Fcopy_sequence (result
);
4479 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4483 val
= Ffont_xlfd_name (val
, Qt
);
4484 XSETCAR (tail
, val
);
4487 else if (VECTORP (result
))
4489 result
= Fcopy_sequence (result
);
4490 for (i
= 0; i
< ASIZE (result
); i
++)
4492 val
= AREF (result
, i
);
4494 val
= Ffont_xlfd_name (val
, Qt
);
4495 ASET (result
, i
, val
);
4498 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4501 extern void syms_of_ftfont
P_ (());
4502 extern void syms_of_xfont
P_ (());
4503 extern void syms_of_xftfont
P_ (());
4504 extern void syms_of_ftxfont
P_ (());
4505 extern void syms_of_bdffont
P_ (());
4506 extern void syms_of_w32font
P_ (());
4507 extern void syms_of_atmfont
P_ (());
4512 sort_shift_bits
[FONT_SLANT_INDEX
] = 0;
4513 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 7;
4514 sort_shift_bits
[FONT_SIZE_INDEX
] = 14;
4515 sort_shift_bits
[FONT_WIDTH_INDEX
] = 21;
4516 sort_shift_bits
[FONT_ADSTYLE_INDEX
] = 28;
4517 sort_shift_bits
[FONT_FOUNDRY_INDEX
] = 29;
4518 sort_shift_bits
[FONT_FAMILY_INDEX
] = 30;
4519 /* Note that sort_shift_bits[FONT_SORT_TYPE] and
4520 sort_shift_bits[FONT_SORT_REGISTRY] are never used. */
4522 staticpro (&font_charset_alist
);
4523 font_charset_alist
= Qnil
;
4525 DEFSYM (Qfont_spec
, "font-spec");
4526 DEFSYM (Qfont_entity
, "font-entity");
4527 DEFSYM (Qfont_object
, "font-object");
4529 DEFSYM (Qopentype
, "opentype");
4531 DEFSYM (Qiso8859_1
, "iso8859-1");
4532 DEFSYM (Qiso10646_1
, "iso10646-1");
4533 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4534 DEFSYM (Qunicode_sip
, "unicode-sip");
4536 DEFSYM (QCotf
, ":otf");
4537 DEFSYM (QClang
, ":lang");
4538 DEFSYM (QCscript
, ":script");
4539 DEFSYM (QCantialias
, ":antialias");
4541 DEFSYM (QCfoundry
, ":foundry");
4542 DEFSYM (QCadstyle
, ":adstyle");
4543 DEFSYM (QCregistry
, ":registry");
4544 DEFSYM (QCspacing
, ":spacing");
4545 DEFSYM (QCdpi
, ":dpi");
4546 DEFSYM (QCscalable
, ":scalable");
4547 DEFSYM (QCavgwidth
, ":avgwidth");
4548 DEFSYM (QCfont_entity
, ":font-entity");
4549 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
4556 staticpro (&null_vector
);
4557 null_vector
= Fmake_vector (make_number (0), Qnil
);
4559 staticpro (&scratch_font_spec
);
4560 scratch_font_spec
= Ffont_spec (0, NULL
);
4561 staticpro (&scratch_font_prefer
);
4562 scratch_font_prefer
= Ffont_spec (0, NULL
);
4566 staticpro (&otf_list
);
4568 #endif /* HAVE_LIBOTF */
4572 defsubr (&Sfont_spec
);
4573 defsubr (&Sfont_get
);
4574 defsubr (&Sfont_put
);
4575 defsubr (&Slist_fonts
);
4576 defsubr (&Sfont_family_list
);
4577 defsubr (&Sfind_font
);
4578 defsubr (&Sfont_xlfd_name
);
4579 defsubr (&Sclear_font_cache
);
4580 defsubr (&Sfont_make_gstring
);
4581 defsubr (&Sfont_fill_gstring
);
4582 defsubr (&Sfont_shape_text
);
4584 defsubr (&Sfont_drive_otf
);
4585 defsubr (&Sfont_otf_alternates
);
4589 defsubr (&Sopen_font
);
4590 defsubr (&Sclose_font
);
4591 defsubr (&Squery_font
);
4592 defsubr (&Sget_font_glyphs
);
4593 defsubr (&Sfont_match_p
);
4594 defsubr (&Sfont_at
);
4596 defsubr (&Sdraw_string
);
4598 #endif /* FONT_DEBUG */
4599 #ifdef HAVE_WINDOW_SYSTEM
4600 defsubr (&Sfont_info
);
4603 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
4605 Alist of fontname patterns vs the corresponding encoding and repertory info.
4606 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
4607 where ENCODING is a charset or a char-table,
4608 and REPERTORY is a charset, a char-table, or nil.
4610 If ENCODING and REPERTORY are the same, the element can have the form
4611 \(REGEXP . ENCODING).
4613 ENCODING is for converting a character to a glyph code of the font.
4614 If ENCODING is a charset, encoding a character by the charset gives
4615 the corresponding glyph code. If ENCODING is a char-table, looking up
4616 the table by a character gives the corresponding glyph code.
4618 REPERTORY specifies a repertory of characters supported by the font.
4619 If REPERTORY is a charset, all characters beloging to the charset are
4620 supported. If REPERTORY is a char-table, all characters who have a
4621 non-nil value in the table are supported. If REPERTORY is nil, Emacs
4622 gets the repertory information by an opened font and ENCODING. */);
4623 Vfont_encoding_alist
= Qnil
;
4625 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
4626 doc
: /* Vector of valid font weight values.
4627 Each element has the form:
4628 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
4629 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symobls. */);
4630 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
4632 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
4633 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
4634 See `font-weight_table' for the format of the vector. */);
4635 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
4637 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
4638 doc
: /* Alist of font width symbols vs the corresponding numeric values.
4639 See `font-weight_table' for the format of the vector. */);
4640 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
4642 staticpro (&font_style_table
);
4643 font_style_table
= Fmake_vector (make_number (3), Qnil
);
4644 ASET (font_style_table
, 0, Vfont_weight_table
);
4645 ASET (font_style_table
, 1, Vfont_slant_table
);
4646 ASET (font_style_table
, 2, Vfont_width_table
);
4648 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
4649 *Logging list of font related actions and results.
4650 The value t means to suppress the logging.
4651 The initial value is set to nil if the environment variable
4652 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
4655 #ifdef HAVE_WINDOW_SYSTEM
4656 #ifdef HAVE_FREETYPE
4658 #ifdef HAVE_X_WINDOWS
4663 #endif /* HAVE_XFT */
4664 #endif /* HAVE_X_WINDOWS */
4665 #else /* not HAVE_FREETYPE */
4666 #ifdef HAVE_X_WINDOWS
4668 #endif /* HAVE_X_WINDOWS */
4669 #endif /* not HAVE_FREETYPE */
4672 #endif /* HAVE_BDFFONT */
4675 #endif /* WINDOWSNT */
4679 #endif /* HAVE_WINDOW_SYSTEM */
4682 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
4683 (do not change this comment) */