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/>. */
31 #include "dispextern.h"
33 #include "character.h"
34 #include "composite.h"
40 #endif /* HAVE_X_WINDOWS */
44 #endif /* HAVE_NTGUI */
50 Lisp_Object Qfont_spec
, Qfont_entity
, Qfont_object
;
53 extern Lisp_Object Qfontsize
;
56 Lisp_Object Qopentype
;
58 /* Important character set strings. */
59 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
62 #define DEFAULT_ENCODING Qiso10646_1
64 #define DEFAULT_ENCODING Qiso8859_1
67 /* Unicode category `Cf'. */
68 static Lisp_Object QCf
;
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_GLYPH_LEN (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 */
2164 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2165 static int font_compare
P_ ((const void *, const void *));
2166 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
2169 /* We sort fonts by scoring each of them against a specified
2170 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2171 the value is, the closer the font is to the font-spec.
2173 The lowest 2 bits of the score is used for driver type. The font
2174 available by the most preferred font driver is 0.
2176 Each 7-bit in the higher 28 bits are used for numeric properties
2177 WEIGHT, SLANT, WIDTH, and SIZE. */
2179 /* How many bits to shift to store the difference value of each font
2180 property in a score. Note that flots for FONT_TYPE_INDEX and
2181 FONT_REGISTRY_INDEX are not used. */
2182 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2184 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2185 The return value indicates how different ENTITY is compared with
2189 font_score (entity
, spec_prop
)
2190 Lisp_Object entity
, *spec_prop
;
2195 /* Score three style numeric fields. Maximum difference is 127. */
2196 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2197 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2199 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2204 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2207 /* Score the size. Maximum difference is 127. */
2208 i
= FONT_SIZE_INDEX
;
2209 if (! NILP (spec_prop
[i
]) && XINT (AREF (entity
, i
)) > 0)
2211 /* We use the higher 6-bit for the actual size difference. The
2212 lowest bit is set if the DPI is different. */
2213 int diff
= XINT (spec_prop
[i
]) - XINT (AREF (entity
, i
));
2218 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2219 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2221 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2228 /* The comparison function for qsort. */
2231 font_compare (d1
, d2
)
2232 const void *d1
, *d2
;
2234 return (*(unsigned *) d1
- *(unsigned *) d2
);
2238 /* The structure for elements being sorted by qsort. */
2239 struct font_sort_data
2246 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2247 If PREFER specifies a point-size, calculate the corresponding
2248 pixel-size from QCdpi property of PREFER or from the Y-resolution
2249 of FRAME before sorting.
2251 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2252 return the sorted VEC. */
2255 font_sort_entites (vec
, prefer
, frame
, best_only
)
2256 Lisp_Object vec
, prefer
, frame
;
2259 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2261 struct font_sort_data
*data
;
2262 unsigned best_score
;
2263 Lisp_Object best_entity
, driver_type
;
2265 struct frame
*f
= XFRAME (frame
);
2266 struct font_driver_list
*list
;
2271 return best_only
? AREF (vec
, 0) : vec
;
2273 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_DPI_INDEX
; i
++)
2274 prefer_prop
[i
] = AREF (prefer
, i
);
2275 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2276 prefer_prop
[FONT_SIZE_INDEX
]
2277 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2279 /* Scoring and sorting. */
2280 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2281 best_score
= 0xFFFFFFFF;
2282 /* We are sure that the length of VEC > 1. */
2283 driver_type
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2284 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2285 driver_order
++, list
= list
->next
)
2286 if (EQ (driver_type
, list
->driver
->type
))
2288 best_entity
= data
[0].entity
= AREF (vec
, 0);
2289 best_score
= data
[0].score
2290 = font_score (data
[0].entity
, prefer_prop
) | driver_order
;
2291 for (i
= 0; i
< len
; i
++)
2293 if (!EQ (driver_type
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2294 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2295 driver_order
++, list
= list
->next
)
2296 if (EQ (driver_type
, list
->driver
->type
))
2298 data
[i
].entity
= AREF (vec
, i
);
2299 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
) | driver_order
;
2300 if (best_only
&& best_score
> data
[i
].score
)
2302 best_score
= data
[i
].score
;
2303 best_entity
= data
[i
].entity
;
2304 if (best_score
== 0)
2310 qsort (data
, len
, sizeof *data
, font_compare
);
2311 for (i
= 0; i
< len
; i
++)
2312 ASET (vec
, i
, data
[i
].entity
);
2318 font_add_log ("sort-by", prefer
, vec
);
2323 /* API of Font Service Layer. */
2325 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2326 sort_shift_bits. Finternal_set_font_selection_order calls this
2327 function with font_sort_order after setting up it. */
2330 font_update_sort_order (order
)
2335 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2337 int xlfd_idx
= order
[i
];
2339 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2340 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2341 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2342 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2343 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2344 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2346 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2351 font_check_otf_features (script
, langsys
, features
, table
)
2352 Lisp_Object script
, langsys
, features
, table
;
2357 table
= assq_no_quit (script
, table
);
2360 table
= XCDR (table
);
2361 if (! NILP (langsys
))
2363 table
= assq_no_quit (langsys
, table
);
2369 val
= assq_no_quit (Qnil
, table
);
2371 table
= XCAR (table
);
2375 table
= XCDR (table
);
2376 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2378 if (NILP (XCAR (features
)))
2380 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2386 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2389 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2391 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2393 script
= XCAR (spec
);
2397 langsys
= XCAR (spec
);
2408 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2409 XCAR (otf_capability
)))
2411 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2412 XCDR (otf_capability
)))
2419 /* Check if FONT (font-entity or font-object) matches with the font
2420 specification SPEC. */
2423 font_match_p (spec
, font
)
2424 Lisp_Object spec
, font
;
2426 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2427 Lisp_Object extra
, font_extra
;
2430 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2431 if (! NILP (AREF (spec
, i
))
2432 && ! NILP (AREF (font
, i
))
2433 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2435 props
= XFONT_SPEC (spec
)->props
;
2436 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2438 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2439 prop
[i
] = AREF (spec
, i
);
2440 prop
[FONT_SIZE_INDEX
]
2441 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2445 if (font_score (font
, props
) > 0)
2447 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2448 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2449 for (; CONSP (extra
); extra
= XCDR (extra
))
2451 Lisp_Object key
= XCAR (XCAR (extra
));
2452 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2454 if (EQ (key
, QClang
))
2456 val2
= assq_no_quit (key
, font_extra
);
2465 if (NILP (Fmemq (val
, val2
)))
2470 ? NILP (Fmemq (val
, XCDR (val2
)))
2474 else if (EQ (key
, QCscript
))
2476 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2478 for (val2
= XCDR (val2
); CONSP (val2
); val2
= XCDR (val2
))
2479 if (font_encode_char (font
, XINT (XCAR (val2
)))
2480 == FONT_INVALID_CODE
)
2483 else if (EQ (key
, QCotf
))
2487 if (! FONT_OBJECT_P (font
))
2489 fontp
= XFONT_OBJECT (font
);
2490 if (! fontp
->driver
->otf_capability
)
2492 val2
= fontp
->driver
->otf_capability (fontp
);
2493 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2504 Each font backend has the callback function get_cache, and it
2505 returns a cons cell of which cdr part can be freely used for
2506 caching fonts. The cons cell may be shared by multiple frames
2507 and/or multiple font drivers. So, we arrange the cdr part as this:
2509 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2511 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2512 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2513 cons (FONT-SPEC FONT-ENTITY ...). */
2515 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2516 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2517 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2518 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2519 struct font_driver
*));
2522 font_prepare_cache (f
, driver
)
2524 struct font_driver
*driver
;
2526 Lisp_Object cache
, val
;
2528 cache
= driver
->get_cache (f
);
2530 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2534 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2535 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2539 val
= XCDR (XCAR (val
));
2540 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2546 font_finish_cache (f
, driver
)
2548 struct font_driver
*driver
;
2550 Lisp_Object cache
, val
, tmp
;
2553 cache
= driver
->get_cache (f
);
2555 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2556 cache
= val
, val
= XCDR (val
);
2557 font_assert (! NILP (val
));
2558 tmp
= XCDR (XCAR (val
));
2559 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2560 if (XINT (XCAR (tmp
)) == 0)
2562 font_clear_cache (f
, XCAR (val
), driver
);
2563 XSETCDR (cache
, XCDR (val
));
2569 font_get_cache (f
, driver
)
2571 struct font_driver
*driver
;
2573 Lisp_Object val
= driver
->get_cache (f
);
2574 Lisp_Object type
= driver
->type
;
2576 font_assert (CONSP (val
));
2577 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2578 font_assert (CONSP (val
));
2579 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2580 val
= XCDR (XCAR (val
));
2584 static int num_fonts
;
2587 font_clear_cache (f
, cache
, driver
)
2590 struct font_driver
*driver
;
2592 Lisp_Object tail
, elt
;
2594 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2595 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2598 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)) && VECTORP (XCDR (elt
)))
2600 Lisp_Object vec
= XCDR (elt
);
2603 for (i
= 0; i
< ASIZE (vec
); i
++)
2605 Lisp_Object entity
= AREF (vec
, i
);
2607 if (EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2609 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2611 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2613 Lisp_Object val
= XCAR (objlist
);
2614 struct font
*font
= XFONT_OBJECT (val
);
2616 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2618 font_assert (font
&& driver
== font
->driver
);
2619 driver
->close (f
, font
);
2623 if (driver
->free_entity
)
2624 driver
->free_entity (entity
);
2629 XSETCDR (cache
, Qnil
);
2633 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2636 font_delete_unmatched (list
, spec
, size
)
2637 Lisp_Object list
, spec
;
2640 Lisp_Object entity
, val
;
2641 enum font_property_index prop
;
2643 for (val
= Qnil
; CONSP (list
); list
= XCDR (list
))
2645 entity
= XCAR (list
);
2646 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2647 if (INTEGERP (AREF (spec
, prop
))
2648 && ((XINT (AREF (spec
, prop
)) >> 8)
2649 != (XINT (AREF (entity
, prop
)) >> 8)))
2650 prop
= FONT_SPEC_MAX
;
2651 if (prop
< FONT_SPEC_MAX
2653 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2655 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2658 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2659 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2660 prop
= FONT_SPEC_MAX
;
2662 if (prop
< FONT_SPEC_MAX
2663 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2664 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2665 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2666 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2667 prop
= FONT_SPEC_MAX
;
2668 if (prop
< FONT_SPEC_MAX
2669 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2670 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2671 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2672 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2673 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2674 prop
= FONT_SPEC_MAX
;
2675 if (prop
< FONT_SPEC_MAX
)
2676 val
= Fcons (entity
, val
);
2682 /* Return a vector of font-entities matching with SPEC on FRAME. */
2685 font_list_entities (frame
, spec
)
2686 Lisp_Object frame
, spec
;
2688 FRAME_PTR f
= XFRAME (frame
);
2689 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2690 Lisp_Object ftype
, val
;
2693 int need_filtering
= 0;
2696 font_assert (FONT_SPEC_P (spec
));
2698 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2699 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2700 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2701 size
= font_pixel_size (f
, spec
);
2705 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2706 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2707 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2708 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2710 ASET (scratch_font_spec
, i
, Qnil
);
2711 if (! NILP (AREF (spec
, i
)))
2713 if (i
== FONT_DPI_INDEX
)
2714 /* Skip FONT_SPACING_INDEX */
2717 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2718 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2720 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2724 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2726 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2728 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2730 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2731 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2738 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2739 copy
= Fcopy_font_spec (scratch_font_spec
);
2740 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2741 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2743 if (! NILP (val
) && need_filtering
)
2744 val
= font_delete_unmatched (val
, spec
, size
);
2749 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2750 font_add_log ("list", spec
, val
);
2755 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2756 nil, is an array of face's attributes, which specifies preferred
2757 font-related attributes. */
2760 font_matching_entity (f
, attrs
, spec
)
2762 Lisp_Object
*attrs
, spec
;
2764 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2765 Lisp_Object ftype
, size
, entity
;
2767 Lisp_Object work
= Fcopy_font_spec (spec
);
2769 XSETFRAME (frame
, f
);
2770 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2771 size
= AREF (spec
, FONT_SIZE_INDEX
);
2774 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2775 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2776 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2777 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2780 for (; driver_list
; driver_list
= driver_list
->next
)
2782 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2784 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2787 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2788 entity
= assoc_no_quit (work
, XCDR (cache
));
2790 entity
= XCDR (entity
);
2793 entity
= driver_list
->driver
->match (frame
, work
);
2794 copy
= Fcopy_font_spec (work
);
2795 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2796 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2798 if (! NILP (entity
))
2801 font_add_log ("match", work
, entity
);
2806 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2807 opened font object. */
2810 font_open_entity (f
, entity
, pixel_size
)
2815 struct font_driver_list
*driver_list
;
2816 Lisp_Object objlist
, size
, val
, font_object
;
2818 int min_width
, height
;
2820 font_assert (FONT_ENTITY_P (entity
));
2821 size
= AREF (entity
, FONT_SIZE_INDEX
);
2822 if (XINT (size
) != 0)
2823 pixel_size
= XINT (size
);
2825 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2826 objlist
= XCDR (objlist
))
2827 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2828 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2829 return XCAR (objlist
);
2831 val
= AREF (entity
, FONT_TYPE_INDEX
);
2832 for (driver_list
= f
->font_driver_list
;
2833 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2834 driver_list
= driver_list
->next
);
2838 font_object
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2839 font_add_log ("open", entity
, font_object
);
2840 if (NILP (font_object
))
2842 ASET (entity
, FONT_OBJLIST_INDEX
,
2843 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2844 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
2847 font
= XFONT_OBJECT (font_object
);
2848 min_width
= (font
->min_width
? font
->min_width
2849 : font
->average_width
? font
->average_width
2850 : font
->space_width
? font
->space_width
2852 height
= (font
->height
? font
->height
: 1);
2853 #ifdef HAVE_WINDOW_SYSTEM
2854 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2855 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2857 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2858 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2859 fonts_changed_p
= 1;
2863 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2864 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2865 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2866 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2874 /* Close FONT_OBJECT that is opened on frame F. */
2877 font_close_object (f
, font_object
)
2879 Lisp_Object font_object
;
2881 struct font
*font
= XFONT_OBJECT (font_object
);
2883 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2884 /* Already closed. */
2886 font_add_log ("close", font_object
, Qnil
);
2887 font
->driver
->close (f
, font
);
2888 #ifdef HAVE_WINDOW_SYSTEM
2889 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2890 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2896 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2897 FONT is a font-entity and it must be opened to check. */
2900 font_has_char (f
, font
, c
)
2907 if (FONT_ENTITY_P (font
))
2909 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2910 struct font_driver_list
*driver_list
;
2912 for (driver_list
= f
->font_driver_list
;
2913 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2914 driver_list
= driver_list
->next
);
2917 if (! driver_list
->driver
->has_char
)
2919 return driver_list
->driver
->has_char (font
, c
);
2922 font_assert (FONT_OBJECT_P (font
));
2923 fontp
= XFONT_OBJECT (font
);
2924 if (fontp
->driver
->has_char
)
2926 int result
= fontp
->driver
->has_char (font
, c
);
2931 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2935 /* Return the glyph ID of FONT_OBJECT for character C. */
2938 font_encode_char (font_object
, c
)
2939 Lisp_Object font_object
;
2944 font_assert (FONT_OBJECT_P (font_object
));
2945 font
= XFONT_OBJECT (font_object
);
2946 return font
->driver
->encode_char (font
, c
);
2950 /* Return the name of FONT_OBJECT. */
2953 font_get_name (font_object
)
2954 Lisp_Object font_object
;
2956 font_assert (FONT_OBJECT_P (font_object
));
2957 return AREF (font_object
, FONT_NAME_INDEX
);
2961 /* Return the specification of FONT_OBJECT. */
2964 font_get_spec (font_object
)
2965 Lisp_Object font_object
;
2967 Lisp_Object spec
= font_make_spec ();
2970 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2971 ASET (spec
, i
, AREF (font_object
, i
));
2972 ASET (spec
, FONT_SIZE_INDEX
,
2973 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2978 font_spec_from_name (font_name
)
2979 Lisp_Object font_name
;
2981 Lisp_Object args
[2];
2984 args
[1] = font_name
;
2985 return Ffont_spec (2, args
);
2990 font_clear_prop (attrs
, prop
)
2992 enum font_property_index prop
;
2994 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2998 if (NILP (AREF (font
, prop
))
2999 && prop
!= FONT_FAMILY_INDEX
3000 && prop
!= FONT_FOUNDRY_INDEX
3001 && prop
!= FONT_WIDTH_INDEX
3002 && prop
!= FONT_SIZE_INDEX
)
3004 font
= Fcopy_font_spec (font
);
3005 ASET (font
, prop
, Qnil
);
3006 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3008 if (prop
== FONT_FAMILY_INDEX
)
3009 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3010 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3011 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3012 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3013 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3014 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3015 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3017 else if (prop
== FONT_SIZE_INDEX
)
3019 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3020 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3021 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3023 else if (prop
== FONT_WIDTH_INDEX
)
3024 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3025 attrs
[LFACE_FONT_INDEX
] = font
;
3029 font_update_lface (f
, attrs
)
3035 spec
= attrs
[LFACE_FONT_INDEX
];
3036 if (! FONT_SPEC_P (spec
))
3039 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3040 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3041 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3042 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3043 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3044 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3045 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3046 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);;
3047 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3048 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3049 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3053 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3058 val
= Ffont_get (spec
, QCdpi
);
3061 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3064 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3065 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3066 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3071 /* Return a font-entity satisfying SPEC and best matching with face's
3072 font related attributes in ATTRS. C, if not negative, is a
3073 character that the entity must support. */
3076 font_find_for_lface (f
, attrs
, spec
, c
)
3083 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
3084 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3086 int i
, j
, k
, l
, result
;
3088 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3089 if (NILP (registry
[0]))
3091 registry
[0] = DEFAULT_ENCODING
;
3092 registry
[1] = Qascii_0
;
3093 registry
[2] = null_vector
;
3096 registry
[1] = null_vector
;
3098 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3100 struct charset
*encoding
, *repertory
;
3102 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3103 &encoding
, &repertory
) < 0)
3107 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3109 /* Any font of this registry support C. So, let's
3110 suppress the further checking. */
3113 else if (c
> encoding
->max_char
)
3117 work
= Fcopy_font_spec (spec
);
3118 XSETFRAME (frame
, f
);
3119 size
= AREF (spec
, FONT_SIZE_INDEX
);
3120 pixel_size
= font_pixel_size (f
, spec
);
3121 if (pixel_size
== 0)
3123 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3125 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3127 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3128 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3129 if (! NILP (foundry
[0]))
3130 foundry
[1] = null_vector
;
3131 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3133 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3134 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3136 foundry
[2] = null_vector
;
3139 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3141 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3142 if (! NILP (adstyle
[0]))
3143 adstyle
[1] = null_vector
;
3144 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3146 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3148 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3150 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3152 adstyle
[2] = null_vector
;
3155 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3158 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3161 val
= AREF (work
, FONT_FAMILY_INDEX
);
3162 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3164 val
= attrs
[LFACE_FAMILY_INDEX
];
3165 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3169 family
= alloca ((sizeof family
[0]) * 2);
3171 family
[1] = null_vector
; /* terminator. */
3176 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3184 if (! NILP (alters
))
3186 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3187 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3188 family
[i
] = XCAR (alters
);
3189 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3191 family
[i
] = null_vector
;
3195 family
= alloca ((sizeof family
[0]) * 3);
3198 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3200 family
[i
] = null_vector
;
3204 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3206 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3207 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3209 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3210 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3212 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3213 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3215 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3216 entities
= font_list_entities (frame
, work
);
3217 if (ASIZE (entities
) > 0)
3225 if (ASIZE (entities
) == 1)
3228 return AREF (entities
, 0);
3232 /* Sort fonts by properties specified in LFACE. */
3233 Lisp_Object prefer
= scratch_font_prefer
;
3235 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3236 ASET (prefer
, i
, AREF (work
, i
));
3237 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3239 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3241 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3242 if (NILP (AREF (prefer
, i
)))
3243 ASET (prefer
, i
, AREF (face_font
, i
));
3245 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3246 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3247 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3248 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3249 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3250 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3251 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3252 entities
= font_sort_entites (entities
, prefer
, frame
, c
< 0);
3257 for (i
= 0; i
< ASIZE (entities
); i
++)
3261 val
= AREF (entities
, i
);
3264 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3265 if (! EQ (AREF (val
, j
), props
[j
]))
3267 if (j
> FONT_REGISTRY_INDEX
)
3270 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3271 props
[j
] = AREF (val
, j
);
3272 result
= font_has_char (f
, val
, c
);
3277 val
= font_open_for_lface (f
, val
, attrs
, spec
);
3280 result
= font_has_char (f
, val
, c
);
3281 font_close_object (f
, val
);
3283 return AREF (entities
, i
);
3290 font_open_for_lface (f
, entity
, attrs
, spec
)
3298 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3299 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3300 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3301 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3302 size
= font_pixel_size (f
, spec
);
3305 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3308 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3312 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3313 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3317 return font_open_entity (f
, entity
, size
);
3321 /* Find a font satisfying SPEC and best matching with face's
3322 attributes in ATTRS on FRAME, and return the opened
3326 font_load_for_lface (f
, attrs
, spec
)
3328 Lisp_Object
*attrs
, spec
;
3332 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3335 /* No font is listed for SPEC, but each font-backend may have
3336 the different criteria about "font matching". So, try
3338 entity
= font_matching_entity (f
, attrs
, spec
);
3342 return font_open_for_lface (f
, entity
, attrs
, spec
);
3346 /* Make FACE on frame F ready to use the font opened for FACE. */
3349 font_prepare_for_face (f
, face
)
3353 if (face
->font
->driver
->prepare_face
)
3354 face
->font
->driver
->prepare_face (f
, face
);
3358 /* Make FACE on frame F stop using the font opened for FACE. */
3361 font_done_for_face (f
, face
)
3365 if (face
->font
->driver
->done_face
)
3366 face
->font
->driver
->done_face (f
, face
);
3371 /* Open a font best matching with NAME on frame F. If no proper font
3372 is found, return Qnil. */
3375 font_open_by_name (f
, name
)
3379 Lisp_Object args
[2];
3380 Lisp_Object spec
, attrs
[LFACE_VECTOR_SIZE
];
3383 args
[1] = make_unibyte_string (name
, strlen (name
));
3384 spec
= Ffont_spec (2, args
);
3385 /* We set up the default font-related attributes of a face to prefer
3387 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3388 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3389 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3391 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3393 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3395 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3397 return font_load_for_lface (f
, attrs
, spec
);
3401 /* Register font-driver DRIVER. This function is used in two ways.
3403 The first is with frame F non-NULL. In this case, make DRIVER
3404 available (but not yet activated) on F. All frame creaters
3405 (e.g. Fx_create_frame) must call this function at least once with
3406 an available font-driver.
3408 The second is with frame F NULL. In this case, DRIVER is globally
3409 registered in the variable `font_driver_list'. All font-driver
3410 implementations must call this function in its syms_of_XXXX
3411 (e.g. syms_of_xfont). */
3414 register_font_driver (driver
, f
)
3415 struct font_driver
*driver
;
3418 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3419 struct font_driver_list
*prev
, *list
;
3421 if (f
&& ! driver
->draw
)
3422 error ("Unusable font driver for a frame: %s",
3423 SDATA (SYMBOL_NAME (driver
->type
)));
3425 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3426 if (EQ (list
->driver
->type
, driver
->type
))
3427 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3429 list
= malloc (sizeof (struct font_driver_list
));
3431 list
->driver
= driver
;
3436 f
->font_driver_list
= list
;
3438 font_driver_list
= list
;
3444 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3445 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3446 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3448 A caller must free all realized faces if any in advance. The
3449 return value is a list of font backends actually made used on
3453 font_update_drivers (f
, new_drivers
)
3455 Lisp_Object new_drivers
;
3457 Lisp_Object active_drivers
= Qnil
;
3458 struct font_driver
*driver
;
3459 struct font_driver_list
*list
;
3461 /* At first, turn off non-requested drivers, and turn on requested
3463 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3465 driver
= list
->driver
;
3466 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3471 if (driver
->end_for_frame
)
3472 driver
->end_for_frame (f
);
3473 font_finish_cache (f
, driver
);
3478 if (! driver
->start_for_frame
3479 || driver
->start_for_frame (f
) == 0)
3481 font_prepare_cache (f
, driver
);
3488 if (NILP (new_drivers
))
3491 if (! EQ (new_drivers
, Qt
))
3493 /* Re-order the driver list according to new_drivers. */
3494 struct font_driver_list
**list_table
, **next
;
3498 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3499 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3501 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3502 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3505 list_table
[i
++] = list
;
3507 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3509 list_table
[i
] = list
;
3510 list_table
[i
] = NULL
;
3512 next
= &f
->font_driver_list
;
3513 for (i
= 0; list_table
[i
]; i
++)
3515 *next
= list_table
[i
];
3516 next
= &(*next
)->next
;
3521 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3523 active_drivers
= nconc2 (active_drivers
,
3524 Fcons (list
->driver
->type
, Qnil
));
3525 return active_drivers
;
3529 font_put_frame_data (f
, driver
, data
)
3531 struct font_driver
*driver
;
3534 struct font_data_list
*list
, *prev
;
3536 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3537 prev
= list
, list
= list
->next
)
3538 if (list
->driver
== driver
)
3545 prev
->next
= list
->next
;
3547 f
->font_data_list
= list
->next
;
3555 list
= malloc (sizeof (struct font_data_list
));
3558 list
->driver
= driver
;
3559 list
->next
= f
->font_data_list
;
3560 f
->font_data_list
= list
;
3568 font_get_frame_data (f
, driver
)
3570 struct font_driver
*driver
;
3572 struct font_data_list
*list
;
3574 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3575 if (list
->driver
== driver
)
3583 /* Return the font used to draw character C by FACE at buffer position
3584 POS in window W. If STRING is non-nil, it is a string containing C
3585 at index POS. If C is negative, get C from the current buffer or
3589 font_at (c
, pos
, face
, w
, string
)
3598 Lisp_Object font_object
;
3604 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3607 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3609 c
= FETCH_CHAR (pos_byte
);
3612 c
= FETCH_BYTE (pos
);
3618 multibyte
= STRING_MULTIBYTE (string
);
3621 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3623 str
= SDATA (string
) + pos_byte
;
3624 c
= STRING_CHAR (str
, 0);
3627 c
= SDATA (string
)[pos
];
3631 f
= XFRAME (w
->frame
);
3632 if (! FRAME_WINDOW_P (f
))
3639 if (STRINGP (string
))
3640 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3641 DEFAULT_FACE_ID
, 0);
3643 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3645 face
= FACE_FROM_ID (f
, face_id
);
3649 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3650 face
= FACE_FROM_ID (f
, face_id
);
3655 XSETFONT (font_object
, face
->font
);
3660 #ifdef HAVE_WINDOW_SYSTEM
3662 /* Check how many characters after POS (at most to *LIMIT) can be
3663 displayed by the same font on the window W. FACE, if non-NULL, is
3664 the face selected for the character at POS. If STRING is not nil,
3665 it is the string to check instead of the current buffer. In that
3666 case, FACE must be not NULL.
3668 The return value is the font-object for the character at POS.
3669 *LIMIT is set to the position where that font can't be used.
3671 It is assured that the current buffer (or STRING) is multibyte. */
3674 font_range (pos
, limit
, w
, face
, string
)
3675 EMACS_INT pos
, *limit
;
3680 EMACS_INT pos_byte
, ignore
, start
, start_byte
;
3682 Lisp_Object font_object
= Qnil
;
3686 pos_byte
= CHAR_TO_BYTE (pos
);
3691 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
, *limit
, 0);
3692 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3698 pos_byte
= string_char_to_byte (string
, pos
);
3701 start
= pos
, start_byte
= pos_byte
;
3702 while (pos
< *limit
)
3704 Lisp_Object category
;
3707 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3709 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3710 if (NILP (font_object
))
3712 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3713 if (NILP (font_object
))
3718 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3719 if (! EQ (category
, QCf
)
3720 && font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3722 Lisp_Object f
= font_for_char (face
, c
, pos
- 1, string
);
3723 EMACS_INT i
, i_byte
;
3731 i
= start
, i_byte
= start_byte
;
3736 FETCH_CHAR_ADVANCE_NO_CHECK (c
, i
, i_byte
);
3738 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, i
, i_byte
);
3739 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3740 if (! EQ (category
, QCf
)
3741 && font_encode_char (f
, c
) == FONT_INVALID_CODE
)
3757 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3758 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3759 Return nil otherwise.
3760 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3761 which kind of font it is. It must be one of `font-spec', `font-entity',
3763 (object
, extra_type
)
3764 Lisp_Object object
, extra_type
;
3766 if (NILP (extra_type
))
3767 return (FONTP (object
) ? Qt
: Qnil
);
3768 if (EQ (extra_type
, Qfont_spec
))
3769 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3770 if (EQ (extra_type
, Qfont_entity
))
3771 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3772 if (EQ (extra_type
, Qfont_object
))
3773 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3774 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3777 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3778 doc
: /* Return a newly created font-spec with arguments as properties.
3780 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3781 valid font property name listed below:
3783 `:family', `:weight', `:slant', `:width'
3785 They are the same as face attributes of the same name. See
3786 `set-face-attribute'.
3790 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3794 VALUE must be a string or a symbol specifying the additional
3795 typographic style information of a font, e.g. ``sans''.
3799 VALUE must be a string or a symbol specifying the charset registry and
3800 encoding of a font, e.g. ``iso8859-1''.
3804 VALUE must be a non-negative integer or a floating point number
3805 specifying the font size. It specifies the font size in pixels
3806 (if VALUE is an integer), or in points (if VALUE is a float).
3810 VALUE must be a string of XLFD-style or fontconfig-style font name.
3811 usage: (font-spec ARGS ...) */)
3816 Lisp_Object spec
= font_make_spec ();
3819 for (i
= 0; i
< nargs
; i
+= 2)
3821 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3823 if (EQ (key
, QCname
))
3826 font_parse_name ((char *) SDATA (val
), spec
);
3827 font_put_extra (spec
, key
, val
);
3831 int idx
= get_font_prop_index (key
);
3835 val
= font_prop_validate (idx
, Qnil
, val
);
3836 if (idx
< FONT_EXTRA_INDEX
)
3837 ASET (spec
, idx
, val
);
3839 font_put_extra (spec
, key
, val
);
3842 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3848 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3849 doc
: /* Return a copy of FONT as a font-spec. */)
3853 Lisp_Object new_spec
, tail
, prev
, extra
;
3857 new_spec
= font_make_spec ();
3858 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3859 ASET (new_spec
, i
, AREF (font
, i
));
3860 extra
= Fcopy_sequence (AREF (font
, FONT_EXTRA_INDEX
));
3861 /* We must remove :font-entity property. */
3862 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3863 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3866 extra
= XCDR (extra
);
3868 XSETCDR (prev
, XCDR (tail
));
3871 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3875 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3876 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3877 Every specified properties in FROM override the corresponding
3878 properties in TO. */)
3880 Lisp_Object from
, to
;
3882 Lisp_Object extra
, tail
;
3887 to
= Fcopy_font_spec (to
);
3888 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3889 ASET (to
, i
, AREF (from
, i
));
3890 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3891 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3892 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3894 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3897 XSETCDR (slot
, XCDR (XCAR (tail
)));
3899 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3901 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3905 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3906 doc
: /* Return the value of FONT's property KEY.
3907 FONT is a font-spec, a font-entity, or a font-object. */)
3909 Lisp_Object font
, key
;
3916 idx
= get_font_prop_index (key
);
3917 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3918 return font_style_symbolic (font
, idx
, 0);
3919 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3920 return AREF (font
, idx
);
3921 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3924 #ifdef HAVE_WINDOW_SYSTEM
3926 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3927 doc
: /* Return a plist of face attributes generated by FONT.
3928 FONT is a font name, a font-spec, a font-entity, or a font-object.
3929 The return value is a list of the form
3931 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3933 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3934 compatible with `set-face-attribute'. Some of these key-attribute pairs
3935 may be omitted from the list if they are not specified by FONT.
3937 The optional argument FRAME specifies the frame that the face attributes
3938 are to be displayed on. If omitted, the selected frame is used. */)
3940 Lisp_Object font
, frame
;
3943 Lisp_Object plist
[10];
3948 frame
= selected_frame
;
3949 CHECK_LIVE_FRAME (frame
);
3954 int fontset
= fs_query_fontset (font
, 0);
3955 Lisp_Object name
= font
;
3957 font
= fontset_ascii (fontset
);
3958 font
= font_spec_from_name (name
);
3960 signal_error ("Invalid font name", name
);
3962 else if (! FONTP (font
))
3963 signal_error ("Invalid font object", font
);
3965 val
= AREF (font
, FONT_FAMILY_INDEX
);
3968 plist
[n
++] = QCfamily
;
3969 plist
[n
++] = SYMBOL_NAME (val
);
3972 val
= AREF (font
, FONT_SIZE_INDEX
);
3975 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
3976 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
3977 plist
[n
++] = QCheight
;
3978 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
3980 else if (FLOATP (val
))
3982 plist
[n
++] = QCheight
;
3983 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
3986 val
= FONT_WEIGHT_FOR_FACE (font
);
3989 plist
[n
++] = QCweight
;
3993 val
= FONT_SLANT_FOR_FACE (font
);
3996 plist
[n
++] = QCslant
;
4000 val
= FONT_WIDTH_FOR_FACE (font
);
4003 plist
[n
++] = QCwidth
;
4007 return Flist (n
, plist
);
4012 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4013 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
4014 (font_spec
, prop
, val
)
4015 Lisp_Object font_spec
, prop
, val
;
4019 CHECK_FONT_SPEC (font_spec
);
4020 idx
= get_font_prop_index (prop
);
4021 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4022 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
4024 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
4028 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4029 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4030 Optional 2nd argument FRAME specifies the target frame.
4031 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4032 Optional 4th argument PREFER, if non-nil, is a font-spec to
4033 control the order of the returned list. Fonts are sorted by
4034 how close they are to PREFER. */)
4035 (font_spec
, frame
, num
, prefer
)
4036 Lisp_Object font_spec
, frame
, num
, prefer
;
4038 Lisp_Object vec
, list
, tail
;
4042 frame
= selected_frame
;
4043 CHECK_LIVE_FRAME (frame
);
4044 CHECK_FONT_SPEC (font_spec
);
4052 if (! NILP (prefer
))
4053 CHECK_FONT_SPEC (prefer
);
4055 vec
= font_list_entities (frame
, font_spec
);
4060 return Fcons (AREF (vec
, 0), Qnil
);
4062 if (! NILP (prefer
))
4063 vec
= font_sort_entites (vec
, prefer
, frame
, 0);
4065 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
4066 if (n
== 0 || n
> len
)
4068 for (i
= 1; i
< n
; i
++)
4070 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
4072 XSETCDR (tail
, val
);
4078 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4079 doc
: /* List available font families on the current frame.
4080 Optional argument FRAME, if non-nil, specifies the target frame. */)
4085 struct font_driver_list
*driver_list
;
4089 frame
= selected_frame
;
4090 CHECK_LIVE_FRAME (frame
);
4093 for (driver_list
= f
->font_driver_list
; driver_list
;
4094 driver_list
= driver_list
->next
)
4095 if (driver_list
->driver
->list_family
)
4097 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4103 Lisp_Object tail
= list
;
4105 for (; CONSP (val
); val
= XCDR (val
))
4106 if (NILP (Fmemq (XCAR (val
), tail
)))
4107 list
= Fcons (XCAR (val
), list
);
4113 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4114 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4115 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4117 Lisp_Object font_spec
, frame
;
4119 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4126 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4127 doc
: /* Return XLFD name of FONT.
4128 FONT is a font-spec, font-entity, or font-object.
4129 If the name is too long for XLFD (maximum 255 chars), return nil.
4130 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4131 the consecutive wildcards are folded to one. */)
4132 (font
, fold_wildcards
)
4133 Lisp_Object font
, fold_wildcards
;
4140 if (FONT_OBJECT_P (font
))
4142 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4144 if (STRINGP (font_name
)
4145 && SDATA (font_name
)[0] == '-')
4147 if (NILP (fold_wildcards
))
4149 strcpy (name
, (char *) SDATA (font_name
));
4152 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4154 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4157 if (! NILP (fold_wildcards
))
4159 char *p0
= name
, *p1
;
4161 while ((p1
= strstr (p0
, "-*-*")))
4163 strcpy (p1
, p1
+ 2);
4168 return build_string (name
);
4171 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4172 doc
: /* Clear font cache. */)
4175 Lisp_Object list
, frame
;
4177 FOR_EACH_FRAME (list
, frame
)
4179 FRAME_PTR f
= XFRAME (frame
);
4180 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4182 for (; driver_list
; driver_list
= driver_list
->next
)
4183 if (driver_list
->on
)
4185 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4190 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4192 font_assert (! NILP (val
));
4193 val
= XCDR (XCAR (val
));
4194 if (XINT (XCAR (val
)) == 0)
4196 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4197 XSETCDR (cache
, XCDR (val
));
4207 font_fill_lglyph_metrics (glyph
, font_object
)
4208 Lisp_Object glyph
, font_object
;
4210 struct font
*font
= XFONT_OBJECT (font_object
);
4212 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4213 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4214 struct font_metrics metrics
;
4216 LGLYPH_SET_CODE (glyph
, ecode
);
4218 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4219 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4220 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4221 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4222 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4223 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4227 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4228 doc
: /* Shape the glyph-string GSTRING.
4229 Shaping means substituting glyphs and/or adjusting positions of glyphs
4230 to get the correct visual image of character sequences set in the
4231 header of the glyph-string.
4233 If the shaping was successful, the value is GSTRING itself or a newly
4234 created glyph-string. Otherwise, the value is nil. */)
4236 Lisp_Object gstring
;
4239 Lisp_Object font_object
, n
, glyph
;
4242 if (! composition_gstring_p (gstring
))
4243 signal_error ("Invalid glyph-string: ", gstring
);
4244 if (! NILP (LGSTRING_ID (gstring
)))
4246 font_object
= LGSTRING_FONT (gstring
);
4247 CHECK_FONT_OBJECT (font_object
);
4248 font
= XFONT_OBJECT (font_object
);
4249 if (! font
->driver
->shape
)
4252 /* Try at most three times with larger gstring each time. */
4253 for (i
= 0; i
< 3; i
++)
4255 n
= font
->driver
->shape (gstring
);
4258 gstring
= larger_vector (gstring
,
4259 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4262 if (i
== 3 || XINT (n
) == 0)
4265 glyph
= LGSTRING_GLYPH (gstring
, 0);
4266 from
= LGLYPH_FROM (glyph
);
4267 to
= LGLYPH_TO (glyph
);
4268 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4270 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4274 if (NILP (LGLYPH_ADJUSTMENT (this)))
4279 glyph
= LGSTRING_GLYPH (gstring
, j
);
4280 LGLYPH_SET_FROM (glyph
, from
);
4281 LGLYPH_SET_TO (glyph
, to
);
4283 from
= LGLYPH_FROM (this);
4284 to
= LGLYPH_TO (this);
4289 if (from
> LGLYPH_FROM (this))
4290 from
= LGLYPH_FROM (this);
4291 if (to
< LGLYPH_TO (this))
4292 to
= LGLYPH_TO (this);
4298 glyph
= LGSTRING_GLYPH (gstring
, j
);
4299 LGLYPH_SET_FROM (glyph
, from
);
4300 LGLYPH_SET_TO (glyph
, to
);
4302 return composition_gstring_put_cache (gstring
, XINT (n
));
4307 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4308 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4309 OTF-FEATURES specifies which features to apply in this format:
4310 (SCRIPT LANGSYS GSUB GPOS)
4312 SCRIPT is a symbol specifying a script tag of OpenType,
4313 LANGSYS is a symbol specifying a langsys tag of OpenType,
4314 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4316 If LANGYS is nil, the default langsys is selected.
4318 The features are applied in the order they appear in the list. The
4319 symbol `*' means to apply all available features not present in this
4320 list, and the remaining features are ignored. For instance, (vatu
4321 pstf * haln) is to apply vatu and pstf in this order, then to apply
4322 all available features other than vatu, pstf, and haln.
4324 The features are applied to the glyphs in the range FROM and TO of
4325 the glyph-string GSTRING-IN.
4327 If some feature is actually applicable, the resulting glyphs are
4328 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4329 this case, the value is the number of produced glyphs.
4331 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4334 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4335 produced in GSTRING-OUT, and the value is nil.
4337 See the documentation of `font-make-gstring' for the format of
4339 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4340 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4342 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4347 check_otf_features (otf_features
);
4348 CHECK_FONT_OBJECT (font_object
);
4349 font
= XFONT_OBJECT (font_object
);
4350 if (! font
->driver
->otf_drive
)
4351 error ("Font backend %s can't drive OpenType GSUB table",
4352 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4353 CHECK_CONS (otf_features
);
4354 CHECK_SYMBOL (XCAR (otf_features
));
4355 val
= XCDR (otf_features
);
4356 CHECK_SYMBOL (XCAR (val
));
4357 val
= XCDR (otf_features
);
4360 len
= check_gstring (gstring_in
);
4361 CHECK_VECTOR (gstring_out
);
4362 CHECK_NATNUM (from
);
4364 CHECK_NATNUM (index
);
4366 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4367 args_out_of_range_3 (from
, to
, make_number (len
));
4368 if (XINT (index
) >= ASIZE (gstring_out
))
4369 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4370 num
= font
->driver
->otf_drive (font
, otf_features
,
4371 gstring_in
, XINT (from
), XINT (to
),
4372 gstring_out
, XINT (index
), 0);
4375 return make_number (num
);
4378 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4380 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4381 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4383 (SCRIPT LANGSYS FEATURE ...)
4384 See the documentation of `font-drive-otf' for more detail.
4386 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4387 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4388 character code corresponding to the glyph or nil if there's no
4389 corresponding character. */)
4390 (font_object
, character
, otf_features
)
4391 Lisp_Object font_object
, character
, otf_features
;
4394 Lisp_Object gstring_in
, gstring_out
, g
;
4395 Lisp_Object alternates
;
4398 CHECK_FONT_GET_OBJECT (font_object
, font
);
4399 if (! font
->driver
->otf_drive
)
4400 error ("Font backend %s can't drive OpenType GSUB table",
4401 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4402 CHECK_CHARACTER (character
);
4403 CHECK_CONS (otf_features
);
4405 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4406 g
= LGSTRING_GLYPH (gstring_in
, 0);
4407 LGLYPH_SET_CHAR (g
, XINT (character
));
4408 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4409 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4410 gstring_out
, 0, 1)) < 0)
4411 gstring_out
= Ffont_make_gstring (font_object
,
4412 make_number (ASIZE (gstring_out
) * 2));
4414 for (i
= 0; i
< num
; i
++)
4416 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4417 int c
= LGLYPH_CHAR (g
);
4418 unsigned code
= LGLYPH_CODE (g
);
4420 alternates
= Fcons (Fcons (make_number (code
),
4421 c
> 0 ? make_number (c
) : Qnil
),
4424 return Fnreverse (alternates
);
4430 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4431 doc
: /* Open FONT-ENTITY. */)
4432 (font_entity
, size
, frame
)
4433 Lisp_Object font_entity
;
4439 CHECK_FONT_ENTITY (font_entity
);
4441 frame
= selected_frame
;
4442 CHECK_LIVE_FRAME (frame
);
4445 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4448 CHECK_NUMBER_OR_FLOAT (size
);
4450 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
4452 isize
= XINT (size
);
4456 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4459 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4460 doc
: /* Close FONT-OBJECT. */)
4461 (font_object
, frame
)
4462 Lisp_Object font_object
, frame
;
4464 CHECK_FONT_OBJECT (font_object
);
4466 frame
= selected_frame
;
4467 CHECK_LIVE_FRAME (frame
);
4468 font_close_object (XFRAME (frame
), font_object
);
4472 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4473 doc
: /* Return information about FONT-OBJECT.
4474 The value is a vector:
4475 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4478 NAME is a string of the font name (or nil if the font backend doesn't
4481 FILENAME is a string of the font file (or nil if the font backend
4482 doesn't provide a file name).
4484 PIXEL-SIZE is a pixel size by which the font is opened.
4486 SIZE is a maximum advance width of the font in pixels.
4488 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4491 CAPABILITY is a list whose first element is a symbol representing the
4492 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4493 remaining elements describe the details of the font capability.
4495 If the font is OpenType font, the form of the list is
4496 \(opentype GSUB GPOS)
4497 where GSUB shows which "GSUB" features the font supports, and GPOS
4498 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4499 lists of the format:
4500 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4502 If the font is not OpenType font, currently the length of the form is
4505 SCRIPT is a symbol representing OpenType script tag.
4507 LANGSYS is a symbol representing OpenType langsys tag, or nil
4508 representing the default langsys.
4510 FEATURE is a symbol representing OpenType feature tag.
4512 If the font is not OpenType font, CAPABILITY is nil. */)
4514 Lisp_Object font_object
;
4519 CHECK_FONT_GET_OBJECT (font_object
, font
);
4521 val
= Fmake_vector (make_number (9), Qnil
);
4522 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4523 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4524 ASET (val
, 2, make_number (font
->pixel_size
));
4525 ASET (val
, 3, make_number (font
->max_width
));
4526 ASET (val
, 4, make_number (font
->ascent
));
4527 ASET (val
, 5, make_number (font
->descent
));
4528 ASET (val
, 6, make_number (font
->space_width
));
4529 ASET (val
, 7, make_number (font
->average_width
));
4530 if (font
->driver
->otf_capability
)
4531 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4535 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4536 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4537 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4538 (font_object
, string
)
4539 Lisp_Object font_object
, string
;
4545 CHECK_FONT_GET_OBJECT (font_object
, font
);
4546 CHECK_STRING (string
);
4547 len
= SCHARS (string
);
4548 vec
= Fmake_vector (make_number (len
), Qnil
);
4549 for (i
= 0; i
< len
; i
++)
4551 Lisp_Object ch
= Faref (string
, make_number (i
));
4556 struct font_metrics metrics
;
4558 cod
= code
= font
->driver
->encode_char (font
, c
);
4559 if (code
== FONT_INVALID_CODE
)
4561 val
= Fmake_vector (make_number (6), Qnil
);
4562 if (cod
<= MOST_POSITIVE_FIXNUM
)
4563 ASET (val
, 0, make_number (code
));
4565 ASET (val
, 0, Fcons (make_number (code
>> 16),
4566 make_number (code
& 0xFFFF)));
4567 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4568 ASET (val
, 1, make_number (metrics
.lbearing
));
4569 ASET (val
, 2, make_number (metrics
.rbearing
));
4570 ASET (val
, 3, make_number (metrics
.width
));
4571 ASET (val
, 4, make_number (metrics
.ascent
));
4572 ASET (val
, 5, make_number (metrics
.descent
));
4578 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4579 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4580 FONT is a font-spec, font-entity, or font-object. */)
4582 Lisp_Object spec
, font
;
4584 CHECK_FONT_SPEC (spec
);
4587 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4590 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4591 doc
: /* Return a font-object for displaying a character at POSITION.
4592 Optional second arg WINDOW, if non-nil, is a window displaying
4593 the current buffer. It defaults to the currently selected window. */)
4594 (position
, window
, string
)
4595 Lisp_Object position
, window
, string
;
4602 CHECK_NUMBER_COERCE_MARKER (position
);
4603 pos
= XINT (position
);
4604 if (pos
< BEGV
|| pos
>= ZV
)
4605 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4609 CHECK_NUMBER (position
);
4610 CHECK_STRING (string
);
4611 pos
= XINT (position
);
4612 if (pos
< 0 || pos
>= SCHARS (string
))
4613 args_out_of_range (string
, position
);
4616 window
= selected_window
;
4617 CHECK_LIVE_WINDOW (window
);
4618 w
= XWINDOW (window
);
4620 return font_at (-1, pos
, NULL
, w
, string
);
4624 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4625 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4626 The value is a number of glyphs drawn.
4627 Type C-l to recover what previously shown. */)
4628 (font_object
, string
)
4629 Lisp_Object font_object
, string
;
4631 Lisp_Object frame
= selected_frame
;
4632 FRAME_PTR f
= XFRAME (frame
);
4638 CHECK_FONT_GET_OBJECT (font_object
, font
);
4639 CHECK_STRING (string
);
4640 len
= SCHARS (string
);
4641 code
= alloca (sizeof (unsigned) * len
);
4642 for (i
= 0; i
< len
; i
++)
4644 Lisp_Object ch
= Faref (string
, make_number (i
));
4648 code
[i
] = font
->driver
->encode_char (font
, c
);
4649 if (code
[i
] == FONT_INVALID_CODE
)
4652 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4654 if (font
->driver
->prepare_face
)
4655 font
->driver
->prepare_face (f
, face
);
4656 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4657 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4658 if (font
->driver
->done_face
)
4659 font
->driver
->done_face (f
, face
);
4661 return make_number (len
);
4665 #endif /* FONT_DEBUG */
4667 #ifdef HAVE_WINDOW_SYSTEM
4669 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4670 doc
: /* Return information about a font named NAME on frame FRAME.
4671 If FRAME is omitted or nil, use the selected frame.
4672 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4673 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4675 OPENED-NAME is the name used for opening the font,
4676 FULL-NAME is the full name of the font,
4677 SIZE is the maximum bound width of the font,
4678 HEIGHT is the height of the font,
4679 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4680 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4681 how to compose characters.
4682 If the named font is not yet loaded, return nil. */)
4684 Lisp_Object name
, frame
;
4689 Lisp_Object font_object
;
4691 (*check_window_system_func
) ();
4694 CHECK_STRING (name
);
4696 frame
= selected_frame
;
4697 CHECK_LIVE_FRAME (frame
);
4702 int fontset
= fs_query_fontset (name
, 0);
4705 name
= fontset_ascii (fontset
);
4706 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4708 else if (FONT_OBJECT_P (name
))
4710 else if (FONT_ENTITY_P (name
))
4711 font_object
= font_open_entity (f
, name
, 0);
4714 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4715 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4717 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4719 if (NILP (font_object
))
4721 font
= XFONT_OBJECT (font_object
);
4723 info
= Fmake_vector (make_number (7), Qnil
);
4724 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4725 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4726 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4727 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4728 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4729 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4730 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4733 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4734 close it now. Perhaps, we should manage font-objects
4735 by `reference-count'. */
4736 font_close_object (f
, font_object
);
4743 #define BUILD_STYLE_TABLE(TBL) \
4744 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4747 build_style_table (entry
, nelement
)
4748 struct table_entry
*entry
;
4752 Lisp_Object table
, elt
;
4754 table
= Fmake_vector (make_number (nelement
), Qnil
);
4755 for (i
= 0; i
< nelement
; i
++)
4757 for (j
= 0; entry
[i
].names
[j
]; j
++);
4758 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4759 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4760 for (j
= 0; entry
[i
].names
[j
]; j
++)
4761 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4762 ASET (table
, i
, elt
);
4767 static Lisp_Object Vfont_log
;
4768 static int font_log_env_checked
;
4770 /* The deferred font-log data of the form [ACTION ARG RESULT].
4771 If ACTION is not nil, that is added to the log when font_add_log is
4772 called next time. At that time, ACTION is set back to nil. */
4773 static Lisp_Object Vfont_log_deferred
;
4775 /* Prepend the font-related logging data in Vfont_log if it is not
4776 `t'. ACTION describes a kind of font-related action (e.g. listing,
4777 opening), ARG is the argument for the action, and RESULT is the
4778 result of the action. */
4780 font_add_log (action
, arg
, result
)
4782 Lisp_Object arg
, result
;
4784 Lisp_Object tail
, val
;
4787 if (! font_log_env_checked
)
4789 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
4790 font_log_env_checked
= 1;
4792 if (EQ (Vfont_log
, Qt
))
4794 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4796 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
4798 ASET (Vfont_log_deferred
, 0, Qnil
);
4799 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4800 AREF (Vfont_log_deferred
, 2));
4805 Lisp_Object tail
, elt
;
4806 Lisp_Object equalstr
= build_string ("=");
4808 val
= Ffont_xlfd_name (arg
, Qt
);
4809 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4813 if (EQ (XCAR (elt
), QCscript
))
4814 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4815 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4816 else if (EQ (XCAR (elt
), QClang
))
4817 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4818 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4819 else if (EQ (XCAR (elt
), QCotf
) && CONSP (XCDR (elt
)))
4820 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4822 SYMBOL_NAME (XCAR (XCDR (elt
)))));
4828 val
= Ffont_xlfd_name (result
, Qt
);
4829 if (! FONT_SPEC_P (result
))
4830 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4831 build_string (":"), val
);
4834 else if (CONSP (result
))
4836 result
= Fcopy_sequence (result
);
4837 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4841 val
= Ffont_xlfd_name (val
, Qt
);
4842 XSETCAR (tail
, val
);
4845 else if (VECTORP (result
))
4847 result
= Fcopy_sequence (result
);
4848 for (i
= 0; i
< ASIZE (result
); i
++)
4850 val
= AREF (result
, i
);
4852 val
= Ffont_xlfd_name (val
, Qt
);
4853 ASET (result
, i
, val
);
4856 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4859 /* Record a font-related logging data to be added to Vfont_log when
4860 font_add_log is called next time. ACTION, ARG, RESULT are the same
4864 font_deferred_log (action
, arg
, result
)
4866 Lisp_Object arg
, result
;
4868 ASET (Vfont_log_deferred
, 0, build_string (action
));
4869 ASET (Vfont_log_deferred
, 1, arg
);
4870 ASET (Vfont_log_deferred
, 2, result
);
4873 extern void syms_of_ftfont
P_ (());
4874 extern void syms_of_xfont
P_ (());
4875 extern void syms_of_xftfont
P_ (());
4876 extern void syms_of_ftxfont
P_ (());
4877 extern void syms_of_bdffont
P_ (());
4878 extern void syms_of_w32font
P_ (());
4879 extern void syms_of_atmfont
P_ (());
4880 extern void syms_of_nsfont
P_ (());
4885 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
4886 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
4887 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
4888 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
4889 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
4890 /* Note that the other elements in sort_shift_bits are not used. */
4892 staticpro (&font_charset_alist
);
4893 font_charset_alist
= Qnil
;
4895 DEFSYM (Qfont_spec
, "font-spec");
4896 DEFSYM (Qfont_entity
, "font-entity");
4897 DEFSYM (Qfont_object
, "font-object");
4899 DEFSYM (Qopentype
, "opentype");
4901 DEFSYM (Qascii_0
, "ascii-0");
4902 DEFSYM (Qiso8859_1
, "iso8859-1");
4903 DEFSYM (Qiso10646_1
, "iso10646-1");
4904 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4905 DEFSYM (Qunicode_sip
, "unicode-sip");
4909 DEFSYM (QCotf
, ":otf");
4910 DEFSYM (QClang
, ":lang");
4911 DEFSYM (QCscript
, ":script");
4912 DEFSYM (QCantialias
, ":antialias");
4914 DEFSYM (QCfoundry
, ":foundry");
4915 DEFSYM (QCadstyle
, ":adstyle");
4916 DEFSYM (QCregistry
, ":registry");
4917 DEFSYM (QCspacing
, ":spacing");
4918 DEFSYM (QCdpi
, ":dpi");
4919 DEFSYM (QCscalable
, ":scalable");
4920 DEFSYM (QCavgwidth
, ":avgwidth");
4921 DEFSYM (QCfont_entity
, ":font-entity");
4922 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
4929 staticpro (&null_vector
);
4930 null_vector
= Fmake_vector (make_number (0), Qnil
);
4932 staticpro (&scratch_font_spec
);
4933 scratch_font_spec
= Ffont_spec (0, NULL
);
4934 staticpro (&scratch_font_prefer
);
4935 scratch_font_prefer
= Ffont_spec (0, NULL
);
4937 staticpro (&Vfont_log_deferred
);
4938 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
4942 staticpro (&otf_list
);
4944 #endif /* HAVE_LIBOTF */
4948 defsubr (&Sfont_spec
);
4949 defsubr (&Sfont_get
);
4950 #ifdef HAVE_WINDOW_SYSTEM
4951 defsubr (&Sfont_face_attributes
);
4953 defsubr (&Sfont_put
);
4954 defsubr (&Slist_fonts
);
4955 defsubr (&Sfont_family_list
);
4956 defsubr (&Sfind_font
);
4957 defsubr (&Sfont_xlfd_name
);
4958 defsubr (&Sclear_font_cache
);
4959 defsubr (&Sfont_shape_gstring
);
4961 defsubr (&Sfont_drive_otf
);
4962 defsubr (&Sfont_otf_alternates
);
4966 defsubr (&Sopen_font
);
4967 defsubr (&Sclose_font
);
4968 defsubr (&Squery_font
);
4969 defsubr (&Sget_font_glyphs
);
4970 defsubr (&Sfont_match_p
);
4971 defsubr (&Sfont_at
);
4973 defsubr (&Sdraw_string
);
4975 #endif /* FONT_DEBUG */
4976 #ifdef HAVE_WINDOW_SYSTEM
4977 defsubr (&Sfont_info
);
4980 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
4982 Alist of fontname patterns vs the corresponding encoding and repertory info.
4983 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
4984 where ENCODING is a charset or a char-table,
4985 and REPERTORY is a charset, a char-table, or nil.
4987 If ENCODING and REPERTORY are the same, the element can have the form
4988 \(REGEXP . ENCODING).
4990 ENCODING is for converting a character to a glyph code of the font.
4991 If ENCODING is a charset, encoding a character by the charset gives
4992 the corresponding glyph code. If ENCODING is a char-table, looking up
4993 the table by a character gives the corresponding glyph code.
4995 REPERTORY specifies a repertory of characters supported by the font.
4996 If REPERTORY is a charset, all characters beloging to the charset are
4997 supported. If REPERTORY is a char-table, all characters who have a
4998 non-nil value in the table are supported. If REPERTORY is nil, Emacs
4999 gets the repertory information by an opened font and ENCODING. */);
5000 Vfont_encoding_alist
= Qnil
;
5002 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5003 doc
: /* Vector of valid font weight values.
5004 Each element has the form:
5005 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5006 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5007 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5009 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5010 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5011 See `font-weight-table' for the format of the vector. */);
5012 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5014 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5015 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5016 See `font-weight-table' for the format of the vector. */);
5017 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5019 staticpro (&font_style_table
);
5020 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5021 ASET (font_style_table
, 0, Vfont_weight_table
);
5022 ASET (font_style_table
, 1, Vfont_slant_table
);
5023 ASET (font_style_table
, 2, Vfont_width_table
);
5025 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5026 *Logging list of font related actions and results.
5027 The value t means to suppress the logging.
5028 The initial value is set to nil if the environment variable
5029 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5032 #ifdef HAVE_WINDOW_SYSTEM
5033 #ifdef HAVE_FREETYPE
5035 #ifdef HAVE_X_WINDOWS
5040 #endif /* HAVE_XFT */
5041 #endif /* HAVE_X_WINDOWS */
5042 #else /* not HAVE_FREETYPE */
5043 #ifdef HAVE_X_WINDOWS
5045 #endif /* HAVE_X_WINDOWS */
5046 #endif /* not HAVE_FREETYPE */
5049 #endif /* HAVE_BDFFONT */
5052 #endif /* WINDOWSNT */
5055 #endif /* HAVE_NS */
5056 #endif /* HAVE_WINDOW_SYSTEM */
5059 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5060 (do not change this comment) */