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
);
269 dpi
= XINT (XCDR (val
));
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
;
2446 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2453 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2454 copy
= Fcopy_font_spec (scratch_font_spec
);
2455 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2457 if (! NILP (val
) && need_filtering
)
2458 val
= font_delete_unmatched (val
, spec
, size
);
2466 ASET (scratch_font_spec
, FONT_FAMILY_INDEX
,
2467 Fintern (XCAR (tail
), Qnil
));
2472 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2473 font_add_log ("list", spec
, val
);
2478 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2479 nil, is an array of face's attributes, which specifies preferred
2480 font-related attributes. */
2483 font_matching_entity (f
, attrs
, spec
)
2485 Lisp_Object
*attrs
, spec
;
2487 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2488 Lisp_Object ftype
, size
, entity
;
2491 XSETFRAME (frame
, f
);
2492 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2493 size
= AREF (spec
, FONT_SIZE_INDEX
);
2495 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2497 for (; driver_list
; driver_list
= driver_list
->next
)
2499 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2501 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2504 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2505 entity
= assoc_no_quit (spec
, XCDR (cache
));
2507 entity
= XCDR (entity
);
2510 entity
= driver_list
->driver
->match (frame
, spec
);
2511 copy
= Fcopy_font_spec (spec
);
2512 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2513 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2515 if (! NILP (entity
))
2518 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2519 ASET (spec
, FONT_SIZE_INDEX
, size
);
2520 font_add_log ("match", spec
, entity
);
2525 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2526 opened font object. */
2529 font_open_entity (f
, entity
, pixel_size
)
2534 struct font_driver_list
*driver_list
;
2535 Lisp_Object objlist
, size
, val
, font_object
;
2539 font_assert (FONT_ENTITY_P (entity
));
2540 size
= AREF (entity
, FONT_SIZE_INDEX
);
2541 if (XINT (size
) != 0)
2542 pixel_size
= XINT (size
);
2544 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2545 objlist
= XCDR (objlist
))
2546 if (XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2547 return XCAR (objlist
);
2549 val
= AREF (entity
, FONT_TYPE_INDEX
);
2550 for (driver_list
= f
->font_driver_list
;
2551 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2552 driver_list
= driver_list
->next
);
2556 font_object
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2557 font_add_log ("open", entity
, font_object
);
2558 if (NILP (font_object
))
2560 ASET (entity
, FONT_OBJLIST_INDEX
,
2561 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2562 ASET (font_object
, FONT_OBJLIST_INDEX
, AREF (entity
, FONT_OBJLIST_INDEX
));
2565 font
= XFONT_OBJECT (font_object
);
2566 min_width
= (font
->min_width
? font
->min_width
2567 : font
->average_width
? font
->average_width
2568 : font
->space_width
? font
->space_width
2570 #ifdef HAVE_WINDOW_SYSTEM
2571 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2572 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2574 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2575 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
;
2576 fonts_changed_p
= 1;
2580 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2581 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2582 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > font
->height
)
2583 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
, fonts_changed_p
= 1;
2591 /* Close FONT_OBJECT that is opened on frame F. */
2594 font_close_object (f
, font_object
)
2596 Lisp_Object font_object
;
2598 struct font
*font
= XFONT_OBJECT (font_object
);
2599 Lisp_Object objlist
;
2600 Lisp_Object tail
, prev
= Qnil
;
2602 objlist
= AREF (font_object
, FONT_OBJLIST_INDEX
);
2603 for (prev
= Qnil
, tail
= objlist
; CONSP (tail
);
2604 prev
= tail
, tail
= XCDR (tail
))
2605 if (EQ (font_object
, XCAR (tail
)))
2607 font_add_log ("close", font_object
, Qnil
);
2608 font
->driver
->close (f
, font
);
2609 #ifdef HAVE_WINDOW_SYSTEM
2610 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2611 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2614 ASET (font_object
, FONT_OBJLIST_INDEX
, XCDR (objlist
));
2616 XSETCDR (prev
, XCDR (objlist
));
2624 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2625 FONT is a font-entity and it must be opened to check. */
2628 font_has_char (f
, font
, c
)
2635 if (FONT_ENTITY_P (font
))
2637 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2638 struct font_driver_list
*driver_list
;
2640 for (driver_list
= f
->font_driver_list
;
2641 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2642 driver_list
= driver_list
->next
);
2645 if (! driver_list
->driver
->has_char
)
2647 return driver_list
->driver
->has_char (font
, c
);
2650 font_assert (FONT_OBJECT_P (font
));
2651 fontp
= XFONT_OBJECT (font
);
2652 if (fontp
->driver
->has_char
)
2654 int result
= fontp
->driver
->has_char (font
, c
);
2659 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2663 /* Return the glyph ID of FONT_OBJECT for character C. */
2666 font_encode_char (font_object
, c
)
2667 Lisp_Object font_object
;
2672 font_assert (FONT_OBJECT_P (font_object
));
2673 font
= XFONT_OBJECT (font_object
);
2674 return font
->driver
->encode_char (font
, c
);
2678 /* Return the name of FONT_OBJECT. */
2681 font_get_name (font_object
)
2682 Lisp_Object font_object
;
2684 font_assert (FONT_OBJECT_P (font_object
));
2685 return AREF (font_object
, FONT_NAME_INDEX
);
2689 /* Return the specification of FONT_OBJECT. */
2692 font_get_spec (font_object
)
2693 Lisp_Object font_object
;
2695 Lisp_Object spec
= font_make_spec ();
2698 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2699 ASET (spec
, i
, AREF (font_object
, i
));
2700 ASET (spec
, FONT_SIZE_INDEX
,
2701 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2706 font_spec_from_name (font_name
)
2707 Lisp_Object font_name
;
2709 Lisp_Object args
[2];
2712 args
[1] = font_name
;
2713 return Ffont_spec (2, args
);
2718 font_clear_prop (attrs
, prop
)
2720 enum font_property_index prop
;
2722 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2726 if (NILP (AREF (font
, prop
))
2727 && prop
!= FONT_FAMILY_INDEX
&& prop
!= FONT_FAMILY_INDEX
)
2729 font
= Fcopy_font_spec (font
);
2730 ASET (font
, prop
, Qnil
);
2731 if (prop
== FONT_FAMILY_INDEX
)
2733 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
2734 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
2735 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
2736 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2737 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2738 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2740 else if (prop
== FONT_SIZE_INDEX
)
2742 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2743 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2744 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2746 attrs
[LFACE_FONT_INDEX
] = font
;
2750 font_update_lface (f
, attrs
)
2756 spec
= attrs
[LFACE_FONT_INDEX
];
2757 if (! FONT_SPEC_P (spec
))
2760 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
))
2761 || ! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2765 if (NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
2766 family
= AREF (spec
, FONT_FAMILY_INDEX
);
2767 else if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2768 family
= concat2 (SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
)),
2769 build_string ("-*"));
2771 family
= concat3 (SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
)),
2773 SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
)));
2774 attrs
[LFACE_FAMILY_INDEX
] = family
;
2776 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
2777 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
2778 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
2779 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);;
2780 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
2781 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
2782 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
2786 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2791 val
= Ffont_get (spec
, QCdpi
);
2794 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
2797 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2798 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
2799 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
2804 /* Return a font-entity satisfying SPEC and best matching with face's
2805 font related attributes in ATTRS. C, if not negative, is a
2806 character that the entity must support. */
2809 font_find_for_lface (f
, attrs
, spec
, c
)
2815 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
2821 Lisp_Object registry
= AREF (spec
, FONT_REGISTRY_INDEX
);
2822 struct charset
*encoding
, *repertory
;
2824 if (font_registry_charsets (registry
, &encoding
, &repertory
) < 0)
2828 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
2830 /* Any font of this registry support C. So, let's
2831 suppress the further checking. */
2834 else if (c
> encoding
->max_char
)
2838 XSETFRAME (frame
, f
);
2839 size
= AREF (spec
, FONT_SIZE_INDEX
);
2840 ASET (spec
, FONT_SIZE_INDEX
, Qnil
);
2841 entities
= font_list_entities (frame
, spec
);
2842 ASET (spec
, FONT_SIZE_INDEX
, size
);
2843 if (ASIZE (entities
) == 0)
2845 if (ASIZE (entities
) == 1)
2848 return AREF (entities
, 0);
2852 /* Sort fonts by properties specified in LFACE. */
2853 Lisp_Object prefer
= scratch_font_prefer
;
2855 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
2856 ASET (prefer
, i
, AREF (spec
, i
));
2857 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
2859 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
2861 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
2862 if (NILP (AREF (prefer
, i
)))
2863 ASET (prefer
, i
, AREF (face_font
, i
));
2865 if (NILP (AREF (prefer
, FONT_FAMILY_INDEX
)))
2866 font_parse_family_registry (attrs
[LFACE_FAMILY_INDEX
], Qnil
, prefer
);
2867 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
2868 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2869 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
2870 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2871 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
2872 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2873 if (INTEGERP (size
))
2874 ASET (prefer
, FONT_SIZE_INDEX
, size
);
2875 else if (FLOATP (size
))
2876 ASET (prefer
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2879 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
2880 int pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
2881 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2883 ASET (spec
, FONT_SIZE_INDEX
, Qnil
);
2884 entities
= font_sort_entites (entities
, prefer
, frame
, spec
, c
< 0);
2885 ASET (spec
, FONT_SIZE_INDEX
, size
);
2890 for (i
= 0; i
< ASIZE (entities
); i
++)
2894 val
= AREF (entities
, i
);
2897 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
2898 if (! EQ (AREF (val
, j
), props
[j
]))
2900 if (j
> FONT_REGISTRY_INDEX
)
2903 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
2904 props
[j
] = AREF (val
, j
);
2905 result
= font_has_char (f
, val
, c
);
2910 val
= font_open_for_lface (f
, val
, attrs
, spec
);
2913 result
= font_has_char (f
, val
, c
);
2914 font_close_object (f
, val
);
2916 return AREF (entities
, i
);
2923 font_open_for_lface (f
, entity
, attrs
, spec
)
2931 if (FONT_SPEC_P (spec
) && INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2932 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2935 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
2938 size
= POINT_TO_PIXEL (pt
, f
->resy
);
2940 return font_open_entity (f
, entity
, size
);
2944 /* Find a font satisfying SPEC and best matching with face's
2945 attributes in ATTRS on FRAME, and return the opened
2949 font_load_for_lface (f
, attrs
, spec
)
2951 Lisp_Object
*attrs
, spec
;
2955 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
2958 /* No font is listed for SPEC, but each font-backend may have
2959 the different criteria about "font matching". So, try
2961 entity
= font_matching_entity (f
, attrs
, spec
);
2965 return font_open_for_lface (f
, entity
, attrs
, spec
);
2969 /* Make FACE on frame F ready to use the font opened for FACE. */
2972 font_prepare_for_face (f
, face
)
2976 if (face
->font
->driver
->prepare_face
)
2977 face
->font
->driver
->prepare_face (f
, face
);
2981 /* Make FACE on frame F stop using the font opened for FACE. */
2984 font_done_for_face (f
, face
)
2988 if (face
->font
->driver
->done_face
)
2989 face
->font
->driver
->done_face (f
, face
);
2994 /* Open a font best matching with NAME on frame F. If no proper font
2995 is found, return Qnil. */
2998 font_open_by_name (f
, name
)
3002 Lisp_Object args
[2];
3003 Lisp_Object spec
, prefer
, size
, entity
, entity_list
;
3008 XSETFRAME (frame
, f
);
3011 args
[1] = make_unibyte_string (name
, strlen (name
));
3012 spec
= Ffont_spec (2, args
);
3013 prefer
= scratch_font_prefer
;
3014 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
3016 ASET (prefer
, i
, AREF (spec
, i
));
3017 if (NILP (AREF (prefer
, i
))
3018 && i
>= FONT_WEIGHT_INDEX
&& i
<= FONT_WIDTH_INDEX
)
3019 FONT_SET_STYLE (prefer
, i
, make_number (100));
3021 size
= AREF (spec
, FONT_SIZE_INDEX
);
3026 if (INTEGERP (size
))
3027 pixel_size
= XINT (size
);
3028 else /* FLOATP (size) */
3030 double pt
= XFLOAT_DATA (size
);
3032 pixel_size
= POINT_TO_PIXEL (pt
, f
->resy
);
3034 if (pixel_size
== 0)
3035 ASET (spec
, FONT_SIZE_INDEX
, Qnil
);
3037 if (pixel_size
== 0)
3039 pixel_size
= POINT_TO_PIXEL (12.0, f
->resy
);
3040 size
= make_number (pixel_size
);
3041 ASET (prefer
, FONT_SIZE_INDEX
, size
);
3043 if (NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3044 ASET (spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
3046 entity_list
= Flist_fonts (spec
, frame
, make_number (1), prefer
);
3047 if (NILP (entity_list
))
3048 entity
= font_matching_entity (f
, NULL
, spec
);
3050 entity
= XCAR (entity_list
);
3051 return (NILP (entity
)
3053 : font_open_entity (f
, entity
, pixel_size
));
3057 /* Register font-driver DRIVER. This function is used in two ways.
3059 The first is with frame F non-NULL. In this case, make DRIVER
3060 available (but not yet activated) on F. All frame creaters
3061 (e.g. Fx_create_frame) must call this function at least once with
3062 an available font-driver.
3064 The second is with frame F NULL. In this case, DRIVER is globally
3065 registered in the variable `font_driver_list'. All font-driver
3066 implementations must call this function in its syms_of_XXXX
3067 (e.g. syms_of_xfont). */
3070 register_font_driver (driver
, f
)
3071 struct font_driver
*driver
;
3074 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3075 struct font_driver_list
*prev
, *list
;
3077 if (f
&& ! driver
->draw
)
3078 error ("Unusable font driver for a frame: %s",
3079 SDATA (SYMBOL_NAME (driver
->type
)));
3081 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3082 if (EQ (list
->driver
->type
, driver
->type
))
3083 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3085 list
= malloc (sizeof (struct font_driver_list
));
3087 list
->driver
= driver
;
3092 f
->font_driver_list
= list
;
3094 font_driver_list
= list
;
3100 /* Free font-driver list on frame F. It doesn't free font-drivers
3104 free_font_driver_list (f
)
3107 while (f
->font_driver_list
)
3109 struct font_driver_list
*next
= f
->font_driver_list
->next
;
3111 free (f
->font_driver_list
);
3112 f
->font_driver_list
= next
;
3117 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3118 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3119 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3121 A caller must free all realized faces if any in advance. The
3122 return value is a list of font backends actually made used on
3126 font_update_drivers (f
, new_drivers
)
3128 Lisp_Object new_drivers
;
3130 Lisp_Object active_drivers
= Qnil
;
3131 struct font_driver_list
*list
;
3133 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3136 if (! EQ (new_drivers
, Qt
)
3137 && NILP (Fmemq (list
->driver
->type
, new_drivers
)))
3139 if (list
->driver
->end_for_frame
)
3140 list
->driver
->end_for_frame (f
);
3141 font_finish_cache (f
, list
->driver
);
3147 if (EQ (new_drivers
, Qt
)
3148 || ! NILP (Fmemq (list
->driver
->type
, new_drivers
)))
3150 if (! list
->driver
->start_for_frame
3151 || list
->driver
->start_for_frame (f
) == 0)
3153 font_prepare_cache (f
, list
->driver
);
3155 active_drivers
= nconc2 (active_drivers
,
3156 Fcons (list
->driver
->type
, Qnil
));
3161 return active_drivers
;
3165 font_put_frame_data (f
, driver
, data
)
3167 struct font_driver
*driver
;
3170 struct font_data_list
*list
, *prev
;
3172 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3173 prev
= list
, list
= list
->next
)
3174 if (list
->driver
== driver
)
3181 prev
->next
= list
->next
;
3183 f
->font_data_list
= list
->next
;
3191 list
= malloc (sizeof (struct font_data_list
));
3194 list
->driver
= driver
;
3195 list
->next
= f
->font_data_list
;
3196 f
->font_data_list
= list
;
3204 font_get_frame_data (f
, driver
)
3206 struct font_driver
*driver
;
3208 struct font_data_list
*list
;
3210 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3211 if (list
->driver
== driver
)
3219 /* Return the font used to draw character C by FACE at buffer position
3220 POS in window W. If STRING is non-nil, it is a string containing C
3221 at index POS. If C is negative, get C from the current buffer or
3225 font_at (c
, pos
, face
, w
, string
)
3234 Lisp_Object font_object
;
3240 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3243 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3245 c
= FETCH_CHAR (pos_byte
);
3248 c
= FETCH_BYTE (pos
);
3254 multibyte
= STRING_MULTIBYTE (string
);
3257 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3259 str
= SDATA (string
) + pos_byte
;
3260 c
= STRING_CHAR (str
, 0);
3263 c
= SDATA (string
)[pos
];
3267 f
= XFRAME (w
->frame
);
3268 if (! FRAME_WINDOW_P (f
))
3275 if (STRINGP (string
))
3276 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3277 DEFAULT_FACE_ID
, 0);
3279 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3281 face
= FACE_FROM_ID (f
, face_id
);
3285 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3286 face
= FACE_FROM_ID (f
, face_id
);
3291 font_assert (font_check_object ((struct font
*) face
->font
));
3292 XSETFONT (font_object
, face
->font
);
3297 /* Check how many characters after POS (at most to LIMIT) can be
3298 displayed by the same font. FACE is the face selected for the
3299 character as POS on frame F. STRING, if not nil, is the string to
3300 check instead of the current buffer.
3302 The return value is the position of the character that is displayed
3303 by the differnt font than that of the character as POS. */
3306 font_range (pos
, limit
, face
, f
, string
)
3307 EMACS_INT pos
, limit
;
3320 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3321 pos_byte
= CHAR_TO_BYTE (pos
);
3325 multibyte
= STRING_MULTIBYTE (string
);
3326 pos_byte
= string_char_to_byte (string
, pos
);
3330 /* All unibyte character are displayed by the same font. */
3338 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3340 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3341 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3342 face
= FACE_FROM_ID (f
, face_id
);
3349 else if (font
!= face
->font
)
3361 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3362 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3363 Return nil otherwise.
3364 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3365 which kind of font it is. It must be one of `font-spec', `font-entity',
3367 (object
, extra_type
)
3368 Lisp_Object object
, extra_type
;
3370 if (NILP (extra_type
))
3371 return (FONTP (object
) ? Qt
: Qnil
);
3372 if (EQ (extra_type
, Qfont_spec
))
3373 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3374 if (EQ (extra_type
, Qfont_entity
))
3375 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3376 if (EQ (extra_type
, Qfont_object
))
3377 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3378 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3381 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3382 doc
: /* Return a newly created font-spec with arguments as properties.
3384 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3385 valid font property name listed below:
3387 `:family', `:weight', `:slant', `:width'
3389 They are the same as face attributes of the same name. See
3390 `set-face-attribute'.
3394 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3398 VALUE must be a string or a symbol specifying the additional
3399 typographic style information of a font, e.g. ``sans''.
3403 VALUE must be a string or a symbol specifying the charset registry and
3404 encoding of a font, e.g. ``iso8859-1''.
3408 VALUE must be a non-negative integer or a floating point number
3409 specifying the font size. It specifies the font size in pixels
3410 (if VALUE is an integer), or in points (if VALUE is a float).
3411 usage: (font-spec ARGS ...) */)
3416 Lisp_Object spec
= font_make_spec ();
3419 for (i
= 0; i
< nargs
; i
+= 2)
3421 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3423 if (EQ (key
, QCname
))
3426 font_parse_name ((char *) SDATA (val
), spec
);
3427 font_put_extra (spec
, key
, val
);
3429 else if (EQ (key
, QCfamily
))
3432 font_parse_family_registry (val
, Qnil
, spec
);
3436 int idx
= get_font_prop_index (key
);
3440 val
= font_prop_validate (idx
, Qnil
, val
);
3441 if (idx
< FONT_EXTRA_INDEX
)
3442 ASET (spec
, idx
, val
);
3444 font_put_extra (spec
, key
, val
);
3447 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3453 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3454 doc
: /* Return a copy of FONT as a font-spec. */)
3458 Lisp_Object new_spec
, tail
, extra
;
3462 new_spec
= font_make_spec ();
3463 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3464 ASET (new_spec
, i
, AREF (font
, i
));
3466 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3468 if (! EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3469 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3471 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3475 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3476 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3477 Every specified properties in FROM override the corresponding
3478 properties in TO. */)
3480 Lisp_Object from
, to
;
3482 Lisp_Object extra
, tail
;
3487 to
= Fcopy_font_spec (to
);
3488 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3489 ASET (to
, i
, AREF (from
, i
));
3490 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3491 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3492 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3494 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3497 XSETCDR (slot
, XCDR (XCAR (tail
)));
3499 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3501 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3505 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3506 doc
: /* Return the value of FONT's property KEY.
3507 FONT is a font-spec, a font-entity, or a font-object. */)
3509 Lisp_Object font
, key
;
3516 idx
= get_font_prop_index (key
);
3517 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3518 return AREF (font
, idx
);
3519 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3523 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3524 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
3525 (font_spec
, prop
, val
)
3526 Lisp_Object font_spec
, prop
, val
;
3530 CHECK_FONT_SPEC (font_spec
);
3531 idx
= get_font_prop_index (prop
);
3532 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3534 if (idx
== FONT_FAMILY_INDEX
3536 font_parse_family_registry (val
, Qnil
, font_spec
);
3538 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
3541 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
3545 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3546 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3547 Optional 2nd argument FRAME specifies the target frame.
3548 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3549 Optional 4th argument PREFER, if non-nil, is a font-spec to
3550 control the order of the returned list. Fonts are sorted by
3551 how close they are to PREFER. */)
3552 (font_spec
, frame
, num
, prefer
)
3553 Lisp_Object font_spec
, frame
, num
, prefer
;
3555 Lisp_Object vec
, list
, tail
;
3559 frame
= selected_frame
;
3560 CHECK_LIVE_FRAME (frame
);
3561 CHECK_FONT_SPEC (font_spec
);
3569 if (! NILP (prefer
))
3570 CHECK_FONT_SPEC (prefer
);
3572 vec
= font_list_entities (frame
, font_spec
);
3577 return Fcons (AREF (vec
, 0), Qnil
);
3579 if (! NILP (prefer
))
3580 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
, 0);
3582 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3583 if (n
== 0 || n
> len
)
3585 for (i
= 1; i
< n
; i
++)
3587 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3589 XSETCDR (tail
, val
);
3595 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
3596 doc
: /* List available font families on the current frame.
3597 Optional argument FRAME, if non-nil, specifies the target frame. */)
3602 struct font_driver_list
*driver_list
;
3606 frame
= selected_frame
;
3607 CHECK_LIVE_FRAME (frame
);
3610 for (driver_list
= f
->font_driver_list
; driver_list
;
3611 driver_list
= driver_list
->next
)
3612 if (driver_list
->driver
->list_family
)
3614 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3620 Lisp_Object tail
= list
;
3622 for (; CONSP (val
); val
= XCDR (val
))
3623 if (NILP (Fmemq (XCAR (val
), tail
)))
3624 list
= Fcons (XCAR (val
), list
);
3630 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3631 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3632 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3634 Lisp_Object font_spec
, frame
;
3636 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3643 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
3644 doc
: /* Return XLFD name of FONT.
3645 FONT is a font-spec, font-entity, or font-object.
3646 If the name is too long for XLFD (maximum 255 chars), return nil.
3647 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
3648 the consecutive wildcards are folded to one. */)
3649 (font
, fold_wildcards
)
3650 Lisp_Object font
, fold_wildcards
;
3657 if (FONT_OBJECT_P (font
))
3659 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
3661 if (STRINGP (font_name
)
3662 && SDATA (font_name
)[0] == '-')
3664 if (NILP (fold_wildcards
))
3666 strcpy (name
, (char *) SDATA (font_name
));
3669 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
3671 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3674 if (! NILP (fold_wildcards
))
3676 char *p0
= name
, *p1
;
3678 while ((p1
= strstr (p0
, "-*-*")))
3680 strcpy (p1
, p1
+ 2);
3685 return build_string (name
);
3688 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3689 doc
: /* Clear font cache. */)
3692 Lisp_Object list
, frame
;
3694 FOR_EACH_FRAME (list
, frame
)
3696 FRAME_PTR f
= XFRAME (frame
);
3697 struct font_driver_list
*driver_list
= f
->font_driver_list
;
3699 for (; driver_list
; driver_list
= driver_list
->next
)
3700 if (driver_list
->on
)
3702 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
3707 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
3709 font_assert (! NILP (val
));
3710 val
= XCDR (XCAR (val
));
3711 if (XINT (XCAR (val
)) == 0)
3713 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
3714 XSETCDR (cache
, XCDR (val
));
3722 /* The following three functions are still experimental. */
3724 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
3725 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
3726 FONT-OBJECT may be nil if it is not yet known.
3728 G-string is sequence of glyphs of a specific font,
3729 and is a vector of this form:
3730 [ HEADER GLYPH ... ]
3731 HEADER is a vector of this form:
3732 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
3734 FONT-OBJECT is a font-object for all glyphs in the g-string,
3735 WIDTH thru DESCENT are the metrics (in pixels) of the whole G-string.
3736 GLYPH is a vector of this form:
3737 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
3738 [ [X-OFF Y-OFF WADJUST] | nil] ]
3740 FROM-IDX and TO-IDX are used internally and should not be touched.
3741 C is the character of the glyph.
3742 CODE is the glyph-code of C in FONT-OBJECT.
3743 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
3744 X-OFF and Y-OFF are offests to the base position for the glyph.
3745 WADJUST is the adjustment to the normal width of the glyph. */)
3747 Lisp_Object font_object
, num
;
3749 Lisp_Object gstring
, g
;
3753 if (! NILP (font_object
))
3754 CHECK_FONT_OBJECT (font_object
);
3757 len
= XINT (num
) + 1;
3758 gstring
= Fmake_vector (make_number (len
), Qnil
);
3759 g
= Fmake_vector (make_number (6), Qnil
);
3760 ASET (g
, 0, font_object
);
3761 ASET (gstring
, 0, g
);
3762 for (i
= 1; i
< len
; i
++)
3763 ASET (gstring
, i
, Fmake_vector (make_number (10), Qnil
));
3767 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
3768 doc
: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
3769 START and END specify the region to extract characters.
3770 If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
3771 where to extract characters.
3772 FONT-OBJECT may be nil if GSTRING already contains one. */)
3773 (gstring
, font_object
, start
, end
, object
)
3774 Lisp_Object gstring
, font_object
, start
, end
, object
;
3780 CHECK_VECTOR (gstring
);
3781 if (NILP (font_object
))
3782 font_object
= LGSTRING_FONT (gstring
);
3783 font
= XFONT_OBJECT (font_object
);
3785 if (STRINGP (object
))
3787 const unsigned char *p
;
3789 CHECK_NATNUM (start
);
3791 if (XINT (start
) > XINT (end
)
3792 || XINT (end
) > ASIZE (object
)
3793 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3794 args_out_of_range_3 (object
, start
, end
);
3796 len
= XINT (end
) - XINT (start
);
3797 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
3798 for (i
= 0; i
< len
; i
++)
3800 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3801 /* Shut up GCC warning in comparison with
3802 MOST_POSITIVE_FIXNUM below. */
3805 c
= STRING_CHAR_ADVANCE (p
);
3806 cod
= code
= font
->driver
->encode_char (font
, c
);
3807 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
3809 LGLYPH_SET_FROM (g
, i
);
3810 LGLYPH_SET_TO (g
, i
);
3811 LGLYPH_SET_CHAR (g
, c
);
3812 LGLYPH_SET_CODE (g
, code
);
3819 if (! NILP (object
))
3820 Fset_buffer (object
);
3821 validate_region (&start
, &end
);
3822 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3823 args_out_of_range (start
, end
);
3824 len
= XINT (end
) - XINT (start
);
3826 pos_byte
= CHAR_TO_BYTE (pos
);
3827 for (i
= 0; i
< len
; i
++)
3829 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3830 /* Shut up GCC warning in comparison with
3831 MOST_POSITIVE_FIXNUM below. */
3834 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
3835 cod
= code
= font
->driver
->encode_char (font
, c
);
3836 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
3838 LGLYPH_SET_FROM (g
, i
);
3839 LGLYPH_SET_TO (g
, i
);
3840 LGLYPH_SET_CHAR (g
, c
);
3841 LGLYPH_SET_CODE (g
, code
);
3844 for (; i
< LGSTRING_LENGTH (gstring
); i
++)
3845 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
3849 DEFUN ("font-shape-text", Ffont_shape_text
, Sfont_shape_text
, 3, 4, 0,
3850 doc
: /* Shape text between FROM and TO by FONT-OBJECT.
3851 If optional 4th argument STRING is non-nil, it is a string to shape,
3852 and FROM and TO are indices to the string.
3853 The value is the end position of the text that can be shaped by
3855 (from
, to
, font_object
, string
)
3856 Lisp_Object from
, to
, font_object
, string
;
3859 struct font_metrics metrics
;
3860 EMACS_INT start
, end
;
3861 Lisp_Object gstring
, n
;
3864 if (! FONT_OBJECT_P (font_object
))
3866 font
= XFONT_OBJECT (font_object
);
3867 if (! font
->driver
->shape
)
3872 validate_region (&from
, &to
);
3873 start
= XFASTINT (from
);
3874 end
= XFASTINT (to
);
3875 modify_region (current_buffer
, start
, end
, 0);
3879 CHECK_STRING (string
);
3880 start
= XINT (from
);
3882 if (start
< 0 || start
> end
|| end
> SCHARS (string
))
3883 args_out_of_range_3 (string
, from
, to
);
3887 gstring
= Ffont_make_gstring (font_object
, make_number (len
));
3888 Ffont_fill_gstring (gstring
, font_object
, from
, to
, string
);
3890 /* Try at most three times with larger gstring each time. */
3891 for (i
= 0; i
< 3; i
++)
3893 Lisp_Object args
[2];
3895 n
= font
->driver
->shape (gstring
);
3899 args
[1] = Fmake_vector (make_number (len
), Qnil
);
3900 gstring
= Fvconcat (2, args
);
3902 if (! INTEGERP (n
) || XINT (n
) == 0)
3906 for (i
= 0; i
< len
;)
3909 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3910 EMACS_INT this_from
= LGLYPH_FROM (g
);
3911 EMACS_INT this_to
= LGLYPH_TO (g
) + 1;
3913 int need_composition
= 0;
3915 metrics
.lbearing
= LGLYPH_LBEARING (g
);
3916 metrics
.rbearing
= LGLYPH_RBEARING (g
);
3917 metrics
.ascent
= LGLYPH_ASCENT (g
);
3918 metrics
.descent
= LGLYPH_DESCENT (g
);
3919 if (NILP (LGLYPH_ADJUSTMENT (g
)))
3921 metrics
.width
= LGLYPH_WIDTH (g
);
3922 if (LGLYPH_CHAR (g
) == 0 || metrics
.width
== 0)
3923 need_composition
= 1;
3927 metrics
.width
= LGLYPH_WADJUST (g
);
3928 metrics
.lbearing
+= LGLYPH_XOFF (g
);
3929 metrics
.rbearing
+= LGLYPH_XOFF (g
);
3930 metrics
.ascent
-= LGLYPH_YOFF (g
);
3931 metrics
.descent
+= LGLYPH_YOFF (g
);
3932 need_composition
= 1;
3934 for (j
= i
+ 1; j
< len
; j
++)
3938 g
= LGSTRING_GLYPH (gstring
, j
);
3939 if (this_from
!= LGLYPH_FROM (g
))
3941 need_composition
= 1;
3942 x
= metrics
.width
+ LGLYPH_LBEARING (g
) + LGLYPH_XOFF (g
);
3943 if (metrics
.lbearing
> x
)
3944 metrics
.lbearing
= x
;
3945 x
= metrics
.width
+ LGLYPH_RBEARING (g
) + LGLYPH_XOFF (g
);
3946 if (metrics
.rbearing
< x
)
3947 metrics
.rbearing
= x
;
3948 x
= LGLYPH_ASCENT (g
) - LGLYPH_YOFF (g
);
3949 if (metrics
.ascent
< x
)
3951 x
= LGLYPH_DESCENT (g
) - LGLYPH_YOFF (g
);
3952 if (metrics
.descent
< x
)
3953 metrics
.descent
= x
;
3954 if (NILP (LGLYPH_ADJUSTMENT (g
)))
3955 metrics
.width
+= LGLYPH_WIDTH (g
);
3957 metrics
.width
+= LGLYPH_WADJUST (g
);
3960 if (need_composition
)
3962 gstr
= Ffont_make_gstring (font_object
, make_number (j
- i
));
3963 LGSTRING_SET_WIDTH (gstr
, metrics
.width
);
3964 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
3965 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
);
3966 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
3967 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
3968 for (k
= i
; i
< j
; i
++)
3970 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3972 LGLYPH_SET_FROM (g
, LGLYPH_FROM (g
) - this_from
);
3973 LGLYPH_SET_TO (g
, LGLYPH_TO (g
) - this_from
);
3974 LGSTRING_SET_GLYPH (gstr
, i
- k
, LGSTRING_GLYPH (gstring
, i
));
3976 from
= make_number (start
+ this_from
);
3977 to
= make_number (start
+ this_to
);
3979 Fcompose_region_internal (from
, to
, gstr
, Qnil
);
3981 Fcompose_string_internal (string
, from
, to
, gstr
, Qnil
);
3992 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
3993 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
3994 OTF-FEATURES specifies which features to apply in this format:
3995 (SCRIPT LANGSYS GSUB GPOS)
3997 SCRIPT is a symbol specifying a script tag of OpenType,
3998 LANGSYS is a symbol specifying a langsys tag of OpenType,
3999 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4001 If LANGYS is nil, the default langsys is selected.
4003 The features are applied in the order they appear in the list. The
4004 symbol `*' means to apply all available features not present in this
4005 list, and the remaining features are ignored. For instance, (vatu
4006 pstf * haln) is to apply vatu and pstf in this order, then to apply
4007 all available features other than vatu, pstf, and haln.
4009 The features are applied to the glyphs in the range FROM and TO of
4010 the glyph-string GSTRING-IN.
4012 If some feature is actually applicable, the resulting glyphs are
4013 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4014 this case, the value is the number of produced glyphs.
4016 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4019 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4020 produced in GSTRING-OUT, and the value is nil.
4022 See the documentation of `font-make-gstring' for the format of
4024 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4025 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4027 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4032 check_otf_features (otf_features
);
4033 CHECK_FONT_OBJECT (font_object
);
4034 font
= XFONT_OBJECT (font_object
);
4035 if (! font
->driver
->otf_drive
)
4036 error ("Font backend %s can't drive OpenType GSUB table",
4037 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4038 CHECK_CONS (otf_features
);
4039 CHECK_SYMBOL (XCAR (otf_features
));
4040 val
= XCDR (otf_features
);
4041 CHECK_SYMBOL (XCAR (val
));
4042 val
= XCDR (otf_features
);
4045 len
= check_gstring (gstring_in
);
4046 CHECK_VECTOR (gstring_out
);
4047 CHECK_NATNUM (from
);
4049 CHECK_NATNUM (index
);
4051 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4052 args_out_of_range_3 (from
, to
, make_number (len
));
4053 if (XINT (index
) >= ASIZE (gstring_out
))
4054 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4055 num
= font
->driver
->otf_drive (font
, otf_features
,
4056 gstring_in
, XINT (from
), XINT (to
),
4057 gstring_out
, XINT (index
), 0);
4060 return make_number (num
);
4063 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4065 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4066 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4068 (SCRIPT LANGSYS FEATURE ...)
4069 See the documentation of `font-drive-otf' for more detail.
4071 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4072 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4073 character code corresponding to the glyph or nil if there's no
4074 corresponding character. */)
4075 (font_object
, character
, otf_features
)
4076 Lisp_Object font_object
, character
, otf_features
;
4079 Lisp_Object gstring_in
, gstring_out
, g
;
4080 Lisp_Object alternates
;
4083 CHECK_FONT_GET_OBJECT (font_object
, font
);
4084 if (! font
->driver
->otf_drive
)
4085 error ("Font backend %s can't drive OpenType GSUB table",
4086 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4087 CHECK_CHARACTER (character
);
4088 CHECK_CONS (otf_features
);
4090 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4091 g
= LGSTRING_GLYPH (gstring_in
, 0);
4092 LGLYPH_SET_CHAR (g
, XINT (character
));
4093 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4094 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4095 gstring_out
, 0, 1)) < 0)
4096 gstring_out
= Ffont_make_gstring (font_object
,
4097 make_number (ASIZE (gstring_out
) * 2));
4099 for (i
= 0; i
< num
; i
++)
4101 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4102 int c
= LGLYPH_CHAR (g
);
4103 unsigned code
= LGLYPH_CODE (g
);
4105 alternates
= Fcons (Fcons (make_number (code
),
4106 c
> 0 ? make_number (c
) : Qnil
),
4109 return Fnreverse (alternates
);
4115 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4116 doc
: /* Open FONT-ENTITY. */)
4117 (font_entity
, size
, frame
)
4118 Lisp_Object font_entity
;
4124 CHECK_FONT_ENTITY (font_entity
);
4126 frame
= selected_frame
;
4127 CHECK_LIVE_FRAME (frame
);
4130 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4133 CHECK_NUMBER_OR_FLOAT (size
);
4135 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
4137 isize
= XINT (size
);
4141 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4144 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4145 doc
: /* Close FONT-OBJECT. */)
4146 (font_object
, frame
)
4147 Lisp_Object font_object
, frame
;
4149 CHECK_FONT_OBJECT (font_object
);
4151 frame
= selected_frame
;
4152 CHECK_LIVE_FRAME (frame
);
4153 font_close_object (XFRAME (frame
), font_object
);
4157 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4158 doc
: /* Return information about FONT-OBJECT.
4159 The value is a vector:
4160 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4163 NAME is a string of the font name (or nil if the font backend doesn't
4166 FILENAME is a string of the font file (or nil if the font backend
4167 doesn't provide a file name).
4169 PIXEL-SIZE is a pixel size by which the font is opened.
4171 SIZE is a maximum advance width of the font in pixels.
4173 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4176 CAPABILITY is a list whose first element is a symbol representing the
4177 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4178 remaining elements describe the details of the font capability.
4180 If the font is OpenType font, the form of the list is
4181 \(opentype GSUB GPOS)
4182 where GSUB shows which "GSUB" features the font supports, and GPOS
4183 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4184 lists of the format:
4185 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4187 If the font is not OpenType font, currently the length of the form is
4190 SCRIPT is a symbol representing OpenType script tag.
4192 LANGSYS is a symbol representing OpenType langsys tag, or nil
4193 representing the default langsys.
4195 FEATURE is a symbol representing OpenType feature tag.
4197 If the font is not OpenType font, CAPABILITY is nil. */)
4199 Lisp_Object font_object
;
4204 CHECK_FONT_GET_OBJECT (font_object
, font
);
4206 val
= Fmake_vector (make_number (9), Qnil
);
4207 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4208 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4209 ASET (val
, 2, make_number (font
->pixel_size
));
4210 ASET (val
, 3, make_number (font
->max_width
));
4211 ASET (val
, 4, make_number (font
->ascent
));
4212 ASET (val
, 5, make_number (font
->descent
));
4213 ASET (val
, 6, make_number (font
->space_width
));
4214 ASET (val
, 7, make_number (font
->average_width
));
4215 if (font
->driver
->otf_capability
)
4216 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4220 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4221 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4222 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4223 (font_object
, string
)
4224 Lisp_Object font_object
, string
;
4230 CHECK_FONT_GET_OBJECT (font_object
, font
);
4231 CHECK_STRING (string
);
4232 len
= SCHARS (string
);
4233 vec
= Fmake_vector (make_number (len
), Qnil
);
4234 for (i
= 0; i
< len
; i
++)
4236 Lisp_Object ch
= Faref (string
, make_number (i
));
4241 struct font_metrics metrics
;
4243 cod
= code
= font
->driver
->encode_char (font
, c
);
4244 if (code
== FONT_INVALID_CODE
)
4246 val
= Fmake_vector (make_number (6), Qnil
);
4247 if (cod
<= MOST_POSITIVE_FIXNUM
)
4248 ASET (val
, 0, make_number (code
));
4250 ASET (val
, 0, Fcons (make_number (code
>> 16),
4251 make_number (code
& 0xFFFF)));
4252 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4253 ASET (val
, 1, make_number (metrics
.lbearing
));
4254 ASET (val
, 2, make_number (metrics
.rbearing
));
4255 ASET (val
, 3, make_number (metrics
.width
));
4256 ASET (val
, 4, make_number (metrics
.ascent
));
4257 ASET (val
, 5, make_number (metrics
.descent
));
4263 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4264 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4265 FONT is a font-spec, font-entity, or font-object. */)
4267 Lisp_Object spec
, font
;
4269 CHECK_FONT_SPEC (spec
);
4272 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4275 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4276 doc
: /* Return a font-object for displaying a character at POSITION.
4277 Optional second arg WINDOW, if non-nil, is a window displaying
4278 the current buffer. It defaults to the currently selected window. */)
4279 (position
, window
, string
)
4280 Lisp_Object position
, window
, string
;
4287 CHECK_NUMBER_COERCE_MARKER (position
);
4288 pos
= XINT (position
);
4289 if (pos
< BEGV
|| pos
>= ZV
)
4290 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4294 CHECK_NUMBER (position
);
4295 CHECK_STRING (string
);
4296 pos
= XINT (position
);
4297 if (pos
< 0 || pos
>= SCHARS (string
))
4298 args_out_of_range (string
, position
);
4301 window
= selected_window
;
4302 CHECK_LIVE_WINDOW (window
);
4303 w
= XWINDOW (window
);
4305 return font_at (-1, pos
, NULL
, w
, string
);
4309 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4310 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4311 The value is a number of glyphs drawn.
4312 Type C-l to recover what previously shown. */)
4313 (font_object
, string
)
4314 Lisp_Object font_object
, string
;
4316 Lisp_Object frame
= selected_frame
;
4317 FRAME_PTR f
= XFRAME (frame
);
4323 CHECK_FONT_GET_OBJECT (font_object
, font
);
4324 CHECK_STRING (string
);
4325 len
= SCHARS (string
);
4326 code
= alloca (sizeof (unsigned) * len
);
4327 for (i
= 0; i
< len
; i
++)
4329 Lisp_Object ch
= Faref (string
, make_number (i
));
4333 code
[i
] = font
->driver
->encode_char (font
, c
);
4334 if (code
[i
] == FONT_INVALID_CODE
)
4337 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4339 if (font
->driver
->prepare_face
)
4340 font
->driver
->prepare_face (f
, face
);
4341 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4342 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4343 if (font
->driver
->done_face
)
4344 font
->driver
->done_face (f
, face
);
4346 return make_number (len
);
4350 #endif /* FONT_DEBUG */
4352 #ifdef HAVE_WINDOW_SYSTEM
4354 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4355 doc
: /* Return information about a font named NAME on frame FRAME.
4356 If FRAME is omitted or nil, use the selected frame.
4357 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4358 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4360 OPENED-NAME is the name used for opening the font,
4361 FULL-NAME is the full name of the font,
4362 SIZE is the maximum bound width of the font,
4363 HEIGHT is the height of the font,
4364 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4365 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4366 how to compose characters.
4367 If the named font is not yet loaded, return nil. */)
4369 Lisp_Object name
, frame
;
4374 Lisp_Object font_object
;
4376 (*check_window_system_func
) ();
4379 CHECK_STRING (name
);
4381 frame
= selected_frame
;
4382 CHECK_LIVE_FRAME (frame
);
4387 int fontset
= fs_query_fontset (name
, 0);
4390 name
= fontset_ascii (fontset
);
4391 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4393 else if (FONT_OBJECT_P (name
))
4395 else if (FONT_ENTITY_P (name
))
4396 font_object
= font_open_entity (f
, name
, 0);
4399 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4400 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4402 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4404 if (NILP (font_object
))
4406 font
= XFONT_OBJECT (font_object
);
4408 info
= Fmake_vector (make_number (7), Qnil
);
4409 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4410 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4411 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4412 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4413 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4414 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4415 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4418 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4419 close it now. Perhaps, we should manage font-objects
4420 by `reference-count'. */
4421 font_close_object (f
, font_object
);
4428 #define BUILD_STYLE_TABLE(TBL) \
4429 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4432 build_style_table (entry
, nelement
)
4433 struct table_entry
*entry
;
4437 Lisp_Object table
, elt
;
4439 table
= Fmake_vector (make_number (nelement
), Qnil
);
4440 for (i
= 0; i
< nelement
; i
++)
4442 for (j
= 0; entry
[i
].names
[j
]; j
++);
4443 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4444 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4445 for (j
= 0; entry
[i
].names
[j
]; j
++)
4446 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4447 ASET (table
, i
, elt
);
4452 static Lisp_Object Vfont_log
;
4453 static int font_log_env_checked
;
4456 font_add_log (action
, arg
, result
)
4458 Lisp_Object arg
, result
;
4460 Lisp_Object tail
, val
;
4463 if (! font_log_env_checked
)
4465 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
4466 font_log_env_checked
= 1;
4468 if (EQ (Vfont_log
, Qt
))
4471 arg
= Ffont_xlfd_name (arg
, Qt
);
4473 result
= Ffont_xlfd_name (result
, Qt
);
4474 else if (CONSP (result
))
4476 result
= Fcopy_sequence (result
);
4477 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4481 val
= Ffont_xlfd_name (val
, Qt
);
4482 XSETCAR (tail
, val
);
4485 else if (VECTORP (result
))
4487 result
= Fcopy_sequence (result
);
4488 for (i
= 0; i
< ASIZE (result
); i
++)
4490 val
= AREF (result
, i
);
4492 val
= Ffont_xlfd_name (val
, Qt
);
4493 ASET (result
, i
, val
);
4496 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4499 extern void syms_of_ftfont
P_ (());
4500 extern void syms_of_xfont
P_ (());
4501 extern void syms_of_xftfont
P_ (());
4502 extern void syms_of_ftxfont
P_ (());
4503 extern void syms_of_bdffont
P_ (());
4504 extern void syms_of_w32font
P_ (());
4505 extern void syms_of_atmfont
P_ (());
4510 sort_shift_bits
[FONT_SLANT_INDEX
] = 0;
4511 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 7;
4512 sort_shift_bits
[FONT_SIZE_INDEX
] = 14;
4513 sort_shift_bits
[FONT_WIDTH_INDEX
] = 21;
4514 sort_shift_bits
[FONT_ADSTYLE_INDEX
] = 28;
4515 sort_shift_bits
[FONT_FOUNDRY_INDEX
] = 29;
4516 sort_shift_bits
[FONT_FAMILY_INDEX
] = 30;
4517 /* Note that sort_shift_bits[FONT_SORT_TYPE] and
4518 sort_shift_bits[FONT_SORT_REGISTRY] are never used. */
4520 staticpro (&font_charset_alist
);
4521 font_charset_alist
= Qnil
;
4523 DEFSYM (Qfont_spec
, "font-spec");
4524 DEFSYM (Qfont_entity
, "font-entity");
4525 DEFSYM (Qfont_object
, "font-object");
4527 DEFSYM (Qopentype
, "opentype");
4529 DEFSYM (Qiso8859_1
, "iso8859-1");
4530 DEFSYM (Qiso10646_1
, "iso10646-1");
4531 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4532 DEFSYM (Qunicode_sip
, "unicode-sip");
4534 DEFSYM (QCotf
, ":otf");
4535 DEFSYM (QClang
, ":lang");
4536 DEFSYM (QCscript
, ":script");
4537 DEFSYM (QCantialias
, ":antialias");
4539 DEFSYM (QCfoundry
, ":foundry");
4540 DEFSYM (QCadstyle
, ":adstyle");
4541 DEFSYM (QCregistry
, ":registry");
4542 DEFSYM (QCspacing
, ":spacing");
4543 DEFSYM (QCdpi
, ":dpi");
4544 DEFSYM (QCscalable
, ":scalable");
4545 DEFSYM (QCavgwidth
, ":avgwidth");
4546 DEFSYM (QCfont_entity
, ":font-entity");
4547 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
4554 staticpro (&null_vector
);
4555 null_vector
= Fmake_vector (make_number (0), Qnil
);
4557 staticpro (&scratch_font_spec
);
4558 scratch_font_spec
= Ffont_spec (0, NULL
);
4559 staticpro (&scratch_font_prefer
);
4560 scratch_font_prefer
= Ffont_spec (0, NULL
);
4564 staticpro (&otf_list
);
4566 #endif /* HAVE_LIBOTF */
4570 defsubr (&Sfont_spec
);
4571 defsubr (&Sfont_get
);
4572 defsubr (&Sfont_put
);
4573 defsubr (&Slist_fonts
);
4574 defsubr (&Sfont_family_list
);
4575 defsubr (&Sfind_font
);
4576 defsubr (&Sfont_xlfd_name
);
4577 defsubr (&Sclear_font_cache
);
4578 defsubr (&Sfont_make_gstring
);
4579 defsubr (&Sfont_fill_gstring
);
4580 defsubr (&Sfont_shape_text
);
4582 defsubr (&Sfont_drive_otf
);
4583 defsubr (&Sfont_otf_alternates
);
4587 defsubr (&Sopen_font
);
4588 defsubr (&Sclose_font
);
4589 defsubr (&Squery_font
);
4590 defsubr (&Sget_font_glyphs
);
4591 defsubr (&Sfont_match_p
);
4592 defsubr (&Sfont_at
);
4594 defsubr (&Sdraw_string
);
4596 #endif /* FONT_DEBUG */
4597 #ifdef HAVE_WINDOW_SYSTEM
4598 defsubr (&Sfont_info
);
4601 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
4603 Alist of fontname patterns vs the corresponding encoding and repertory info.
4604 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
4605 where ENCODING is a charset or a char-table,
4606 and REPERTORY is a charset, a char-table, or nil.
4608 If ENCODING and REPERTORY are the same, the element can have the form
4609 \(REGEXP . ENCODING).
4611 ENCODING is for converting a character to a glyph code of the font.
4612 If ENCODING is a charset, encoding a character by the charset gives
4613 the corresponding glyph code. If ENCODING is a char-table, looking up
4614 the table by a character gives the corresponding glyph code.
4616 REPERTORY specifies a repertory of characters supported by the font.
4617 If REPERTORY is a charset, all characters beloging to the charset are
4618 supported. If REPERTORY is a char-table, all characters who have a
4619 non-nil value in the table are supported. If REPERTORY is nil, Emacs
4620 gets the repertory information by an opened font and ENCODING. */);
4621 Vfont_encoding_alist
= Qnil
;
4623 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
4624 doc
: /* Vector of valid font weight values.
4625 Each element has the form:
4626 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
4627 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symobls. */);
4628 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
4630 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
4631 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
4632 See `font-weight_table' for the format of the vector. */);
4633 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
4635 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
4636 doc
: /* Alist of font width symbols vs the corresponding numeric values.
4637 See `font-weight_table' for the format of the vector. */);
4638 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
4640 staticpro (&font_style_table
);
4641 font_style_table
= Fmake_vector (make_number (3), Qnil
);
4642 ASET (font_style_table
, 0, Vfont_weight_table
);
4643 ASET (font_style_table
, 1, Vfont_slant_table
);
4644 ASET (font_style_table
, 2, Vfont_width_table
);
4646 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
4647 *Logging list of font related actions and results.
4648 The value t means to suppress the logging.
4649 The initial value is set to nil if the environment variable
4650 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
4653 #ifdef HAVE_WINDOW_SYSTEM
4654 #ifdef HAVE_FREETYPE
4656 #ifdef HAVE_X_WINDOWS
4661 #endif /* HAVE_XFT */
4662 #endif /* HAVE_X_WINDOWS */
4663 #else /* not HAVE_FREETYPE */
4664 #ifdef HAVE_X_WINDOWS
4666 #endif /* HAVE_X_WINDOWS */
4667 #endif /* not HAVE_FREETYPE */
4670 #endif /* HAVE_BDFFONT */
4673 #endif /* WINDOWSNT */
4677 #endif /* HAVE_WINDOW_SYSTEM */
4680 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
4681 (do not change this comment) */