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
;
1603 Lisp_Object styles
[3];
1604 char *style_names
[3] = { "weight", "slant", "width" };
1607 family
= AREF (font
, FONT_FAMILY_INDEX
);
1608 if (! NILP (family
))
1610 if (SYMBOLP (family
))
1612 family
= SYMBOL_NAME (family
);
1613 len
+= SBYTES (family
);
1619 val
= AREF (font
, FONT_SIZE_INDEX
);
1622 if (XINT (val
) != 0)
1623 pixel_size
= XINT (val
);
1625 len
+= 21; /* for ":pixelsize=NUM" */
1627 else if (FLOATP (val
))
1630 point_size
= (int) XFLOAT_DATA (val
);
1631 len
+= 11; /* for "-NUM" */
1634 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1635 if (! NILP (foundry
))
1637 if (SYMBOLP (foundry
))
1639 foundry
= SYMBOL_NAME (foundry
);
1640 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1646 for (i
= 0; i
< 3; i
++)
1648 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1649 if (! NILP (styles
[i
]))
1650 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1651 SDATA (SYMBOL_NAME (styles
[i
])));
1654 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1655 len
+= sprintf (work
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1656 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1657 len
+= strlen (":spacing=100");
1658 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1659 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1660 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1662 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1664 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1666 len
+= SBYTES (val
);
1667 else if (INTEGERP (val
))
1668 len
+= sprintf (work
, "%d", XINT (val
));
1669 else if (SYMBOLP (val
))
1670 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1676 if (! NILP (family
))
1677 p
+= sprintf (p
, "%s", SDATA (family
));
1681 p
+= sprintf (p
, "%d", point_size
);
1683 p
+= sprintf (p
, "-%d", point_size
);
1685 else if (pixel_size
> 0)
1686 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1687 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1688 p
+= sprintf (p
, ":foundry=%s",
1689 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1690 for (i
= 0; i
< 3; i
++)
1691 if (! NILP (styles
[i
]))
1692 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1693 SDATA (SYMBOL_NAME (styles
[i
])));
1694 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1695 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1696 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1697 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1698 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1700 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1701 p
+= sprintf (p
, ":scalable=true");
1703 p
+= sprintf (p
, ":scalable=false");
1708 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1709 NAME (NBYTES length), and return the name length. F is the frame
1710 on which the font is displayed; it is used to calculate the point
1714 font_unparse_gtkname (font
, f
, name
, nbytes
)
1722 Lisp_Object family
, weight
, slant
, size
;
1723 int point_size
= -1;
1725 family
= AREF (font
, FONT_FAMILY_INDEX
);
1726 if (! NILP (family
))
1728 if (! SYMBOLP (family
))
1730 family
= SYMBOL_NAME (family
);
1731 len
+= SBYTES (family
);
1734 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1735 if (EQ (weight
, Qnormal
))
1737 else if (! NILP (weight
))
1739 weight
= SYMBOL_NAME (weight
);
1740 len
+= SBYTES (weight
);
1743 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1744 if (EQ (slant
, Qnormal
))
1746 else if (! NILP (slant
))
1748 slant
= SYMBOL_NAME (slant
);
1749 len
+= SBYTES (slant
);
1752 size
= AREF (font
, FONT_SIZE_INDEX
);
1753 /* Convert pixel size to point size. */
1754 if (INTEGERP (size
))
1756 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1758 if (INTEGERP (font_dpi
))
1759 dpi
= XINT (font_dpi
);
1762 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1765 else if (FLOATP (size
))
1767 point_size
= (int) XFLOAT_DATA (size
);
1774 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1776 if (! NILP (weight
))
1779 p
+= sprintf (p
, " %s", SDATA (weight
));
1780 q
[1] = toupper (q
[1]);
1786 p
+= sprintf (p
, " %s", SDATA (slant
));
1787 q
[1] = toupper (q
[1]);
1791 p
+= sprintf (p
, " %d", point_size
);
1796 /* Parse NAME (null terminated) and store information in FONT
1797 (font-spec or font-entity). If NAME is successfully parsed, return
1798 0. Otherwise return -1. */
1801 font_parse_name (name
, font
)
1805 if (name
[0] == '-' || index (name
, '*'))
1806 return font_parse_xlfd (name
, font
);
1807 return font_parse_fcname (name
, font
);
1811 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1812 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1816 font_parse_family_registry (family
, registry
, font_spec
)
1817 Lisp_Object family
, registry
, font_spec
;
1823 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1825 CHECK_STRING (family
);
1826 len
= SBYTES (family
);
1827 p0
= (char *) SDATA (family
);
1828 p1
= index (p0
, '-');
1831 if ((*p0
!= '*' || p1
- p0
> 1)
1832 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1833 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1836 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1839 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1841 if (! NILP (registry
))
1843 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1844 CHECK_STRING (registry
);
1845 len
= SBYTES (registry
);
1846 p0
= (char *) SDATA (registry
);
1847 p1
= index (p0
, '-');
1850 if (SDATA (registry
)[len
- 1] == '*')
1851 registry
= concat2 (registry
, build_string ("-*"));
1853 registry
= concat2 (registry
, build_string ("*-*"));
1855 registry
= Fdowncase (registry
);
1856 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1861 /* This part (through the next ^L) is still experimental and not
1862 tested much. We may drastically change codes. */
1868 #define LGSTRING_HEADER_SIZE 6
1869 #define LGSTRING_GLYPH_SIZE 8
1872 check_gstring (gstring
)
1873 Lisp_Object gstring
;
1878 CHECK_VECTOR (gstring
);
1879 val
= AREF (gstring
, 0);
1881 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1883 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1884 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1885 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1886 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1887 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1888 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1889 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1890 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1891 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1892 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1893 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1895 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1897 val
= LGSTRING_GLYPH (gstring
, i
);
1899 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1901 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1903 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1904 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1905 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1906 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1907 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1908 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1909 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1910 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1912 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1914 if (ASIZE (val
) < 3)
1916 for (j
= 0; j
< 3; j
++)
1917 CHECK_NUMBER (AREF (val
, j
));
1922 error ("Invalid glyph-string format");
1927 check_otf_features (otf_features
)
1928 Lisp_Object otf_features
;
1932 CHECK_CONS (otf_features
);
1933 CHECK_SYMBOL (XCAR (otf_features
));
1934 otf_features
= XCDR (otf_features
);
1935 CHECK_CONS (otf_features
);
1936 CHECK_SYMBOL (XCAR (otf_features
));
1937 otf_features
= XCDR (otf_features
);
1938 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1940 CHECK_SYMBOL (Fcar (val
));
1941 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1942 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1944 otf_features
= XCDR (otf_features
);
1945 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1947 CHECK_SYMBOL (Fcar (val
));
1948 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1949 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1956 Lisp_Object otf_list
;
1959 otf_tag_symbol (tag
)
1964 OTF_tag_name (tag
, name
);
1965 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1972 Lisp_Object val
= Fassoc (file
, otf_list
);
1976 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1979 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1980 val
= make_save_value (otf
, 0);
1981 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1987 /* Return a list describing which scripts/languages FONT supports by
1988 which GSUB/GPOS features of OpenType tables. See the comment of
1989 (struct font_driver).otf_capability. */
1992 font_otf_capability (font
)
1996 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1999 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
2002 for (i
= 0; i
< 2; i
++)
2004 OTF_GSUB_GPOS
*gsub_gpos
;
2005 Lisp_Object script_list
= Qnil
;
2008 if (OTF_get_features (otf
, i
== 0) < 0)
2010 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2011 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2013 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2014 Lisp_Object langsys_list
= Qnil
;
2015 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2018 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2020 OTF_LangSys
*langsys
;
2021 Lisp_Object feature_list
= Qnil
;
2022 Lisp_Object langsys_tag
;
2025 if (k
== script
->LangSysCount
)
2027 langsys
= &script
->DefaultLangSys
;
2032 langsys
= script
->LangSys
+ k
;
2034 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2036 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2038 OTF_Feature
*feature
2039 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2040 Lisp_Object feature_tag
2041 = otf_tag_symbol (feature
->FeatureTag
);
2043 feature_list
= Fcons (feature_tag
, feature_list
);
2045 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2048 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2053 XSETCAR (capability
, script_list
);
2055 XSETCDR (capability
, script_list
);
2061 /* Parse OTF features in SPEC and write a proper features spec string
2062 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2063 assured that the sufficient memory has already allocated for
2067 generate_otf_features (spec
, features
)
2077 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2083 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2088 else if (! asterisk
)
2090 val
= SYMBOL_NAME (val
);
2091 p
+= sprintf (p
, "%s", SDATA (val
));
2095 val
= SYMBOL_NAME (val
);
2096 p
+= sprintf (p
, "~%s", SDATA (val
));
2100 error ("OTF spec too long");
2104 font_otf_DeviceTable (device_table
)
2105 OTF_DeviceTable
*device_table
;
2107 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2109 return Fcons (make_number (len
),
2110 make_unibyte_string (device_table
->DeltaValue
, len
));
2114 font_otf_ValueRecord (value_format
, value_record
)
2116 OTF_ValueRecord
*value_record
;
2118 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2120 if (value_format
& OTF_XPlacement
)
2121 ASET (val
, 0, make_number (value_record
->XPlacement
));
2122 if (value_format
& OTF_YPlacement
)
2123 ASET (val
, 1, make_number (value_record
->YPlacement
));
2124 if (value_format
& OTF_XAdvance
)
2125 ASET (val
, 2, make_number (value_record
->XAdvance
));
2126 if (value_format
& OTF_YAdvance
)
2127 ASET (val
, 3, make_number (value_record
->YAdvance
));
2128 if (value_format
& OTF_XPlaDevice
)
2129 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2130 if (value_format
& OTF_YPlaDevice
)
2131 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2132 if (value_format
& OTF_XAdvDevice
)
2133 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2134 if (value_format
& OTF_YAdvDevice
)
2135 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2140 font_otf_Anchor (anchor
)
2145 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2146 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2147 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2148 if (anchor
->AnchorFormat
== 2)
2149 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2152 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2153 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2157 #endif /* HAVE_LIBOTF */
2163 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2164 static int font_compare
P_ ((const void *, const void *));
2165 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
2168 /* We sort fonts by scoring each of them against a specified
2169 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2170 the value is, the closer the font is to the font-spec.
2172 The lowest 2 bits of the score is used for driver type. The font
2173 available by the most preferred font driver is 0.
2175 Each 7-bit in the higher 28 bits are used for numeric properties
2176 WEIGHT, SLANT, WIDTH, and SIZE. */
2178 /* How many bits to shift to store the difference value of each font
2179 property in a score. Note that flots for FONT_TYPE_INDEX and
2180 FONT_REGISTRY_INDEX are not used. */
2181 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2183 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2184 The return value indicates how different ENTITY is compared with
2188 font_score (entity
, spec_prop
)
2189 Lisp_Object entity
, *spec_prop
;
2194 /* Score three style numeric fields. Maximum difference is 127. */
2195 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2196 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2198 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2203 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2206 /* Score the size. Maximum difference is 127. */
2207 i
= FONT_SIZE_INDEX
;
2208 if (! NILP (spec_prop
[i
]) && XINT (AREF (entity
, i
)) > 0)
2210 /* We use the higher 6-bit for the actual size difference. The
2211 lowest bit is set if the DPI is different. */
2212 int diff
= XINT (spec_prop
[i
]) - XINT (AREF (entity
, i
));
2217 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2218 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2220 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2227 /* The comparison function for qsort. */
2230 font_compare (d1
, d2
)
2231 const void *d1
, *d2
;
2233 return (*(unsigned *) d1
- *(unsigned *) d2
);
2237 /* The structure for elements being sorted by qsort. */
2238 struct font_sort_data
2245 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2246 If PREFER specifies a point-size, calculate the corresponding
2247 pixel-size from QCdpi property of PREFER or from the Y-resolution
2248 of FRAME before sorting.
2250 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2251 return the sorted VEC. */
2254 font_sort_entites (vec
, prefer
, frame
, best_only
)
2255 Lisp_Object vec
, prefer
, frame
;
2258 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2260 struct font_sort_data
*data
;
2261 unsigned best_score
;
2262 Lisp_Object best_entity
, driver_type
;
2264 struct frame
*f
= XFRAME (frame
);
2265 struct font_driver_list
*list
;
2270 return best_only
? AREF (vec
, 0) : vec
;
2272 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_DPI_INDEX
; i
++)
2273 prefer_prop
[i
] = AREF (prefer
, i
);
2274 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2275 prefer_prop
[FONT_SIZE_INDEX
]
2276 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2278 /* Scoring and sorting. */
2279 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2280 best_score
= 0xFFFFFFFF;
2281 /* We are sure that the length of VEC > 1. */
2282 driver_type
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2283 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2284 driver_order
++, list
= list
->next
)
2285 if (EQ (driver_type
, list
->driver
->type
))
2287 best_entity
= data
[0].entity
= AREF (vec
, 0);
2288 best_score
= data
[0].score
2289 = font_score (data
[0].entity
, prefer_prop
) | driver_order
;
2290 for (i
= 0; i
< len
; i
++)
2292 if (!EQ (driver_type
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2293 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2294 driver_order
++, list
= list
->next
)
2295 if (EQ (driver_type
, list
->driver
->type
))
2297 data
[i
].entity
= AREF (vec
, i
);
2298 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
) | driver_order
;
2299 if (best_only
&& best_score
> data
[i
].score
)
2301 best_score
= data
[i
].score
;
2302 best_entity
= data
[i
].entity
;
2303 if (best_score
== 0)
2309 qsort (data
, len
, sizeof *data
, font_compare
);
2310 for (i
= 0; i
< len
; i
++)
2311 ASET (vec
, i
, data
[i
].entity
);
2317 font_add_log ("sort-by", prefer
, vec
);
2322 /* API of Font Service Layer. */
2324 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2325 sort_shift_bits. Finternal_set_font_selection_order calls this
2326 function with font_sort_order after setting up it. */
2329 font_update_sort_order (order
)
2334 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2336 int xlfd_idx
= order
[i
];
2338 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2339 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2340 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2341 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2342 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2343 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2345 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2350 font_check_otf_features (script
, langsys
, features
, table
)
2351 Lisp_Object script
, langsys
, features
, table
;
2356 table
= assq_no_quit (script
, table
);
2359 table
= XCDR (table
);
2360 if (! NILP (langsys
))
2362 table
= assq_no_quit (langsys
, table
);
2368 val
= assq_no_quit (Qnil
, table
);
2370 table
= XCAR (table
);
2374 table
= XCDR (table
);
2375 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2377 if (NILP (XCAR (features
)))
2379 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2385 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2388 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2390 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2392 script
= XCAR (spec
);
2396 langsys
= XCAR (spec
);
2407 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2408 XCAR (otf_capability
)))
2410 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2411 XCDR (otf_capability
)))
2418 /* Check if FONT (font-entity or font-object) matches with the font
2419 specification SPEC. */
2422 font_match_p (spec
, font
)
2423 Lisp_Object spec
, font
;
2425 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2426 Lisp_Object extra
, font_extra
;
2429 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2430 if (! NILP (AREF (spec
, i
))
2431 && ! NILP (AREF (font
, i
))
2432 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2434 props
= XFONT_SPEC (spec
)->props
;
2435 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2437 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2438 prop
[i
] = AREF (spec
, i
);
2439 prop
[FONT_SIZE_INDEX
]
2440 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2444 if (font_score (font
, props
) > 0)
2446 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2447 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2448 for (; CONSP (extra
); extra
= XCDR (extra
))
2450 Lisp_Object key
= XCAR (XCAR (extra
));
2451 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2453 if (EQ (key
, QClang
))
2455 val2
= assq_no_quit (key
, font_extra
);
2464 if (NILP (Fmemq (val
, val2
)))
2469 ? NILP (Fmemq (val
, XCDR (val2
)))
2473 else if (EQ (key
, QCscript
))
2475 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2481 /* All characters in the list must be supported. */
2482 for (; CONSP (val2
); val2
= XCDR (val2
))
2484 if (! NATNUMP (XCAR (val2
)))
2486 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2487 == FONT_INVALID_CODE
)
2491 else if (VECTORP (val2
))
2493 /* At most one character in the vector must be supported. */
2494 for (i
= 0; i
< ASIZE (val2
); i
++)
2496 if (! NATNUMP (AREF (val2
, i
)))
2498 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2499 != FONT_INVALID_CODE
)
2502 if (i
== ASIZE (val2
))
2507 else if (EQ (key
, QCotf
))
2511 if (! FONT_OBJECT_P (font
))
2513 fontp
= XFONT_OBJECT (font
);
2514 if (! fontp
->driver
->otf_capability
)
2516 val2
= fontp
->driver
->otf_capability (fontp
);
2517 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2528 Each font backend has the callback function get_cache, and it
2529 returns a cons cell of which cdr part can be freely used for
2530 caching fonts. The cons cell may be shared by multiple frames
2531 and/or multiple font drivers. So, we arrange the cdr part as this:
2533 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2535 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2536 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2537 cons (FONT-SPEC FONT-ENTITY ...). */
2539 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2540 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2541 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2542 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2543 struct font_driver
*));
2546 font_prepare_cache (f
, driver
)
2548 struct font_driver
*driver
;
2550 Lisp_Object cache
, val
;
2552 cache
= driver
->get_cache (f
);
2554 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2558 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2559 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2563 val
= XCDR (XCAR (val
));
2564 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2570 font_finish_cache (f
, driver
)
2572 struct font_driver
*driver
;
2574 Lisp_Object cache
, val
, tmp
;
2577 cache
= driver
->get_cache (f
);
2579 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2580 cache
= val
, val
= XCDR (val
);
2581 font_assert (! NILP (val
));
2582 tmp
= XCDR (XCAR (val
));
2583 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2584 if (XINT (XCAR (tmp
)) == 0)
2586 font_clear_cache (f
, XCAR (val
), driver
);
2587 XSETCDR (cache
, XCDR (val
));
2593 font_get_cache (f
, driver
)
2595 struct font_driver
*driver
;
2597 Lisp_Object val
= driver
->get_cache (f
);
2598 Lisp_Object type
= driver
->type
;
2600 font_assert (CONSP (val
));
2601 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2602 font_assert (CONSP (val
));
2603 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2604 val
= XCDR (XCAR (val
));
2608 static int num_fonts
;
2611 font_clear_cache (f
, cache
, driver
)
2614 struct font_driver
*driver
;
2616 Lisp_Object tail
, elt
;
2618 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2619 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2622 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)) && VECTORP (XCDR (elt
)))
2624 Lisp_Object vec
= XCDR (elt
);
2627 for (i
= 0; i
< ASIZE (vec
); i
++)
2629 Lisp_Object entity
= AREF (vec
, i
);
2631 if (EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2633 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2635 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2637 Lisp_Object val
= XCAR (objlist
);
2638 struct font
*font
= XFONT_OBJECT (val
);
2640 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2642 font_assert (font
&& driver
== font
->driver
);
2643 driver
->close (f
, font
);
2647 if (driver
->free_entity
)
2648 driver
->free_entity (entity
);
2653 XSETCDR (cache
, Qnil
);
2657 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2660 font_delete_unmatched (list
, spec
, size
)
2661 Lisp_Object list
, spec
;
2664 Lisp_Object entity
, val
;
2665 enum font_property_index prop
;
2667 for (val
= Qnil
; CONSP (list
); list
= XCDR (list
))
2669 entity
= XCAR (list
);
2670 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2671 if (INTEGERP (AREF (spec
, prop
))
2672 && ((XINT (AREF (spec
, prop
)) >> 8)
2673 != (XINT (AREF (entity
, prop
)) >> 8)))
2674 prop
= FONT_SPEC_MAX
;
2675 if (prop
< FONT_SPEC_MAX
2677 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2679 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2682 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2683 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2684 prop
= FONT_SPEC_MAX
;
2686 if (prop
< FONT_SPEC_MAX
2687 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2688 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2689 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2690 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2691 prop
= FONT_SPEC_MAX
;
2692 if (prop
< FONT_SPEC_MAX
2693 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2694 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2695 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2696 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2697 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2698 prop
= FONT_SPEC_MAX
;
2699 if (prop
< FONT_SPEC_MAX
)
2700 val
= Fcons (entity
, val
);
2706 /* Return a vector of font-entities matching with SPEC on FRAME. */
2709 font_list_entities (frame
, spec
)
2710 Lisp_Object frame
, spec
;
2712 FRAME_PTR f
= XFRAME (frame
);
2713 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2714 Lisp_Object ftype
, val
;
2717 int need_filtering
= 0;
2720 font_assert (FONT_SPEC_P (spec
));
2722 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2723 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2724 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2725 size
= font_pixel_size (f
, spec
);
2729 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2730 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2731 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2732 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2734 ASET (scratch_font_spec
, i
, Qnil
);
2735 if (! NILP (AREF (spec
, i
)))
2737 if (i
== FONT_DPI_INDEX
)
2738 /* Skip FONT_SPACING_INDEX */
2741 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2742 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2744 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2748 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2750 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2752 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2754 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2755 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2762 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2763 copy
= Fcopy_font_spec (scratch_font_spec
);
2764 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2765 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2767 if (! NILP (val
) && need_filtering
)
2768 val
= font_delete_unmatched (val
, spec
, size
);
2773 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2774 font_add_log ("list", spec
, val
);
2779 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2780 nil, is an array of face's attributes, which specifies preferred
2781 font-related attributes. */
2784 font_matching_entity (f
, attrs
, spec
)
2786 Lisp_Object
*attrs
, spec
;
2788 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2789 Lisp_Object ftype
, size
, entity
;
2791 Lisp_Object work
= Fcopy_font_spec (spec
);
2793 XSETFRAME (frame
, f
);
2794 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2795 size
= AREF (spec
, FONT_SIZE_INDEX
);
2798 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2799 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2800 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2801 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2804 for (; driver_list
; driver_list
= driver_list
->next
)
2806 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2808 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2811 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2812 entity
= assoc_no_quit (work
, XCDR (cache
));
2814 entity
= XCDR (entity
);
2817 entity
= driver_list
->driver
->match (frame
, work
);
2818 copy
= Fcopy_font_spec (work
);
2819 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2820 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2822 if (! NILP (entity
))
2825 font_add_log ("match", work
, entity
);
2830 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2831 opened font object. */
2834 font_open_entity (f
, entity
, pixel_size
)
2839 struct font_driver_list
*driver_list
;
2840 Lisp_Object objlist
, size
, val
, font_object
;
2842 int min_width
, height
;
2844 font_assert (FONT_ENTITY_P (entity
));
2845 size
= AREF (entity
, FONT_SIZE_INDEX
);
2846 if (XINT (size
) != 0)
2847 pixel_size
= XINT (size
);
2849 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2850 objlist
= XCDR (objlist
))
2851 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2852 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2853 return XCAR (objlist
);
2855 val
= AREF (entity
, FONT_TYPE_INDEX
);
2856 for (driver_list
= f
->font_driver_list
;
2857 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2858 driver_list
= driver_list
->next
);
2862 font_object
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2863 font_add_log ("open", entity
, font_object
);
2864 if (NILP (font_object
))
2866 ASET (entity
, FONT_OBJLIST_INDEX
,
2867 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2868 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
2871 font
= XFONT_OBJECT (font_object
);
2872 min_width
= (font
->min_width
? font
->min_width
2873 : font
->average_width
? font
->average_width
2874 : font
->space_width
? font
->space_width
2876 height
= (font
->height
? font
->height
: 1);
2877 #ifdef HAVE_WINDOW_SYSTEM
2878 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2879 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2881 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2882 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2883 fonts_changed_p
= 1;
2887 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2888 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2889 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2890 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2898 /* Close FONT_OBJECT that is opened on frame F. */
2901 font_close_object (f
, font_object
)
2903 Lisp_Object font_object
;
2905 struct font
*font
= XFONT_OBJECT (font_object
);
2907 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2908 /* Already closed. */
2910 font_add_log ("close", font_object
, Qnil
);
2911 font
->driver
->close (f
, font
);
2912 #ifdef HAVE_WINDOW_SYSTEM
2913 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2914 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2920 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2921 FONT is a font-entity and it must be opened to check. */
2924 font_has_char (f
, font
, c
)
2931 if (FONT_ENTITY_P (font
))
2933 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2934 struct font_driver_list
*driver_list
;
2936 for (driver_list
= f
->font_driver_list
;
2937 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2938 driver_list
= driver_list
->next
);
2941 if (! driver_list
->driver
->has_char
)
2943 return driver_list
->driver
->has_char (font
, c
);
2946 font_assert (FONT_OBJECT_P (font
));
2947 fontp
= XFONT_OBJECT (font
);
2948 if (fontp
->driver
->has_char
)
2950 int result
= fontp
->driver
->has_char (font
, c
);
2955 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2959 /* Return the glyph ID of FONT_OBJECT for character C. */
2962 font_encode_char (font_object
, c
)
2963 Lisp_Object font_object
;
2968 font_assert (FONT_OBJECT_P (font_object
));
2969 font
= XFONT_OBJECT (font_object
);
2970 return font
->driver
->encode_char (font
, c
);
2974 /* Return the name of FONT_OBJECT. */
2977 font_get_name (font_object
)
2978 Lisp_Object font_object
;
2980 font_assert (FONT_OBJECT_P (font_object
));
2981 return AREF (font_object
, FONT_NAME_INDEX
);
2985 /* Return the specification of FONT_OBJECT. */
2988 font_get_spec (font_object
)
2989 Lisp_Object font_object
;
2991 Lisp_Object spec
= font_make_spec ();
2994 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2995 ASET (spec
, i
, AREF (font_object
, i
));
2996 ASET (spec
, FONT_SIZE_INDEX
,
2997 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
3002 font_spec_from_name (font_name
)
3003 Lisp_Object font_name
;
3005 Lisp_Object args
[2];
3008 args
[1] = font_name
;
3009 return Ffont_spec (2, args
);
3014 font_clear_prop (attrs
, prop
)
3016 enum font_property_index prop
;
3018 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3022 if (NILP (AREF (font
, prop
))
3023 && prop
!= FONT_FAMILY_INDEX
3024 && prop
!= FONT_FOUNDRY_INDEX
3025 && prop
!= FONT_WIDTH_INDEX
3026 && prop
!= FONT_SIZE_INDEX
)
3028 font
= Fcopy_font_spec (font
);
3029 ASET (font
, prop
, Qnil
);
3030 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3032 if (prop
== FONT_FAMILY_INDEX
)
3033 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3034 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3035 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3036 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3037 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3038 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3039 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3041 else if (prop
== FONT_SIZE_INDEX
)
3043 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3044 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3045 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3047 else if (prop
== FONT_WIDTH_INDEX
)
3048 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3049 attrs
[LFACE_FONT_INDEX
] = font
;
3053 font_update_lface (f
, attrs
)
3059 spec
= attrs
[LFACE_FONT_INDEX
];
3060 if (! FONT_SPEC_P (spec
))
3063 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3064 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3065 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3066 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3067 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3068 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3069 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3070 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);;
3071 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3072 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3073 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3077 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3082 val
= Ffont_get (spec
, QCdpi
);
3085 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3088 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3089 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3090 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3095 /* Return a font-entity satisfying SPEC and best matching with face's
3096 font related attributes in ATTRS. C, if not negative, is a
3097 character that the entity must support. */
3100 font_find_for_lface (f
, attrs
, spec
, c
)
3107 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
3108 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3110 int i
, j
, k
, l
, result
;
3112 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3113 if (NILP (registry
[0]))
3115 registry
[0] = DEFAULT_ENCODING
;
3116 registry
[1] = Qascii_0
;
3117 registry
[2] = null_vector
;
3120 registry
[1] = null_vector
;
3122 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3124 struct charset
*encoding
, *repertory
;
3126 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3127 &encoding
, &repertory
) < 0)
3131 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3133 /* Any font of this registry support C. So, let's
3134 suppress the further checking. */
3137 else if (c
> encoding
->max_char
)
3141 work
= Fcopy_font_spec (spec
);
3142 XSETFRAME (frame
, f
);
3143 size
= AREF (spec
, FONT_SIZE_INDEX
);
3144 pixel_size
= font_pixel_size (f
, spec
);
3145 if (pixel_size
== 0)
3147 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3149 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3151 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3152 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3153 if (! NILP (foundry
[0]))
3154 foundry
[1] = null_vector
;
3155 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3157 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3158 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3160 foundry
[2] = null_vector
;
3163 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3165 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3166 if (! NILP (adstyle
[0]))
3167 adstyle
[1] = null_vector
;
3168 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3170 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3172 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3174 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3176 adstyle
[2] = null_vector
;
3179 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3182 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3185 val
= AREF (work
, FONT_FAMILY_INDEX
);
3186 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3188 val
= attrs
[LFACE_FAMILY_INDEX
];
3189 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3193 family
= alloca ((sizeof family
[0]) * 2);
3195 family
[1] = null_vector
; /* terminator. */
3200 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3208 if (! NILP (alters
))
3210 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3211 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3212 family
[i
] = XCAR (alters
);
3213 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3215 family
[i
] = null_vector
;
3219 family
= alloca ((sizeof family
[0]) * 3);
3222 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3224 family
[i
] = null_vector
;
3228 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3230 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3231 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3233 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3234 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3236 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3237 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3239 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3240 entities
= font_list_entities (frame
, work
);
3241 if (ASIZE (entities
) > 0)
3249 if (ASIZE (entities
) == 1)
3252 return AREF (entities
, 0);
3256 /* Sort fonts by properties specified in LFACE. */
3257 Lisp_Object prefer
= scratch_font_prefer
;
3259 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3260 ASET (prefer
, i
, AREF (work
, i
));
3261 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3263 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3265 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3266 if (NILP (AREF (prefer
, i
)))
3267 ASET (prefer
, i
, AREF (face_font
, i
));
3269 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3270 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3271 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3272 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3273 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3274 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3275 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3276 entities
= font_sort_entites (entities
, prefer
, frame
, c
< 0);
3281 for (i
= 0; i
< ASIZE (entities
); i
++)
3285 val
= AREF (entities
, i
);
3288 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3289 if (! EQ (AREF (val
, j
), props
[j
]))
3291 if (j
> FONT_REGISTRY_INDEX
)
3294 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3295 props
[j
] = AREF (val
, j
);
3296 result
= font_has_char (f
, val
, c
);
3301 val
= font_open_for_lface (f
, val
, attrs
, spec
);
3304 result
= font_has_char (f
, val
, c
);
3305 font_close_object (f
, val
);
3307 return AREF (entities
, i
);
3314 font_open_for_lface (f
, entity
, attrs
, spec
)
3322 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3323 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3324 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3325 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3326 size
= font_pixel_size (f
, spec
);
3329 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3332 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3336 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3337 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3341 return font_open_entity (f
, entity
, size
);
3345 /* Find a font satisfying SPEC and best matching with face's
3346 attributes in ATTRS on FRAME, and return the opened
3350 font_load_for_lface (f
, attrs
, spec
)
3352 Lisp_Object
*attrs
, spec
;
3356 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3359 /* No font is listed for SPEC, but each font-backend may have
3360 the different criteria about "font matching". So, try
3362 entity
= font_matching_entity (f
, attrs
, spec
);
3366 return font_open_for_lface (f
, entity
, attrs
, spec
);
3370 /* Make FACE on frame F ready to use the font opened for FACE. */
3373 font_prepare_for_face (f
, face
)
3377 if (face
->font
->driver
->prepare_face
)
3378 face
->font
->driver
->prepare_face (f
, face
);
3382 /* Make FACE on frame F stop using the font opened for FACE. */
3385 font_done_for_face (f
, face
)
3389 if (face
->font
->driver
->done_face
)
3390 face
->font
->driver
->done_face (f
, face
);
3395 /* Open a font best matching with NAME on frame F. If no proper font
3396 is found, return Qnil. */
3399 font_open_by_name (f
, name
)
3403 Lisp_Object args
[2];
3404 Lisp_Object spec
, attrs
[LFACE_VECTOR_SIZE
];
3407 args
[1] = make_unibyte_string (name
, strlen (name
));
3408 spec
= Ffont_spec (2, args
);
3409 /* We set up the default font-related attributes of a face to prefer
3411 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3412 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3413 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3415 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3417 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3419 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3421 return font_load_for_lface (f
, attrs
, spec
);
3425 /* Register font-driver DRIVER. This function is used in two ways.
3427 The first is with frame F non-NULL. In this case, make DRIVER
3428 available (but not yet activated) on F. All frame creaters
3429 (e.g. Fx_create_frame) must call this function at least once with
3430 an available font-driver.
3432 The second is with frame F NULL. In this case, DRIVER is globally
3433 registered in the variable `font_driver_list'. All font-driver
3434 implementations must call this function in its syms_of_XXXX
3435 (e.g. syms_of_xfont). */
3438 register_font_driver (driver
, f
)
3439 struct font_driver
*driver
;
3442 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3443 struct font_driver_list
*prev
, *list
;
3445 if (f
&& ! driver
->draw
)
3446 error ("Unusable font driver for a frame: %s",
3447 SDATA (SYMBOL_NAME (driver
->type
)));
3449 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3450 if (EQ (list
->driver
->type
, driver
->type
))
3451 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3453 list
= xmalloc (sizeof (struct font_driver_list
));
3455 list
->driver
= driver
;
3460 f
->font_driver_list
= list
;
3462 font_driver_list
= list
;
3468 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3469 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3470 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3472 A caller must free all realized faces if any in advance. The
3473 return value is a list of font backends actually made used on
3477 font_update_drivers (f
, new_drivers
)
3479 Lisp_Object new_drivers
;
3481 Lisp_Object active_drivers
= Qnil
;
3482 struct font_driver
*driver
;
3483 struct font_driver_list
*list
;
3485 /* At first, turn off non-requested drivers, and turn on requested
3487 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3489 driver
= list
->driver
;
3490 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3495 if (driver
->end_for_frame
)
3496 driver
->end_for_frame (f
);
3497 font_finish_cache (f
, driver
);
3502 if (! driver
->start_for_frame
3503 || driver
->start_for_frame (f
) == 0)
3505 font_prepare_cache (f
, driver
);
3512 if (NILP (new_drivers
))
3515 if (! EQ (new_drivers
, Qt
))
3517 /* Re-order the driver list according to new_drivers. */
3518 struct font_driver_list
**list_table
, **next
;
3522 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3523 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3525 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3526 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3529 list_table
[i
++] = list
;
3531 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3533 list_table
[i
] = list
;
3534 list_table
[i
] = NULL
;
3536 next
= &f
->font_driver_list
;
3537 for (i
= 0; list_table
[i
]; i
++)
3539 *next
= list_table
[i
];
3540 next
= &(*next
)->next
;
3545 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3547 active_drivers
= nconc2 (active_drivers
,
3548 Fcons (list
->driver
->type
, Qnil
));
3549 return active_drivers
;
3553 font_put_frame_data (f
, driver
, data
)
3555 struct font_driver
*driver
;
3558 struct font_data_list
*list
, *prev
;
3560 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3561 prev
= list
, list
= list
->next
)
3562 if (list
->driver
== driver
)
3569 prev
->next
= list
->next
;
3571 f
->font_data_list
= list
->next
;
3579 list
= xmalloc (sizeof (struct font_data_list
));
3580 list
->driver
= driver
;
3581 list
->next
= f
->font_data_list
;
3582 f
->font_data_list
= list
;
3590 font_get_frame_data (f
, driver
)
3592 struct font_driver
*driver
;
3594 struct font_data_list
*list
;
3596 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3597 if (list
->driver
== driver
)
3605 /* Return the font used to draw character C by FACE at buffer position
3606 POS in window W. If STRING is non-nil, it is a string containing C
3607 at index POS. If C is negative, get C from the current buffer or
3611 font_at (c
, pos
, face
, w
, string
)
3620 Lisp_Object font_object
;
3626 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3629 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3631 c
= FETCH_CHAR (pos_byte
);
3634 c
= FETCH_BYTE (pos
);
3640 multibyte
= STRING_MULTIBYTE (string
);
3643 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3645 str
= SDATA (string
) + pos_byte
;
3646 c
= STRING_CHAR (str
, 0);
3649 c
= SDATA (string
)[pos
];
3653 f
= XFRAME (w
->frame
);
3654 if (! FRAME_WINDOW_P (f
))
3661 if (STRINGP (string
))
3662 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3663 DEFAULT_FACE_ID
, 0);
3665 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3667 face
= FACE_FROM_ID (f
, face_id
);
3671 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3672 face
= FACE_FROM_ID (f
, face_id
);
3677 XSETFONT (font_object
, face
->font
);
3682 #ifdef HAVE_WINDOW_SYSTEM
3684 /* Check how many characters after POS (at most to *LIMIT) can be
3685 displayed by the same font on the window W. FACE, if non-NULL, is
3686 the face selected for the character at POS. If STRING is not nil,
3687 it is the string to check instead of the current buffer. In that
3688 case, FACE must be not NULL.
3690 The return value is the font-object for the character at POS.
3691 *LIMIT is set to the position where that font can't be used.
3693 It is assured that the current buffer (or STRING) is multibyte. */
3696 font_range (pos
, limit
, w
, face
, string
)
3697 EMACS_INT pos
, *limit
;
3702 EMACS_INT pos_byte
, ignore
, start
, start_byte
;
3704 Lisp_Object font_object
= Qnil
;
3708 pos_byte
= CHAR_TO_BYTE (pos
);
3713 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
, *limit
, 0);
3714 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3720 pos_byte
= string_char_to_byte (string
, pos
);
3723 start
= pos
, start_byte
= pos_byte
;
3724 while (pos
< *limit
)
3726 Lisp_Object category
;
3729 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3731 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3732 if (NILP (font_object
))
3734 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3735 if (NILP (font_object
))
3740 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3741 if (! EQ (category
, QCf
)
3742 && font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3744 Lisp_Object f
= font_for_char (face
, c
, pos
- 1, string
);
3745 EMACS_INT i
, i_byte
;
3753 i
= start
, i_byte
= start_byte
;
3758 FETCH_CHAR_ADVANCE_NO_CHECK (c
, i
, i_byte
);
3760 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, i
, i_byte
);
3761 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3762 if (! EQ (category
, QCf
)
3763 && font_encode_char (f
, c
) == FONT_INVALID_CODE
)
3779 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3780 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3781 Return nil otherwise.
3782 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3783 which kind of font it is. It must be one of `font-spec', `font-entity',
3785 (object
, extra_type
)
3786 Lisp_Object object
, extra_type
;
3788 if (NILP (extra_type
))
3789 return (FONTP (object
) ? Qt
: Qnil
);
3790 if (EQ (extra_type
, Qfont_spec
))
3791 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3792 if (EQ (extra_type
, Qfont_entity
))
3793 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3794 if (EQ (extra_type
, Qfont_object
))
3795 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3796 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3799 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3800 doc
: /* Return a newly created font-spec with arguments as properties.
3802 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3803 valid font property name listed below:
3805 `:family', `:weight', `:slant', `:width'
3807 They are the same as face attributes of the same name. See
3808 `set-face-attribute'.
3812 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3816 VALUE must be a string or a symbol specifying the additional
3817 typographic style information of a font, e.g. ``sans''.
3821 VALUE must be a string or a symbol specifying the charset registry and
3822 encoding of a font, e.g. ``iso8859-1''.
3826 VALUE must be a non-negative integer or a floating point number
3827 specifying the font size. It specifies the font size in pixels
3828 (if VALUE is an integer), or in points (if VALUE is a float).
3832 VALUE must be a string of XLFD-style or fontconfig-style font name.
3833 usage: (font-spec ARGS ...)
3837 VALUE must be a symbol representing a script that the font must
3843 Lisp_Object spec
= font_make_spec ();
3846 for (i
= 0; i
< nargs
; i
+= 2)
3848 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3850 if (EQ (key
, QCname
))
3853 font_parse_name ((char *) SDATA (val
), spec
);
3854 font_put_extra (spec
, key
, val
);
3858 int idx
= get_font_prop_index (key
);
3862 val
= font_prop_validate (idx
, Qnil
, val
);
3863 if (idx
< FONT_EXTRA_INDEX
)
3864 ASET (spec
, idx
, val
);
3866 font_put_extra (spec
, key
, val
);
3869 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3875 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3876 doc
: /* Return a copy of FONT as a font-spec. */)
3880 Lisp_Object new_spec
, tail
, prev
, extra
;
3884 new_spec
= font_make_spec ();
3885 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3886 ASET (new_spec
, i
, AREF (font
, i
));
3887 extra
= Fcopy_sequence (AREF (font
, FONT_EXTRA_INDEX
));
3888 /* We must remove :font-entity property. */
3889 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3890 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3893 extra
= XCDR (extra
);
3895 XSETCDR (prev
, XCDR (tail
));
3898 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3902 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3903 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3904 Every specified properties in FROM override the corresponding
3905 properties in TO. */)
3907 Lisp_Object from
, to
;
3909 Lisp_Object extra
, tail
;
3914 to
= Fcopy_font_spec (to
);
3915 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3916 ASET (to
, i
, AREF (from
, i
));
3917 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3918 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3919 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3921 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3924 XSETCDR (slot
, XCDR (XCAR (tail
)));
3926 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3928 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3932 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3933 doc
: /* Return the value of FONT's property KEY.
3934 FONT is a font-spec, a font-entity, or a font-object.
3935 KEY must be one of these symbols:
3936 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
3937 :size, :name, :script
3938 See the documentation of `font-spec' for their meanings.
3939 If FONT is a font-entity or font-object, the value of :script may be
3940 a list of scripts that are supported by the font. */)
3942 Lisp_Object font
, key
;
3949 idx
= get_font_prop_index (key
);
3950 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3951 return font_style_symbolic (font
, idx
, 0);
3952 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3953 return AREF (font
, idx
);
3954 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3957 #ifdef HAVE_WINDOW_SYSTEM
3959 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3960 doc
: /* Return a plist of face attributes generated by FONT.
3961 FONT is a font name, a font-spec, a font-entity, or a font-object.
3962 The return value is a list of the form
3964 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3966 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3967 compatible with `set-face-attribute'. Some of these key-attribute pairs
3968 may be omitted from the list if they are not specified by FONT.
3970 The optional argument FRAME specifies the frame that the face attributes
3971 are to be displayed on. If omitted, the selected frame is used. */)
3973 Lisp_Object font
, frame
;
3976 Lisp_Object plist
[10];
3981 frame
= selected_frame
;
3982 CHECK_LIVE_FRAME (frame
);
3987 int fontset
= fs_query_fontset (font
, 0);
3988 Lisp_Object name
= font
;
3990 font
= fontset_ascii (fontset
);
3991 font
= font_spec_from_name (name
);
3993 signal_error ("Invalid font name", name
);
3995 else if (! FONTP (font
))
3996 signal_error ("Invalid font object", font
);
3998 val
= AREF (font
, FONT_FAMILY_INDEX
);
4001 plist
[n
++] = QCfamily
;
4002 plist
[n
++] = SYMBOL_NAME (val
);
4005 val
= AREF (font
, FONT_SIZE_INDEX
);
4008 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4009 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4010 plist
[n
++] = QCheight
;
4011 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4013 else if (FLOATP (val
))
4015 plist
[n
++] = QCheight
;
4016 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4019 val
= FONT_WEIGHT_FOR_FACE (font
);
4022 plist
[n
++] = QCweight
;
4026 val
= FONT_SLANT_FOR_FACE (font
);
4029 plist
[n
++] = QCslant
;
4033 val
= FONT_WIDTH_FOR_FACE (font
);
4036 plist
[n
++] = QCwidth
;
4040 return Flist (n
, plist
);
4045 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4046 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
4047 (font_spec
, prop
, val
)
4048 Lisp_Object font_spec
, prop
, val
;
4052 CHECK_FONT_SPEC (font_spec
);
4053 idx
= get_font_prop_index (prop
);
4054 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4055 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
4057 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
4061 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4062 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4063 Optional 2nd argument FRAME specifies the target frame.
4064 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4065 Optional 4th argument PREFER, if non-nil, is a font-spec to
4066 control the order of the returned list. Fonts are sorted by
4067 how close they are to PREFER. */)
4068 (font_spec
, frame
, num
, prefer
)
4069 Lisp_Object font_spec
, frame
, num
, prefer
;
4071 Lisp_Object vec
, list
, tail
;
4075 frame
= selected_frame
;
4076 CHECK_LIVE_FRAME (frame
);
4077 CHECK_FONT_SPEC (font_spec
);
4085 if (! NILP (prefer
))
4086 CHECK_FONT_SPEC (prefer
);
4088 vec
= font_list_entities (frame
, font_spec
);
4093 return Fcons (AREF (vec
, 0), Qnil
);
4095 if (! NILP (prefer
))
4096 vec
= font_sort_entites (vec
, prefer
, frame
, 0);
4098 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
4099 if (n
== 0 || n
> len
)
4101 for (i
= 1; i
< n
; i
++)
4103 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
4105 XSETCDR (tail
, val
);
4111 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4112 doc
: /* List available font families on the current frame.
4113 Optional argument FRAME, if non-nil, specifies the target frame. */)
4118 struct font_driver_list
*driver_list
;
4122 frame
= selected_frame
;
4123 CHECK_LIVE_FRAME (frame
);
4126 for (driver_list
= f
->font_driver_list
; driver_list
;
4127 driver_list
= driver_list
->next
)
4128 if (driver_list
->driver
->list_family
)
4130 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4136 Lisp_Object tail
= list
;
4138 for (; CONSP (val
); val
= XCDR (val
))
4139 if (NILP (Fmemq (XCAR (val
), tail
)))
4140 list
= Fcons (XCAR (val
), list
);
4146 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4147 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4148 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4150 Lisp_Object font_spec
, frame
;
4152 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4159 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4160 doc
: /* Return XLFD name of FONT.
4161 FONT is a font-spec, font-entity, or font-object.
4162 If the name is too long for XLFD (maximum 255 chars), return nil.
4163 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4164 the consecutive wildcards are folded to one. */)
4165 (font
, fold_wildcards
)
4166 Lisp_Object font
, fold_wildcards
;
4173 if (FONT_OBJECT_P (font
))
4175 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4177 if (STRINGP (font_name
)
4178 && SDATA (font_name
)[0] == '-')
4180 if (NILP (fold_wildcards
))
4182 strcpy (name
, (char *) SDATA (font_name
));
4185 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4187 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4190 if (! NILP (fold_wildcards
))
4192 char *p0
= name
, *p1
;
4194 while ((p1
= strstr (p0
, "-*-*")))
4196 strcpy (p1
, p1
+ 2);
4201 return build_string (name
);
4204 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4205 doc
: /* Clear font cache. */)
4208 Lisp_Object list
, frame
;
4210 FOR_EACH_FRAME (list
, frame
)
4212 FRAME_PTR f
= XFRAME (frame
);
4213 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4215 for (; driver_list
; driver_list
= driver_list
->next
)
4216 if (driver_list
->on
)
4218 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4223 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4225 font_assert (! NILP (val
));
4226 val
= XCDR (XCAR (val
));
4227 if (XINT (XCAR (val
)) == 0)
4229 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4230 XSETCDR (cache
, XCDR (val
));
4240 font_fill_lglyph_metrics (glyph
, font_object
)
4241 Lisp_Object glyph
, font_object
;
4243 struct font
*font
= XFONT_OBJECT (font_object
);
4245 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4246 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4247 struct font_metrics metrics
;
4249 LGLYPH_SET_CODE (glyph
, ecode
);
4251 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4252 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4253 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4254 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4255 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4256 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4260 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4261 doc
: /* Shape the glyph-string GSTRING.
4262 Shaping means substituting glyphs and/or adjusting positions of glyphs
4263 to get the correct visual image of character sequences set in the
4264 header of the glyph-string.
4266 If the shaping was successful, the value is GSTRING itself or a newly
4267 created glyph-string. Otherwise, the value is nil. */)
4269 Lisp_Object gstring
;
4272 Lisp_Object font_object
, n
, glyph
;
4275 if (! composition_gstring_p (gstring
))
4276 signal_error ("Invalid glyph-string: ", gstring
);
4277 if (! NILP (LGSTRING_ID (gstring
)))
4279 font_object
= LGSTRING_FONT (gstring
);
4280 CHECK_FONT_OBJECT (font_object
);
4281 font
= XFONT_OBJECT (font_object
);
4282 if (! font
->driver
->shape
)
4285 /* Try at most three times with larger gstring each time. */
4286 for (i
= 0; i
< 3; i
++)
4288 n
= font
->driver
->shape (gstring
);
4291 gstring
= larger_vector (gstring
,
4292 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4295 if (i
== 3 || XINT (n
) == 0)
4298 glyph
= LGSTRING_GLYPH (gstring
, 0);
4299 from
= LGLYPH_FROM (glyph
);
4300 to
= LGLYPH_TO (glyph
);
4301 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4303 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4307 if (NILP (LGLYPH_ADJUSTMENT (this)))
4312 glyph
= LGSTRING_GLYPH (gstring
, j
);
4313 LGLYPH_SET_FROM (glyph
, from
);
4314 LGLYPH_SET_TO (glyph
, to
);
4316 from
= LGLYPH_FROM (this);
4317 to
= LGLYPH_TO (this);
4322 if (from
> LGLYPH_FROM (this))
4323 from
= LGLYPH_FROM (this);
4324 if (to
< LGLYPH_TO (this))
4325 to
= LGLYPH_TO (this);
4331 glyph
= LGSTRING_GLYPH (gstring
, j
);
4332 LGLYPH_SET_FROM (glyph
, from
);
4333 LGLYPH_SET_TO (glyph
, to
);
4335 return composition_gstring_put_cache (gstring
, XINT (n
));
4340 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4341 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4342 OTF-FEATURES specifies which features to apply in this format:
4343 (SCRIPT LANGSYS GSUB GPOS)
4345 SCRIPT is a symbol specifying a script tag of OpenType,
4346 LANGSYS is a symbol specifying a langsys tag of OpenType,
4347 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4349 If LANGYS is nil, the default langsys is selected.
4351 The features are applied in the order they appear in the list. The
4352 symbol `*' means to apply all available features not present in this
4353 list, and the remaining features are ignored. For instance, (vatu
4354 pstf * haln) is to apply vatu and pstf in this order, then to apply
4355 all available features other than vatu, pstf, and haln.
4357 The features are applied to the glyphs in the range FROM and TO of
4358 the glyph-string GSTRING-IN.
4360 If some feature is actually applicable, the resulting glyphs are
4361 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4362 this case, the value is the number of produced glyphs.
4364 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4367 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4368 produced in GSTRING-OUT, and the value is nil.
4370 See the documentation of `font-make-gstring' for the format of
4372 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4373 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4375 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4380 check_otf_features (otf_features
);
4381 CHECK_FONT_OBJECT (font_object
);
4382 font
= XFONT_OBJECT (font_object
);
4383 if (! font
->driver
->otf_drive
)
4384 error ("Font backend %s can't drive OpenType GSUB table",
4385 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4386 CHECK_CONS (otf_features
);
4387 CHECK_SYMBOL (XCAR (otf_features
));
4388 val
= XCDR (otf_features
);
4389 CHECK_SYMBOL (XCAR (val
));
4390 val
= XCDR (otf_features
);
4393 len
= check_gstring (gstring_in
);
4394 CHECK_VECTOR (gstring_out
);
4395 CHECK_NATNUM (from
);
4397 CHECK_NATNUM (index
);
4399 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4400 args_out_of_range_3 (from
, to
, make_number (len
));
4401 if (XINT (index
) >= ASIZE (gstring_out
))
4402 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4403 num
= font
->driver
->otf_drive (font
, otf_features
,
4404 gstring_in
, XINT (from
), XINT (to
),
4405 gstring_out
, XINT (index
), 0);
4408 return make_number (num
);
4411 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4413 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4414 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4416 (SCRIPT LANGSYS FEATURE ...)
4417 See the documentation of `font-drive-otf' for more detail.
4419 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4420 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4421 character code corresponding to the glyph or nil if there's no
4422 corresponding character. */)
4423 (font_object
, character
, otf_features
)
4424 Lisp_Object font_object
, character
, otf_features
;
4427 Lisp_Object gstring_in
, gstring_out
, g
;
4428 Lisp_Object alternates
;
4431 CHECK_FONT_GET_OBJECT (font_object
, font
);
4432 if (! font
->driver
->otf_drive
)
4433 error ("Font backend %s can't drive OpenType GSUB table",
4434 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4435 CHECK_CHARACTER (character
);
4436 CHECK_CONS (otf_features
);
4438 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4439 g
= LGSTRING_GLYPH (gstring_in
, 0);
4440 LGLYPH_SET_CHAR (g
, XINT (character
));
4441 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4442 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4443 gstring_out
, 0, 1)) < 0)
4444 gstring_out
= Ffont_make_gstring (font_object
,
4445 make_number (ASIZE (gstring_out
) * 2));
4447 for (i
= 0; i
< num
; i
++)
4449 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4450 int c
= LGLYPH_CHAR (g
);
4451 unsigned code
= LGLYPH_CODE (g
);
4453 alternates
= Fcons (Fcons (make_number (code
),
4454 c
> 0 ? make_number (c
) : Qnil
),
4457 return Fnreverse (alternates
);
4463 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4464 doc
: /* Open FONT-ENTITY. */)
4465 (font_entity
, size
, frame
)
4466 Lisp_Object font_entity
;
4472 CHECK_FONT_ENTITY (font_entity
);
4474 frame
= selected_frame
;
4475 CHECK_LIVE_FRAME (frame
);
4478 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4481 CHECK_NUMBER_OR_FLOAT (size
);
4483 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4485 isize
= XINT (size
);
4489 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4492 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4493 doc
: /* Close FONT-OBJECT. */)
4494 (font_object
, frame
)
4495 Lisp_Object font_object
, frame
;
4497 CHECK_FONT_OBJECT (font_object
);
4499 frame
= selected_frame
;
4500 CHECK_LIVE_FRAME (frame
);
4501 font_close_object (XFRAME (frame
), font_object
);
4505 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4506 doc
: /* Return information about FONT-OBJECT.
4507 The value is a vector:
4508 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4511 NAME is a string of the font name (or nil if the font backend doesn't
4514 FILENAME is a string of the font file (or nil if the font backend
4515 doesn't provide a file name).
4517 PIXEL-SIZE is a pixel size by which the font is opened.
4519 SIZE is a maximum advance width of the font in pixels.
4521 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4524 CAPABILITY is a list whose first element is a symbol representing the
4525 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4526 remaining elements describe the details of the font capability.
4528 If the font is OpenType font, the form of the list is
4529 \(opentype GSUB GPOS)
4530 where GSUB shows which "GSUB" features the font supports, and GPOS
4531 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4532 lists of the format:
4533 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4535 If the font is not OpenType font, currently the length of the form is
4538 SCRIPT is a symbol representing OpenType script tag.
4540 LANGSYS is a symbol representing OpenType langsys tag, or nil
4541 representing the default langsys.
4543 FEATURE is a symbol representing OpenType feature tag.
4545 If the font is not OpenType font, CAPABILITY is nil. */)
4547 Lisp_Object font_object
;
4552 CHECK_FONT_GET_OBJECT (font_object
, font
);
4554 val
= Fmake_vector (make_number (9), Qnil
);
4555 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4556 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4557 ASET (val
, 2, make_number (font
->pixel_size
));
4558 ASET (val
, 3, make_number (font
->max_width
));
4559 ASET (val
, 4, make_number (font
->ascent
));
4560 ASET (val
, 5, make_number (font
->descent
));
4561 ASET (val
, 6, make_number (font
->space_width
));
4562 ASET (val
, 7, make_number (font
->average_width
));
4563 if (font
->driver
->otf_capability
)
4564 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4568 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4569 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4570 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4571 (font_object
, string
)
4572 Lisp_Object font_object
, string
;
4578 CHECK_FONT_GET_OBJECT (font_object
, font
);
4579 CHECK_STRING (string
);
4580 len
= SCHARS (string
);
4581 vec
= Fmake_vector (make_number (len
), Qnil
);
4582 for (i
= 0; i
< len
; i
++)
4584 Lisp_Object ch
= Faref (string
, make_number (i
));
4589 struct font_metrics metrics
;
4591 cod
= code
= font
->driver
->encode_char (font
, c
);
4592 if (code
== FONT_INVALID_CODE
)
4594 val
= Fmake_vector (make_number (6), Qnil
);
4595 if (cod
<= MOST_POSITIVE_FIXNUM
)
4596 ASET (val
, 0, make_number (code
));
4598 ASET (val
, 0, Fcons (make_number (code
>> 16),
4599 make_number (code
& 0xFFFF)));
4600 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4601 ASET (val
, 1, make_number (metrics
.lbearing
));
4602 ASET (val
, 2, make_number (metrics
.rbearing
));
4603 ASET (val
, 3, make_number (metrics
.width
));
4604 ASET (val
, 4, make_number (metrics
.ascent
));
4605 ASET (val
, 5, make_number (metrics
.descent
));
4611 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4612 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4613 FONT is a font-spec, font-entity, or font-object. */)
4615 Lisp_Object spec
, font
;
4617 CHECK_FONT_SPEC (spec
);
4620 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4623 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4624 doc
: /* Return a font-object for displaying a character at POSITION.
4625 Optional second arg WINDOW, if non-nil, is a window displaying
4626 the current buffer. It defaults to the currently selected window. */)
4627 (position
, window
, string
)
4628 Lisp_Object position
, window
, string
;
4635 CHECK_NUMBER_COERCE_MARKER (position
);
4636 pos
= XINT (position
);
4637 if (pos
< BEGV
|| pos
>= ZV
)
4638 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4642 CHECK_NUMBER (position
);
4643 CHECK_STRING (string
);
4644 pos
= XINT (position
);
4645 if (pos
< 0 || pos
>= SCHARS (string
))
4646 args_out_of_range (string
, position
);
4649 window
= selected_window
;
4650 CHECK_LIVE_WINDOW (window
);
4651 w
= XWINDOW (window
);
4653 return font_at (-1, pos
, NULL
, w
, string
);
4657 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4658 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4659 The value is a number of glyphs drawn.
4660 Type C-l to recover what previously shown. */)
4661 (font_object
, string
)
4662 Lisp_Object font_object
, string
;
4664 Lisp_Object frame
= selected_frame
;
4665 FRAME_PTR f
= XFRAME (frame
);
4671 CHECK_FONT_GET_OBJECT (font_object
, font
);
4672 CHECK_STRING (string
);
4673 len
= SCHARS (string
);
4674 code
= alloca (sizeof (unsigned) * len
);
4675 for (i
= 0; i
< len
; i
++)
4677 Lisp_Object ch
= Faref (string
, make_number (i
));
4681 code
[i
] = font
->driver
->encode_char (font
, c
);
4682 if (code
[i
] == FONT_INVALID_CODE
)
4685 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4687 if (font
->driver
->prepare_face
)
4688 font
->driver
->prepare_face (f
, face
);
4689 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4690 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4691 if (font
->driver
->done_face
)
4692 font
->driver
->done_face (f
, face
);
4694 return make_number (len
);
4698 #endif /* FONT_DEBUG */
4700 #ifdef HAVE_WINDOW_SYSTEM
4702 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4703 doc
: /* Return information about a font named NAME on frame FRAME.
4704 If FRAME is omitted or nil, use the selected frame.
4705 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4706 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4708 OPENED-NAME is the name used for opening the font,
4709 FULL-NAME is the full name of the font,
4710 SIZE is the maximum bound width of the font,
4711 HEIGHT is the height of the font,
4712 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4713 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4714 how to compose characters.
4715 If the named font is not yet loaded, return nil. */)
4717 Lisp_Object name
, frame
;
4722 Lisp_Object font_object
;
4724 (*check_window_system_func
) ();
4727 CHECK_STRING (name
);
4729 frame
= selected_frame
;
4730 CHECK_LIVE_FRAME (frame
);
4735 int fontset
= fs_query_fontset (name
, 0);
4738 name
= fontset_ascii (fontset
);
4739 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4741 else if (FONT_OBJECT_P (name
))
4743 else if (FONT_ENTITY_P (name
))
4744 font_object
= font_open_entity (f
, name
, 0);
4747 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4748 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4750 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4752 if (NILP (font_object
))
4754 font
= XFONT_OBJECT (font_object
);
4756 info
= Fmake_vector (make_number (7), Qnil
);
4757 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4758 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4759 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4760 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4761 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4762 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4763 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4766 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4767 close it now. Perhaps, we should manage font-objects
4768 by `reference-count'. */
4769 font_close_object (f
, font_object
);
4776 #define BUILD_STYLE_TABLE(TBL) \
4777 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4780 build_style_table (entry
, nelement
)
4781 struct table_entry
*entry
;
4785 Lisp_Object table
, elt
;
4787 table
= Fmake_vector (make_number (nelement
), Qnil
);
4788 for (i
= 0; i
< nelement
; i
++)
4790 for (j
= 0; entry
[i
].names
[j
]; j
++);
4791 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4792 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4793 for (j
= 0; entry
[i
].names
[j
]; j
++)
4794 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4795 ASET (table
, i
, elt
);
4800 static Lisp_Object Vfont_log
;
4801 static int font_log_env_checked
;
4803 /* The deferred font-log data of the form [ACTION ARG RESULT].
4804 If ACTION is not nil, that is added to the log when font_add_log is
4805 called next time. At that time, ACTION is set back to nil. */
4806 static Lisp_Object Vfont_log_deferred
;
4808 /* Prepend the font-related logging data in Vfont_log if it is not
4809 `t'. ACTION describes a kind of font-related action (e.g. listing,
4810 opening), ARG is the argument for the action, and RESULT is the
4811 result of the action. */
4813 font_add_log (action
, arg
, result
)
4815 Lisp_Object arg
, result
;
4817 Lisp_Object tail
, val
;
4820 if (! font_log_env_checked
)
4822 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
4823 font_log_env_checked
= 1;
4825 if (EQ (Vfont_log
, Qt
))
4827 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4829 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
4831 ASET (Vfont_log_deferred
, 0, Qnil
);
4832 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4833 AREF (Vfont_log_deferred
, 2));
4838 Lisp_Object tail
, elt
;
4839 Lisp_Object equalstr
= build_string ("=");
4841 val
= Ffont_xlfd_name (arg
, Qt
);
4842 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4846 if (EQ (XCAR (elt
), QCscript
)
4847 && SYMBOLP (XCDR (elt
)))
4848 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4849 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4850 else if (EQ (XCAR (elt
), QClang
)
4851 && SYMBOLP (XCDR (elt
)))
4852 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4853 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4854 else if (EQ (XCAR (elt
), QCotf
)
4855 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
4856 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4858 SYMBOL_NAME (XCAR (XCDR (elt
)))));
4864 val
= Ffont_xlfd_name (result
, Qt
);
4865 if (! FONT_SPEC_P (result
))
4866 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4867 build_string (":"), val
);
4870 else if (CONSP (result
))
4872 result
= Fcopy_sequence (result
);
4873 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4877 val
= Ffont_xlfd_name (val
, Qt
);
4878 XSETCAR (tail
, val
);
4881 else if (VECTORP (result
))
4883 result
= Fcopy_sequence (result
);
4884 for (i
= 0; i
< ASIZE (result
); i
++)
4886 val
= AREF (result
, i
);
4888 val
= Ffont_xlfd_name (val
, Qt
);
4889 ASET (result
, i
, val
);
4892 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4895 /* Record a font-related logging data to be added to Vfont_log when
4896 font_add_log is called next time. ACTION, ARG, RESULT are the same
4900 font_deferred_log (action
, arg
, result
)
4902 Lisp_Object arg
, result
;
4904 ASET (Vfont_log_deferred
, 0, build_string (action
));
4905 ASET (Vfont_log_deferred
, 1, arg
);
4906 ASET (Vfont_log_deferred
, 2, result
);
4909 extern void syms_of_ftfont
P_ (());
4910 extern void syms_of_xfont
P_ (());
4911 extern void syms_of_xftfont
P_ (());
4912 extern void syms_of_ftxfont
P_ (());
4913 extern void syms_of_bdffont
P_ (());
4914 extern void syms_of_w32font
P_ (());
4915 extern void syms_of_atmfont
P_ (());
4916 extern void syms_of_nsfont
P_ (());
4921 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
4922 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
4923 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
4924 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
4925 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
4926 /* Note that the other elements in sort_shift_bits are not used. */
4928 staticpro (&font_charset_alist
);
4929 font_charset_alist
= Qnil
;
4931 DEFSYM (Qfont_spec
, "font-spec");
4932 DEFSYM (Qfont_entity
, "font-entity");
4933 DEFSYM (Qfont_object
, "font-object");
4935 DEFSYM (Qopentype
, "opentype");
4937 DEFSYM (Qascii_0
, "ascii-0");
4938 DEFSYM (Qiso8859_1
, "iso8859-1");
4939 DEFSYM (Qiso10646_1
, "iso10646-1");
4940 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4941 DEFSYM (Qunicode_sip
, "unicode-sip");
4945 DEFSYM (QCotf
, ":otf");
4946 DEFSYM (QClang
, ":lang");
4947 DEFSYM (QCscript
, ":script");
4948 DEFSYM (QCantialias
, ":antialias");
4950 DEFSYM (QCfoundry
, ":foundry");
4951 DEFSYM (QCadstyle
, ":adstyle");
4952 DEFSYM (QCregistry
, ":registry");
4953 DEFSYM (QCspacing
, ":spacing");
4954 DEFSYM (QCdpi
, ":dpi");
4955 DEFSYM (QCscalable
, ":scalable");
4956 DEFSYM (QCavgwidth
, ":avgwidth");
4957 DEFSYM (QCfont_entity
, ":font-entity");
4958 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
4965 staticpro (&null_vector
);
4966 null_vector
= Fmake_vector (make_number (0), Qnil
);
4968 staticpro (&scratch_font_spec
);
4969 scratch_font_spec
= Ffont_spec (0, NULL
);
4970 staticpro (&scratch_font_prefer
);
4971 scratch_font_prefer
= Ffont_spec (0, NULL
);
4973 staticpro (&Vfont_log_deferred
);
4974 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
4978 staticpro (&otf_list
);
4980 #endif /* HAVE_LIBOTF */
4984 defsubr (&Sfont_spec
);
4985 defsubr (&Sfont_get
);
4986 #ifdef HAVE_WINDOW_SYSTEM
4987 defsubr (&Sfont_face_attributes
);
4989 defsubr (&Sfont_put
);
4990 defsubr (&Slist_fonts
);
4991 defsubr (&Sfont_family_list
);
4992 defsubr (&Sfind_font
);
4993 defsubr (&Sfont_xlfd_name
);
4994 defsubr (&Sclear_font_cache
);
4995 defsubr (&Sfont_shape_gstring
);
4997 defsubr (&Sfont_drive_otf
);
4998 defsubr (&Sfont_otf_alternates
);
5002 defsubr (&Sopen_font
);
5003 defsubr (&Sclose_font
);
5004 defsubr (&Squery_font
);
5005 defsubr (&Sget_font_glyphs
);
5006 defsubr (&Sfont_match_p
);
5007 defsubr (&Sfont_at
);
5009 defsubr (&Sdraw_string
);
5011 #endif /* FONT_DEBUG */
5012 #ifdef HAVE_WINDOW_SYSTEM
5013 defsubr (&Sfont_info
);
5016 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5018 Alist of fontname patterns vs the corresponding encoding and repertory info.
5019 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5020 where ENCODING is a charset or a char-table,
5021 and REPERTORY is a charset, a char-table, or nil.
5023 If ENCODING and REPERTORY are the same, the element can have the form
5024 \(REGEXP . ENCODING).
5026 ENCODING is for converting a character to a glyph code of the font.
5027 If ENCODING is a charset, encoding a character by the charset gives
5028 the corresponding glyph code. If ENCODING is a char-table, looking up
5029 the table by a character gives the corresponding glyph code.
5031 REPERTORY specifies a repertory of characters supported by the font.
5032 If REPERTORY is a charset, all characters beloging to the charset are
5033 supported. If REPERTORY is a char-table, all characters who have a
5034 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5035 gets the repertory information by an opened font and ENCODING. */);
5036 Vfont_encoding_alist
= Qnil
;
5038 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5039 doc
: /* Vector of valid font weight values.
5040 Each element has the form:
5041 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5042 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5043 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5045 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5046 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5047 See `font-weight-table' for the format of the vector. */);
5048 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5050 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5051 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5052 See `font-weight-table' for the format of the vector. */);
5053 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5055 staticpro (&font_style_table
);
5056 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5057 ASET (font_style_table
, 0, Vfont_weight_table
);
5058 ASET (font_style_table
, 1, Vfont_slant_table
);
5059 ASET (font_style_table
, 2, Vfont_width_table
);
5061 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5062 *Logging list of font related actions and results.
5063 The value t means to suppress the logging.
5064 The initial value is set to nil if the environment variable
5065 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5068 #ifdef HAVE_WINDOW_SYSTEM
5069 #ifdef HAVE_FREETYPE
5071 #ifdef HAVE_X_WINDOWS
5076 #endif /* HAVE_XFT */
5077 #endif /* HAVE_X_WINDOWS */
5078 #else /* not HAVE_FREETYPE */
5079 #ifdef HAVE_X_WINDOWS
5081 #endif /* HAVE_X_WINDOWS */
5082 #endif /* not HAVE_FREETYPE */
5085 #endif /* HAVE_BDFFONT */
5088 #endif /* WINDOWSNT */
5091 #endif /* HAVE_NS */
5092 #endif /* HAVE_WINDOW_SYSTEM */
5095 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5096 (do not change this comment) */