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