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 */
57 Lisp_Object Qfont_spec
, Qfont_entity
, Qfont_object
;
59 Lisp_Object Qopentype
;
61 /* Important character set strings. */
62 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
65 #define DEFAULT_ENCODING Qiso10646_1
67 #define DEFAULT_ENCODING Qiso8859_1
70 /* Special vector of zero length. This is repeatedly used by (struct
71 font_driver *)->list when a specified font is not found. */
72 static Lisp_Object null_vector
;
74 static Lisp_Object Vfont_weight_table
, Vfont_slant_table
, Vfont_width_table
;
76 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
77 static Lisp_Object font_style_table
;
79 /* Structure used for tables mapping weight, slant, and width numeric
80 values and their names. */
85 /* The first one is a valid name as a face attribute.
86 The second one (if any) is a typical name in XLFD field. */
91 /* Table of weight numeric values and their names. This table must be
92 sorted by numeric values in ascending order. */
94 static struct table_entry weight_table
[] =
97 { 20, { "ultra-light", "ultralight" }},
98 { 40, { "extra-light", "extralight" }},
100 { 75, { "semi-light", "semilight", "demilight", "book" }},
101 { 100, { "normal", "medium", "regular" }},
102 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
104 { 205, { "extra-bold", "extrabold" }},
105 { 210, { "ultra-bold", "ultrabold", "black" }}
108 /* Table of slant numeric values and their names. This table must be
109 sorted by numeric values in ascending order. */
111 static struct table_entry slant_table
[] =
113 { 0, { "reverse-oblique", "ro" }},
114 { 10, { "reverse-italic", "ri" }},
115 { 100, { "normal", "r" }},
116 { 200, { "italic" ,"i", "ot" }},
117 { 210, { "oblique", "o" }}
120 /* Table of width numeric values and their names. This table must be
121 sorted by numeric values in ascending order. */
123 static struct table_entry width_table
[] =
125 { 50, { "ultra-condensed", "ultracondensed" }},
126 { 63, { "extra-condensed", "extracondensed" }},
127 { 75, { "condensed", "compressed", "narrow" }},
128 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
129 { 100, { "normal", "medium", "regular" }},
130 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
131 { 125, { "expanded" }},
132 { 150, { "extra-expanded", "extraexpanded" }},
133 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
136 extern Lisp_Object Qnormal
;
138 /* Symbols representing keys of normal font properties. */
139 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
;
140 extern Lisp_Object QCheight
, QCsize
, QCname
;
142 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
;
143 /* Symbols representing keys of font extra info. */
144 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
145 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
146 /* Symbols representing values of font spacing property. */
147 Lisp_Object Qc
, Qm
, Qp
, Qd
;
149 Lisp_Object Vfont_encoding_alist
;
151 /* Alist of font registry symbol and the corresponding charsets
152 information. The information is retrieved from
153 Vfont_encoding_alist on demand.
155 Eash element has the form:
156 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
160 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
161 encodes a character code to a glyph code of a font, and
162 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
163 character is supported by a font.
165 The latter form means that the information for REGISTRY couldn't be
167 static Lisp_Object font_charset_alist
;
169 /* List of all font drivers. Each font-backend (XXXfont.c) calls
170 register_font_driver in syms_of_XXXfont to register its font-driver
172 static struct font_driver_list
*font_driver_list
;
176 /* Creaters of font-related Lisp object. */
181 Lisp_Object font_spec
;
182 struct font_spec
*spec
183 = ((struct font_spec
*)
184 allocate_pseudovector (VECSIZE (struct font_spec
),
185 FONT_SPEC_MAX
, PVEC_FONT
));
186 XSETFONT (font_spec
, spec
);
193 Lisp_Object font_entity
;
194 struct font_entity
*entity
195 = ((struct font_entity
*)
196 allocate_pseudovector (VECSIZE (struct font_entity
),
197 FONT_ENTITY_MAX
, PVEC_FONT
));
198 XSETFONT (font_entity
, entity
);
202 /* Create a font-object whose structure size is SIZE. If ENTITY is
203 not nil, copy properties from ENTITY to the font-object. If
204 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
206 font_make_object (size
, entity
, pixelsize
)
211 Lisp_Object font_object
;
213 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
216 XSETFONT (font_object
, font
);
220 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
221 font
->props
[i
] = AREF (entity
, i
);
222 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
223 font
->props
[FONT_EXTRA_INDEX
]
224 = Fcopy_sequence (AREF (entity
, FONT_EXTRA_INDEX
));
227 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
233 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
234 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
235 static Lisp_Object font_matching_entity
P_ ((FRAME_PTR
, Lisp_Object
*,
238 /* Number of registered font drivers. */
239 static int num_font_drivers
;
242 /* Return a Lispy value of a font property value at STR and LEN bytes.
243 If STR is "*", it returns nil.
244 If FORCE_SYMBOL is zero and all characters in STR are digits, it
245 returns an integer. Otherwise, it returns a symbol interned from
249 font_intern_prop (str
, len
, force_symbol
)
258 if (len
== 1 && *str
== '*')
260 if (!force_symbol
&& len
>=1 && isdigit (*str
))
262 for (i
= 1; i
< len
; i
++)
263 if (! isdigit (str
[i
]))
266 return make_number (atoi (str
));
269 /* The following code is copied from the function intern (in lread.c). */
271 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
272 obarray
= check_obarray (obarray
);
273 tem
= oblookup (obarray
, str
, len
, len
);
276 return Fintern (make_unibyte_string (str
, len
), obarray
);
279 /* Return a pixel size of font-spec SPEC on frame F. */
282 font_pixel_size (f
, spec
)
286 #ifdef HAVE_WINDOW_SYSTEM
287 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
296 font_assert (FLOATP (size
));
297 point_size
= XFLOAT_DATA (size
);
298 val
= AREF (spec
, FONT_DPI_INDEX
);
303 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
311 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
312 font vector. If VAL is not valid (i.e. not registered in
313 font_style_table), return -1 if NOERROR is zero, and return a
314 proper index if NOERROR is nonzero. In that case, register VAL in
315 font_style_table if VAL is a symbol, and return a closest index if
316 VAL is an integer. */
319 font_style_to_value (prop
, val
, noerror
)
320 enum font_property_index prop
;
324 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
325 int len
= ASIZE (table
);
331 Lisp_Object args
[2], elt
;
333 /* At first try exact match. */
334 for (i
= 0; i
< len
; i
++)
335 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
336 if (EQ (val
, AREF (AREF (table
, i
), j
)))
337 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
338 | (i
<< 4) | (j
- 1));
339 /* Try also with case-folding match. */
340 s
= SDATA (SYMBOL_NAME (val
));
341 for (i
= 0; i
< len
; i
++)
342 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
344 elt
= AREF (AREF (table
, i
), j
);
345 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
346 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
347 | (i
<< 4) | (j
- 1));
353 elt
= Fmake_vector (make_number (2), make_number (255));
356 args
[1] = Fmake_vector (make_number (1), elt
);
357 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
358 return (255 << 8) | (i
<< 4);
363 int numeric
= XINT (val
);
365 for (i
= 0, last_n
= -1; i
< len
; i
++)
367 int n
= XINT (AREF (AREF (table
, i
), 0));
370 return (n
<< 8) | (i
<< 4);
375 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
376 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
382 return ((last_n
<< 8) | ((i
- 1) << 4));
387 font_style_symbolic (font
, prop
, for_face
)
389 enum font_property_index prop
;
392 Lisp_Object val
= AREF (font
, prop
);
393 Lisp_Object table
, elt
;
398 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
399 i
= XINT (val
) & 0xFF;
400 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
401 elt
= AREF (table
, ((i
>> 4) & 0xF));
402 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
403 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
406 extern Lisp_Object Vface_alternative_font_family_alist
;
408 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
411 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
412 FONTNAME. ENCODING is a charset symbol that specifies the encoding
413 of the font. REPERTORY is a charset symbol or nil. */
416 find_font_encoding (fontname
)
417 Lisp_Object fontname
;
419 Lisp_Object tail
, elt
;
421 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
425 && STRINGP (XCAR (elt
))
426 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
427 && (SYMBOLP (XCDR (elt
))
428 ? CHARSETP (XCDR (elt
))
429 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
432 /* We don't know the encoding of this font. Let's assume `ascii'. */
436 /* Return encoding charset and repertory charset for REGISTRY in
437 ENCODING and REPERTORY correspondingly. If correct information for
438 REGISTRY is available, return 0. Otherwise return -1. */
441 font_registry_charsets (registry
, encoding
, repertory
)
442 Lisp_Object registry
;
443 struct charset
**encoding
, **repertory
;
446 int encoding_id
, repertory_id
;
448 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
454 encoding_id
= XINT (XCAR (val
));
455 repertory_id
= XINT (XCDR (val
));
459 val
= find_font_encoding (SYMBOL_NAME (registry
));
460 if (SYMBOLP (val
) && CHARSETP (val
))
462 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
464 else if (CONSP (val
))
466 if (! CHARSETP (XCAR (val
)))
468 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
469 if (NILP (XCDR (val
)))
473 if (! CHARSETP (XCDR (val
)))
475 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
480 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
482 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
486 *encoding
= CHARSET_FROM_ID (encoding_id
);
488 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
493 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
498 /* Font property value validaters. See the comment of
499 font_property_table for the meaning of the arguments. */
501 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
502 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
503 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
504 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
505 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
506 static int get_font_prop_index
P_ ((Lisp_Object
));
509 font_prop_validate_symbol (prop
, val
)
510 Lisp_Object prop
, val
;
513 val
= Fintern (val
, Qnil
);
516 else if (EQ (prop
, QCregistry
))
517 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
523 font_prop_validate_style (style
, val
)
524 Lisp_Object style
, val
;
526 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
527 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
534 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
538 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
540 if ((n
& 0xF) + 1 >= ASIZE (elt
))
542 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
546 else if (SYMBOLP (val
))
548 int n
= font_style_to_value (prop
, val
, 0);
550 val
= n
>= 0 ? make_number (n
) : Qerror
;
558 font_prop_validate_non_neg (prop
, val
)
559 Lisp_Object prop
, val
;
561 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
566 font_prop_validate_spacing (prop
, val
)
567 Lisp_Object prop
, val
;
569 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
571 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
573 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
575 if (spacing
== 'c' || spacing
== 'C')
576 return make_number (FONT_SPACING_CHARCELL
);
577 if (spacing
== 'm' || spacing
== 'M')
578 return make_number (FONT_SPACING_MONO
);
579 if (spacing
== 'p' || spacing
== 'P')
580 return make_number (FONT_SPACING_PROPORTIONAL
);
581 if (spacing
== 'd' || spacing
== 'D')
582 return make_number (FONT_SPACING_DUAL
);
588 font_prop_validate_otf (prop
, val
)
589 Lisp_Object prop
, val
;
591 Lisp_Object tail
, tmp
;
594 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
595 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
596 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
599 if (! SYMBOLP (XCAR (val
)))
604 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
606 for (i
= 0; i
< 2; i
++)
613 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
614 if (! SYMBOLP (XCAR (tmp
)))
622 /* Structure of known font property keys and validater of the
626 /* Pointer to the key symbol. */
628 /* Function to validate PROP's value VAL, or NULL if any value is
629 ok. The value is VAL or its regularized value if VAL is valid,
630 and Qerror if not. */
631 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
632 } font_property_table
[] =
633 { { &QCtype
, font_prop_validate_symbol
},
634 { &QCfoundry
, font_prop_validate_symbol
},
635 { &QCfamily
, font_prop_validate_symbol
},
636 { &QCadstyle
, font_prop_validate_symbol
},
637 { &QCregistry
, font_prop_validate_symbol
},
638 { &QCweight
, font_prop_validate_style
},
639 { &QCslant
, font_prop_validate_style
},
640 { &QCwidth
, font_prop_validate_style
},
641 { &QCsize
, font_prop_validate_non_neg
},
642 { &QCdpi
, font_prop_validate_non_neg
},
643 { &QCspacing
, font_prop_validate_spacing
},
644 { &QCavgwidth
, font_prop_validate_non_neg
},
645 /* The order of the above entries must match with enum
646 font_property_index. */
647 { &QClang
, font_prop_validate_symbol
},
648 { &QCscript
, font_prop_validate_symbol
},
649 { &QCotf
, font_prop_validate_otf
}
652 /* Size (number of elements) of the above table. */
653 #define FONT_PROPERTY_TABLE_SIZE \
654 ((sizeof font_property_table) / (sizeof *font_property_table))
656 /* Return an index number of font property KEY or -1 if KEY is not an
657 already known property. */
660 get_font_prop_index (key
)
665 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
666 if (EQ (key
, *font_property_table
[i
].key
))
671 /* Validate the font property. The property key is specified by the
672 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
673 signal an error. The value is VAL or the regularized one. */
676 font_prop_validate (idx
, prop
, val
)
678 Lisp_Object prop
, val
;
680 Lisp_Object validated
;
685 prop
= *font_property_table
[idx
].key
;
688 idx
= get_font_prop_index (prop
);
692 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
693 if (EQ (validated
, Qerror
))
694 signal_error ("invalid font property", Fcons (prop
, val
));
699 /* Store VAL as a value of extra font property PROP in FONT while
700 keeping the sorting order. Don't check the validity of VAL. */
703 font_put_extra (font
, prop
, val
)
704 Lisp_Object font
, prop
, val
;
706 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
707 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
711 Lisp_Object prev
= Qnil
;
714 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
715 prev
= extra
, extra
= XCDR (extra
);
717 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
719 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
727 /* Font name parser and unparser */
729 static int parse_matrix
P_ ((char *));
730 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
731 static int font_parse_name
P_ ((char *, Lisp_Object
));
733 /* An enumerator for each field of an XLFD font name. */
734 enum xlfd_field_index
753 /* An enumerator for mask bit corresponding to each XLFD field. */
756 XLFD_FOUNDRY_MASK
= 0x0001,
757 XLFD_FAMILY_MASK
= 0x0002,
758 XLFD_WEIGHT_MASK
= 0x0004,
759 XLFD_SLANT_MASK
= 0x0008,
760 XLFD_SWIDTH_MASK
= 0x0010,
761 XLFD_ADSTYLE_MASK
= 0x0020,
762 XLFD_PIXEL_MASK
= 0x0040,
763 XLFD_POINT_MASK
= 0x0080,
764 XLFD_RESX_MASK
= 0x0100,
765 XLFD_RESY_MASK
= 0x0200,
766 XLFD_SPACING_MASK
= 0x0400,
767 XLFD_AVGWIDTH_MASK
= 0x0800,
768 XLFD_REGISTRY_MASK
= 0x1000,
769 XLFD_ENCODING_MASK
= 0x2000
773 /* Parse P pointing the pixel/point size field of the form
774 `[A B C D]' which specifies a transformation matrix:
780 by which all glyphs of the font are transformed. The spec says
781 that scalar value N for the pixel/point size is equivalent to:
782 A = N * resx/resy, B = C = 0, D = N.
784 Return the scalar value N if the form is valid. Otherwise return
795 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
798 matrix
[i
] = - strtod (p
+ 1, &end
);
800 matrix
[i
] = strtod (p
, &end
);
803 return (i
== 4 ? (int) matrix
[3] : -1);
806 /* Expand a wildcard field in FIELD (the first N fields are filled) to
807 multiple fields to fill in all 14 XLFD fields while restring a
808 field position by its contents. */
811 font_expand_wildcards (field
, n
)
812 Lisp_Object field
[XLFD_LAST_INDEX
];
816 Lisp_Object tmp
[XLFD_LAST_INDEX
];
817 /* Array of information about where this element can go. Nth
818 element is for Nth element of FIELD. */
820 /* Minimum possible field. */
822 /* Maxinum possible field. */
824 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
826 } range
[XLFD_LAST_INDEX
];
828 int range_from
, range_to
;
831 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
832 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
833 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
834 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
835 | XLFD_AVGWIDTH_MASK)
836 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
838 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
839 field. The value is shifted to left one bit by one in the
841 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
842 range_mask
= (range_mask
<< 1) | 1;
844 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
845 position-based retriction for FIELD[I]. */
846 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
847 i
++, range_from
++, range_to
++, range_mask
<<= 1)
849 Lisp_Object val
= field
[i
];
855 range
[i
].from
= range_from
;
856 range
[i
].to
= range_to
;
857 range
[i
].mask
= range_mask
;
861 /* The triplet FROM, TO, and MASK is a value-based
862 retriction for FIELD[I]. */
868 int numeric
= XINT (val
);
871 from
= to
= XLFD_ENCODING_INDEX
,
872 mask
= XLFD_ENCODING_MASK
;
873 else if (numeric
== 0)
874 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
875 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
876 else if (numeric
<= 48)
877 from
= to
= XLFD_PIXEL_INDEX
,
878 mask
= XLFD_PIXEL_MASK
;
880 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
881 mask
= XLFD_LARGENUM_MASK
;
883 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
884 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
885 mask
= XLFD_NULL_MASK
;
887 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
890 Lisp_Object name
= SYMBOL_NAME (val
);
892 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
893 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
894 mask
= XLFD_REGENC_MASK
;
896 from
= to
= XLFD_ENCODING_INDEX
,
897 mask
= XLFD_ENCODING_MASK
;
899 else if (range_from
<= XLFD_WEIGHT_INDEX
900 && range_to
>= XLFD_WEIGHT_INDEX
901 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
902 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
903 else if (range_from
<= XLFD_SLANT_INDEX
904 && range_to
>= XLFD_SLANT_INDEX
905 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
906 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
907 else if (range_from
<= XLFD_SWIDTH_INDEX
908 && range_to
>= XLFD_SWIDTH_INDEX
909 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
910 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
913 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
914 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
916 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
917 mask
= XLFD_SYMBOL_MASK
;
920 /* Merge position-based and value-based restrictions. */
922 while (from
< range_from
)
923 mask
&= ~(1 << from
++);
924 while (from
< 14 && ! (mask
& (1 << from
)))
926 while (to
> range_to
)
927 mask
&= ~(1 << to
--);
928 while (to
>= 0 && ! (mask
& (1 << to
)))
932 range
[i
].from
= from
;
934 range
[i
].mask
= mask
;
936 if (from
> range_from
|| to
< range_to
)
938 /* The range is narrowed by value-based restrictions.
939 Reflect it to the other fields. */
941 /* Following fields should be after FROM. */
943 /* Preceding fields should be before TO. */
944 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
946 /* Check FROM for non-wildcard field. */
947 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
949 while (range
[j
].from
< from
)
950 range
[j
].mask
&= ~(1 << range
[j
].from
++);
951 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
953 range
[j
].from
= from
;
956 from
= range
[j
].from
;
957 if (range
[j
].to
> to
)
959 while (range
[j
].to
> to
)
960 range
[j
].mask
&= ~(1 << range
[j
].to
--);
961 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
974 /* Decide all fileds from restrictions in RANGE. */
975 for (i
= j
= 0; i
< n
; i
++)
977 if (j
< range
[i
].from
)
979 if (i
== 0 || ! NILP (tmp
[i
- 1]))
980 /* None of TMP[X] corresponds to Jth field. */
982 for (; j
< range
[i
].from
; j
++)
987 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
989 for (; j
< XLFD_LAST_INDEX
; j
++)
991 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
992 field
[XLFD_ENCODING_INDEX
]
993 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
998 #ifdef ENABLE_CHECKING
999 /* Match a 14-field XLFD pattern against a full XLFD font name. */
1001 font_match_xlfd (char *pattern
, char *name
)
1003 while (*pattern
&& *name
)
1005 if (*pattern
== *name
)
1007 else if (*pattern
== '*')
1008 if (*name
== pattern
[1])
1019 /* Make sure the font object matches the XLFD font name. */
1021 font_check_xlfd_parse (Lisp_Object font
, char *name
)
1023 char name_check
[256];
1024 font_unparse_xlfd (font
, 0, name_check
, 255);
1025 return font_match_xlfd (name_check
, name
);
1031 /* Parse NAME (null terminated) as XLFD and store information in FONT
1032 (font-spec or font-entity). Size property of FONT is set as
1034 specified XLFD fields FONT property
1035 --------------------- -------------
1036 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1037 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1038 POINT_SIZE POINT_SIZE/10 (Lisp float)
1040 If NAME is successfully parsed, return 0. Otherwise return -1.
1042 FONT is usually a font-spec, but when this function is called from
1043 X font backend driver, it is a font-entity. In that case, NAME is
1044 a fully specified XLFD. */
1047 font_parse_xlfd (name
, font
)
1051 int len
= strlen (name
);
1053 char *f
[XLFD_LAST_INDEX
+ 1];
1058 /* Maximum XLFD name length is 255. */
1060 /* Accept "*-.." as a fully specified XLFD. */
1061 if (name
[0] == '*' && name
[1] == '-')
1062 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1065 for (p
= name
+ i
; *p
; p
++)
1069 if (i
== XLFD_LAST_INDEX
)
1074 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1075 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1077 if (i
== XLFD_LAST_INDEX
)
1079 /* Fully specified XLFD. */
1082 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1083 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1084 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1085 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1087 val
= INTERN_FIELD_SYM (i
);
1090 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1092 ASET (font
, j
, make_number (n
));
1095 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1096 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1097 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1099 ASET (font
, FONT_REGISTRY_INDEX
,
1100 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1101 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1103 p
= f
[XLFD_PIXEL_INDEX
];
1104 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1105 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1108 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1110 ASET (font
, FONT_SIZE_INDEX
, val
);
1113 double point_size
= -1;
1115 font_assert (FONT_SPEC_P (font
));
1116 p
= f
[XLFD_POINT_INDEX
];
1118 point_size
= parse_matrix (p
);
1119 else if (isdigit (*p
))
1120 point_size
= atoi (p
), point_size
/= 10;
1121 if (point_size
>= 0)
1122 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1126 ASET (font
, FONT_DPI_INDEX
, INTERN_FIELD (XLFD_RESY_INDEX
));
1127 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1130 val
= font_prop_validate_spacing (QCspacing
, val
);
1131 if (! INTEGERP (val
))
1133 ASET (font
, FONT_SPACING_INDEX
, val
);
1135 p
= f
[XLFD_AVGWIDTH_INDEX
];
1138 ASET (font
, FONT_AVGWIDTH_INDEX
,
1139 font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0));
1143 int wild_card_found
= 0;
1144 Lisp_Object prop
[XLFD_LAST_INDEX
];
1146 if (FONT_ENTITY_P (font
))
1148 for (j
= 0; j
< i
; j
++)
1152 if (f
[j
][1] && f
[j
][1] != '-')
1155 wild_card_found
= 1;
1158 prop
[j
] = INTERN_FIELD (j
);
1160 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1162 if (! wild_card_found
)
1164 if (font_expand_wildcards (prop
, i
) < 0)
1167 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1168 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1169 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1170 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1171 if (! NILP (prop
[i
]))
1173 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1175 ASET (font
, j
, make_number (n
));
1177 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1178 val
= prop
[XLFD_REGISTRY_INDEX
];
1181 val
= prop
[XLFD_ENCODING_INDEX
];
1183 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1185 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1186 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1188 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1189 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1191 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1193 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1194 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1195 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1197 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1199 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1202 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1203 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1204 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1206 val
= font_prop_validate_spacing (QCspacing
,
1207 prop
[XLFD_SPACING_INDEX
]);
1208 if (! INTEGERP (val
))
1210 ASET (font
, FONT_SPACING_INDEX
, val
);
1212 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1213 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1219 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1220 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1221 0, use PIXEL_SIZE instead. */
1224 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1230 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1234 font_assert (FONTP (font
));
1236 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1239 if (i
== FONT_ADSTYLE_INDEX
)
1240 j
= XLFD_ADSTYLE_INDEX
;
1241 else if (i
== FONT_REGISTRY_INDEX
)
1242 j
= XLFD_REGISTRY_INDEX
;
1243 val
= AREF (font
, i
);
1246 if (j
== XLFD_REGISTRY_INDEX
)
1247 f
[j
] = "*-*", len
+= 4;
1249 f
[j
] = "*", len
+= 2;
1254 val
= SYMBOL_NAME (val
);
1255 if (j
== XLFD_REGISTRY_INDEX
1256 && ! strchr ((char *) SDATA (val
), '-'))
1258 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1259 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1261 f
[j
] = alloca (SBYTES (val
) + 3);
1262 sprintf (f
[j
], "%s-*", SDATA (val
));
1263 len
+= SBYTES (val
) + 3;
1267 f
[j
] = alloca (SBYTES (val
) + 4);
1268 sprintf (f
[j
], "%s*-*", SDATA (val
));
1269 len
+= SBYTES (val
) + 4;
1273 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1277 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1280 val
= font_style_symbolic (font
, i
, 0);
1282 f
[j
] = "*", len
+= 2;
1285 val
= SYMBOL_NAME (val
);
1286 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1290 val
= AREF (font
, FONT_SIZE_INDEX
);
1291 font_assert (NUMBERP (val
) || NILP (val
));
1299 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1300 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1303 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1305 else if (FLOATP (val
))
1307 i
= XFLOAT_DATA (val
) * 10;
1308 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1309 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1312 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1314 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1316 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1317 f
[XLFD_RESX_INDEX
] = alloca (22);
1318 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1322 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1323 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1325 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1327 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1328 : spacing
<= FONT_SPACING_DUAL
? "d"
1329 : spacing
<= FONT_SPACING_MONO
? "m"
1334 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1335 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1337 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1338 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
],
1339 "%d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1342 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1343 len
++; /* for terminating '\0'. */
1346 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1347 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1348 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1349 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1350 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1351 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1352 f
[XLFD_REGISTRY_INDEX
]);
1355 /* Parse NAME (null terminated) and store information in FONT
1356 (font-spec or font-entity). NAME is supplied in either the
1357 Fontconfig or GTK font name format. If NAME is successfully
1358 parsed, return 0. Otherwise return -1.
1360 The fontconfig format is
1362 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1366 FAMILY [PROPS...] [SIZE]
1368 This function tries to guess which format it is. */
1371 font_parse_fcname (name
, font
)
1376 char *size_beg
= NULL
, *size_end
= NULL
;
1377 char *props_beg
= NULL
, *family_end
= NULL
;
1378 int len
= strlen (name
);
1383 for (p
= name
; *p
; p
++)
1385 if (*p
== '\\' && p
[1])
1389 props_beg
= family_end
= p
;
1394 int decimal
= 0, size_found
= 1;
1395 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1398 if (*q
!= '.' || decimal
)
1417 /* A fontconfig name with size and/or property data. */
1418 if (family_end
> name
)
1421 family
= font_intern_prop (name
, family_end
- name
, 1);
1422 ASET (font
, FONT_FAMILY_INDEX
, family
);
1426 double point_size
= strtod (size_beg
, &size_end
);
1427 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1428 if (*size_end
== ':' && size_end
[1])
1429 props_beg
= size_end
;
1433 /* Now parse ":KEY=VAL" patterns. */
1436 for (p
= props_beg
; *p
; p
= q
)
1438 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1441 /* Must be an enumerated value. */
1445 val
= font_intern_prop (p
, q
- p
, 1);
1447 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1449 if (PROP_MATCH ("light", 5)
1450 || PROP_MATCH ("medium", 6)
1451 || PROP_MATCH ("demibold", 8)
1452 || PROP_MATCH ("bold", 4)
1453 || PROP_MATCH ("black", 5))
1454 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1455 else if (PROP_MATCH ("roman", 5)
1456 || PROP_MATCH ("italic", 6)
1457 || PROP_MATCH ("oblique", 7))
1458 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1459 else if (PROP_MATCH ("charcell", 8))
1460 ASET (font
, FONT_SPACING_INDEX
,
1461 make_number (FONT_SPACING_CHARCELL
));
1462 else if (PROP_MATCH ("mono", 4))
1463 ASET (font
, FONT_SPACING_INDEX
,
1464 make_number (FONT_SPACING_MONO
));
1465 else if (PROP_MATCH ("proportional", 12))
1466 ASET (font
, FONT_SPACING_INDEX
,
1467 make_number (FONT_SPACING_PROPORTIONAL
));
1476 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1477 prop
= FONT_SIZE_INDEX
;
1480 key
= font_intern_prop (p
, q
- p
, 1);
1481 prop
= get_font_prop_index (key
);
1485 for (q
= p
; *q
&& *q
!= ':'; q
++);
1486 val
= font_intern_prop (p
, q
- p
, 0);
1488 if (prop
>= FONT_FOUNDRY_INDEX
1489 && prop
< FONT_EXTRA_INDEX
)
1490 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1492 Ffont_put (font
, key
, val
);
1500 /* Either a fontconfig-style name with no size and property
1501 data, or a GTK-style name. */
1503 int word_len
, prop_found
= 0;
1505 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1511 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1519 double point_size
= strtod (p
, &q
);
1520 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1525 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1526 if (*q
== '\\' && q
[1])
1530 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1532 if (PROP_MATCH ("Ultra-Light", 11))
1535 prop
= font_intern_prop ("ultra-light", 11, 1);
1536 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1538 else if (PROP_MATCH ("Light", 5))
1541 prop
= font_intern_prop ("light", 5, 1);
1542 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1544 else if (PROP_MATCH ("Semi-Bold", 9))
1547 prop
= font_intern_prop ("semi-bold", 9, 1);
1548 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1550 else if (PROP_MATCH ("Bold", 4))
1553 prop
= font_intern_prop ("bold", 4, 1);
1554 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1556 else if (PROP_MATCH ("Italic", 6))
1559 prop
= font_intern_prop ("italic", 4, 1);
1560 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1562 else if (PROP_MATCH ("Oblique", 7))
1565 prop
= font_intern_prop ("oblique", 7, 1);
1566 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1570 return -1; /* Unknown property in GTK-style font name. */
1579 family
= font_intern_prop (name
, family_end
- name
, 1);
1580 ASET (font
, FONT_FAMILY_INDEX
, family
);
1587 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1588 NAME (NBYTES length), and return the name length. If
1589 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1592 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1598 Lisp_Object family
, foundry
;
1599 Lisp_Object tail
, val
;
1604 Lisp_Object styles
[3];
1605 char *style_names
[3] = { "weight", "slant", "width" };
1608 family
= AREF (font
, FONT_FAMILY_INDEX
);
1609 if (! NILP (family
))
1611 if (SYMBOLP (family
))
1613 family
= SYMBOL_NAME (family
);
1614 len
+= SBYTES (family
);
1620 val
= AREF (font
, FONT_SIZE_INDEX
);
1623 if (XINT (val
) != 0)
1624 pixel_size
= XINT (val
);
1626 len
+= 21; /* for ":pixelsize=NUM" */
1628 else if (FLOATP (val
))
1631 point_size
= (int) XFLOAT_DATA (val
);
1632 len
+= 11; /* for "-NUM" */
1635 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1636 if (! NILP (foundry
))
1638 if (SYMBOLP (foundry
))
1640 foundry
= SYMBOL_NAME (foundry
);
1641 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1647 for (i
= 0; i
< 3; i
++)
1649 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1650 if (! NILP (styles
[i
]))
1651 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1652 SDATA (SYMBOL_NAME (styles
[i
])));
1655 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1656 len
+= sprintf (work
, ":dpi=%d", dpi
);
1657 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1658 len
+= strlen (":spacing=100");
1659 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1660 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1661 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1663 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1665 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1667 len
+= SBYTES (val
);
1668 else if (INTEGERP (val
))
1669 len
+= sprintf (work
, "%d", XINT (val
));
1670 else if (SYMBOLP (val
))
1671 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1677 if (! NILP (family
))
1678 p
+= sprintf (p
, "%s", SDATA (family
));
1682 p
+= sprintf (p
, "%d", point_size
);
1684 p
+= sprintf (p
, "-%d", point_size
);
1686 else if (pixel_size
> 0)
1687 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1688 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1689 p
+= sprintf (p
, ":foundry=%s",
1690 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1691 for (i
= 0; i
< 3; i
++)
1692 if (! NILP (styles
[i
]))
1693 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1694 SDATA (SYMBOL_NAME (styles
[i
])));
1695 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1696 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1697 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1698 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1699 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1701 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1702 p
+= sprintf (p
, ":scalable=true");
1704 p
+= sprintf (p
, ":scalable=false");
1709 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1710 NAME (NBYTES length), and return the name length. F is the frame
1711 on which the font is displayed; it is used to calculate the point
1715 font_unparse_gtkname (font
, f
, name
, nbytes
)
1723 Lisp_Object family
, weight
, slant
, size
;
1724 int point_size
= -1;
1726 family
= AREF (font
, FONT_FAMILY_INDEX
);
1727 if (! NILP (family
))
1729 if (! SYMBOLP (family
))
1731 family
= SYMBOL_NAME (family
);
1732 len
+= SBYTES (family
);
1735 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1736 if (EQ (weight
, Qnormal
))
1738 else if (! NILP (weight
))
1740 weight
= SYMBOL_NAME (weight
);
1741 len
+= SBYTES (weight
);
1744 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1745 if (EQ (slant
, Qnormal
))
1747 else if (! NILP (slant
))
1749 slant
= SYMBOL_NAME (slant
);
1750 len
+= SBYTES (slant
);
1753 size
= AREF (font
, FONT_SIZE_INDEX
);
1754 /* Convert pixel size to point size. */
1755 if (INTEGERP (size
))
1757 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1759 if (INTEGERP (font_dpi
))
1760 dpi
= XINT (font_dpi
);
1763 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1766 else if (FLOATP (size
))
1768 point_size
= (int) XFLOAT_DATA (size
);
1775 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1777 if (! NILP (weight
))
1780 p
+= sprintf (p
, " %s", SDATA (weight
));
1781 q
[1] = toupper (q
[1]);
1787 p
+= sprintf (p
, " %s", SDATA (slant
));
1788 q
[1] = toupper (q
[1]);
1792 p
+= sprintf (p
, " %d", point_size
);
1797 /* Parse NAME (null terminated) and store information in FONT
1798 (font-spec or font-entity). If NAME is successfully parsed, return
1799 0. Otherwise return -1. */
1802 font_parse_name (name
, font
)
1806 if (name
[0] == '-' || index (name
, '*'))
1807 return font_parse_xlfd (name
, font
);
1808 return font_parse_fcname (name
, font
);
1812 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1813 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1817 font_parse_family_registry (family
, registry
, font_spec
)
1818 Lisp_Object family
, registry
, font_spec
;
1824 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1826 CHECK_STRING (family
);
1827 len
= SBYTES (family
);
1828 p0
= (char *) SDATA (family
);
1829 p1
= index (p0
, '-');
1832 if ((*p0
!= '*' || p1
- p0
> 1)
1833 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1834 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1837 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1840 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1842 if (! NILP (registry
))
1844 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1845 CHECK_STRING (registry
);
1846 len
= SBYTES (registry
);
1847 p0
= (char *) SDATA (registry
);
1848 p1
= index (p0
, '-');
1851 if (SDATA (registry
)[len
- 1] == '*')
1852 registry
= concat2 (registry
, build_string ("-*"));
1854 registry
= concat2 (registry
, build_string ("*-*"));
1856 registry
= Fdowncase (registry
);
1857 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1862 /* This part (through the next ^L) is still experimental and not
1863 tested much. We may drastically change codes. */
1869 #define LGSTRING_HEADER_SIZE 6
1870 #define LGSTRING_GLYPH_SIZE 8
1873 check_gstring (gstring
)
1874 Lisp_Object gstring
;
1879 CHECK_VECTOR (gstring
);
1880 val
= AREF (gstring
, 0);
1882 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1884 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1885 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1886 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1887 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1888 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1889 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1890 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1891 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1892 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1893 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1894 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1896 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1898 val
= LGSTRING_GLYPH (gstring
, i
);
1900 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1902 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1904 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1905 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1906 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1907 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1908 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1909 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1910 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1911 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1913 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1915 if (ASIZE (val
) < 3)
1917 for (j
= 0; j
< 3; j
++)
1918 CHECK_NUMBER (AREF (val
, j
));
1923 error ("Invalid glyph-string format");
1928 check_otf_features (otf_features
)
1929 Lisp_Object otf_features
;
1933 CHECK_CONS (otf_features
);
1934 CHECK_SYMBOL (XCAR (otf_features
));
1935 otf_features
= XCDR (otf_features
);
1936 CHECK_CONS (otf_features
);
1937 CHECK_SYMBOL (XCAR (otf_features
));
1938 otf_features
= XCDR (otf_features
);
1939 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1941 CHECK_SYMBOL (Fcar (val
));
1942 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1943 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1945 otf_features
= XCDR (otf_features
);
1946 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1948 CHECK_SYMBOL (Fcar (val
));
1949 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1950 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1957 Lisp_Object otf_list
;
1960 otf_tag_symbol (tag
)
1965 OTF_tag_name (tag
, name
);
1966 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1973 Lisp_Object val
= Fassoc (file
, otf_list
);
1977 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1980 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1981 val
= make_save_value (otf
, 0);
1982 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1988 /* Return a list describing which scripts/languages FONT supports by
1989 which GSUB/GPOS features of OpenType tables. See the comment of
1990 (struct font_driver).otf_capability. */
1993 font_otf_capability (font
)
1997 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
2000 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
2003 for (i
= 0; i
< 2; i
++)
2005 OTF_GSUB_GPOS
*gsub_gpos
;
2006 Lisp_Object script_list
= Qnil
;
2009 if (OTF_get_features (otf
, i
== 0) < 0)
2011 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2012 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2014 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2015 Lisp_Object langsys_list
= Qnil
;
2016 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2019 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2021 OTF_LangSys
*langsys
;
2022 Lisp_Object feature_list
= Qnil
;
2023 Lisp_Object langsys_tag
;
2026 if (k
== script
->LangSysCount
)
2028 langsys
= &script
->DefaultLangSys
;
2033 langsys
= script
->LangSys
+ k
;
2035 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2037 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2039 OTF_Feature
*feature
2040 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2041 Lisp_Object feature_tag
2042 = otf_tag_symbol (feature
->FeatureTag
);
2044 feature_list
= Fcons (feature_tag
, feature_list
);
2046 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2049 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2054 XSETCAR (capability
, script_list
);
2056 XSETCDR (capability
, script_list
);
2062 /* Parse OTF features in SPEC and write a proper features spec string
2063 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2064 assured that the sufficient memory has already allocated for
2068 generate_otf_features (spec
, features
)
2078 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2084 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2089 else if (! asterisk
)
2091 val
= SYMBOL_NAME (val
);
2092 p
+= sprintf (p
, "%s", SDATA (val
));
2096 val
= SYMBOL_NAME (val
);
2097 p
+= sprintf (p
, "~%s", SDATA (val
));
2101 error ("OTF spec too long");
2105 font_otf_DeviceTable (device_table
)
2106 OTF_DeviceTable
*device_table
;
2108 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2110 return Fcons (make_number (len
),
2111 make_unibyte_string (device_table
->DeltaValue
, len
));
2115 font_otf_ValueRecord (value_format
, value_record
)
2117 OTF_ValueRecord
*value_record
;
2119 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2121 if (value_format
& OTF_XPlacement
)
2122 ASET (val
, 0, make_number (value_record
->XPlacement
));
2123 if (value_format
& OTF_YPlacement
)
2124 ASET (val
, 1, make_number (value_record
->YPlacement
));
2125 if (value_format
& OTF_XAdvance
)
2126 ASET (val
, 2, make_number (value_record
->XAdvance
));
2127 if (value_format
& OTF_YAdvance
)
2128 ASET (val
, 3, make_number (value_record
->YAdvance
));
2129 if (value_format
& OTF_XPlaDevice
)
2130 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2131 if (value_format
& OTF_YPlaDevice
)
2132 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2133 if (value_format
& OTF_XAdvDevice
)
2134 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2135 if (value_format
& OTF_YAdvDevice
)
2136 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2141 font_otf_Anchor (anchor
)
2146 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2147 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2148 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2149 if (anchor
->AnchorFormat
== 2)
2150 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2153 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2154 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2158 #endif /* HAVE_LIBOTF */
2161 /* G-string (glyph string) handler */
2163 /* G-string is a vector of the form [HEADER GLYPH ...].
2164 See the docstring of `font-make-gstring' for more detail. */
2167 font_prepare_composition (cmp
, f
)
2168 struct composition
*cmp
;
2172 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
2173 cmp
->hash_index
* 2);
2175 cmp
->font
= XFONT_OBJECT (LGSTRING_FONT (gstring
));
2176 cmp
->glyph_len
= LGSTRING_LENGTH (gstring
);
2177 cmp
->pixel_width
= LGSTRING_WIDTH (gstring
);
2178 cmp
->lbearing
= LGSTRING_LBEARING (gstring
);
2179 cmp
->rbearing
= LGSTRING_RBEARING (gstring
);
2180 cmp
->ascent
= LGSTRING_ASCENT (gstring
);
2181 cmp
->descent
= LGSTRING_DESCENT (gstring
);
2182 cmp
->width
= cmp
->pixel_width
/ FRAME_COLUMN_WIDTH (f
);
2183 if (cmp
->width
== 0)
2192 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2193 static int font_compare
P_ ((const void *, const void *));
2194 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
2197 /* We sort fonts by scoring each of them against a specified
2198 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2199 the value is, the closer the font is to the font-spec.
2201 The lowest 2 bits of the score is used for driver type. The font
2202 available by the most preferred font driver is 0.
2204 Each 7-bit in the higher 28 bits are used for numeric properties
2205 WEIGHT, SLANT, WIDTH, and SIZE. */
2207 /* How many bits to shift to store the difference value of each font
2208 property in a score. Note that flots for FONT_TYPE_INDEX and
2209 FONT_REGISTRY_INDEX are not used. */
2210 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2212 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2213 The return value indicates how different ENTITY is compared with
2217 font_score (entity
, spec_prop
)
2218 Lisp_Object entity
, *spec_prop
;
2223 /* Score three style numeric fields. Maximum difference is 127. */
2224 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2225 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2227 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2232 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2235 /* Score the size. Maximum difference is 127. */
2236 i
= FONT_SIZE_INDEX
;
2237 if (! NILP (spec_prop
[i
]) && XINT (AREF (entity
, i
)) > 0)
2239 /* We use the higher 6-bit for the actual size difference. The
2240 lowest bit is set if the DPI is different. */
2241 int diff
= XINT (spec_prop
[i
]) - XINT (AREF (entity
, i
));
2246 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2247 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2249 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2256 /* The comparison function for qsort. */
2259 font_compare (d1
, d2
)
2260 const void *d1
, *d2
;
2262 return (*(unsigned *) d1
- *(unsigned *) d2
);
2266 /* The structure for elements being sorted by qsort. */
2267 struct font_sort_data
2274 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2275 If PREFER specifies a point-size, calculate the corresponding
2276 pixel-size from QCdpi property of PREFER or from the Y-resolution
2277 of FRAME before sorting.
2279 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2280 return the sorted VEC. */
2283 font_sort_entites (vec
, prefer
, frame
, best_only
)
2284 Lisp_Object vec
, prefer
, frame
;
2287 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2289 struct font_sort_data
*data
;
2290 unsigned best_score
;
2291 Lisp_Object best_entity
, driver_type
;
2293 struct frame
*f
= XFRAME (frame
);
2294 struct font_driver_list
*list
;
2299 return best_only
? AREF (vec
, 0) : vec
;
2301 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_DPI_INDEX
; i
++)
2302 prefer_prop
[i
] = AREF (prefer
, i
);
2303 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2304 prefer_prop
[FONT_SIZE_INDEX
]
2305 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2307 /* Scoring and sorting. */
2308 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2309 best_score
= 0xFFFFFFFF;
2310 /* We are sure that the length of VEC > 1. */
2311 driver_type
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2312 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2313 driver_order
++, list
= list
->next
)
2314 if (EQ (driver_type
, list
->driver
->type
))
2316 best_entity
= data
[0].entity
= AREF (vec
, 0);
2317 best_score
= data
[0].score
2318 = font_score (data
[0].entity
, prefer_prop
) | driver_order
;
2319 for (i
= 0; i
< len
; i
++)
2321 if (!EQ (driver_type
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2322 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2323 driver_order
++, list
= list
->next
)
2324 if (EQ (driver_type
, list
->driver
->type
))
2326 data
[i
].entity
= AREF (vec
, i
);
2327 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
) | driver_order
;
2328 if (best_only
&& best_score
> data
[i
].score
)
2330 best_score
= data
[i
].score
;
2331 best_entity
= data
[i
].entity
;
2332 if (best_score
== 0)
2338 qsort (data
, len
, sizeof *data
, font_compare
);
2339 for (i
= 0; i
< len
; i
++)
2340 ASET (vec
, i
, data
[i
].entity
);
2346 font_add_log ("sort-by", prefer
, vec
);
2351 /* API of Font Service Layer. */
2353 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2354 sort_shift_bits. Finternal_set_font_selection_order calls this
2355 function with font_sort_order after setting up it. */
2358 font_update_sort_order (order
)
2363 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2365 int xlfd_idx
= order
[i
];
2367 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2368 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2369 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2370 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2371 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2372 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2374 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2379 font_check_otf_features (script
, langsys
, features
, table
)
2380 Lisp_Object script
, langsys
, features
, table
;
2385 table
= assq_no_quit (script
, table
);
2388 table
= XCDR (table
);
2389 if (! NILP (langsys
))
2391 table
= assq_no_quit (langsys
, table
);
2397 val
= assq_no_quit (Qnil
, table
);
2399 table
= XCAR (table
);
2403 table
= XCDR (table
);
2404 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2406 if (NILP (XCAR (features
)))
2408 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2414 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2417 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2419 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2421 script
= XCAR (spec
);
2425 langsys
= XCAR (spec
);
2436 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2437 XCAR (otf_capability
)))
2439 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2440 XCDR (otf_capability
)))
2447 /* Check if FONT (font-entity or font-object) matches with the font
2448 specification SPEC. */
2451 font_match_p (spec
, font
)
2452 Lisp_Object spec
, font
;
2454 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2455 Lisp_Object extra
, font_extra
;
2458 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2459 if (! NILP (AREF (spec
, i
))
2460 && ! NILP (AREF (font
, i
))
2461 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2463 props
= XFONT_SPEC (spec
)->props
;
2464 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2466 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2467 prop
[i
] = AREF (spec
, i
);
2468 prop
[FONT_SIZE_INDEX
]
2469 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2473 if (font_score (font
, props
) > 0)
2475 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2476 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2477 for (; CONSP (extra
); extra
= XCDR (extra
))
2479 Lisp_Object key
= XCAR (XCAR (extra
));
2480 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2482 if (EQ (key
, QClang
))
2484 val2
= assq_no_quit (key
, font_extra
);
2493 if (NILP (Fmemq (val
, val2
)))
2498 ? NILP (Fmemq (val
, XCDR (val2
)))
2502 else if (EQ (key
, QCscript
))
2504 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2506 for (val2
= XCDR (val2
); CONSP (val2
); val2
= XCDR (val2
))
2507 if (font_encode_char (font
, XINT (XCAR (val2
)))
2508 == FONT_INVALID_CODE
)
2511 else if (EQ (key
, QCotf
))
2515 if (! FONT_OBJECT_P (font
))
2517 fontp
= XFONT_OBJECT (font
);
2518 if (! fontp
->driver
->otf_capability
)
2520 val2
= fontp
->driver
->otf_capability (fontp
);
2521 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2532 Each font backend has the callback function get_cache, and it
2533 returns a cons cell of which cdr part can be freely used for
2534 caching fonts. The cons cell may be shared by multiple frames
2535 and/or multiple font drivers. So, we arrange the cdr part as this:
2537 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2539 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2540 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2541 cons (FONT-SPEC FONT-ENTITY ...). */
2543 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2544 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2545 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2546 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2547 struct font_driver
*));
2550 font_prepare_cache (f
, driver
)
2552 struct font_driver
*driver
;
2554 Lisp_Object cache
, val
;
2556 cache
= driver
->get_cache (f
);
2558 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2562 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2563 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2567 val
= XCDR (XCAR (val
));
2568 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2574 font_finish_cache (f
, driver
)
2576 struct font_driver
*driver
;
2578 Lisp_Object cache
, val
, tmp
;
2581 cache
= driver
->get_cache (f
);
2583 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2584 cache
= val
, val
= XCDR (val
);
2585 font_assert (! NILP (val
));
2586 tmp
= XCDR (XCAR (val
));
2587 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2588 if (XINT (XCAR (tmp
)) == 0)
2590 font_clear_cache (f
, XCAR (val
), driver
);
2591 XSETCDR (cache
, XCDR (val
));
2597 font_get_cache (f
, driver
)
2599 struct font_driver
*driver
;
2601 Lisp_Object val
= driver
->get_cache (f
);
2602 Lisp_Object type
= driver
->type
;
2604 font_assert (CONSP (val
));
2605 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2606 font_assert (CONSP (val
));
2607 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2608 val
= XCDR (XCAR (val
));
2612 static int num_fonts
;
2615 font_clear_cache (f
, cache
, driver
)
2618 struct font_driver
*driver
;
2620 Lisp_Object tail
, elt
;
2622 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2623 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2626 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)) && VECTORP (XCDR (elt
)))
2628 Lisp_Object vec
= XCDR (elt
);
2631 for (i
= 0; i
< ASIZE (vec
); i
++)
2633 Lisp_Object entity
= AREF (vec
, i
);
2635 if (EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2637 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2639 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2641 Lisp_Object val
= XCAR (objlist
);
2642 struct font
*font
= XFONT_OBJECT (val
);
2644 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2646 font_assert (font
&& driver
== font
->driver
);
2647 driver
->close (f
, font
);
2651 if (driver
->free_entity
)
2652 driver
->free_entity (entity
);
2657 XSETCDR (cache
, Qnil
);
2661 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2664 font_delete_unmatched (list
, spec
, size
)
2665 Lisp_Object list
, spec
;
2668 Lisp_Object entity
, val
;
2669 enum font_property_index prop
;
2671 for (val
= Qnil
; CONSP (list
); list
= XCDR (list
))
2673 entity
= XCAR (list
);
2674 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2675 if (INTEGERP (AREF (spec
, prop
))
2676 && ((XINT (AREF (spec
, prop
)) >> 8)
2677 != (XINT (AREF (entity
, prop
)) >> 8)))
2678 prop
= FONT_SPEC_MAX
;
2679 if (prop
< FONT_SPEC_MAX
2681 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2683 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2686 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2687 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2688 prop
= FONT_SPEC_MAX
;
2690 if (prop
< FONT_SPEC_MAX
2691 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2692 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2693 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2694 prop
= FONT_SPEC_MAX
;
2695 if (prop
< FONT_SPEC_MAX
2696 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2697 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2698 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2699 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2700 prop
= FONT_SPEC_MAX
;
2701 if (prop
< FONT_SPEC_MAX
)
2702 val
= Fcons (entity
, val
);
2708 /* Return a vector of font-entities matching with SPEC on FRAME. */
2711 font_list_entities (frame
, spec
)
2712 Lisp_Object frame
, spec
;
2714 FRAME_PTR f
= XFRAME (frame
);
2715 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2716 Lisp_Object ftype
, val
;
2719 int need_filtering
= 0;
2722 font_assert (FONT_SPEC_P (spec
));
2724 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2725 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2726 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2727 size
= font_pixel_size (f
, spec
);
2731 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2732 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2733 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2734 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2736 ASET (scratch_font_spec
, i
, Qnil
);
2737 if (! NILP (AREF (spec
, i
)))
2739 if (i
== FONT_DPI_INDEX
)
2740 /* Skip FONT_SPACING_INDEX */
2743 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2744 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2746 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2750 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2752 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2754 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2756 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2757 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2764 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2765 copy
= Fcopy_font_spec (scratch_font_spec
);
2766 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2767 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2769 if (! NILP (val
) && need_filtering
)
2770 val
= font_delete_unmatched (val
, spec
, size
);
2775 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2776 font_add_log ("list", spec
, val
);
2781 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2782 nil, is an array of face's attributes, which specifies preferred
2783 font-related attributes. */
2786 font_matching_entity (f
, attrs
, spec
)
2788 Lisp_Object
*attrs
, spec
;
2790 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2791 Lisp_Object ftype
, size
, entity
;
2794 XSETFRAME (frame
, f
);
2795 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2796 size
= AREF (spec
, FONT_SIZE_INDEX
);
2798 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2800 for (; driver_list
; driver_list
= driver_list
->next
)
2802 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2804 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2807 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2808 entity
= assoc_no_quit (spec
, XCDR (cache
));
2810 entity
= XCDR (entity
);
2813 entity
= driver_list
->driver
->match (frame
, spec
);
2814 copy
= Fcopy_font_spec (spec
);
2815 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2816 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2818 if (! NILP (entity
))
2821 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2822 ASET (spec
, FONT_SIZE_INDEX
, size
);
2823 font_add_log ("match", spec
, entity
);
2828 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2829 opened font object. */
2832 font_open_entity (f
, entity
, pixel_size
)
2837 struct font_driver_list
*driver_list
;
2838 Lisp_Object objlist
, size
, val
, font_object
;
2840 int min_width
, height
;
2842 font_assert (FONT_ENTITY_P (entity
));
2843 size
= AREF (entity
, FONT_SIZE_INDEX
);
2844 if (XINT (size
) != 0)
2845 pixel_size
= XINT (size
);
2847 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2848 objlist
= XCDR (objlist
))
2849 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2850 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2851 return XCAR (objlist
);
2853 val
= AREF (entity
, FONT_TYPE_INDEX
);
2854 for (driver_list
= f
->font_driver_list
;
2855 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2856 driver_list
= driver_list
->next
);
2860 font_object
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2861 font_add_log ("open", entity
, font_object
);
2862 if (NILP (font_object
))
2864 ASET (entity
, FONT_OBJLIST_INDEX
,
2865 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2866 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
2869 font
= XFONT_OBJECT (font_object
);
2870 min_width
= (font
->min_width
? font
->min_width
2871 : font
->average_width
? font
->average_width
2872 : font
->space_width
? font
->space_width
2874 height
= (font
->height
? font
->height
: 1);
2875 #ifdef HAVE_WINDOW_SYSTEM
2876 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2877 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2879 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2880 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2881 fonts_changed_p
= 1;
2885 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2886 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2887 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2888 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2896 /* Close FONT_OBJECT that is opened on frame F. */
2899 font_close_object (f
, font_object
)
2901 Lisp_Object font_object
;
2903 struct font
*font
= XFONT_OBJECT (font_object
);
2905 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2906 /* Already closed. */
2908 font_add_log ("close", font_object
, Qnil
);
2909 font
->driver
->close (f
, font
);
2910 #ifdef HAVE_WINDOW_SYSTEM
2911 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2912 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2918 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2919 FONT is a font-entity and it must be opened to check. */
2922 font_has_char (f
, font
, c
)
2929 if (FONT_ENTITY_P (font
))
2931 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2932 struct font_driver_list
*driver_list
;
2934 for (driver_list
= f
->font_driver_list
;
2935 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2936 driver_list
= driver_list
->next
);
2939 if (! driver_list
->driver
->has_char
)
2941 return driver_list
->driver
->has_char (font
, c
);
2944 font_assert (FONT_OBJECT_P (font
));
2945 fontp
= XFONT_OBJECT (font
);
2946 if (fontp
->driver
->has_char
)
2948 int result
= fontp
->driver
->has_char (font
, c
);
2953 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2957 /* Return the glyph ID of FONT_OBJECT for character C. */
2960 font_encode_char (font_object
, c
)
2961 Lisp_Object font_object
;
2966 font_assert (FONT_OBJECT_P (font_object
));
2967 font
= XFONT_OBJECT (font_object
);
2968 return font
->driver
->encode_char (font
, c
);
2972 /* Return the name of FONT_OBJECT. */
2975 font_get_name (font_object
)
2976 Lisp_Object font_object
;
2978 font_assert (FONT_OBJECT_P (font_object
));
2979 return AREF (font_object
, FONT_NAME_INDEX
);
2983 /* Return the specification of FONT_OBJECT. */
2986 font_get_spec (font_object
)
2987 Lisp_Object font_object
;
2989 Lisp_Object spec
= font_make_spec ();
2992 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2993 ASET (spec
, i
, AREF (font_object
, i
));
2994 ASET (spec
, FONT_SIZE_INDEX
,
2995 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
3000 font_spec_from_name (font_name
)
3001 Lisp_Object font_name
;
3003 Lisp_Object args
[2];
3006 args
[1] = font_name
;
3007 return Ffont_spec (2, args
);
3012 font_clear_prop (attrs
, prop
)
3014 enum font_property_index prop
;
3016 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3020 if (NILP (AREF (font
, prop
))
3021 && prop
!= FONT_FAMILY_INDEX
&& prop
!= FONT_FOUNDRY_INDEX
3022 && prop
!= FONT_SIZE_INDEX
)
3024 font
= Fcopy_font_spec (font
);
3025 ASET (font
, prop
, Qnil
);
3026 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3028 if (prop
== FONT_FAMILY_INDEX
)
3029 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3030 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3031 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3032 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3033 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3034 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3035 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3037 else if (prop
== FONT_SIZE_INDEX
)
3039 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3040 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3041 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3043 attrs
[LFACE_FONT_INDEX
] = font
;
3047 font_update_lface (f
, attrs
)
3053 spec
= attrs
[LFACE_FONT_INDEX
];
3054 if (! FONT_SPEC_P (spec
))
3057 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3058 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3059 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3060 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3061 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3062 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3063 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3064 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);;
3065 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3066 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3067 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3071 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3076 val
= Ffont_get (spec
, QCdpi
);
3079 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3082 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3083 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3084 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3089 /* Return a font-entity satisfying SPEC and best matching with face's
3090 font related attributes in ATTRS. C, if not negative, is a
3091 character that the entity must support. */
3094 font_find_for_lface (f
, attrs
, spec
, c
)
3101 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
3102 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3104 int i
, j
, k
, l
, result
;
3106 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3107 if (NILP (registry
[0]))
3109 registry
[0] = DEFAULT_ENCODING
;
3110 registry
[1] = Qascii_0
;
3111 registry
[2] = null_vector
;
3114 registry
[1] = null_vector
;
3116 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3118 struct charset
*encoding
, *repertory
;
3120 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3121 &encoding
, &repertory
) < 0)
3125 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3127 /* Any font of this registry support C. So, let's
3128 suppress the further checking. */
3131 else if (c
> encoding
->max_char
)
3135 work
= Fcopy_font_spec (spec
);
3136 XSETFRAME (frame
, f
);
3137 size
= AREF (spec
, FONT_SIZE_INDEX
);
3138 pixel_size
= font_pixel_size (f
, spec
);
3139 if (pixel_size
== 0)
3141 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3143 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3145 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3146 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3147 if (! NILP (foundry
[0]))
3148 foundry
[1] = null_vector
;
3149 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3151 foundry
[0] = font_intern_prop (SDATA (attrs
[LFACE_FOUNDRY_INDEX
]),
3152 SBYTES (attrs
[LFACE_FOUNDRY_INDEX
]), 1);
3154 foundry
[2] = null_vector
;
3157 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3159 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3160 if (! NILP (adstyle
[0]))
3161 adstyle
[1] = null_vector
;
3162 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3164 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3166 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3168 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3170 adstyle
[2] = null_vector
;
3173 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3176 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3179 val
= AREF (work
, FONT_FAMILY_INDEX
);
3180 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3181 val
= font_intern_prop (SDATA (attrs
[LFACE_FAMILY_INDEX
]),
3182 SBYTES (attrs
[LFACE_FAMILY_INDEX
]), 1);
3185 family
= alloca ((sizeof family
[0]) * 2);
3187 family
[1] = null_vector
; /* terminator. */
3192 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3194 if (! NILP (alters
))
3196 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3197 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3198 family
[i
] = XCAR (alters
);
3199 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3201 family
[i
] = null_vector
;
3205 family
= alloca ((sizeof family
[0]) * 3);
3208 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3210 family
[i
] = null_vector
;
3214 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3216 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3217 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3219 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3220 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3222 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3223 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3225 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3226 entities
= font_list_entities (frame
, work
);
3227 if (ASIZE (entities
) > 0)
3235 if (ASIZE (entities
) == 1)
3238 return AREF (entities
, 0);
3242 /* Sort fonts by properties specified in LFACE. */
3243 Lisp_Object prefer
= scratch_font_prefer
;
3245 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3246 ASET (prefer
, i
, AREF (work
, i
));
3247 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3249 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3251 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3252 if (NILP (AREF (prefer
, i
)))
3253 ASET (prefer
, i
, AREF (face_font
, i
));
3255 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3256 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3257 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3258 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3259 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3260 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3261 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3262 entities
= font_sort_entites (entities
, prefer
, frame
, c
< 0);
3267 for (i
= 0; i
< ASIZE (entities
); i
++)
3271 val
= AREF (entities
, i
);
3274 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3275 if (! EQ (AREF (val
, j
), props
[j
]))
3277 if (j
> FONT_REGISTRY_INDEX
)
3280 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3281 props
[j
] = AREF (val
, j
);
3282 result
= font_has_char (f
, val
, c
);
3287 val
= font_open_for_lface (f
, val
, attrs
, spec
);
3290 result
= font_has_char (f
, val
, c
);
3291 font_close_object (f
, val
);
3293 return AREF (entities
, i
);
3300 font_open_for_lface (f
, entity
, attrs
, spec
)
3308 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3309 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3310 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3311 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3312 size
= font_pixel_size (f
, spec
);
3315 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3318 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3320 return font_open_entity (f
, entity
, size
);
3324 /* Find a font satisfying SPEC and best matching with face's
3325 attributes in ATTRS on FRAME, and return the opened
3329 font_load_for_lface (f
, attrs
, spec
)
3331 Lisp_Object
*attrs
, spec
;
3335 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3338 /* No font is listed for SPEC, but each font-backend may have
3339 the different criteria about "font matching". So, try
3341 entity
= font_matching_entity (f
, attrs
, spec
);
3345 return font_open_for_lface (f
, entity
, attrs
, spec
);
3349 /* Make FACE on frame F ready to use the font opened for FACE. */
3352 font_prepare_for_face (f
, face
)
3356 if (face
->font
->driver
->prepare_face
)
3357 face
->font
->driver
->prepare_face (f
, face
);
3361 /* Make FACE on frame F stop using the font opened for FACE. */
3364 font_done_for_face (f
, face
)
3368 if (face
->font
->driver
->done_face
)
3369 face
->font
->driver
->done_face (f
, face
);
3374 /* Open a font best matching with NAME on frame F. If no proper font
3375 is found, return Qnil. */
3378 font_open_by_name (f
, name
)
3382 Lisp_Object args
[2];
3383 Lisp_Object spec
, attrs
[LFACE_VECTOR_SIZE
];
3386 args
[1] = make_unibyte_string (name
, strlen (name
));
3387 spec
= Ffont_spec (2, args
);
3388 /* We set up the default font-related attributes of a face to prefer
3390 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3391 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3392 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3393 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3394 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3396 return font_load_for_lface (f
, attrs
, spec
);
3400 /* Register font-driver DRIVER. This function is used in two ways.
3402 The first is with frame F non-NULL. In this case, make DRIVER
3403 available (but not yet activated) on F. All frame creaters
3404 (e.g. Fx_create_frame) must call this function at least once with
3405 an available font-driver.
3407 The second is with frame F NULL. In this case, DRIVER is globally
3408 registered in the variable `font_driver_list'. All font-driver
3409 implementations must call this function in its syms_of_XXXX
3410 (e.g. syms_of_xfont). */
3413 register_font_driver (driver
, f
)
3414 struct font_driver
*driver
;
3417 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3418 struct font_driver_list
*prev
, *list
;
3420 if (f
&& ! driver
->draw
)
3421 error ("Unusable font driver for a frame: %s",
3422 SDATA (SYMBOL_NAME (driver
->type
)));
3424 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3425 if (EQ (list
->driver
->type
, driver
->type
))
3426 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3428 list
= malloc (sizeof (struct font_driver_list
));
3430 list
->driver
= driver
;
3435 f
->font_driver_list
= list
;
3437 font_driver_list
= list
;
3443 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3444 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3445 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3447 A caller must free all realized faces if any in advance. The
3448 return value is a list of font backends actually made used on
3452 font_update_drivers (f
, new_drivers
)
3454 Lisp_Object new_drivers
;
3456 Lisp_Object active_drivers
= Qnil
;
3457 struct font_driver
*driver
;
3458 struct font_driver_list
*list
;
3460 /* At first, turn off non-requested drivers, and turn on requested
3462 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3464 driver
= list
->driver
;
3465 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3470 if (driver
->end_for_frame
)
3471 driver
->end_for_frame (f
);
3472 font_finish_cache (f
, driver
);
3477 if (! driver
->start_for_frame
3478 || driver
->start_for_frame (f
) == 0)
3480 font_prepare_cache (f
, driver
);
3487 if (NILP (new_drivers
))
3490 if (! EQ (new_drivers
, Qt
))
3492 /* Re-order the driver list according to new_drivers. */
3493 struct font_driver_list
**list_table
, **next
;
3497 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3498 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3500 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3501 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3504 list_table
[i
++] = list
;
3506 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3508 list_table
[i
] = list
;
3509 list_table
[i
] = NULL
;
3511 next
= &f
->font_driver_list
;
3512 for (i
= 0; list_table
[i
]; i
++)
3514 *next
= list_table
[i
];
3515 next
= &(*next
)->next
;
3520 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3522 active_drivers
= nconc2 (active_drivers
,
3523 Fcons (list
->driver
->type
, Qnil
));
3524 return active_drivers
;
3528 font_put_frame_data (f
, driver
, data
)
3530 struct font_driver
*driver
;
3533 struct font_data_list
*list
, *prev
;
3535 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3536 prev
= list
, list
= list
->next
)
3537 if (list
->driver
== driver
)
3544 prev
->next
= list
->next
;
3546 f
->font_data_list
= list
->next
;
3554 list
= malloc (sizeof (struct font_data_list
));
3557 list
->driver
= driver
;
3558 list
->next
= f
->font_data_list
;
3559 f
->font_data_list
= list
;
3567 font_get_frame_data (f
, driver
)
3569 struct font_driver
*driver
;
3571 struct font_data_list
*list
;
3573 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3574 if (list
->driver
== driver
)
3582 /* Return the font used to draw character C by FACE at buffer position
3583 POS in window W. If STRING is non-nil, it is a string containing C
3584 at index POS. If C is negative, get C from the current buffer or
3588 font_at (c
, pos
, face
, w
, string
)
3597 Lisp_Object font_object
;
3603 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3606 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3608 c
= FETCH_CHAR (pos_byte
);
3611 c
= FETCH_BYTE (pos
);
3617 multibyte
= STRING_MULTIBYTE (string
);
3620 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3622 str
= SDATA (string
) + pos_byte
;
3623 c
= STRING_CHAR (str
, 0);
3626 c
= SDATA (string
)[pos
];
3630 f
= XFRAME (w
->frame
);
3631 if (! FRAME_WINDOW_P (f
))
3638 if (STRINGP (string
))
3639 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3640 DEFAULT_FACE_ID
, 0);
3642 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3644 face
= FACE_FROM_ID (f
, face_id
);
3648 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3649 face
= FACE_FROM_ID (f
, face_id
);
3654 XSETFONT (font_object
, face
->font
);
3659 /* Check how many characters after POS (at most to LIMIT) can be
3660 displayed by the same font. FACE is the face selected for the
3661 character as POS on frame F. STRING, if not nil, is the string to
3662 check instead of the current buffer.
3664 The return value is the position of the character that is displayed
3665 by the differnt font than that of the character as POS. */
3668 font_range (pos
, limit
, face
, f
, string
)
3669 EMACS_INT pos
, limit
;
3682 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3683 pos_byte
= CHAR_TO_BYTE (pos
);
3687 multibyte
= STRING_MULTIBYTE (string
);
3688 pos_byte
= string_char_to_byte (string
, pos
);
3692 /* All unibyte character are displayed by the same font. */
3700 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3702 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3703 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3704 face
= FACE_FROM_ID (f
, face_id
);
3711 else if (font
!= face
->font
)
3723 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3724 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3725 Return nil otherwise.
3726 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3727 which kind of font it is. It must be one of `font-spec', `font-entity',
3729 (object
, extra_type
)
3730 Lisp_Object object
, extra_type
;
3732 if (NILP (extra_type
))
3733 return (FONTP (object
) ? Qt
: Qnil
);
3734 if (EQ (extra_type
, Qfont_spec
))
3735 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3736 if (EQ (extra_type
, Qfont_entity
))
3737 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3738 if (EQ (extra_type
, Qfont_object
))
3739 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3740 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3743 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3744 doc
: /* Return a newly created font-spec with arguments as properties.
3746 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3747 valid font property name listed below:
3749 `:family', `:weight', `:slant', `:width'
3751 They are the same as face attributes of the same name. See
3752 `set-face-attribute'.
3756 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3760 VALUE must be a string or a symbol specifying the additional
3761 typographic style information of a font, e.g. ``sans''.
3765 VALUE must be a string or a symbol specifying the charset registry and
3766 encoding of a font, e.g. ``iso8859-1''.
3770 VALUE must be a non-negative integer or a floating point number
3771 specifying the font size. It specifies the font size in pixels
3772 (if VALUE is an integer), or in points (if VALUE is a float).
3776 VALUE must be a string of XLFD-style or fontconfig-style font name.
3777 usage: (font-spec ARGS ...) */)
3782 Lisp_Object spec
= font_make_spec ();
3785 for (i
= 0; i
< nargs
; i
+= 2)
3787 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3789 if (EQ (key
, QCname
))
3792 font_parse_name ((char *) SDATA (val
), spec
);
3793 font_put_extra (spec
, key
, val
);
3797 int idx
= get_font_prop_index (key
);
3801 val
= font_prop_validate (idx
, Qnil
, val
);
3802 if (idx
< FONT_EXTRA_INDEX
)
3803 ASET (spec
, idx
, val
);
3805 font_put_extra (spec
, key
, val
);
3808 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3814 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3815 doc
: /* Return a copy of FONT as a font-spec. */)
3819 Lisp_Object new_spec
, tail
, prev
, extra
;
3823 new_spec
= font_make_spec ();
3824 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3825 ASET (new_spec
, i
, AREF (font
, i
));
3826 extra
= Fcopy_sequence (AREF (font
, FONT_EXTRA_INDEX
));
3827 /* We must remove :font-entity property. */
3828 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3829 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3832 extra
= XCDR (extra
);
3834 XSETCDR (prev
, XCDR (tail
));
3837 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3841 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3842 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3843 Every specified properties in FROM override the corresponding
3844 properties in TO. */)
3846 Lisp_Object from
, to
;
3848 Lisp_Object extra
, tail
;
3853 to
= Fcopy_font_spec (to
);
3854 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3855 ASET (to
, i
, AREF (from
, i
));
3856 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3857 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3858 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3860 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3863 XSETCDR (slot
, XCDR (XCAR (tail
)));
3865 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3867 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3871 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3872 doc
: /* Return the value of FONT's property KEY.
3873 FONT is a font-spec, a font-entity, or a font-object. */)
3875 Lisp_Object font
, key
;
3882 idx
= get_font_prop_index (key
);
3883 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3884 return font_style_symbolic (font
, idx
, 0);
3885 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3886 return AREF (font
, idx
);
3887 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3890 #ifdef HAVE_WINDOW_SYSTEM
3892 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3893 doc
: /* Return a plist of face attributes generated by FONT.
3894 FONT is a font name, a font-spec, a font-entity, or a font-object.
3895 The return value is a list of the form
3897 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3899 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3900 compatible with `set-face-attribute'. Some of these key-attribute pairs
3901 may be omitted from the list if they are not specified by FONT.
3903 The optional argument FRAME specifies the frame that the face attributes
3904 are to be displayed on. If omitted, the selected frame is used. */)
3906 Lisp_Object font
, frame
;
3909 Lisp_Object plist
[10];
3914 frame
= selected_frame
;
3915 CHECK_LIVE_FRAME (frame
);
3920 int fontset
= fs_query_fontset (font
, 0);
3921 Lisp_Object name
= font
;
3923 font
= fontset_ascii (fontset
);
3924 font
= font_spec_from_name (name
);
3926 signal_error ("Invalid font name", name
);
3928 else if (! FONTP (font
))
3929 signal_error ("Invalid font object", font
);
3931 val
= AREF (font
, FONT_FAMILY_INDEX
);
3934 plist
[n
++] = QCfamily
;
3935 plist
[n
++] = SYMBOL_NAME (val
);
3938 val
= AREF (font
, FONT_SIZE_INDEX
);
3941 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
3942 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
3943 plist
[n
++] = QCheight
;
3944 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
3946 else if (FLOATP (val
))
3948 plist
[n
++] = QCheight
;
3949 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
3952 val
= FONT_WEIGHT_FOR_FACE (font
);
3955 plist
[n
++] = QCweight
;
3959 val
= FONT_SLANT_FOR_FACE (font
);
3962 plist
[n
++] = QCslant
;
3966 val
= FONT_WIDTH_FOR_FACE (font
);
3969 plist
[n
++] = QCwidth
;
3973 return Flist (n
, plist
);
3978 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3979 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
3980 (font_spec
, prop
, val
)
3981 Lisp_Object font_spec
, prop
, val
;
3985 CHECK_FONT_SPEC (font_spec
);
3986 idx
= get_font_prop_index (prop
);
3987 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3988 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
3990 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
3994 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3995 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3996 Optional 2nd argument FRAME specifies the target frame.
3997 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3998 Optional 4th argument PREFER, if non-nil, is a font-spec to
3999 control the order of the returned list. Fonts are sorted by
4000 how close they are to PREFER. */)
4001 (font_spec
, frame
, num
, prefer
)
4002 Lisp_Object font_spec
, frame
, num
, prefer
;
4004 Lisp_Object vec
, list
, tail
;
4008 frame
= selected_frame
;
4009 CHECK_LIVE_FRAME (frame
);
4010 CHECK_FONT_SPEC (font_spec
);
4018 if (! NILP (prefer
))
4019 CHECK_FONT_SPEC (prefer
);
4021 vec
= font_list_entities (frame
, font_spec
);
4026 return Fcons (AREF (vec
, 0), Qnil
);
4028 if (! NILP (prefer
))
4029 vec
= font_sort_entites (vec
, prefer
, frame
, 0);
4031 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
4032 if (n
== 0 || n
> len
)
4034 for (i
= 1; i
< n
; i
++)
4036 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
4038 XSETCDR (tail
, val
);
4044 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4045 doc
: /* List available font families on the current frame.
4046 Optional argument FRAME, if non-nil, specifies the target frame. */)
4051 struct font_driver_list
*driver_list
;
4055 frame
= selected_frame
;
4056 CHECK_LIVE_FRAME (frame
);
4059 for (driver_list
= f
->font_driver_list
; driver_list
;
4060 driver_list
= driver_list
->next
)
4061 if (driver_list
->driver
->list_family
)
4063 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4069 Lisp_Object tail
= list
;
4071 for (; CONSP (val
); val
= XCDR (val
))
4072 if (NILP (Fmemq (XCAR (val
), tail
)))
4073 list
= Fcons (XCAR (val
), list
);
4079 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4080 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4081 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4083 Lisp_Object font_spec
, frame
;
4085 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4092 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4093 doc
: /* Return XLFD name of FONT.
4094 FONT is a font-spec, font-entity, or font-object.
4095 If the name is too long for XLFD (maximum 255 chars), return nil.
4096 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4097 the consecutive wildcards are folded to one. */)
4098 (font
, fold_wildcards
)
4099 Lisp_Object font
, fold_wildcards
;
4106 if (FONT_OBJECT_P (font
))
4108 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4110 if (STRINGP (font_name
)
4111 && SDATA (font_name
)[0] == '-')
4113 if (NILP (fold_wildcards
))
4115 strcpy (name
, (char *) SDATA (font_name
));
4118 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4120 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4123 if (! NILP (fold_wildcards
))
4125 char *p0
= name
, *p1
;
4127 while ((p1
= strstr (p0
, "-*-*")))
4129 strcpy (p1
, p1
+ 2);
4134 return build_string (name
);
4137 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4138 doc
: /* Clear font cache. */)
4141 Lisp_Object list
, frame
;
4143 FOR_EACH_FRAME (list
, frame
)
4145 FRAME_PTR f
= XFRAME (frame
);
4146 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4148 for (; driver_list
; driver_list
= driver_list
->next
)
4149 if (driver_list
->on
)
4151 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4156 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4158 font_assert (! NILP (val
));
4159 val
= XCDR (XCAR (val
));
4160 if (XINT (XCAR (val
)) == 0)
4162 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4163 XSETCDR (cache
, XCDR (val
));
4171 /* The following three functions are still experimental. */
4173 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
4174 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
4175 FONT-OBJECT may be nil if it is not yet known.
4177 G-string is sequence of glyphs of a specific font,
4178 and is a vector of this form:
4179 [ HEADER GLYPH ... ]
4180 HEADER is a vector of this form:
4181 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
4183 FONT-OBJECT is a font-object for all glyphs in the g-string,
4184 WIDTH thru DESCENT are the metrics (in pixels) of the whole G-string.
4185 GLYPH is a vector of this form:
4186 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
4187 [ [X-OFF Y-OFF WADJUST] | nil] ]
4189 FROM-IDX and TO-IDX are used internally and should not be touched.
4190 C is the character of the glyph.
4191 CODE is the glyph-code of C in FONT-OBJECT.
4192 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4193 X-OFF and Y-OFF are offests to the base position for the glyph.
4194 WADJUST is the adjustment to the normal width of the glyph. */)
4196 Lisp_Object font_object
, num
;
4198 Lisp_Object gstring
, g
;
4202 if (! NILP (font_object
))
4203 CHECK_FONT_OBJECT (font_object
);
4206 len
= XINT (num
) + 1;
4207 gstring
= Fmake_vector (make_number (len
), Qnil
);
4208 g
= Fmake_vector (make_number (6), Qnil
);
4209 ASET (g
, 0, font_object
);
4210 ASET (gstring
, 0, g
);
4211 for (i
= 1; i
< len
; i
++)
4212 ASET (gstring
, i
, Fmake_vector (make_number (10), Qnil
));
4216 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
4217 doc
: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
4218 START and END specify the region to extract characters.
4219 If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
4220 where to extract characters.
4221 FONT-OBJECT may be nil if GSTRING already contains one. */)
4222 (gstring
, font_object
, start
, end
, object
)
4223 Lisp_Object gstring
, font_object
, start
, end
, object
;
4229 CHECK_VECTOR (gstring
);
4230 if (NILP (font_object
))
4231 font_object
= LGSTRING_FONT (gstring
);
4232 font
= XFONT_OBJECT (font_object
);
4234 if (STRINGP (object
))
4236 const unsigned char *p
;
4238 CHECK_NATNUM (start
);
4240 if (XINT (start
) > XINT (end
)
4241 || XINT (end
) > ASIZE (object
)
4242 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
4243 args_out_of_range_3 (object
, start
, end
);
4245 len
= XINT (end
) - XINT (start
);
4246 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
4247 for (i
= 0; i
< len
; i
++)
4249 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4250 /* Shut up GCC warning in comparison with
4251 MOST_POSITIVE_FIXNUM below. */
4254 c
= STRING_CHAR_ADVANCE (p
);
4255 cod
= code
= font
->driver
->encode_char (font
, c
);
4256 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
4258 LGLYPH_SET_FROM (g
, i
);
4259 LGLYPH_SET_TO (g
, i
);
4260 LGLYPH_SET_CHAR (g
, c
);
4261 LGLYPH_SET_CODE (g
, code
);
4268 if (! NILP (object
))
4269 Fset_buffer (object
);
4270 validate_region (&start
, &end
);
4271 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
4272 args_out_of_range (start
, end
);
4273 len
= XINT (end
) - XINT (start
);
4275 pos_byte
= CHAR_TO_BYTE (pos
);
4276 for (i
= 0; i
< len
; i
++)
4278 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4279 /* Shut up GCC warning in comparison with
4280 MOST_POSITIVE_FIXNUM below. */
4283 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
4284 cod
= code
= font
->driver
->encode_char (font
, c
);
4285 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
4287 LGLYPH_SET_FROM (g
, i
);
4288 LGLYPH_SET_TO (g
, i
);
4289 LGLYPH_SET_CHAR (g
, c
);
4290 LGLYPH_SET_CODE (g
, code
);
4293 for (; i
< LGSTRING_LENGTH (gstring
); i
++)
4294 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
4298 DEFUN ("font-shape-text", Ffont_shape_text
, Sfont_shape_text
, 3, 4, 0,
4299 doc
: /* Shape text between FROM and TO by FONT-OBJECT.
4300 If optional 4th argument STRING is non-nil, it is a string to shape,
4301 and FROM and TO are indices to the string.
4302 The value is the end position of the text that can be shaped by
4304 (from
, to
, font_object
, string
)
4305 Lisp_Object from
, to
, font_object
, string
;
4308 struct font_metrics metrics
;
4309 EMACS_INT start
, end
;
4310 Lisp_Object gstring
, n
;
4313 if (! FONT_OBJECT_P (font_object
))
4315 font
= XFONT_OBJECT (font_object
);
4316 if (! font
->driver
->shape
)
4321 validate_region (&from
, &to
);
4322 start
= XFASTINT (from
);
4323 end
= XFASTINT (to
);
4324 modify_region (current_buffer
, start
, end
, 0);
4328 CHECK_STRING (string
);
4329 start
= XINT (from
);
4331 if (start
< 0 || start
> end
|| end
> SCHARS (string
))
4332 args_out_of_range_3 (string
, from
, to
);
4336 gstring
= Ffont_make_gstring (font_object
, make_number (len
));
4337 Ffont_fill_gstring (gstring
, font_object
, from
, to
, string
);
4339 /* Try at most three times with larger gstring each time. */
4340 for (i
= 0; i
< 3; i
++)
4342 Lisp_Object args
[2];
4344 n
= font
->driver
->shape (gstring
);
4348 args
[1] = Fmake_vector (make_number (len
), Qnil
);
4349 gstring
= Fvconcat (2, args
);
4351 if (! INTEGERP (n
) || XINT (n
) == 0)
4355 for (i
= 0; i
< len
;)
4358 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4359 EMACS_INT this_from
= LGLYPH_FROM (g
);
4360 EMACS_INT this_to
= LGLYPH_TO (g
) + 1;
4362 int need_composition
= 0;
4364 metrics
.lbearing
= LGLYPH_LBEARING (g
);
4365 metrics
.rbearing
= LGLYPH_RBEARING (g
);
4366 metrics
.ascent
= LGLYPH_ASCENT (g
);
4367 metrics
.descent
= LGLYPH_DESCENT (g
);
4368 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4370 metrics
.width
= LGLYPH_WIDTH (g
);
4371 if (LGLYPH_CHAR (g
) == 0 || metrics
.width
== 0)
4372 need_composition
= 1;
4376 metrics
.width
= LGLYPH_WADJUST (g
);
4377 metrics
.lbearing
+= LGLYPH_XOFF (g
);
4378 metrics
.rbearing
+= LGLYPH_XOFF (g
);
4379 metrics
.ascent
-= LGLYPH_YOFF (g
);
4380 metrics
.descent
+= LGLYPH_YOFF (g
);
4381 need_composition
= 1;
4383 for (j
= i
+ 1; j
< len
; j
++)
4387 g
= LGSTRING_GLYPH (gstring
, j
);
4388 if (this_from
!= LGLYPH_FROM (g
))
4390 need_composition
= 1;
4391 x
= metrics
.width
+ LGLYPH_LBEARING (g
) + LGLYPH_XOFF (g
);
4392 if (metrics
.lbearing
> x
)
4393 metrics
.lbearing
= x
;
4394 x
= metrics
.width
+ LGLYPH_RBEARING (g
) + LGLYPH_XOFF (g
);
4395 if (metrics
.rbearing
< x
)
4396 metrics
.rbearing
= x
;
4397 x
= LGLYPH_ASCENT (g
) - LGLYPH_YOFF (g
);
4398 if (metrics
.ascent
< x
)
4400 x
= LGLYPH_DESCENT (g
) - LGLYPH_YOFF (g
);
4401 if (metrics
.descent
< x
)
4402 metrics
.descent
= x
;
4403 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4404 metrics
.width
+= LGLYPH_WIDTH (g
);
4406 metrics
.width
+= LGLYPH_WADJUST (g
);
4409 if (need_composition
)
4411 gstr
= Ffont_make_gstring (font_object
, make_number (j
- i
));
4412 LGSTRING_SET_WIDTH (gstr
, metrics
.width
);
4413 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
4414 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
);
4415 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
4416 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
4417 for (k
= i
; i
< j
; i
++)
4419 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4421 LGLYPH_SET_FROM (g
, LGLYPH_FROM (g
) - this_from
);
4422 LGLYPH_SET_TO (g
, LGLYPH_TO (g
) - this_from
);
4423 LGSTRING_SET_GLYPH (gstr
, i
- k
, LGSTRING_GLYPH (gstring
, i
));
4425 from
= make_number (start
+ this_from
);
4426 to
= make_number (start
+ this_to
);
4428 Fcompose_region_internal (from
, to
, gstr
, Qnil
);
4430 Fcompose_string_internal (string
, from
, to
, gstr
, Qnil
);
4441 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4442 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4443 OTF-FEATURES specifies which features to apply in this format:
4444 (SCRIPT LANGSYS GSUB GPOS)
4446 SCRIPT is a symbol specifying a script tag of OpenType,
4447 LANGSYS is a symbol specifying a langsys tag of OpenType,
4448 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4450 If LANGYS is nil, the default langsys is selected.
4452 The features are applied in the order they appear in the list. The
4453 symbol `*' means to apply all available features not present in this
4454 list, and the remaining features are ignored. For instance, (vatu
4455 pstf * haln) is to apply vatu and pstf in this order, then to apply
4456 all available features other than vatu, pstf, and haln.
4458 The features are applied to the glyphs in the range FROM and TO of
4459 the glyph-string GSTRING-IN.
4461 If some feature is actually applicable, the resulting glyphs are
4462 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4463 this case, the value is the number of produced glyphs.
4465 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4468 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4469 produced in GSTRING-OUT, and the value is nil.
4471 See the documentation of `font-make-gstring' for the format of
4473 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4474 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4476 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4481 check_otf_features (otf_features
);
4482 CHECK_FONT_OBJECT (font_object
);
4483 font
= XFONT_OBJECT (font_object
);
4484 if (! font
->driver
->otf_drive
)
4485 error ("Font backend %s can't drive OpenType GSUB table",
4486 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4487 CHECK_CONS (otf_features
);
4488 CHECK_SYMBOL (XCAR (otf_features
));
4489 val
= XCDR (otf_features
);
4490 CHECK_SYMBOL (XCAR (val
));
4491 val
= XCDR (otf_features
);
4494 len
= check_gstring (gstring_in
);
4495 CHECK_VECTOR (gstring_out
);
4496 CHECK_NATNUM (from
);
4498 CHECK_NATNUM (index
);
4500 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4501 args_out_of_range_3 (from
, to
, make_number (len
));
4502 if (XINT (index
) >= ASIZE (gstring_out
))
4503 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4504 num
= font
->driver
->otf_drive (font
, otf_features
,
4505 gstring_in
, XINT (from
), XINT (to
),
4506 gstring_out
, XINT (index
), 0);
4509 return make_number (num
);
4512 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4514 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4515 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4517 (SCRIPT LANGSYS FEATURE ...)
4518 See the documentation of `font-drive-otf' for more detail.
4520 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4521 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4522 character code corresponding to the glyph or nil if there's no
4523 corresponding character. */)
4524 (font_object
, character
, otf_features
)
4525 Lisp_Object font_object
, character
, otf_features
;
4528 Lisp_Object gstring_in
, gstring_out
, g
;
4529 Lisp_Object alternates
;
4532 CHECK_FONT_GET_OBJECT (font_object
, font
);
4533 if (! font
->driver
->otf_drive
)
4534 error ("Font backend %s can't drive OpenType GSUB table",
4535 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4536 CHECK_CHARACTER (character
);
4537 CHECK_CONS (otf_features
);
4539 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4540 g
= LGSTRING_GLYPH (gstring_in
, 0);
4541 LGLYPH_SET_CHAR (g
, XINT (character
));
4542 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4543 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4544 gstring_out
, 0, 1)) < 0)
4545 gstring_out
= Ffont_make_gstring (font_object
,
4546 make_number (ASIZE (gstring_out
) * 2));
4548 for (i
= 0; i
< num
; i
++)
4550 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4551 int c
= LGLYPH_CHAR (g
);
4552 unsigned code
= LGLYPH_CODE (g
);
4554 alternates
= Fcons (Fcons (make_number (code
),
4555 c
> 0 ? make_number (c
) : Qnil
),
4558 return Fnreverse (alternates
);
4564 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4565 doc
: /* Open FONT-ENTITY. */)
4566 (font_entity
, size
, frame
)
4567 Lisp_Object font_entity
;
4573 CHECK_FONT_ENTITY (font_entity
);
4575 frame
= selected_frame
;
4576 CHECK_LIVE_FRAME (frame
);
4579 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4582 CHECK_NUMBER_OR_FLOAT (size
);
4584 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
4586 isize
= XINT (size
);
4590 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4593 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4594 doc
: /* Close FONT-OBJECT. */)
4595 (font_object
, frame
)
4596 Lisp_Object font_object
, frame
;
4598 CHECK_FONT_OBJECT (font_object
);
4600 frame
= selected_frame
;
4601 CHECK_LIVE_FRAME (frame
);
4602 font_close_object (XFRAME (frame
), font_object
);
4606 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4607 doc
: /* Return information about FONT-OBJECT.
4608 The value is a vector:
4609 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4612 NAME is a string of the font name (or nil if the font backend doesn't
4615 FILENAME is a string of the font file (or nil if the font backend
4616 doesn't provide a file name).
4618 PIXEL-SIZE is a pixel size by which the font is opened.
4620 SIZE is a maximum advance width of the font in pixels.
4622 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4625 CAPABILITY is a list whose first element is a symbol representing the
4626 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4627 remaining elements describe the details of the font capability.
4629 If the font is OpenType font, the form of the list is
4630 \(opentype GSUB GPOS)
4631 where GSUB shows which "GSUB" features the font supports, and GPOS
4632 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4633 lists of the format:
4634 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4636 If the font is not OpenType font, currently the length of the form is
4639 SCRIPT is a symbol representing OpenType script tag.
4641 LANGSYS is a symbol representing OpenType langsys tag, or nil
4642 representing the default langsys.
4644 FEATURE is a symbol representing OpenType feature tag.
4646 If the font is not OpenType font, CAPABILITY is nil. */)
4648 Lisp_Object font_object
;
4653 CHECK_FONT_GET_OBJECT (font_object
, font
);
4655 val
= Fmake_vector (make_number (9), Qnil
);
4656 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4657 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4658 ASET (val
, 2, make_number (font
->pixel_size
));
4659 ASET (val
, 3, make_number (font
->max_width
));
4660 ASET (val
, 4, make_number (font
->ascent
));
4661 ASET (val
, 5, make_number (font
->descent
));
4662 ASET (val
, 6, make_number (font
->space_width
));
4663 ASET (val
, 7, make_number (font
->average_width
));
4664 if (font
->driver
->otf_capability
)
4665 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4669 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4670 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4671 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4672 (font_object
, string
)
4673 Lisp_Object font_object
, string
;
4679 CHECK_FONT_GET_OBJECT (font_object
, font
);
4680 CHECK_STRING (string
);
4681 len
= SCHARS (string
);
4682 vec
= Fmake_vector (make_number (len
), Qnil
);
4683 for (i
= 0; i
< len
; i
++)
4685 Lisp_Object ch
= Faref (string
, make_number (i
));
4690 struct font_metrics metrics
;
4692 cod
= code
= font
->driver
->encode_char (font
, c
);
4693 if (code
== FONT_INVALID_CODE
)
4695 val
= Fmake_vector (make_number (6), Qnil
);
4696 if (cod
<= MOST_POSITIVE_FIXNUM
)
4697 ASET (val
, 0, make_number (code
));
4699 ASET (val
, 0, Fcons (make_number (code
>> 16),
4700 make_number (code
& 0xFFFF)));
4701 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4702 ASET (val
, 1, make_number (metrics
.lbearing
));
4703 ASET (val
, 2, make_number (metrics
.rbearing
));
4704 ASET (val
, 3, make_number (metrics
.width
));
4705 ASET (val
, 4, make_number (metrics
.ascent
));
4706 ASET (val
, 5, make_number (metrics
.descent
));
4712 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4713 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4714 FONT is a font-spec, font-entity, or font-object. */)
4716 Lisp_Object spec
, font
;
4718 CHECK_FONT_SPEC (spec
);
4721 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4724 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4725 doc
: /* Return a font-object for displaying a character at POSITION.
4726 Optional second arg WINDOW, if non-nil, is a window displaying
4727 the current buffer. It defaults to the currently selected window. */)
4728 (position
, window
, string
)
4729 Lisp_Object position
, window
, string
;
4736 CHECK_NUMBER_COERCE_MARKER (position
);
4737 pos
= XINT (position
);
4738 if (pos
< BEGV
|| pos
>= ZV
)
4739 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4743 CHECK_NUMBER (position
);
4744 CHECK_STRING (string
);
4745 pos
= XINT (position
);
4746 if (pos
< 0 || pos
>= SCHARS (string
))
4747 args_out_of_range (string
, position
);
4750 window
= selected_window
;
4751 CHECK_LIVE_WINDOW (window
);
4752 w
= XWINDOW (window
);
4754 return font_at (-1, pos
, NULL
, w
, string
);
4758 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4759 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4760 The value is a number of glyphs drawn.
4761 Type C-l to recover what previously shown. */)
4762 (font_object
, string
)
4763 Lisp_Object font_object
, string
;
4765 Lisp_Object frame
= selected_frame
;
4766 FRAME_PTR f
= XFRAME (frame
);
4772 CHECK_FONT_GET_OBJECT (font_object
, font
);
4773 CHECK_STRING (string
);
4774 len
= SCHARS (string
);
4775 code
= alloca (sizeof (unsigned) * len
);
4776 for (i
= 0; i
< len
; i
++)
4778 Lisp_Object ch
= Faref (string
, make_number (i
));
4782 code
[i
] = font
->driver
->encode_char (font
, c
);
4783 if (code
[i
] == FONT_INVALID_CODE
)
4786 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4788 if (font
->driver
->prepare_face
)
4789 font
->driver
->prepare_face (f
, face
);
4790 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4791 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4792 if (font
->driver
->done_face
)
4793 font
->driver
->done_face (f
, face
);
4795 return make_number (len
);
4799 #endif /* FONT_DEBUG */
4801 #ifdef HAVE_WINDOW_SYSTEM
4803 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4804 doc
: /* Return information about a font named NAME on frame FRAME.
4805 If FRAME is omitted or nil, use the selected frame.
4806 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4807 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4809 OPENED-NAME is the name used for opening the font,
4810 FULL-NAME is the full name of the font,
4811 SIZE is the maximum bound width of the font,
4812 HEIGHT is the height of the font,
4813 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4814 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4815 how to compose characters.
4816 If the named font is not yet loaded, return nil. */)
4818 Lisp_Object name
, frame
;
4823 Lisp_Object font_object
;
4825 (*check_window_system_func
) ();
4828 CHECK_STRING (name
);
4830 frame
= selected_frame
;
4831 CHECK_LIVE_FRAME (frame
);
4836 int fontset
= fs_query_fontset (name
, 0);
4839 name
= fontset_ascii (fontset
);
4840 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4842 else if (FONT_OBJECT_P (name
))
4844 else if (FONT_ENTITY_P (name
))
4845 font_object
= font_open_entity (f
, name
, 0);
4848 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4849 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4851 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4853 if (NILP (font_object
))
4855 font
= XFONT_OBJECT (font_object
);
4857 info
= Fmake_vector (make_number (7), Qnil
);
4858 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4859 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4860 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4861 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4862 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4863 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4864 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4867 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4868 close it now. Perhaps, we should manage font-objects
4869 by `reference-count'. */
4870 font_close_object (f
, font_object
);
4877 #define BUILD_STYLE_TABLE(TBL) \
4878 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4881 build_style_table (entry
, nelement
)
4882 struct table_entry
*entry
;
4886 Lisp_Object table
, elt
;
4888 table
= Fmake_vector (make_number (nelement
), Qnil
);
4889 for (i
= 0; i
< nelement
; i
++)
4891 for (j
= 0; entry
[i
].names
[j
]; j
++);
4892 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4893 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4894 for (j
= 0; entry
[i
].names
[j
]; j
++)
4895 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4896 ASET (table
, i
, elt
);
4901 static Lisp_Object Vfont_log
;
4902 static int font_log_env_checked
;
4905 font_add_log (action
, arg
, result
)
4907 Lisp_Object arg
, result
;
4909 Lisp_Object tail
, val
;
4912 if (! font_log_env_checked
)
4914 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
4915 font_log_env_checked
= 1;
4917 if (EQ (Vfont_log
, Qt
))
4920 arg
= Ffont_xlfd_name (arg
, Qt
);
4923 val
= Ffont_xlfd_name (result
, Qt
);
4924 if (! FONT_SPEC_P (result
))
4925 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4926 build_string (":"), val
);
4929 else if (CONSP (result
))
4931 result
= Fcopy_sequence (result
);
4932 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4936 val
= Ffont_xlfd_name (val
, Qt
);
4937 XSETCAR (tail
, val
);
4940 else if (VECTORP (result
))
4942 result
= Fcopy_sequence (result
);
4943 for (i
= 0; i
< ASIZE (result
); i
++)
4945 val
= AREF (result
, i
);
4947 val
= Ffont_xlfd_name (val
, Qt
);
4948 ASET (result
, i
, val
);
4951 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4954 extern void syms_of_ftfont
P_ (());
4955 extern void syms_of_xfont
P_ (());
4956 extern void syms_of_xftfont
P_ (());
4957 extern void syms_of_ftxfont
P_ (());
4958 extern void syms_of_bdffont
P_ (());
4959 extern void syms_of_w32font
P_ (());
4960 extern void syms_of_atmfont
P_ (());
4961 extern void syms_of_nsfont
P_ (());
4966 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
4967 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
4968 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
4969 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
4970 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
4971 /* Note that the other elements in sort_shift_bits are not used. */
4973 staticpro (&font_charset_alist
);
4974 font_charset_alist
= Qnil
;
4976 DEFSYM (Qfont_spec
, "font-spec");
4977 DEFSYM (Qfont_entity
, "font-entity");
4978 DEFSYM (Qfont_object
, "font-object");
4980 DEFSYM (Qopentype
, "opentype");
4982 DEFSYM (Qascii_0
, "ascii-0");
4983 DEFSYM (Qiso8859_1
, "iso8859-1");
4984 DEFSYM (Qiso10646_1
, "iso10646-1");
4985 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4986 DEFSYM (Qunicode_sip
, "unicode-sip");
4988 DEFSYM (QCotf
, ":otf");
4989 DEFSYM (QClang
, ":lang");
4990 DEFSYM (QCscript
, ":script");
4991 DEFSYM (QCantialias
, ":antialias");
4993 DEFSYM (QCfoundry
, ":foundry");
4994 DEFSYM (QCadstyle
, ":adstyle");
4995 DEFSYM (QCregistry
, ":registry");
4996 DEFSYM (QCspacing
, ":spacing");
4997 DEFSYM (QCdpi
, ":dpi");
4998 DEFSYM (QCscalable
, ":scalable");
4999 DEFSYM (QCavgwidth
, ":avgwidth");
5000 DEFSYM (QCfont_entity
, ":font-entity");
5001 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5008 staticpro (&null_vector
);
5009 null_vector
= Fmake_vector (make_number (0), Qnil
);
5011 staticpro (&scratch_font_spec
);
5012 scratch_font_spec
= Ffont_spec (0, NULL
);
5013 staticpro (&scratch_font_prefer
);
5014 scratch_font_prefer
= Ffont_spec (0, NULL
);
5018 staticpro (&otf_list
);
5020 #endif /* HAVE_LIBOTF */
5024 defsubr (&Sfont_spec
);
5025 defsubr (&Sfont_get
);
5026 #ifdef HAVE_WINDOW_SYSTEM
5027 defsubr (&Sfont_face_attributes
);
5029 defsubr (&Sfont_put
);
5030 defsubr (&Slist_fonts
);
5031 defsubr (&Sfont_family_list
);
5032 defsubr (&Sfind_font
);
5033 defsubr (&Sfont_xlfd_name
);
5034 defsubr (&Sclear_font_cache
);
5035 defsubr (&Sfont_make_gstring
);
5036 defsubr (&Sfont_fill_gstring
);
5037 defsubr (&Sfont_shape_text
);
5039 defsubr (&Sfont_drive_otf
);
5040 defsubr (&Sfont_otf_alternates
);
5044 defsubr (&Sopen_font
);
5045 defsubr (&Sclose_font
);
5046 defsubr (&Squery_font
);
5047 defsubr (&Sget_font_glyphs
);
5048 defsubr (&Sfont_match_p
);
5049 defsubr (&Sfont_at
);
5051 defsubr (&Sdraw_string
);
5053 #endif /* FONT_DEBUG */
5054 #ifdef HAVE_WINDOW_SYSTEM
5055 defsubr (&Sfont_info
);
5058 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5060 Alist of fontname patterns vs the corresponding encoding and repertory info.
5061 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5062 where ENCODING is a charset or a char-table,
5063 and REPERTORY is a charset, a char-table, or nil.
5065 If ENCODING and REPERTORY are the same, the element can have the form
5066 \(REGEXP . ENCODING).
5068 ENCODING is for converting a character to a glyph code of the font.
5069 If ENCODING is a charset, encoding a character by the charset gives
5070 the corresponding glyph code. If ENCODING is a char-table, looking up
5071 the table by a character gives the corresponding glyph code.
5073 REPERTORY specifies a repertory of characters supported by the font.
5074 If REPERTORY is a charset, all characters beloging to the charset are
5075 supported. If REPERTORY is a char-table, all characters who have a
5076 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5077 gets the repertory information by an opened font and ENCODING. */);
5078 Vfont_encoding_alist
= Qnil
;
5080 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5081 doc
: /* Vector of valid font weight values.
5082 Each element has the form:
5083 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5084 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5085 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5087 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5088 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5089 See `font-weight-table' for the format of the vector. */);
5090 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5092 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5093 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5094 See `font-weight-table' for the format of the vector. */);
5095 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5097 staticpro (&font_style_table
);
5098 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5099 ASET (font_style_table
, 0, Vfont_weight_table
);
5100 ASET (font_style_table
, 1, Vfont_slant_table
);
5101 ASET (font_style_table
, 2, Vfont_width_table
);
5103 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5104 *Logging list of font related actions and results.
5105 The value t means to suppress the logging.
5106 The initial value is set to nil if the environment variable
5107 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5110 #ifdef HAVE_WINDOW_SYSTEM
5111 #ifdef HAVE_FREETYPE
5113 #ifdef HAVE_X_WINDOWS
5118 #endif /* HAVE_XFT */
5119 #endif /* HAVE_X_WINDOWS */
5120 #else /* not HAVE_FREETYPE */
5121 #ifdef HAVE_X_WINDOWS
5123 #endif /* HAVE_X_WINDOWS */
5124 #endif /* not HAVE_FREETYPE */
5127 #endif /* HAVE_BDFFONT */
5130 #endif /* WINDOWSNT */
5133 #endif /* HAVE_NS */
5137 #endif /* HAVE_WINDOW_SYSTEM */
5140 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5141 (do not change this comment) */