1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
3 Copyright (C) 2006, 2007, 2008, 2009
4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H13PRO009
7 This file is part of GNU Emacs.
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
31 #include "dispextern.h"
33 #include "character.h"
34 #include "composite.h"
40 #endif /* HAVE_X_WINDOWS */
44 #endif /* HAVE_NTGUI */
50 Lisp_Object Qfont_spec
, Qfont_entity
, Qfont_object
;
53 extern Lisp_Object Qfontsize
;
56 Lisp_Object Qopentype
;
58 /* Important character set strings. */
59 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
62 #define DEFAULT_ENCODING Qiso10646_1
64 #define DEFAULT_ENCODING Qiso8859_1
67 /* Unicode category `Cf'. */
68 static Lisp_Object QCf
;
70 /* Special vector of zero length. This is repeatedly used by (struct
71 font_driver *)->list when a specified font is not found. */
72 static Lisp_Object null_vector
;
74 static Lisp_Object Vfont_weight_table
, Vfont_slant_table
, Vfont_width_table
;
76 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
77 static Lisp_Object font_style_table
;
79 /* Structure used for tables mapping weight, slant, and width numeric
80 values and their names. */
85 /* The first one is a valid name as a face attribute.
86 The second one (if any) is a typical name in XLFD field. */
91 /* Table of weight numeric values and their names. This table must be
92 sorted by numeric values in ascending order. */
94 static struct table_entry weight_table
[] =
97 { 20, { "ultra-light", "ultralight" }},
98 { 40, { "extra-light", "extralight" }},
100 { 75, { "semi-light", "semilight", "demilight", "book" }},
101 { 100, { "normal", "medium", "regular" }},
102 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
104 { 205, { "extra-bold", "extrabold" }},
105 { 210, { "ultra-bold", "ultrabold", "black" }}
108 /* Table of slant numeric values and their names. This table must be
109 sorted by numeric values in ascending order. */
111 static struct table_entry slant_table
[] =
113 { 0, { "reverse-oblique", "ro" }},
114 { 10, { "reverse-italic", "ri" }},
115 { 100, { "normal", "r" }},
116 { 200, { "italic" ,"i", "ot" }},
117 { 210, { "oblique", "o" }}
120 /* Table of width numeric values and their names. This table must be
121 sorted by numeric values in ascending order. */
123 static struct table_entry width_table
[] =
125 { 50, { "ultra-condensed", "ultracondensed" }},
126 { 63, { "extra-condensed", "extracondensed" }},
127 { 75, { "condensed", "compressed", "narrow" }},
128 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
129 { 100, { "normal", "medium", "regular" }},
130 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
131 { 125, { "expanded" }},
132 { 150, { "extra-expanded", "extraexpanded" }},
133 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
136 extern Lisp_Object Qnormal
;
138 /* Symbols representing keys of normal font properties. */
139 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
;
140 extern Lisp_Object QCheight
, QCsize
, QCname
;
142 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
;
143 /* Symbols representing keys of font extra info. */
144 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
145 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
146 /* Symbols representing values of font spacing property. */
147 Lisp_Object Qc
, Qm
, Qp
, Qd
;
149 Lisp_Object Vfont_encoding_alist
;
151 /* Alist of font registry symbol and the corresponding charsets
152 information. The information is retrieved from
153 Vfont_encoding_alist on demand.
155 Eash element has the form:
156 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
160 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
161 encodes a character code to a glyph code of a font, and
162 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
163 character is supported by a font.
165 The latter form means that the information for REGISTRY couldn't be
167 static Lisp_Object font_charset_alist
;
169 /* List of all font drivers. Each font-backend (XXXfont.c) calls
170 register_font_driver in syms_of_XXXfont to register its font-driver
172 static struct font_driver_list
*font_driver_list
;
176 /* Creaters of font-related Lisp object. */
181 Lisp_Object font_spec
;
182 struct font_spec
*spec
183 = ((struct font_spec
*)
184 allocate_pseudovector (VECSIZE (struct font_spec
),
185 FONT_SPEC_MAX
, PVEC_FONT
));
186 XSETFONT (font_spec
, spec
);
193 Lisp_Object font_entity
;
194 struct font_entity
*entity
195 = ((struct font_entity
*)
196 allocate_pseudovector (VECSIZE (struct font_entity
),
197 FONT_ENTITY_MAX
, PVEC_FONT
));
198 XSETFONT (font_entity
, entity
);
202 /* Create a font-object whose structure size is SIZE. If ENTITY is
203 not nil, copy properties from ENTITY to the font-object. If
204 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
206 font_make_object (size
, entity
, pixelsize
)
211 Lisp_Object font_object
;
213 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
216 XSETFONT (font_object
, font
);
220 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
221 font
->props
[i
] = AREF (entity
, i
);
222 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
223 font
->props
[FONT_EXTRA_INDEX
]
224 = Fcopy_sequence (AREF (entity
, FONT_EXTRA_INDEX
));
227 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
233 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
234 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
235 static Lisp_Object font_matching_entity
P_ ((FRAME_PTR
, Lisp_Object
*,
238 /* Number of registered font drivers. */
239 static int num_font_drivers
;
242 /* Return a Lispy value of a font property value at STR and LEN bytes.
243 If STR is "*", it returns nil.
244 If FORCE_SYMBOL is zero and all characters in STR are digits, it
245 returns an integer. Otherwise, it returns a symbol interned from
249 font_intern_prop (str
, len
, force_symbol
)
259 if (len
== 1 && *str
== '*')
261 if (!force_symbol
&& len
>=1 && isdigit (*str
))
263 for (i
= 1; i
< len
; i
++)
264 if (! isdigit (str
[i
]))
267 return make_number (atoi (str
));
270 /* The following code is copied from the function intern (in
271 lread.c), and modified to suite our purpose. */
273 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
274 obarray
= check_obarray (obarray
);
275 parse_str_as_multibyte (str
, len
, &nchars
, &nbytes
);
276 if (len
== nchars
|| len
!= nbytes
)
277 /* CONTENTS contains no multibyte sequences or contains an invalid
278 multibyte sequence. We'll make a unibyte string. */
279 tem
= oblookup (obarray
, str
, len
, len
);
281 tem
= oblookup (obarray
, str
, nchars
, len
);
284 if (len
== nchars
|| len
!= nbytes
)
285 tem
= make_unibyte_string (str
, len
);
287 tem
= make_multibyte_string (str
, nchars
, len
);
288 return Fintern (tem
, obarray
);
291 /* Return a pixel size of font-spec SPEC on frame F. */
294 font_pixel_size (f
, spec
)
298 #ifdef HAVE_WINDOW_SYSTEM
299 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
308 font_assert (FLOATP (size
));
309 point_size
= XFLOAT_DATA (size
);
310 val
= AREF (spec
, FONT_DPI_INDEX
);
315 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
323 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
324 font vector. If VAL is not valid (i.e. not registered in
325 font_style_table), return -1 if NOERROR is zero, and return a
326 proper index if NOERROR is nonzero. In that case, register VAL in
327 font_style_table if VAL is a symbol, and return a closest index if
328 VAL is an integer. */
331 font_style_to_value (prop
, val
, noerror
)
332 enum font_property_index prop
;
336 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
337 int len
= ASIZE (table
);
343 Lisp_Object args
[2], elt
;
345 /* At first try exact match. */
346 for (i
= 0; i
< len
; i
++)
347 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
348 if (EQ (val
, AREF (AREF (table
, i
), j
)))
349 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
350 | (i
<< 4) | (j
- 1));
351 /* Try also with case-folding match. */
352 s
= SDATA (SYMBOL_NAME (val
));
353 for (i
= 0; i
< len
; i
++)
354 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
356 elt
= AREF (AREF (table
, i
), j
);
357 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
358 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
359 | (i
<< 4) | (j
- 1));
365 elt
= Fmake_vector (make_number (2), make_number (255));
368 args
[1] = Fmake_vector (make_number (1), elt
);
369 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
370 return (255 << 8) | (i
<< 4);
375 int numeric
= XINT (val
);
377 for (i
= 0, last_n
= -1; i
< len
; i
++)
379 int n
= XINT (AREF (AREF (table
, i
), 0));
382 return (n
<< 8) | (i
<< 4);
387 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
388 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
394 return ((last_n
<< 8) | ((i
- 1) << 4));
399 font_style_symbolic (font
, prop
, for_face
)
401 enum font_property_index prop
;
404 Lisp_Object val
= AREF (font
, prop
);
405 Lisp_Object table
, elt
;
410 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
411 i
= XINT (val
) & 0xFF;
412 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
413 elt
= AREF (table
, ((i
>> 4) & 0xF));
414 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
415 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
418 extern Lisp_Object Vface_alternative_font_family_alist
;
420 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
423 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
424 FONTNAME. ENCODING is a charset symbol that specifies the encoding
425 of the font. REPERTORY is a charset symbol or nil. */
428 find_font_encoding (fontname
)
429 Lisp_Object fontname
;
431 Lisp_Object tail
, elt
;
433 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
437 && STRINGP (XCAR (elt
))
438 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
439 && (SYMBOLP (XCDR (elt
))
440 ? CHARSETP (XCDR (elt
))
441 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
444 /* We don't know the encoding of this font. Let's assume `ascii'. */
448 /* Return encoding charset and repertory charset for REGISTRY in
449 ENCODING and REPERTORY correspondingly. If correct information for
450 REGISTRY is available, return 0. Otherwise return -1. */
453 font_registry_charsets (registry
, encoding
, repertory
)
454 Lisp_Object registry
;
455 struct charset
**encoding
, **repertory
;
458 int encoding_id
, repertory_id
;
460 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
466 encoding_id
= XINT (XCAR (val
));
467 repertory_id
= XINT (XCDR (val
));
471 val
= find_font_encoding (SYMBOL_NAME (registry
));
472 if (SYMBOLP (val
) && CHARSETP (val
))
474 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
476 else if (CONSP (val
))
478 if (! CHARSETP (XCAR (val
)))
480 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
481 if (NILP (XCDR (val
)))
485 if (! CHARSETP (XCDR (val
)))
487 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
492 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
494 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
498 *encoding
= CHARSET_FROM_ID (encoding_id
);
500 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
505 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
510 /* Font property value validaters. See the comment of
511 font_property_table for the meaning of the arguments. */
513 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
514 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
515 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
516 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
517 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
518 static int get_font_prop_index
P_ ((Lisp_Object
));
521 font_prop_validate_symbol (prop
, val
)
522 Lisp_Object prop
, val
;
525 val
= Fintern (val
, Qnil
);
528 else if (EQ (prop
, QCregistry
))
529 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
535 font_prop_validate_style (style
, val
)
536 Lisp_Object style
, val
;
538 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
539 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
546 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
550 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
552 if ((n
& 0xF) + 1 >= ASIZE (elt
))
554 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
558 else if (SYMBOLP (val
))
560 int n
= font_style_to_value (prop
, val
, 0);
562 val
= n
>= 0 ? make_number (n
) : Qerror
;
570 font_prop_validate_non_neg (prop
, val
)
571 Lisp_Object prop
, val
;
573 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
578 font_prop_validate_spacing (prop
, val
)
579 Lisp_Object prop
, val
;
581 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
583 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
585 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
587 if (spacing
== 'c' || spacing
== 'C')
588 return make_number (FONT_SPACING_CHARCELL
);
589 if (spacing
== 'm' || spacing
== 'M')
590 return make_number (FONT_SPACING_MONO
);
591 if (spacing
== 'p' || spacing
== 'P')
592 return make_number (FONT_SPACING_PROPORTIONAL
);
593 if (spacing
== 'd' || spacing
== 'D')
594 return make_number (FONT_SPACING_DUAL
);
600 font_prop_validate_otf (prop
, val
)
601 Lisp_Object prop
, val
;
603 Lisp_Object tail
, tmp
;
606 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
607 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
608 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
611 if (! SYMBOLP (XCAR (val
)))
616 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
618 for (i
= 0; i
< 2; i
++)
625 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
626 if (! SYMBOLP (XCAR (tmp
)))
634 /* Structure of known font property keys and validater of the
638 /* Pointer to the key symbol. */
640 /* Function to validate PROP's value VAL, or NULL if any value is
641 ok. The value is VAL or its regularized value if VAL is valid,
642 and Qerror if not. */
643 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
644 } font_property_table
[] =
645 { { &QCtype
, font_prop_validate_symbol
},
646 { &QCfoundry
, font_prop_validate_symbol
},
647 { &QCfamily
, font_prop_validate_symbol
},
648 { &QCadstyle
, font_prop_validate_symbol
},
649 { &QCregistry
, font_prop_validate_symbol
},
650 { &QCweight
, font_prop_validate_style
},
651 { &QCslant
, font_prop_validate_style
},
652 { &QCwidth
, font_prop_validate_style
},
653 { &QCsize
, font_prop_validate_non_neg
},
654 { &QCdpi
, font_prop_validate_non_neg
},
655 { &QCspacing
, font_prop_validate_spacing
},
656 { &QCavgwidth
, font_prop_validate_non_neg
},
657 /* The order of the above entries must match with enum
658 font_property_index. */
659 { &QClang
, font_prop_validate_symbol
},
660 { &QCscript
, font_prop_validate_symbol
},
661 { &QCotf
, font_prop_validate_otf
}
664 /* Size (number of elements) of the above table. */
665 #define FONT_PROPERTY_TABLE_SIZE \
666 ((sizeof font_property_table) / (sizeof *font_property_table))
668 /* Return an index number of font property KEY or -1 if KEY is not an
669 already known property. */
672 get_font_prop_index (key
)
677 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
678 if (EQ (key
, *font_property_table
[i
].key
))
683 /* Validate the font property. The property key is specified by the
684 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
685 signal an error. The value is VAL or the regularized one. */
688 font_prop_validate (idx
, prop
, val
)
690 Lisp_Object prop
, val
;
692 Lisp_Object validated
;
697 prop
= *font_property_table
[idx
].key
;
700 idx
= get_font_prop_index (prop
);
704 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
705 if (EQ (validated
, Qerror
))
706 signal_error ("invalid font property", Fcons (prop
, val
));
711 /* Store VAL as a value of extra font property PROP in FONT while
712 keeping the sorting order. Don't check the validity of VAL. */
715 font_put_extra (font
, prop
, val
)
716 Lisp_Object font
, prop
, val
;
718 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
719 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
723 Lisp_Object prev
= Qnil
;
726 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
727 prev
= extra
, extra
= XCDR (extra
);
729 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
731 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
739 /* Font name parser and unparser */
741 static int parse_matrix
P_ ((char *));
742 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
743 static int font_parse_name
P_ ((char *, Lisp_Object
));
745 /* An enumerator for each field of an XLFD font name. */
746 enum xlfd_field_index
765 /* An enumerator for mask bit corresponding to each XLFD field. */
768 XLFD_FOUNDRY_MASK
= 0x0001,
769 XLFD_FAMILY_MASK
= 0x0002,
770 XLFD_WEIGHT_MASK
= 0x0004,
771 XLFD_SLANT_MASK
= 0x0008,
772 XLFD_SWIDTH_MASK
= 0x0010,
773 XLFD_ADSTYLE_MASK
= 0x0020,
774 XLFD_PIXEL_MASK
= 0x0040,
775 XLFD_POINT_MASK
= 0x0080,
776 XLFD_RESX_MASK
= 0x0100,
777 XLFD_RESY_MASK
= 0x0200,
778 XLFD_SPACING_MASK
= 0x0400,
779 XLFD_AVGWIDTH_MASK
= 0x0800,
780 XLFD_REGISTRY_MASK
= 0x1000,
781 XLFD_ENCODING_MASK
= 0x2000
785 /* Parse P pointing the pixel/point size field of the form
786 `[A B C D]' which specifies a transformation matrix:
792 by which all glyphs of the font are transformed. The spec says
793 that scalar value N for the pixel/point size is equivalent to:
794 A = N * resx/resy, B = C = 0, D = N.
796 Return the scalar value N if the form is valid. Otherwise return
807 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
810 matrix
[i
] = - strtod (p
+ 1, &end
);
812 matrix
[i
] = strtod (p
, &end
);
815 return (i
== 4 ? (int) matrix
[3] : -1);
818 /* Expand a wildcard field in FIELD (the first N fields are filled) to
819 multiple fields to fill in all 14 XLFD fields while restring a
820 field position by its contents. */
823 font_expand_wildcards (field
, n
)
824 Lisp_Object field
[XLFD_LAST_INDEX
];
828 Lisp_Object tmp
[XLFD_LAST_INDEX
];
829 /* Array of information about where this element can go. Nth
830 element is for Nth element of FIELD. */
832 /* Minimum possible field. */
834 /* Maxinum possible field. */
836 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
838 } range
[XLFD_LAST_INDEX
];
840 int range_from
, range_to
;
843 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
844 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
845 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
846 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
847 | XLFD_AVGWIDTH_MASK)
848 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
850 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
851 field. The value is shifted to left one bit by one in the
853 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
854 range_mask
= (range_mask
<< 1) | 1;
856 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
857 position-based retriction for FIELD[I]. */
858 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
859 i
++, range_from
++, range_to
++, range_mask
<<= 1)
861 Lisp_Object val
= field
[i
];
867 range
[i
].from
= range_from
;
868 range
[i
].to
= range_to
;
869 range
[i
].mask
= range_mask
;
873 /* The triplet FROM, TO, and MASK is a value-based
874 retriction for FIELD[I]. */
880 int numeric
= XINT (val
);
883 from
= to
= XLFD_ENCODING_INDEX
,
884 mask
= XLFD_ENCODING_MASK
;
885 else if (numeric
== 0)
886 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
887 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
888 else if (numeric
<= 48)
889 from
= to
= XLFD_PIXEL_INDEX
,
890 mask
= XLFD_PIXEL_MASK
;
892 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
893 mask
= XLFD_LARGENUM_MASK
;
895 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
896 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
897 mask
= XLFD_NULL_MASK
;
899 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
902 Lisp_Object name
= SYMBOL_NAME (val
);
904 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
905 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
906 mask
= XLFD_REGENC_MASK
;
908 from
= to
= XLFD_ENCODING_INDEX
,
909 mask
= XLFD_ENCODING_MASK
;
911 else if (range_from
<= XLFD_WEIGHT_INDEX
912 && range_to
>= XLFD_WEIGHT_INDEX
913 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
914 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
915 else if (range_from
<= XLFD_SLANT_INDEX
916 && range_to
>= XLFD_SLANT_INDEX
917 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
918 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
919 else if (range_from
<= XLFD_SWIDTH_INDEX
920 && range_to
>= XLFD_SWIDTH_INDEX
921 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
922 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
925 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
926 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
928 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
929 mask
= XLFD_SYMBOL_MASK
;
932 /* Merge position-based and value-based restrictions. */
934 while (from
< range_from
)
935 mask
&= ~(1 << from
++);
936 while (from
< 14 && ! (mask
& (1 << from
)))
938 while (to
> range_to
)
939 mask
&= ~(1 << to
--);
940 while (to
>= 0 && ! (mask
& (1 << to
)))
944 range
[i
].from
= from
;
946 range
[i
].mask
= mask
;
948 if (from
> range_from
|| to
< range_to
)
950 /* The range is narrowed by value-based restrictions.
951 Reflect it to the other fields. */
953 /* Following fields should be after FROM. */
955 /* Preceding fields should be before TO. */
956 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
958 /* Check FROM for non-wildcard field. */
959 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
961 while (range
[j
].from
< from
)
962 range
[j
].mask
&= ~(1 << range
[j
].from
++);
963 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
965 range
[j
].from
= from
;
968 from
= range
[j
].from
;
969 if (range
[j
].to
> to
)
971 while (range
[j
].to
> to
)
972 range
[j
].mask
&= ~(1 << range
[j
].to
--);
973 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
986 /* Decide all fileds from restrictions in RANGE. */
987 for (i
= j
= 0; i
< n
; i
++)
989 if (j
< range
[i
].from
)
991 if (i
== 0 || ! NILP (tmp
[i
- 1]))
992 /* None of TMP[X] corresponds to Jth field. */
994 for (; j
< range
[i
].from
; j
++)
999 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
1001 for (; j
< XLFD_LAST_INDEX
; j
++)
1003 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
1004 field
[XLFD_ENCODING_INDEX
]
1005 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1010 #ifdef ENABLE_CHECKING
1011 /* Match a 14-field XLFD pattern against a full XLFD font name. */
1013 font_match_xlfd (char *pattern
, char *name
)
1015 while (*pattern
&& *name
)
1017 if (*pattern
== *name
)
1019 else if (*pattern
== '*')
1020 if (*name
== pattern
[1])
1031 /* Make sure the font object matches the XLFD font name. */
1033 font_check_xlfd_parse (Lisp_Object font
, char *name
)
1035 char name_check
[256];
1036 font_unparse_xlfd (font
, 0, name_check
, 255);
1037 return font_match_xlfd (name_check
, name
);
1043 /* Parse NAME (null terminated) as XLFD and store information in FONT
1044 (font-spec or font-entity). Size property of FONT is set as
1046 specified XLFD fields FONT property
1047 --------------------- -------------
1048 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1049 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1050 POINT_SIZE POINT_SIZE/10 (Lisp float)
1052 If NAME is successfully parsed, return 0. Otherwise return -1.
1054 FONT is usually a font-spec, but when this function is called from
1055 X font backend driver, it is a font-entity. In that case, NAME is
1056 a fully specified XLFD. */
1059 font_parse_xlfd (name
, font
)
1063 int len
= strlen (name
);
1065 char *f
[XLFD_LAST_INDEX
+ 1];
1069 if (len
> 255 || !len
)
1070 /* Maximum XLFD name length is 255. */
1072 /* Accept "*-.." as a fully specified XLFD. */
1073 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1074 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1077 for (p
= name
+ i
; *p
; p
++)
1081 if (i
== XLFD_LAST_INDEX
)
1086 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1087 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1089 if (i
== XLFD_LAST_INDEX
)
1091 /* Fully specified XLFD. */
1094 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1095 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1096 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1097 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1099 val
= INTERN_FIELD_SYM (i
);
1102 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1104 ASET (font
, j
, make_number (n
));
1107 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1108 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1109 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1111 ASET (font
, FONT_REGISTRY_INDEX
,
1112 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1113 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1115 p
= f
[XLFD_PIXEL_INDEX
];
1116 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1117 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1120 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1122 ASET (font
, FONT_SIZE_INDEX
, val
);
1125 double point_size
= -1;
1127 font_assert (FONT_SPEC_P (font
));
1128 p
= f
[XLFD_POINT_INDEX
];
1130 point_size
= parse_matrix (p
);
1131 else if (isdigit (*p
))
1132 point_size
= atoi (p
), point_size
/= 10;
1133 if (point_size
>= 0)
1134 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1138 ASET (font
, FONT_DPI_INDEX
, INTERN_FIELD (XLFD_RESY_INDEX
));
1139 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1142 val
= font_prop_validate_spacing (QCspacing
, val
);
1143 if (! INTEGERP (val
))
1145 ASET (font
, FONT_SPACING_INDEX
, val
);
1147 p
= f
[XLFD_AVGWIDTH_INDEX
];
1150 ASET (font
, FONT_AVGWIDTH_INDEX
,
1151 font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0));
1155 int wild_card_found
= 0;
1156 Lisp_Object prop
[XLFD_LAST_INDEX
];
1158 if (FONT_ENTITY_P (font
))
1160 for (j
= 0; j
< i
; j
++)
1164 if (f
[j
][1] && f
[j
][1] != '-')
1167 wild_card_found
= 1;
1170 prop
[j
] = INTERN_FIELD (j
);
1172 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1174 if (! wild_card_found
)
1176 if (font_expand_wildcards (prop
, i
) < 0)
1179 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1180 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1181 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1182 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1183 if (! NILP (prop
[i
]))
1185 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1187 ASET (font
, j
, make_number (n
));
1189 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1190 val
= prop
[XLFD_REGISTRY_INDEX
];
1193 val
= prop
[XLFD_ENCODING_INDEX
];
1195 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1197 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1198 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1200 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1201 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1203 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1205 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1206 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1207 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1209 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1211 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1214 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1215 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1216 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1218 val
= font_prop_validate_spacing (QCspacing
,
1219 prop
[XLFD_SPACING_INDEX
]);
1220 if (! INTEGERP (val
))
1222 ASET (font
, FONT_SPACING_INDEX
, val
);
1224 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1225 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1231 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1232 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1233 0, use PIXEL_SIZE instead. */
1236 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1242 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1246 font_assert (FONTP (font
));
1248 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1251 if (i
== FONT_ADSTYLE_INDEX
)
1252 j
= XLFD_ADSTYLE_INDEX
;
1253 else if (i
== FONT_REGISTRY_INDEX
)
1254 j
= XLFD_REGISTRY_INDEX
;
1255 val
= AREF (font
, i
);
1258 if (j
== XLFD_REGISTRY_INDEX
)
1259 f
[j
] = "*-*", len
+= 4;
1261 f
[j
] = "*", len
+= 2;
1266 val
= SYMBOL_NAME (val
);
1267 if (j
== XLFD_REGISTRY_INDEX
1268 && ! strchr ((char *) SDATA (val
), '-'))
1270 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1271 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1273 f
[j
] = alloca (SBYTES (val
) + 3);
1274 sprintf (f
[j
], "%s-*", SDATA (val
));
1275 len
+= SBYTES (val
) + 3;
1279 f
[j
] = alloca (SBYTES (val
) + 4);
1280 sprintf (f
[j
], "%s*-*", SDATA (val
));
1281 len
+= SBYTES (val
) + 4;
1285 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1289 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1292 val
= font_style_symbolic (font
, i
, 0);
1294 f
[j
] = "*", len
+= 2;
1297 val
= SYMBOL_NAME (val
);
1298 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1302 val
= AREF (font
, FONT_SIZE_INDEX
);
1303 font_assert (NUMBERP (val
) || NILP (val
));
1311 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1312 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1315 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1317 else if (FLOATP (val
))
1319 i
= XFLOAT_DATA (val
) * 10;
1320 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1321 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1324 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1326 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1328 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1329 f
[XLFD_RESX_INDEX
] = alloca (22);
1330 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1334 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1335 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1337 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1339 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1340 : spacing
<= FONT_SPACING_DUAL
? "d"
1341 : spacing
<= FONT_SPACING_MONO
? "m"
1346 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1347 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1349 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1350 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
],
1351 "%d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1354 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1355 len
++; /* for terminating '\0'. */
1358 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1359 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1360 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1361 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1362 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1363 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1364 f
[XLFD_REGISTRY_INDEX
]);
1367 /* Parse NAME (null terminated) and store information in FONT
1368 (font-spec or font-entity). NAME is supplied in either the
1369 Fontconfig or GTK font name format. If NAME is successfully
1370 parsed, return 0. Otherwise return -1.
1372 The fontconfig format is
1374 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1378 FAMILY [PROPS...] [SIZE]
1380 This function tries to guess which format it is. */
1383 font_parse_fcname (name
, font
)
1388 char *size_beg
= NULL
, *size_end
= NULL
;
1389 char *props_beg
= NULL
, *family_end
= NULL
;
1390 int len
= strlen (name
);
1395 for (p
= name
; *p
; p
++)
1397 if (*p
== '\\' && p
[1])
1401 props_beg
= family_end
= p
;
1406 int decimal
= 0, size_found
= 1;
1407 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1410 if (*q
!= '.' || decimal
)
1429 /* A fontconfig name with size and/or property data. */
1430 if (family_end
> name
)
1433 family
= font_intern_prop (name
, family_end
- name
, 1);
1434 ASET (font
, FONT_FAMILY_INDEX
, family
);
1438 double point_size
= strtod (size_beg
, &size_end
);
1439 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1440 if (*size_end
== ':' && size_end
[1])
1441 props_beg
= size_end
;
1445 /* Now parse ":KEY=VAL" patterns. */
1448 for (p
= props_beg
; *p
; p
= q
)
1450 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1453 /* Must be an enumerated value. */
1457 val
= font_intern_prop (p
, q
- p
, 1);
1459 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1461 if (PROP_MATCH ("light", 5)
1462 || PROP_MATCH ("medium", 6)
1463 || PROP_MATCH ("demibold", 8)
1464 || PROP_MATCH ("bold", 4)
1465 || PROP_MATCH ("black", 5))
1466 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1467 else if (PROP_MATCH ("roman", 5)
1468 || PROP_MATCH ("italic", 6)
1469 || PROP_MATCH ("oblique", 7))
1470 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1471 else if (PROP_MATCH ("charcell", 8))
1472 ASET (font
, FONT_SPACING_INDEX
,
1473 make_number (FONT_SPACING_CHARCELL
));
1474 else if (PROP_MATCH ("mono", 4))
1475 ASET (font
, FONT_SPACING_INDEX
,
1476 make_number (FONT_SPACING_MONO
));
1477 else if (PROP_MATCH ("proportional", 12))
1478 ASET (font
, FONT_SPACING_INDEX
,
1479 make_number (FONT_SPACING_PROPORTIONAL
));
1488 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1489 prop
= FONT_SIZE_INDEX
;
1492 key
= font_intern_prop (p
, q
- p
, 1);
1493 prop
= get_font_prop_index (key
);
1497 for (q
= p
; *q
&& *q
!= ':'; q
++);
1498 val
= font_intern_prop (p
, q
- p
, 0);
1500 if (prop
>= FONT_FOUNDRY_INDEX
1501 && prop
< FONT_EXTRA_INDEX
)
1502 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1504 Ffont_put (font
, key
, val
);
1512 /* Either a fontconfig-style name with no size and property
1513 data, or a GTK-style name. */
1515 int word_len
, prop_found
= 0;
1517 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1523 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1531 double point_size
= strtod (p
, &q
);
1532 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1537 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1538 if (*q
== '\\' && q
[1])
1542 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1544 if (PROP_MATCH ("Ultra-Light", 11))
1547 prop
= font_intern_prop ("ultra-light", 11, 1);
1548 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1550 else if (PROP_MATCH ("Light", 5))
1553 prop
= font_intern_prop ("light", 5, 1);
1554 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1556 else if (PROP_MATCH ("Semi-Bold", 9))
1559 prop
= font_intern_prop ("semi-bold", 9, 1);
1560 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1562 else if (PROP_MATCH ("Bold", 4))
1565 prop
= font_intern_prop ("bold", 4, 1);
1566 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1568 else if (PROP_MATCH ("Italic", 6))
1571 prop
= font_intern_prop ("italic", 4, 1);
1572 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1574 else if (PROP_MATCH ("Oblique", 7))
1577 prop
= font_intern_prop ("oblique", 7, 1);
1578 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1582 return -1; /* Unknown property in GTK-style font name. */
1591 family
= font_intern_prop (name
, family_end
- name
, 1);
1592 ASET (font
, FONT_FAMILY_INDEX
, family
);
1599 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1600 NAME (NBYTES length), and return the name length. If
1601 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1604 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1610 Lisp_Object family
, foundry
;
1611 Lisp_Object tail
, val
;
1615 Lisp_Object styles
[3];
1616 char *style_names
[3] = { "weight", "slant", "width" };
1619 family
= AREF (font
, FONT_FAMILY_INDEX
);
1620 if (! NILP (family
))
1622 if (SYMBOLP (family
))
1624 family
= SYMBOL_NAME (family
);
1625 len
+= SBYTES (family
);
1631 val
= AREF (font
, FONT_SIZE_INDEX
);
1634 if (XINT (val
) != 0)
1635 pixel_size
= XINT (val
);
1637 len
+= 21; /* for ":pixelsize=NUM" */
1639 else if (FLOATP (val
))
1642 point_size
= (int) XFLOAT_DATA (val
);
1643 len
+= 11; /* for "-NUM" */
1646 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1647 if (! NILP (foundry
))
1649 if (SYMBOLP (foundry
))
1651 foundry
= SYMBOL_NAME (foundry
);
1652 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1658 for (i
= 0; i
< 3; i
++)
1660 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1661 if (! NILP (styles
[i
]))
1662 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1663 SDATA (SYMBOL_NAME (styles
[i
])));
1666 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1667 len
+= sprintf (work
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1668 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1669 len
+= strlen (":spacing=100");
1670 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1671 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1672 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1674 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1676 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1678 len
+= SBYTES (val
);
1679 else if (INTEGERP (val
))
1680 len
+= sprintf (work
, "%d", XINT (val
));
1681 else if (SYMBOLP (val
))
1682 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1688 if (! NILP (family
))
1689 p
+= sprintf (p
, "%s", SDATA (family
));
1693 p
+= sprintf (p
, "%d", point_size
);
1695 p
+= sprintf (p
, "-%d", point_size
);
1697 else if (pixel_size
> 0)
1698 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1699 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1700 p
+= sprintf (p
, ":foundry=%s",
1701 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1702 for (i
= 0; i
< 3; i
++)
1703 if (! NILP (styles
[i
]))
1704 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1705 SDATA (SYMBOL_NAME (styles
[i
])));
1706 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1707 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1708 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1709 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1710 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1712 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1713 p
+= sprintf (p
, ":scalable=true");
1715 p
+= sprintf (p
, ":scalable=false");
1720 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1721 NAME (NBYTES length), and return the name length. F is the frame
1722 on which the font is displayed; it is used to calculate the point
1726 font_unparse_gtkname (font
, f
, name
, nbytes
)
1734 Lisp_Object family
, weight
, slant
, size
;
1735 int point_size
= -1;
1737 family
= AREF (font
, FONT_FAMILY_INDEX
);
1738 if (! NILP (family
))
1740 if (! SYMBOLP (family
))
1742 family
= SYMBOL_NAME (family
);
1743 len
+= SBYTES (family
);
1746 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1747 if (EQ (weight
, Qnormal
))
1749 else if (! NILP (weight
))
1751 weight
= SYMBOL_NAME (weight
);
1752 len
+= SBYTES (weight
);
1755 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1756 if (EQ (slant
, Qnormal
))
1758 else if (! NILP (slant
))
1760 slant
= SYMBOL_NAME (slant
);
1761 len
+= SBYTES (slant
);
1764 size
= AREF (font
, FONT_SIZE_INDEX
);
1765 /* Convert pixel size to point size. */
1766 if (INTEGERP (size
))
1768 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1770 if (INTEGERP (font_dpi
))
1771 dpi
= XINT (font_dpi
);
1774 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1777 else if (FLOATP (size
))
1779 point_size
= (int) XFLOAT_DATA (size
);
1786 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1788 if (! NILP (weight
))
1791 p
+= sprintf (p
, " %s", SDATA (weight
));
1792 q
[1] = toupper (q
[1]);
1798 p
+= sprintf (p
, " %s", SDATA (slant
));
1799 q
[1] = toupper (q
[1]);
1803 p
+= sprintf (p
, " %d", point_size
);
1808 /* Parse NAME (null terminated) and store information in FONT
1809 (font-spec or font-entity). If NAME is successfully parsed, return
1810 0. Otherwise return -1. */
1813 font_parse_name (name
, font
)
1817 if (name
[0] == '-' || index (name
, '*') || index (name
, '?'))
1818 return font_parse_xlfd (name
, font
);
1819 return font_parse_fcname (name
, font
);
1823 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1824 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1828 font_parse_family_registry (family
, registry
, font_spec
)
1829 Lisp_Object family
, registry
, font_spec
;
1835 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1837 CHECK_STRING (family
);
1838 len
= SBYTES (family
);
1839 p0
= (char *) SDATA (family
);
1840 p1
= index (p0
, '-');
1843 if ((*p0
!= '*' || p1
- p0
> 1)
1844 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1845 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1848 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1851 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1853 if (! NILP (registry
))
1855 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1856 CHECK_STRING (registry
);
1857 len
= SBYTES (registry
);
1858 p0
= (char *) SDATA (registry
);
1859 p1
= index (p0
, '-');
1862 if (SDATA (registry
)[len
- 1] == '*')
1863 registry
= concat2 (registry
, build_string ("-*"));
1865 registry
= concat2 (registry
, build_string ("*-*"));
1867 registry
= Fdowncase (registry
);
1868 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1873 /* This part (through the next ^L) is still experimental and not
1874 tested much. We may drastically change codes. */
1880 #define LGSTRING_HEADER_SIZE 6
1881 #define LGSTRING_GLYPH_SIZE 8
1884 check_gstring (gstring
)
1885 Lisp_Object gstring
;
1890 CHECK_VECTOR (gstring
);
1891 val
= AREF (gstring
, 0);
1893 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1895 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1896 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1897 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1898 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1899 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1900 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1901 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1902 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1903 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1904 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1905 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1907 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1909 val
= LGSTRING_GLYPH (gstring
, i
);
1911 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1913 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1915 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1916 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1917 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1918 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1919 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1920 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1921 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1922 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1924 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1926 if (ASIZE (val
) < 3)
1928 for (j
= 0; j
< 3; j
++)
1929 CHECK_NUMBER (AREF (val
, j
));
1934 error ("Invalid glyph-string format");
1939 check_otf_features (otf_features
)
1940 Lisp_Object otf_features
;
1944 CHECK_CONS (otf_features
);
1945 CHECK_SYMBOL (XCAR (otf_features
));
1946 otf_features
= XCDR (otf_features
);
1947 CHECK_CONS (otf_features
);
1948 CHECK_SYMBOL (XCAR (otf_features
));
1949 otf_features
= XCDR (otf_features
);
1950 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1952 CHECK_SYMBOL (Fcar (val
));
1953 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1954 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1956 otf_features
= XCDR (otf_features
);
1957 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1959 CHECK_SYMBOL (Fcar (val
));
1960 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1961 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1968 Lisp_Object otf_list
;
1971 otf_tag_symbol (tag
)
1976 OTF_tag_name (tag
, name
);
1977 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1984 Lisp_Object val
= Fassoc (file
, otf_list
);
1988 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1991 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1992 val
= make_save_value (otf
, 0);
1993 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1999 /* Return a list describing which scripts/languages FONT supports by
2000 which GSUB/GPOS features of OpenType tables. See the comment of
2001 (struct font_driver).otf_capability. */
2004 font_otf_capability (font
)
2008 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
2011 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
2014 for (i
= 0; i
< 2; i
++)
2016 OTF_GSUB_GPOS
*gsub_gpos
;
2017 Lisp_Object script_list
= Qnil
;
2020 if (OTF_get_features (otf
, i
== 0) < 0)
2022 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2023 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2025 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2026 Lisp_Object langsys_list
= Qnil
;
2027 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2030 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2032 OTF_LangSys
*langsys
;
2033 Lisp_Object feature_list
= Qnil
;
2034 Lisp_Object langsys_tag
;
2037 if (k
== script
->LangSysCount
)
2039 langsys
= &script
->DefaultLangSys
;
2044 langsys
= script
->LangSys
+ k
;
2046 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2048 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2050 OTF_Feature
*feature
2051 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2052 Lisp_Object feature_tag
2053 = otf_tag_symbol (feature
->FeatureTag
);
2055 feature_list
= Fcons (feature_tag
, feature_list
);
2057 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2060 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2065 XSETCAR (capability
, script_list
);
2067 XSETCDR (capability
, script_list
);
2073 /* Parse OTF features in SPEC and write a proper features spec string
2074 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2075 assured that the sufficient memory has already allocated for
2079 generate_otf_features (spec
, features
)
2089 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2095 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2100 else if (! asterisk
)
2102 val
= SYMBOL_NAME (val
);
2103 p
+= sprintf (p
, "%s", SDATA (val
));
2107 val
= SYMBOL_NAME (val
);
2108 p
+= sprintf (p
, "~%s", SDATA (val
));
2112 error ("OTF spec too long");
2116 font_otf_DeviceTable (device_table
)
2117 OTF_DeviceTable
*device_table
;
2119 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2121 return Fcons (make_number (len
),
2122 make_unibyte_string (device_table
->DeltaValue
, len
));
2126 font_otf_ValueRecord (value_format
, value_record
)
2128 OTF_ValueRecord
*value_record
;
2130 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2132 if (value_format
& OTF_XPlacement
)
2133 ASET (val
, 0, make_number (value_record
->XPlacement
));
2134 if (value_format
& OTF_YPlacement
)
2135 ASET (val
, 1, make_number (value_record
->YPlacement
));
2136 if (value_format
& OTF_XAdvance
)
2137 ASET (val
, 2, make_number (value_record
->XAdvance
));
2138 if (value_format
& OTF_YAdvance
)
2139 ASET (val
, 3, make_number (value_record
->YAdvance
));
2140 if (value_format
& OTF_XPlaDevice
)
2141 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2142 if (value_format
& OTF_YPlaDevice
)
2143 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2144 if (value_format
& OTF_XAdvDevice
)
2145 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2146 if (value_format
& OTF_YAdvDevice
)
2147 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2152 font_otf_Anchor (anchor
)
2157 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2158 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2159 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2160 if (anchor
->AnchorFormat
== 2)
2161 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2164 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2165 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2169 #endif /* HAVE_LIBOTF */
2175 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2176 static int font_compare
P_ ((const void *, const void *));
2177 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
2180 /* Return a rescaling ratio of FONT_ENTITY. */
2181 extern Lisp_Object Vface_font_rescale_alist
;
2184 font_rescale_ratio (font_entity
)
2185 Lisp_Object font_entity
;
2187 Lisp_Object tail
, elt
;
2188 Lisp_Object name
= Qnil
;
2190 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2193 if (FLOATP (XCDR (elt
)))
2195 if (STRINGP (XCAR (elt
)))
2198 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2199 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2200 return XFLOAT_DATA (XCDR (elt
));
2202 else if (FONT_SPEC_P (XCAR (elt
)))
2204 if (font_match_p (XCAR (elt
), font_entity
))
2205 return XFLOAT_DATA (XCDR (elt
));
2212 /* We sort fonts by scoring each of them against a specified
2213 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2214 the value is, the closer the font is to the font-spec.
2216 The lowest 2 bits of the score is used for driver type. The font
2217 available by the most preferred font driver is 0.
2219 Each 7-bit in the higher 28 bits are used for numeric properties
2220 WEIGHT, SLANT, WIDTH, and SIZE. */
2222 /* How many bits to shift to store the difference value of each font
2223 property in a score. Note that flots for FONT_TYPE_INDEX and
2224 FONT_REGISTRY_INDEX are not used. */
2225 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2227 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2228 The return value indicates how different ENTITY is compared with
2232 font_score (entity
, spec_prop
)
2233 Lisp_Object entity
, *spec_prop
;
2238 /* Score three style numeric fields. Maximum difference is 127. */
2239 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2240 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2242 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2247 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2250 /* Score the size. Maximum difference is 127. */
2251 i
= FONT_SIZE_INDEX
;
2252 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2253 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2255 /* We use the higher 6-bit for the actual size difference. The
2256 lowest bit is set if the DPI is different. */
2258 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2260 if (CONSP (Vface_font_rescale_alist
))
2261 pixel_size
*= font_rescale_ratio (entity
);
2262 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2266 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2267 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2269 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2276 /* The comparison function for qsort. */
2279 font_compare (d1
, d2
)
2280 const void *d1
, *d2
;
2282 return (*(unsigned *) d1
- *(unsigned *) d2
);
2286 /* The structure for elements being sorted by qsort. */
2287 struct font_sort_data
2294 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2295 If PREFER specifies a point-size, calculate the corresponding
2296 pixel-size from QCdpi property of PREFER or from the Y-resolution
2297 of FRAME before sorting.
2299 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2300 return the sorted VEC. */
2303 font_sort_entites (vec
, prefer
, frame
, best_only
)
2304 Lisp_Object vec
, prefer
, frame
;
2307 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2309 struct font_sort_data
*data
;
2310 unsigned best_score
;
2311 Lisp_Object best_entity
, driver_type
;
2313 struct frame
*f
= XFRAME (frame
);
2314 struct font_driver_list
*list
;
2319 return best_only
? AREF (vec
, 0) : vec
;
2321 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_DPI_INDEX
; i
++)
2322 prefer_prop
[i
] = AREF (prefer
, i
);
2323 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2324 prefer_prop
[FONT_SIZE_INDEX
]
2325 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2327 /* Scoring and sorting. */
2328 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2329 best_score
= 0xFFFFFFFF;
2330 /* We are sure that the length of VEC > 1. */
2331 driver_type
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2332 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2333 driver_order
++, list
= list
->next
)
2334 if (EQ (driver_type
, list
->driver
->type
))
2336 best_entity
= data
[0].entity
= AREF (vec
, 0);
2337 best_score
= data
[0].score
2338 = font_score (data
[0].entity
, prefer_prop
) | driver_order
;
2339 for (i
= 0; i
< len
; i
++)
2341 if (!EQ (driver_type
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2342 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2343 driver_order
++, list
= list
->next
)
2344 if (EQ (driver_type
, list
->driver
->type
))
2346 data
[i
].entity
= AREF (vec
, i
);
2347 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
) | driver_order
;
2348 if (best_only
&& best_score
> data
[i
].score
)
2350 best_score
= data
[i
].score
;
2351 best_entity
= data
[i
].entity
;
2352 if (best_score
== 0)
2358 qsort (data
, len
, sizeof *data
, font_compare
);
2359 for (i
= 0; i
< len
; i
++)
2360 ASET (vec
, i
, data
[i
].entity
);
2366 font_add_log ("sort-by", prefer
, vec
);
2371 /* API of Font Service Layer. */
2373 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2374 sort_shift_bits. Finternal_set_font_selection_order calls this
2375 function with font_sort_order after setting up it. */
2378 font_update_sort_order (order
)
2383 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2385 int xlfd_idx
= order
[i
];
2387 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2388 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2389 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2390 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2391 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2392 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2394 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2399 font_check_otf_features (script
, langsys
, features
, table
)
2400 Lisp_Object script
, langsys
, features
, table
;
2405 table
= assq_no_quit (script
, table
);
2408 table
= XCDR (table
);
2409 if (! NILP (langsys
))
2411 table
= assq_no_quit (langsys
, table
);
2417 val
= assq_no_quit (Qnil
, table
);
2419 table
= XCAR (table
);
2423 table
= XCDR (table
);
2424 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2426 if (NILP (XCAR (features
)))
2431 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2437 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2440 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2442 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2444 script
= XCAR (spec
);
2448 langsys
= XCAR (spec
);
2459 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2460 XCAR (otf_capability
)))
2462 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2463 XCDR (otf_capability
)))
2470 /* Check if FONT (font-entity or font-object) matches with the font
2471 specification SPEC. */
2474 font_match_p (spec
, font
)
2475 Lisp_Object spec
, font
;
2477 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2478 Lisp_Object extra
, font_extra
;
2481 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2482 if (! NILP (AREF (spec
, i
))
2483 && ! NILP (AREF (font
, i
))
2484 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2486 props
= XFONT_SPEC (spec
)->props
;
2487 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2489 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2490 prop
[i
] = AREF (spec
, i
);
2491 prop
[FONT_SIZE_INDEX
]
2492 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2496 if (font_score (font
, props
) > 0)
2498 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2499 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2500 for (; CONSP (extra
); extra
= XCDR (extra
))
2502 Lisp_Object key
= XCAR (XCAR (extra
));
2503 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2505 if (EQ (key
, QClang
))
2507 val2
= assq_no_quit (key
, font_extra
);
2516 if (NILP (Fmemq (val
, val2
)))
2521 ? NILP (Fmemq (val
, XCDR (val2
)))
2525 else if (EQ (key
, QCscript
))
2527 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2533 /* All characters in the list must be supported. */
2534 for (; CONSP (val2
); val2
= XCDR (val2
))
2536 if (! NATNUMP (XCAR (val2
)))
2538 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2539 == FONT_INVALID_CODE
)
2543 else if (VECTORP (val2
))
2545 /* At most one character in the vector must be supported. */
2546 for (i
= 0; i
< ASIZE (val2
); i
++)
2548 if (! NATNUMP (AREF (val2
, i
)))
2550 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2551 != FONT_INVALID_CODE
)
2554 if (i
== ASIZE (val2
))
2559 else if (EQ (key
, QCotf
))
2563 if (! FONT_OBJECT_P (font
))
2565 fontp
= XFONT_OBJECT (font
);
2566 if (! fontp
->driver
->otf_capability
)
2568 val2
= fontp
->driver
->otf_capability (fontp
);
2569 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2580 Each font backend has the callback function get_cache, and it
2581 returns a cons cell of which cdr part can be freely used for
2582 caching fonts. The cons cell may be shared by multiple frames
2583 and/or multiple font drivers. So, we arrange the cdr part as this:
2585 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2587 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2588 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2589 cons (FONT-SPEC FONT-ENTITY ...). */
2591 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2592 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2593 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2594 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2595 struct font_driver
*));
2598 font_prepare_cache (f
, driver
)
2600 struct font_driver
*driver
;
2602 Lisp_Object cache
, val
;
2604 cache
= driver
->get_cache (f
);
2606 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2610 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2611 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2615 val
= XCDR (XCAR (val
));
2616 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2622 font_finish_cache (f
, driver
)
2624 struct font_driver
*driver
;
2626 Lisp_Object cache
, val
, tmp
;
2629 cache
= driver
->get_cache (f
);
2631 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2632 cache
= val
, val
= XCDR (val
);
2633 font_assert (! NILP (val
));
2634 tmp
= XCDR (XCAR (val
));
2635 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2636 if (XINT (XCAR (tmp
)) == 0)
2638 font_clear_cache (f
, XCAR (val
), driver
);
2639 XSETCDR (cache
, XCDR (val
));
2645 font_get_cache (f
, driver
)
2647 struct font_driver
*driver
;
2649 Lisp_Object val
= driver
->get_cache (f
);
2650 Lisp_Object type
= driver
->type
;
2652 font_assert (CONSP (val
));
2653 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2654 font_assert (CONSP (val
));
2655 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2656 val
= XCDR (XCAR (val
));
2660 static int num_fonts
;
2663 font_clear_cache (f
, cache
, driver
)
2666 struct font_driver
*driver
;
2668 Lisp_Object tail
, elt
;
2669 Lisp_Object tail2
, entity
;
2671 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2672 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2675 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2676 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2678 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2680 entity
= XCAR (tail2
);
2682 if (FONT_ENTITY_P (entity
)
2683 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2685 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2687 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2689 Lisp_Object val
= XCAR (objlist
);
2690 struct font
*font
= XFONT_OBJECT (val
);
2692 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2694 font_assert (font
&& driver
== font
->driver
);
2695 driver
->close (f
, font
);
2699 if (driver
->free_entity
)
2700 driver
->free_entity (entity
);
2705 XSETCDR (cache
, Qnil
);
2709 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2712 font_delete_unmatched (list
, spec
, size
)
2713 Lisp_Object list
, spec
;
2716 Lisp_Object entity
, val
;
2717 enum font_property_index prop
;
2719 for (val
= Qnil
; CONSP (list
); list
= XCDR (list
))
2721 entity
= XCAR (list
);
2722 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2723 if (INTEGERP (AREF (spec
, prop
))
2724 && ((XINT (AREF (spec
, prop
)) >> 8)
2725 != (XINT (AREF (entity
, prop
)) >> 8)))
2726 prop
= FONT_SPEC_MAX
;
2727 if (prop
< FONT_SPEC_MAX
2729 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2731 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2734 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2735 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2736 prop
= FONT_SPEC_MAX
;
2738 if (prop
< FONT_SPEC_MAX
2739 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2740 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2741 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2742 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2743 prop
= FONT_SPEC_MAX
;
2744 if (prop
< FONT_SPEC_MAX
2745 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2746 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2747 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2748 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2749 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2750 prop
= FONT_SPEC_MAX
;
2751 if (prop
< FONT_SPEC_MAX
)
2752 val
= Fcons (entity
, val
);
2758 /* Return a vector of font-entities matching with SPEC on FRAME. */
2761 font_list_entities (frame
, spec
)
2762 Lisp_Object frame
, spec
;
2764 FRAME_PTR f
= XFRAME (frame
);
2765 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2766 Lisp_Object ftype
, val
;
2769 int need_filtering
= 0;
2772 font_assert (FONT_SPEC_P (spec
));
2774 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2775 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2776 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2777 size
= font_pixel_size (f
, spec
);
2781 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2782 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2783 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2784 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2786 ASET (scratch_font_spec
, i
, Qnil
);
2787 if (! NILP (AREF (spec
, i
)))
2789 if (i
== FONT_DPI_INDEX
)
2790 /* Skip FONT_SPACING_INDEX */
2793 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2794 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2796 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2800 for (i
= 0; 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
);
2806 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2807 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2814 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2815 copy
= Fcopy_font_spec (scratch_font_spec
);
2816 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2817 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2819 if (! NILP (val
) && need_filtering
)
2820 val
= font_delete_unmatched (val
, spec
, size
);
2825 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2826 font_add_log ("list", spec
, val
);
2831 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2832 nil, is an array of face's attributes, which specifies preferred
2833 font-related attributes. */
2836 font_matching_entity (f
, attrs
, spec
)
2838 Lisp_Object
*attrs
, spec
;
2840 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2841 Lisp_Object ftype
, size
, entity
;
2843 Lisp_Object work
= Fcopy_font_spec (spec
);
2845 XSETFRAME (frame
, f
);
2846 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2847 size
= AREF (spec
, FONT_SIZE_INDEX
);
2850 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2851 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2852 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2853 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2856 for (; driver_list
; driver_list
= driver_list
->next
)
2858 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2860 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2863 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2864 entity
= assoc_no_quit (work
, XCDR (cache
));
2866 entity
= XCDR (entity
);
2869 entity
= driver_list
->driver
->match (frame
, work
);
2870 copy
= Fcopy_font_spec (work
);
2871 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2872 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2874 if (! NILP (entity
))
2877 font_add_log ("match", work
, entity
);
2882 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2883 opened font object. */
2886 font_open_entity (f
, entity
, pixel_size
)
2891 struct font_driver_list
*driver_list
;
2892 Lisp_Object objlist
, size
, val
, font_object
;
2894 int min_width
, height
;
2895 int scaled_pixel_size
;
2897 font_assert (FONT_ENTITY_P (entity
));
2898 size
= AREF (entity
, FONT_SIZE_INDEX
);
2899 if (XINT (size
) != 0)
2900 scaled_pixel_size
= pixel_size
= XINT (size
);
2901 else if (CONSP (Vface_font_rescale_alist
))
2902 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2904 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2905 objlist
= XCDR (objlist
))
2906 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2907 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2908 return XCAR (objlist
);
2910 val
= AREF (entity
, FONT_TYPE_INDEX
);
2911 for (driver_list
= f
->font_driver_list
;
2912 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2913 driver_list
= driver_list
->next
);
2917 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2918 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2919 font_add_log ("open", entity
, font_object
);
2920 if (NILP (font_object
))
2922 ASET (entity
, FONT_OBJLIST_INDEX
,
2923 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2924 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
2927 font
= XFONT_OBJECT (font_object
);
2928 min_width
= (font
->min_width
? font
->min_width
2929 : font
->average_width
? font
->average_width
2930 : font
->space_width
? font
->space_width
2932 height
= (font
->height
? font
->height
: 1);
2933 #ifdef HAVE_WINDOW_SYSTEM
2934 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2935 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2937 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2938 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2939 fonts_changed_p
= 1;
2943 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2944 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2945 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2946 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2954 /* Close FONT_OBJECT that is opened on frame F. */
2957 font_close_object (f
, font_object
)
2959 Lisp_Object font_object
;
2961 struct font
*font
= XFONT_OBJECT (font_object
);
2963 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2964 /* Already closed. */
2966 font_add_log ("close", font_object
, Qnil
);
2967 font
->driver
->close (f
, font
);
2968 #ifdef HAVE_WINDOW_SYSTEM
2969 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2970 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2976 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2977 FONT is a font-entity and it must be opened to check. */
2980 font_has_char (f
, font
, c
)
2987 if (FONT_ENTITY_P (font
))
2989 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2990 struct font_driver_list
*driver_list
;
2992 for (driver_list
= f
->font_driver_list
;
2993 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2994 driver_list
= driver_list
->next
);
2997 if (! driver_list
->driver
->has_char
)
2999 return driver_list
->driver
->has_char (font
, c
);
3002 font_assert (FONT_OBJECT_P (font
));
3003 fontp
= XFONT_OBJECT (font
);
3004 if (fontp
->driver
->has_char
)
3006 int result
= fontp
->driver
->has_char (font
, c
);
3011 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
3015 /* Return the glyph ID of FONT_OBJECT for character C. */
3018 font_encode_char (font_object
, c
)
3019 Lisp_Object font_object
;
3024 font_assert (FONT_OBJECT_P (font_object
));
3025 font
= XFONT_OBJECT (font_object
);
3026 return font
->driver
->encode_char (font
, c
);
3030 /* Return the name of FONT_OBJECT. */
3033 font_get_name (font_object
)
3034 Lisp_Object font_object
;
3036 font_assert (FONT_OBJECT_P (font_object
));
3037 return AREF (font_object
, FONT_NAME_INDEX
);
3041 /* Return the specification of FONT_OBJECT. */
3044 font_get_spec (font_object
)
3045 Lisp_Object font_object
;
3047 Lisp_Object spec
= font_make_spec ();
3050 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
3051 ASET (spec
, i
, AREF (font_object
, i
));
3052 ASET (spec
, FONT_SIZE_INDEX
,
3053 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
3058 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3059 could not be parsed by font_parse_name, return Qnil. */
3062 font_spec_from_name (font_name
)
3063 Lisp_Object font_name
;
3065 Lisp_Object spec
= Ffont_spec (0, NULL
);
3067 CHECK_STRING (font_name
);
3068 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3070 font_put_extra (spec
, QCname
, font_name
);
3076 font_clear_prop (attrs
, prop
)
3078 enum font_property_index prop
;
3080 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3084 if (NILP (AREF (font
, prop
))
3085 && prop
!= FONT_FAMILY_INDEX
3086 && prop
!= FONT_FOUNDRY_INDEX
3087 && prop
!= FONT_WIDTH_INDEX
3088 && prop
!= FONT_SIZE_INDEX
)
3090 font
= Fcopy_font_spec (font
);
3091 ASET (font
, prop
, Qnil
);
3092 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3094 if (prop
== FONT_FAMILY_INDEX
)
3096 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3097 /* If we are setting the font family, we must also clear
3098 FONT_WIDTH_INDEX to avoid rejecting families that lack
3099 support for some widths. */
3100 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3102 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3103 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3104 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3105 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3106 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3107 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3109 else if (prop
== FONT_SIZE_INDEX
)
3111 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3112 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3113 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3115 else if (prop
== FONT_WIDTH_INDEX
)
3116 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3117 attrs
[LFACE_FONT_INDEX
] = font
;
3121 font_update_lface (f
, attrs
)
3127 spec
= attrs
[LFACE_FONT_INDEX
];
3128 if (! FONT_SPEC_P (spec
))
3131 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3132 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3133 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3134 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3135 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3136 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3137 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3138 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);
3139 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3140 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3141 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3145 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3150 val
= Ffont_get (spec
, QCdpi
);
3153 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3155 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3157 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3159 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3160 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3166 /* Return a font-entity satisfying SPEC and best matching with face's
3167 font related attributes in ATTRS. C, if not negative, is a
3168 character that the entity must support. */
3171 font_find_for_lface (f
, attrs
, spec
, c
)
3178 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
3179 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3181 int i
, j
, k
, l
, result
;
3183 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3184 if (NILP (registry
[0]))
3186 registry
[0] = DEFAULT_ENCODING
;
3187 registry
[1] = Qascii_0
;
3188 registry
[2] = null_vector
;
3191 registry
[1] = null_vector
;
3193 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3195 struct charset
*encoding
, *repertory
;
3197 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3198 &encoding
, &repertory
) < 0)
3202 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3204 /* Any font of this registry support C. So, let's
3205 suppress the further checking. */
3208 else if (c
> encoding
->max_char
)
3212 work
= Fcopy_font_spec (spec
);
3213 XSETFRAME (frame
, f
);
3214 size
= AREF (spec
, FONT_SIZE_INDEX
);
3215 pixel_size
= font_pixel_size (f
, spec
);
3216 if (pixel_size
== 0)
3218 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3220 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3222 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3223 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3224 if (! NILP (foundry
[0]))
3225 foundry
[1] = null_vector
;
3226 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3228 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3229 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3231 foundry
[2] = null_vector
;
3234 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3236 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3237 if (! NILP (adstyle
[0]))
3238 adstyle
[1] = null_vector
;
3239 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3241 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3243 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3245 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3247 adstyle
[2] = null_vector
;
3250 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3253 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3256 val
= AREF (work
, FONT_FAMILY_INDEX
);
3257 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3259 val
= attrs
[LFACE_FAMILY_INDEX
];
3260 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3264 family
= alloca ((sizeof family
[0]) * 2);
3266 family
[1] = null_vector
; /* terminator. */
3271 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3279 if (! NILP (alters
))
3281 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3282 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3283 family
[i
] = XCAR (alters
);
3284 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3286 family
[i
] = null_vector
;
3290 family
= alloca ((sizeof family
[0]) * 3);
3293 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3295 family
[i
] = null_vector
;
3299 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3301 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3302 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3304 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3305 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3307 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3308 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3310 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3311 entities
= font_list_entities (frame
, work
);
3312 if (ASIZE (entities
) > 0)
3320 if (ASIZE (entities
) == 1)
3323 return AREF (entities
, 0);
3327 /* Sort fonts by properties specified in LFACE. */
3328 Lisp_Object prefer
= scratch_font_prefer
;
3330 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3331 ASET (prefer
, i
, AREF (work
, i
));
3332 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3334 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3336 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3337 if (NILP (AREF (prefer
, i
)))
3338 ASET (prefer
, i
, AREF (face_font
, i
));
3340 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3341 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3342 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3343 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3344 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3345 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3346 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3347 entities
= font_sort_entites (entities
, prefer
, frame
, c
< 0);
3352 for (i
= 0; i
< ASIZE (entities
); i
++)
3356 val
= AREF (entities
, i
);
3359 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3360 if (! EQ (AREF (val
, j
), props
[j
]))
3362 if (j
> FONT_REGISTRY_INDEX
)
3365 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3366 props
[j
] = AREF (val
, j
);
3367 result
= font_has_char (f
, val
, c
);
3372 val
= font_open_for_lface (f
, val
, attrs
, spec
);
3375 result
= font_has_char (f
, val
, c
);
3376 font_close_object (f
, val
);
3378 return AREF (entities
, i
);
3385 font_open_for_lface (f
, entity
, attrs
, spec
)
3393 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3394 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3395 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3396 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3397 size
= font_pixel_size (f
, spec
);
3401 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3402 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3405 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3406 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3407 if (INTEGERP (height
))
3410 abort(); /* We should never end up here. */
3414 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3418 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3419 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3423 return font_open_entity (f
, entity
, size
);
3427 /* Find a font satisfying SPEC and best matching with face's
3428 attributes in ATTRS on FRAME, and return the opened
3432 font_load_for_lface (f
, attrs
, spec
)
3434 Lisp_Object
*attrs
, spec
;
3438 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3441 /* No font is listed for SPEC, but each font-backend may have
3442 the different criteria about "font matching". So, try
3444 entity
= font_matching_entity (f
, attrs
, spec
);
3448 return font_open_for_lface (f
, entity
, attrs
, spec
);
3452 /* Make FACE on frame F ready to use the font opened for FACE. */
3455 font_prepare_for_face (f
, face
)
3459 if (face
->font
->driver
->prepare_face
)
3460 face
->font
->driver
->prepare_face (f
, face
);
3464 /* Make FACE on frame F stop using the font opened for FACE. */
3467 font_done_for_face (f
, face
)
3471 if (face
->font
->driver
->done_face
)
3472 face
->font
->driver
->done_face (f
, face
);
3477 /* Open a font best matching with NAME on frame F. If no proper font
3478 is found, return Qnil. */
3481 font_open_by_name (f
, name
)
3485 Lisp_Object args
[2];
3486 Lisp_Object spec
, attrs
[LFACE_VECTOR_SIZE
];
3489 args
[1] = make_unibyte_string (name
, strlen (name
));
3490 spec
= Ffont_spec (2, args
);
3491 /* We set up the default font-related attributes of a face to prefer
3493 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3494 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3495 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3497 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3499 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3501 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3503 return font_load_for_lface (f
, attrs
, spec
);
3507 /* Register font-driver DRIVER. This function is used in two ways.
3509 The first is with frame F non-NULL. In this case, make DRIVER
3510 available (but not yet activated) on F. All frame creaters
3511 (e.g. Fx_create_frame) must call this function at least once with
3512 an available font-driver.
3514 The second is with frame F NULL. In this case, DRIVER is globally
3515 registered in the variable `font_driver_list'. All font-driver
3516 implementations must call this function in its syms_of_XXXX
3517 (e.g. syms_of_xfont). */
3520 register_font_driver (driver
, f
)
3521 struct font_driver
*driver
;
3524 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3525 struct font_driver_list
*prev
, *list
;
3527 if (f
&& ! driver
->draw
)
3528 error ("Unusable font driver for a frame: %s",
3529 SDATA (SYMBOL_NAME (driver
->type
)));
3531 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3532 if (EQ (list
->driver
->type
, driver
->type
))
3533 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3535 list
= xmalloc (sizeof (struct font_driver_list
));
3537 list
->driver
= driver
;
3542 f
->font_driver_list
= list
;
3544 font_driver_list
= list
;
3550 free_font_driver_list (f
)
3553 struct font_driver_list
*list
, *next
;
3555 for (list
= f
->font_driver_list
; list
; list
= next
)
3560 f
->font_driver_list
= NULL
;
3564 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3565 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3566 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3568 A caller must free all realized faces if any in advance. The
3569 return value is a list of font backends actually made used on
3573 font_update_drivers (f
, new_drivers
)
3575 Lisp_Object new_drivers
;
3577 Lisp_Object active_drivers
= Qnil
;
3578 struct font_driver
*driver
;
3579 struct font_driver_list
*list
;
3581 /* At first, turn off non-requested drivers, and turn on requested
3583 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3585 driver
= list
->driver
;
3586 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3591 if (driver
->end_for_frame
)
3592 driver
->end_for_frame (f
);
3593 font_finish_cache (f
, driver
);
3598 if (! driver
->start_for_frame
3599 || driver
->start_for_frame (f
) == 0)
3601 font_prepare_cache (f
, driver
);
3608 if (NILP (new_drivers
))
3611 if (! EQ (new_drivers
, Qt
))
3613 /* Re-order the driver list according to new_drivers. */
3614 struct font_driver_list
**list_table
, **next
;
3618 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3619 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3621 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3622 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3625 list_table
[i
++] = list
;
3627 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3629 list_table
[i
++] = list
;
3630 list_table
[i
] = NULL
;
3632 next
= &f
->font_driver_list
;
3633 for (i
= 0; list_table
[i
]; i
++)
3635 *next
= list_table
[i
];
3636 next
= &(*next
)->next
;
3641 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3643 active_drivers
= nconc2 (active_drivers
,
3644 Fcons (list
->driver
->type
, Qnil
));
3645 return active_drivers
;
3649 font_put_frame_data (f
, driver
, data
)
3651 struct font_driver
*driver
;
3654 struct font_data_list
*list
, *prev
;
3656 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3657 prev
= list
, list
= list
->next
)
3658 if (list
->driver
== driver
)
3665 prev
->next
= list
->next
;
3667 f
->font_data_list
= list
->next
;
3675 list
= xmalloc (sizeof (struct font_data_list
));
3676 list
->driver
= driver
;
3677 list
->next
= f
->font_data_list
;
3678 f
->font_data_list
= list
;
3686 font_get_frame_data (f
, driver
)
3688 struct font_driver
*driver
;
3690 struct font_data_list
*list
;
3692 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3693 if (list
->driver
== driver
)
3701 /* Return the font used to draw character C by FACE at buffer position
3702 POS in window W. If STRING is non-nil, it is a string containing C
3703 at index POS. If C is negative, get C from the current buffer or
3707 font_at (c
, pos
, face
, w
, string
)
3716 Lisp_Object font_object
;
3718 multibyte
= (NILP (string
)
3719 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3720 : STRING_MULTIBYTE (string
));
3727 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3729 c
= FETCH_CHAR (pos_byte
);
3732 c
= FETCH_BYTE (pos
);
3738 multibyte
= STRING_MULTIBYTE (string
);
3741 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3743 str
= SDATA (string
) + pos_byte
;
3744 c
= STRING_CHAR (str
, 0);
3747 c
= SDATA (string
)[pos
];
3751 f
= XFRAME (w
->frame
);
3752 if (! FRAME_WINDOW_P (f
))
3759 if (STRINGP (string
))
3760 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3761 DEFAULT_FACE_ID
, 0);
3763 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3765 face
= FACE_FROM_ID (f
, face_id
);
3769 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3770 face
= FACE_FROM_ID (f
, face_id
);
3775 XSETFONT (font_object
, face
->font
);
3780 #ifdef HAVE_WINDOW_SYSTEM
3782 /* Check how many characters after POS (at most to *LIMIT) can be
3783 displayed by the same font on the window W. FACE, if non-NULL, is
3784 the face selected for the character at POS. If STRING is not nil,
3785 it is the string to check instead of the current buffer. In that
3786 case, FACE must be not NULL.
3788 The return value is the font-object for the character at POS.
3789 *LIMIT is set to the position where that font can't be used.
3791 It is assured that the current buffer (or STRING) is multibyte. */
3794 font_range (pos
, limit
, w
, face
, string
)
3795 EMACS_INT pos
, *limit
;
3800 EMACS_INT pos_byte
, ignore
, start
, start_byte
;
3802 Lisp_Object font_object
= Qnil
;
3806 pos_byte
= CHAR_TO_BYTE (pos
);
3811 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
, *limit
, 0);
3812 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3818 pos_byte
= string_char_to_byte (string
, pos
);
3821 start
= pos
, start_byte
= pos_byte
;
3822 while (pos
< *limit
)
3824 Lisp_Object category
;
3827 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3829 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3830 if (NILP (font_object
))
3832 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3833 if (NILP (font_object
))
3838 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3839 if (! EQ (category
, QCf
)
3840 && ! CHAR_VARIATION_SELECTOR_P (c
)
3841 && font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3843 Lisp_Object f
= font_for_char (face
, c
, pos
- 1, string
);
3844 EMACS_INT i
, i_byte
;
3852 i
= start
, i_byte
= start_byte
;
3857 FETCH_CHAR_ADVANCE_NO_CHECK (c
, i
, i_byte
);
3859 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, i
, i_byte
);
3860 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3861 if (! EQ (category
, QCf
)
3862 && ! CHAR_VARIATION_SELECTOR_P (c
)
3863 && font_encode_char (f
, c
) == FONT_INVALID_CODE
)
3879 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3880 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3881 Return nil otherwise.
3882 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3883 which kind of font it is. It must be one of `font-spec', `font-entity',
3885 (object
, extra_type
)
3886 Lisp_Object object
, extra_type
;
3888 if (NILP (extra_type
))
3889 return (FONTP (object
) ? Qt
: Qnil
);
3890 if (EQ (extra_type
, Qfont_spec
))
3891 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3892 if (EQ (extra_type
, Qfont_entity
))
3893 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3894 if (EQ (extra_type
, Qfont_object
))
3895 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3896 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3899 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3900 doc
: /* Return a newly created font-spec with arguments as properties.
3902 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3903 valid font property name listed below:
3905 `:family', `:weight', `:slant', `:width'
3907 They are the same as face attributes of the same name. See
3908 `set-face-attribute'.
3912 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3916 VALUE must be a string or a symbol specifying the additional
3917 typographic style information of a font, e.g. ``sans''.
3921 VALUE must be a string or a symbol specifying the charset registry and
3922 encoding of a font, e.g. ``iso8859-1''.
3926 VALUE must be a non-negative integer or a floating point number
3927 specifying the font size. It specifies the font size in pixels (if
3928 VALUE is an integer), or in points (if VALUE is a float).
3932 VALUE must be a string of XLFD-style or fontconfig-style font name.
3936 VALUE must be a symbol representing a script that the font must
3937 support. It may be a symbol representing a subgroup of a script
3938 listed in the variable `script-representative-chars'.
3942 VALUE must be a symbol of two-letter ISO-639 language names,
3947 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3948 required OpenType features.
3950 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3951 LANGSYS-TAG: OpenType language system tag symbol,
3952 or nil for the default language system.
3953 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3954 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3956 GSUB and GPOS may contain `nil' element. In such a case, the font
3957 must not have any of the remaining elements.
3959 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3960 be an OpenType font, and whose GPOS table of `thai' script's default
3961 language system must contain `mark' feature.
3963 usage: (font-spec ARGS...) */)
3968 Lisp_Object spec
= font_make_spec ();
3971 for (i
= 0; i
< nargs
; i
+= 2)
3973 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3975 if (EQ (key
, QCname
))
3978 font_parse_name ((char *) SDATA (val
), spec
);
3979 font_put_extra (spec
, key
, val
);
3983 int idx
= get_font_prop_index (key
);
3987 val
= font_prop_validate (idx
, Qnil
, val
);
3988 if (idx
< FONT_EXTRA_INDEX
)
3989 ASET (spec
, idx
, val
);
3991 font_put_extra (spec
, key
, val
);
3994 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
4000 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
4001 doc
: /* Return a copy of FONT as a font-spec. */)
4005 Lisp_Object new_spec
, tail
, prev
, extra
;
4009 new_spec
= font_make_spec ();
4010 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
4011 ASET (new_spec
, i
, AREF (font
, i
));
4012 extra
= Fcopy_sequence (AREF (font
, FONT_EXTRA_INDEX
));
4013 /* We must remove :font-entity property. */
4014 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
4015 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
4018 extra
= XCDR (extra
);
4020 XSETCDR (prev
, XCDR (tail
));
4023 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
4027 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
4028 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
4029 Every specified properties in FROM override the corresponding
4030 properties in TO. */)
4032 Lisp_Object from
, to
;
4034 Lisp_Object extra
, tail
;
4039 to
= Fcopy_font_spec (to
);
4040 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
4041 ASET (to
, i
, AREF (from
, i
));
4042 extra
= AREF (to
, FONT_EXTRA_INDEX
);
4043 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
4044 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
4046 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
4049 XSETCDR (slot
, XCDR (XCAR (tail
)));
4051 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
4053 ASET (to
, FONT_EXTRA_INDEX
, extra
);
4057 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
4058 doc
: /* Return the value of FONT's property KEY.
4059 FONT is a font-spec, a font-entity, or a font-object.
4060 KEY must be one of these symbols:
4061 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4062 :size, :name, :script
4063 See the documentation of `font-spec' for their meanings.
4064 If FONT is a font-entity or font-object, the value of :script may be
4065 a list of scripts that are supported by the font. */)
4067 Lisp_Object font
, key
;
4074 idx
= get_font_prop_index (key
);
4075 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4076 return font_style_symbolic (font
, idx
, 0);
4077 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4078 return AREF (font
, idx
);
4079 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
4082 #ifdef HAVE_WINDOW_SYSTEM
4084 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4085 doc
: /* Return a plist of face attributes generated by FONT.
4086 FONT is a font name, a font-spec, a font-entity, or a font-object.
4087 The return value is a list of the form
4089 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4091 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4092 compatible with `set-face-attribute'. Some of these key-attribute pairs
4093 may be omitted from the list if they are not specified by FONT.
4095 The optional argument FRAME specifies the frame that the face attributes
4096 are to be displayed on. If omitted, the selected frame is used. */)
4098 Lisp_Object font
, frame
;
4101 Lisp_Object plist
[10];
4106 frame
= selected_frame
;
4107 CHECK_LIVE_FRAME (frame
);
4112 int fontset
= fs_query_fontset (font
, 0);
4113 Lisp_Object name
= font
;
4115 font
= fontset_ascii (fontset
);
4116 font
= font_spec_from_name (name
);
4118 signal_error ("Invalid font name", name
);
4120 else if (! FONTP (font
))
4121 signal_error ("Invalid font object", font
);
4123 val
= AREF (font
, FONT_FAMILY_INDEX
);
4126 plist
[n
++] = QCfamily
;
4127 plist
[n
++] = SYMBOL_NAME (val
);
4130 val
= AREF (font
, FONT_SIZE_INDEX
);
4133 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4134 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4135 plist
[n
++] = QCheight
;
4136 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4138 else if (FLOATP (val
))
4140 plist
[n
++] = QCheight
;
4141 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4144 val
= FONT_WEIGHT_FOR_FACE (font
);
4147 plist
[n
++] = QCweight
;
4151 val
= FONT_SLANT_FOR_FACE (font
);
4154 plist
[n
++] = QCslant
;
4158 val
= FONT_WIDTH_FOR_FACE (font
);
4161 plist
[n
++] = QCwidth
;
4165 return Flist (n
, plist
);
4170 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4171 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
4172 (font_spec
, prop
, val
)
4173 Lisp_Object font_spec
, prop
, val
;
4177 CHECK_FONT_SPEC (font_spec
);
4178 idx
= get_font_prop_index (prop
);
4179 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4180 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
4182 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
4186 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4187 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4188 Optional 2nd argument FRAME specifies the target frame.
4189 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4190 Optional 4th argument PREFER, if non-nil, is a font-spec to
4191 control the order of the returned list. Fonts are sorted by
4192 how close they are to PREFER. */)
4193 (font_spec
, frame
, num
, prefer
)
4194 Lisp_Object font_spec
, frame
, num
, prefer
;
4196 Lisp_Object vec
, list
, tail
;
4200 frame
= selected_frame
;
4201 CHECK_LIVE_FRAME (frame
);
4202 CHECK_FONT_SPEC (font_spec
);
4210 if (! NILP (prefer
))
4211 CHECK_FONT_SPEC (prefer
);
4213 vec
= font_list_entities (frame
, font_spec
);
4218 return Fcons (AREF (vec
, 0), Qnil
);
4220 if (! NILP (prefer
))
4221 vec
= font_sort_entites (vec
, prefer
, frame
, 0);
4223 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
4224 if (n
== 0 || n
> len
)
4226 for (i
= 1; i
< n
; i
++)
4228 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
4230 XSETCDR (tail
, val
);
4236 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4237 doc
: /* List available font families on the current frame.
4238 Optional argument FRAME, if non-nil, specifies the target frame. */)
4243 struct font_driver_list
*driver_list
;
4247 frame
= selected_frame
;
4248 CHECK_LIVE_FRAME (frame
);
4251 for (driver_list
= f
->font_driver_list
; driver_list
;
4252 driver_list
= driver_list
->next
)
4253 if (driver_list
->driver
->list_family
)
4255 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4256 Lisp_Object tail
= list
;
4258 for (; CONSP (val
); val
= XCDR (val
))
4259 if (NILP (Fmemq (XCAR (val
), tail
))
4260 && SYMBOLP (XCAR (val
)))
4261 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4266 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4267 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4268 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4270 Lisp_Object font_spec
, frame
;
4272 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4279 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4280 doc
: /* Return XLFD name of FONT.
4281 FONT is a font-spec, font-entity, or font-object.
4282 If the name is too long for XLFD (maximum 255 chars), return nil.
4283 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4284 the consecutive wildcards are folded to one. */)
4285 (font
, fold_wildcards
)
4286 Lisp_Object font
, fold_wildcards
;
4293 if (FONT_OBJECT_P (font
))
4295 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4297 if (STRINGP (font_name
)
4298 && SDATA (font_name
)[0] == '-')
4300 if (NILP (fold_wildcards
))
4302 strcpy (name
, (char *) SDATA (font_name
));
4305 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4307 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4310 if (! NILP (fold_wildcards
))
4312 char *p0
= name
, *p1
;
4314 while ((p1
= strstr (p0
, "-*-*")))
4316 strcpy (p1
, p1
+ 2);
4321 return build_string (name
);
4324 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4325 doc
: /* Clear font cache. */)
4328 Lisp_Object list
, frame
;
4330 FOR_EACH_FRAME (list
, frame
)
4332 FRAME_PTR f
= XFRAME (frame
);
4333 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4335 for (; driver_list
; driver_list
= driver_list
->next
)
4336 if (driver_list
->on
)
4338 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4343 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4345 font_assert (! NILP (val
));
4346 val
= XCDR (XCAR (val
));
4347 if (XINT (XCAR (val
)) == 0)
4349 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4350 XSETCDR (cache
, XCDR (val
));
4360 font_fill_lglyph_metrics (glyph
, font_object
)
4361 Lisp_Object glyph
, font_object
;
4363 struct font
*font
= XFONT_OBJECT (font_object
);
4365 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4366 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4367 struct font_metrics metrics
;
4369 LGLYPH_SET_CODE (glyph
, ecode
);
4371 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4372 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4373 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4374 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4375 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4376 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4380 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4381 doc
: /* Shape the glyph-string GSTRING.
4382 Shaping means substituting glyphs and/or adjusting positions of glyphs
4383 to get the correct visual image of character sequences set in the
4384 header of the glyph-string.
4386 If the shaping was successful, the value is GSTRING itself or a newly
4387 created glyph-string. Otherwise, the value is nil. */)
4389 Lisp_Object gstring
;
4392 Lisp_Object font_object
, n
, glyph
;
4395 if (! composition_gstring_p (gstring
))
4396 signal_error ("Invalid glyph-string: ", gstring
);
4397 if (! NILP (LGSTRING_ID (gstring
)))
4399 font_object
= LGSTRING_FONT (gstring
);
4400 CHECK_FONT_OBJECT (font_object
);
4401 font
= XFONT_OBJECT (font_object
);
4402 if (! font
->driver
->shape
)
4405 /* Try at most three times with larger gstring each time. */
4406 for (i
= 0; i
< 3; i
++)
4408 n
= font
->driver
->shape (gstring
);
4411 gstring
= larger_vector (gstring
,
4412 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4415 if (i
== 3 || XINT (n
) == 0)
4418 glyph
= LGSTRING_GLYPH (gstring
, 0);
4419 from
= LGLYPH_FROM (glyph
);
4420 to
= LGLYPH_TO (glyph
);
4421 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4423 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4427 if (NILP (LGLYPH_ADJUSTMENT (this)))
4432 glyph
= LGSTRING_GLYPH (gstring
, j
);
4433 LGLYPH_SET_FROM (glyph
, from
);
4434 LGLYPH_SET_TO (glyph
, to
);
4436 from
= LGLYPH_FROM (this);
4437 to
= LGLYPH_TO (this);
4442 if (from
> LGLYPH_FROM (this))
4443 from
= LGLYPH_FROM (this);
4444 if (to
< LGLYPH_TO (this))
4445 to
= LGLYPH_TO (this);
4451 glyph
= LGSTRING_GLYPH (gstring
, j
);
4452 LGLYPH_SET_FROM (glyph
, from
);
4453 LGLYPH_SET_TO (glyph
, to
);
4455 return composition_gstring_put_cache (gstring
, XINT (n
));
4458 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4460 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4461 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4463 VARIATION-SELECTOR is a chracter code of variation selection
4464 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4465 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4466 (font_object
, character
)
4467 Lisp_Object font_object
, character
;
4469 unsigned variations
[256];
4474 CHECK_FONT_OBJECT (font_object
);
4475 CHECK_CHARACTER (character
);
4476 font
= XFONT_OBJECT (font_object
);
4477 if (! font
->driver
->get_variation_glyphs
)
4479 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4483 for (i
= 0; i
< 255; i
++)
4487 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4488 /* Stops GCC whining about limited range of data type. */
4489 EMACS_INT var
= variations
[i
];
4491 if (var
> MOST_POSITIVE_FIXNUM
)
4492 code
= Fcons (make_number ((variations
[i
]) >> 16),
4493 make_number ((variations
[i
]) & 0xFFFF));
4495 code
= make_number (variations
[i
]);
4496 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4503 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4504 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4505 OTF-FEATURES specifies which features to apply in this format:
4506 (SCRIPT LANGSYS GSUB GPOS)
4508 SCRIPT is a symbol specifying a script tag of OpenType,
4509 LANGSYS is a symbol specifying a langsys tag of OpenType,
4510 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4512 If LANGYS is nil, the default langsys is selected.
4514 The features are applied in the order they appear in the list. The
4515 symbol `*' means to apply all available features not present in this
4516 list, and the remaining features are ignored. For instance, (vatu
4517 pstf * haln) is to apply vatu and pstf in this order, then to apply
4518 all available features other than vatu, pstf, and haln.
4520 The features are applied to the glyphs in the range FROM and TO of
4521 the glyph-string GSTRING-IN.
4523 If some feature is actually applicable, the resulting glyphs are
4524 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4525 this case, the value is the number of produced glyphs.
4527 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4530 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4531 produced in GSTRING-OUT, and the value is nil.
4533 See the documentation of `font-make-gstring' for the format of
4535 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4536 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4538 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4543 check_otf_features (otf_features
);
4544 CHECK_FONT_OBJECT (font_object
);
4545 font
= XFONT_OBJECT (font_object
);
4546 if (! font
->driver
->otf_drive
)
4547 error ("Font backend %s can't drive OpenType GSUB table",
4548 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4549 CHECK_CONS (otf_features
);
4550 CHECK_SYMBOL (XCAR (otf_features
));
4551 val
= XCDR (otf_features
);
4552 CHECK_SYMBOL (XCAR (val
));
4553 val
= XCDR (otf_features
);
4556 len
= check_gstring (gstring_in
);
4557 CHECK_VECTOR (gstring_out
);
4558 CHECK_NATNUM (from
);
4560 CHECK_NATNUM (index
);
4562 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4563 args_out_of_range_3 (from
, to
, make_number (len
));
4564 if (XINT (index
) >= ASIZE (gstring_out
))
4565 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4566 num
= font
->driver
->otf_drive (font
, otf_features
,
4567 gstring_in
, XINT (from
), XINT (to
),
4568 gstring_out
, XINT (index
), 0);
4571 return make_number (num
);
4574 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4576 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4577 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4579 (SCRIPT LANGSYS FEATURE ...)
4580 See the documentation of `font-drive-otf' for more detail.
4582 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4583 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4584 character code corresponding to the glyph or nil if there's no
4585 corresponding character. */)
4586 (font_object
, character
, otf_features
)
4587 Lisp_Object font_object
, character
, otf_features
;
4590 Lisp_Object gstring_in
, gstring_out
, g
;
4591 Lisp_Object alternates
;
4594 CHECK_FONT_GET_OBJECT (font_object
, font
);
4595 if (! font
->driver
->otf_drive
)
4596 error ("Font backend %s can't drive OpenType GSUB table",
4597 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4598 CHECK_CHARACTER (character
);
4599 CHECK_CONS (otf_features
);
4601 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4602 g
= LGSTRING_GLYPH (gstring_in
, 0);
4603 LGLYPH_SET_CHAR (g
, XINT (character
));
4604 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4605 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4606 gstring_out
, 0, 1)) < 0)
4607 gstring_out
= Ffont_make_gstring (font_object
,
4608 make_number (ASIZE (gstring_out
) * 2));
4610 for (i
= 0; i
< num
; i
++)
4612 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4613 int c
= LGLYPH_CHAR (g
);
4614 unsigned code
= LGLYPH_CODE (g
);
4616 alternates
= Fcons (Fcons (make_number (code
),
4617 c
> 0 ? make_number (c
) : Qnil
),
4620 return Fnreverse (alternates
);
4626 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4627 doc
: /* Open FONT-ENTITY. */)
4628 (font_entity
, size
, frame
)
4629 Lisp_Object font_entity
;
4635 CHECK_FONT_ENTITY (font_entity
);
4637 frame
= selected_frame
;
4638 CHECK_LIVE_FRAME (frame
);
4641 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4644 CHECK_NUMBER_OR_FLOAT (size
);
4646 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4648 isize
= XINT (size
);
4652 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4655 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4656 doc
: /* Close FONT-OBJECT. */)
4657 (font_object
, frame
)
4658 Lisp_Object font_object
, frame
;
4660 CHECK_FONT_OBJECT (font_object
);
4662 frame
= selected_frame
;
4663 CHECK_LIVE_FRAME (frame
);
4664 font_close_object (XFRAME (frame
), font_object
);
4668 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4669 doc
: /* Return information about FONT-OBJECT.
4670 The value is a vector:
4671 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4674 NAME is a string of the font name (or nil if the font backend doesn't
4677 FILENAME is a string of the font file (or nil if the font backend
4678 doesn't provide a file name).
4680 PIXEL-SIZE is a pixel size by which the font is opened.
4682 SIZE is a maximum advance width of the font in pixels.
4684 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4687 CAPABILITY is a list whose first element is a symbol representing the
4688 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4689 remaining elements describe the details of the font capability.
4691 If the font is OpenType font, the form of the list is
4692 \(opentype GSUB GPOS)
4693 where GSUB shows which "GSUB" features the font supports, and GPOS
4694 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4695 lists of the format:
4696 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4698 If the font is not OpenType font, currently the length of the form is
4701 SCRIPT is a symbol representing OpenType script tag.
4703 LANGSYS is a symbol representing OpenType langsys tag, or nil
4704 representing the default langsys.
4706 FEATURE is a symbol representing OpenType feature tag.
4708 If the font is not OpenType font, CAPABILITY is nil. */)
4710 Lisp_Object font_object
;
4715 CHECK_FONT_GET_OBJECT (font_object
, font
);
4717 val
= Fmake_vector (make_number (9), Qnil
);
4718 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4719 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4720 ASET (val
, 2, make_number (font
->pixel_size
));
4721 ASET (val
, 3, make_number (font
->max_width
));
4722 ASET (val
, 4, make_number (font
->ascent
));
4723 ASET (val
, 5, make_number (font
->descent
));
4724 ASET (val
, 6, make_number (font
->space_width
));
4725 ASET (val
, 7, make_number (font
->average_width
));
4726 if (font
->driver
->otf_capability
)
4727 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4731 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4732 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4733 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4734 (font_object
, string
)
4735 Lisp_Object font_object
, string
;
4741 CHECK_FONT_GET_OBJECT (font_object
, font
);
4742 CHECK_STRING (string
);
4743 len
= SCHARS (string
);
4744 vec
= Fmake_vector (make_number (len
), Qnil
);
4745 for (i
= 0; i
< len
; i
++)
4747 Lisp_Object ch
= Faref (string
, make_number (i
));
4752 struct font_metrics metrics
;
4754 cod
= code
= font
->driver
->encode_char (font
, c
);
4755 if (code
== FONT_INVALID_CODE
)
4757 val
= Fmake_vector (make_number (6), Qnil
);
4758 if (cod
<= MOST_POSITIVE_FIXNUM
)
4759 ASET (val
, 0, make_number (code
));
4761 ASET (val
, 0, Fcons (make_number (code
>> 16),
4762 make_number (code
& 0xFFFF)));
4763 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4764 ASET (val
, 1, make_number (metrics
.lbearing
));
4765 ASET (val
, 2, make_number (metrics
.rbearing
));
4766 ASET (val
, 3, make_number (metrics
.width
));
4767 ASET (val
, 4, make_number (metrics
.ascent
));
4768 ASET (val
, 5, make_number (metrics
.descent
));
4774 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4775 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4776 FONT is a font-spec, font-entity, or font-object. */)
4778 Lisp_Object spec
, font
;
4780 CHECK_FONT_SPEC (spec
);
4783 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4786 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4787 doc
: /* Return a font-object for displaying a character at POSITION.
4788 Optional second arg WINDOW, if non-nil, is a window displaying
4789 the current buffer. It defaults to the currently selected window. */)
4790 (position
, window
, string
)
4791 Lisp_Object position
, window
, string
;
4798 CHECK_NUMBER_COERCE_MARKER (position
);
4799 pos
= XINT (position
);
4800 if (pos
< BEGV
|| pos
>= ZV
)
4801 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4805 CHECK_NUMBER (position
);
4806 CHECK_STRING (string
);
4807 pos
= XINT (position
);
4808 if (pos
< 0 || pos
>= SCHARS (string
))
4809 args_out_of_range (string
, position
);
4812 window
= selected_window
;
4813 CHECK_LIVE_WINDOW (window
);
4814 w
= XWINDOW (window
);
4816 return font_at (-1, pos
, NULL
, w
, string
);
4820 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4821 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4822 The value is a number of glyphs drawn.
4823 Type C-l to recover what previously shown. */)
4824 (font_object
, string
)
4825 Lisp_Object font_object
, string
;
4827 Lisp_Object frame
= selected_frame
;
4828 FRAME_PTR f
= XFRAME (frame
);
4834 CHECK_FONT_GET_OBJECT (font_object
, font
);
4835 CHECK_STRING (string
);
4836 len
= SCHARS (string
);
4837 code
= alloca (sizeof (unsigned) * len
);
4838 for (i
= 0; i
< len
; i
++)
4840 Lisp_Object ch
= Faref (string
, make_number (i
));
4844 code
[i
] = font
->driver
->encode_char (font
, c
);
4845 if (code
[i
] == FONT_INVALID_CODE
)
4848 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4850 if (font
->driver
->prepare_face
)
4851 font
->driver
->prepare_face (f
, face
);
4852 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4853 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4854 if (font
->driver
->done_face
)
4855 font
->driver
->done_face (f
, face
);
4857 return make_number (len
);
4861 #endif /* FONT_DEBUG */
4863 #ifdef HAVE_WINDOW_SYSTEM
4865 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4866 doc
: /* Return information about a font named NAME on frame FRAME.
4867 If FRAME is omitted or nil, use the selected frame.
4868 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4869 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4871 OPENED-NAME is the name used for opening the font,
4872 FULL-NAME is the full name of the font,
4873 SIZE is the maximum bound width of the font,
4874 HEIGHT is the height of the font,
4875 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4876 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4877 how to compose characters.
4878 If the named font is not yet loaded, return nil. */)
4880 Lisp_Object name
, frame
;
4885 Lisp_Object font_object
;
4887 (*check_window_system_func
) ();
4890 CHECK_STRING (name
);
4892 frame
= selected_frame
;
4893 CHECK_LIVE_FRAME (frame
);
4898 int fontset
= fs_query_fontset (name
, 0);
4901 name
= fontset_ascii (fontset
);
4902 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4904 else if (FONT_OBJECT_P (name
))
4906 else if (FONT_ENTITY_P (name
))
4907 font_object
= font_open_entity (f
, name
, 0);
4910 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4911 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4913 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4915 if (NILP (font_object
))
4917 font
= XFONT_OBJECT (font_object
);
4919 info
= Fmake_vector (make_number (7), Qnil
);
4920 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4921 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4922 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4923 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4924 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4925 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4926 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4929 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4930 close it now. Perhaps, we should manage font-objects
4931 by `reference-count'. */
4932 font_close_object (f
, font_object
);
4939 #define BUILD_STYLE_TABLE(TBL) \
4940 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4943 build_style_table (entry
, nelement
)
4944 struct table_entry
*entry
;
4948 Lisp_Object table
, elt
;
4950 table
= Fmake_vector (make_number (nelement
), Qnil
);
4951 for (i
= 0; i
< nelement
; i
++)
4953 for (j
= 0; entry
[i
].names
[j
]; j
++);
4954 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4955 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4956 for (j
= 0; entry
[i
].names
[j
]; j
++)
4957 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4958 ASET (table
, i
, elt
);
4963 static Lisp_Object Vfont_log
;
4964 static int font_log_env_checked
;
4966 /* The deferred font-log data of the form [ACTION ARG RESULT].
4967 If ACTION is not nil, that is added to the log when font_add_log is
4968 called next time. At that time, ACTION is set back to nil. */
4969 static Lisp_Object Vfont_log_deferred
;
4971 /* Prepend the font-related logging data in Vfont_log if it is not
4972 `t'. ACTION describes a kind of font-related action (e.g. listing,
4973 opening), ARG is the argument for the action, and RESULT is the
4974 result of the action. */
4976 font_add_log (action
, arg
, result
)
4978 Lisp_Object arg
, result
;
4980 Lisp_Object tail
, val
;
4983 if (! font_log_env_checked
)
4985 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
4986 font_log_env_checked
= 1;
4988 if (EQ (Vfont_log
, Qt
))
4990 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4992 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
4994 ASET (Vfont_log_deferred
, 0, Qnil
);
4995 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4996 AREF (Vfont_log_deferred
, 2));
5001 Lisp_Object tail
, elt
;
5002 Lisp_Object equalstr
= build_string ("=");
5004 val
= Ffont_xlfd_name (arg
, Qt
);
5005 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5009 if (EQ (XCAR (elt
), QCscript
)
5010 && SYMBOLP (XCDR (elt
)))
5011 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5012 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5013 else if (EQ (XCAR (elt
), QClang
)
5014 && SYMBOLP (XCDR (elt
)))
5015 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5016 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5017 else if (EQ (XCAR (elt
), QCotf
)
5018 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5019 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5021 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5027 val
= Ffont_xlfd_name (result
, Qt
);
5028 if (! FONT_SPEC_P (result
))
5029 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5030 build_string (":"), val
);
5033 else if (CONSP (result
))
5035 result
= Fcopy_sequence (result
);
5036 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5040 val
= Ffont_xlfd_name (val
, Qt
);
5041 XSETCAR (tail
, val
);
5044 else if (VECTORP (result
))
5046 result
= Fcopy_sequence (result
);
5047 for (i
= 0; i
< ASIZE (result
); i
++)
5049 val
= AREF (result
, i
);
5051 val
= Ffont_xlfd_name (val
, Qt
);
5052 ASET (result
, i
, val
);
5055 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5058 /* Record a font-related logging data to be added to Vfont_log when
5059 font_add_log is called next time. ACTION, ARG, RESULT are the same
5063 font_deferred_log (action
, arg
, result
)
5065 Lisp_Object arg
, result
;
5067 ASET (Vfont_log_deferred
, 0, build_string (action
));
5068 ASET (Vfont_log_deferred
, 1, arg
);
5069 ASET (Vfont_log_deferred
, 2, result
);
5072 extern void syms_of_ftfont
P_ (());
5073 extern void syms_of_xfont
P_ (());
5074 extern void syms_of_xftfont
P_ (());
5075 extern void syms_of_ftxfont
P_ (());
5076 extern void syms_of_bdffont
P_ (());
5077 extern void syms_of_w32font
P_ (());
5078 extern void syms_of_atmfont
P_ (());
5079 extern void syms_of_nsfont
P_ (());
5084 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5085 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5086 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5087 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5088 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5089 /* Note that the other elements in sort_shift_bits are not used. */
5091 staticpro (&font_charset_alist
);
5092 font_charset_alist
= Qnil
;
5094 DEFSYM (Qfont_spec
, "font-spec");
5095 DEFSYM (Qfont_entity
, "font-entity");
5096 DEFSYM (Qfont_object
, "font-object");
5098 DEFSYM (Qopentype
, "opentype");
5100 DEFSYM (Qascii_0
, "ascii-0");
5101 DEFSYM (Qiso8859_1
, "iso8859-1");
5102 DEFSYM (Qiso10646_1
, "iso10646-1");
5103 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5104 DEFSYM (Qunicode_sip
, "unicode-sip");
5108 DEFSYM (QCotf
, ":otf");
5109 DEFSYM (QClang
, ":lang");
5110 DEFSYM (QCscript
, ":script");
5111 DEFSYM (QCantialias
, ":antialias");
5113 DEFSYM (QCfoundry
, ":foundry");
5114 DEFSYM (QCadstyle
, ":adstyle");
5115 DEFSYM (QCregistry
, ":registry");
5116 DEFSYM (QCspacing
, ":spacing");
5117 DEFSYM (QCdpi
, ":dpi");
5118 DEFSYM (QCscalable
, ":scalable");
5119 DEFSYM (QCavgwidth
, ":avgwidth");
5120 DEFSYM (QCfont_entity
, ":font-entity");
5121 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5128 staticpro (&null_vector
);
5129 null_vector
= Fmake_vector (make_number (0), Qnil
);
5131 staticpro (&scratch_font_spec
);
5132 scratch_font_spec
= Ffont_spec (0, NULL
);
5133 staticpro (&scratch_font_prefer
);
5134 scratch_font_prefer
= Ffont_spec (0, NULL
);
5136 staticpro (&Vfont_log_deferred
);
5137 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5141 staticpro (&otf_list
);
5143 #endif /* HAVE_LIBOTF */
5147 defsubr (&Sfont_spec
);
5148 defsubr (&Sfont_get
);
5149 #ifdef HAVE_WINDOW_SYSTEM
5150 defsubr (&Sfont_face_attributes
);
5152 defsubr (&Sfont_put
);
5153 defsubr (&Slist_fonts
);
5154 defsubr (&Sfont_family_list
);
5155 defsubr (&Sfind_font
);
5156 defsubr (&Sfont_xlfd_name
);
5157 defsubr (&Sclear_font_cache
);
5158 defsubr (&Sfont_shape_gstring
);
5159 defsubr (&Sfont_variation_glyphs
);
5161 defsubr (&Sfont_drive_otf
);
5162 defsubr (&Sfont_otf_alternates
);
5166 defsubr (&Sopen_font
);
5167 defsubr (&Sclose_font
);
5168 defsubr (&Squery_font
);
5169 defsubr (&Sget_font_glyphs
);
5170 defsubr (&Sfont_match_p
);
5171 defsubr (&Sfont_at
);
5173 defsubr (&Sdraw_string
);
5175 #endif /* FONT_DEBUG */
5176 #ifdef HAVE_WINDOW_SYSTEM
5177 defsubr (&Sfont_info
);
5180 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5182 Alist of fontname patterns vs the corresponding encoding and repertory info.
5183 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5184 where ENCODING is a charset or a char-table,
5185 and REPERTORY is a charset, a char-table, or nil.
5187 If ENCODING and REPERTORY are the same, the element can have the form
5188 \(REGEXP . ENCODING).
5190 ENCODING is for converting a character to a glyph code of the font.
5191 If ENCODING is a charset, encoding a character by the charset gives
5192 the corresponding glyph code. If ENCODING is a char-table, looking up
5193 the table by a character gives the corresponding glyph code.
5195 REPERTORY specifies a repertory of characters supported by the font.
5196 If REPERTORY is a charset, all characters beloging to the charset are
5197 supported. If REPERTORY is a char-table, all characters who have a
5198 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5199 gets the repertory information by an opened font and ENCODING. */);
5200 Vfont_encoding_alist
= Qnil
;
5202 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5203 doc
: /* Vector of valid font weight values.
5204 Each element has the form:
5205 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5206 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5207 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5209 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5210 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5211 See `font-weight-table' for the format of the vector. */);
5212 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5214 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5215 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5216 See `font-weight-table' for the format of the vector. */);
5217 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5219 staticpro (&font_style_table
);
5220 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5221 ASET (font_style_table
, 0, Vfont_weight_table
);
5222 ASET (font_style_table
, 1, Vfont_slant_table
);
5223 ASET (font_style_table
, 2, Vfont_width_table
);
5225 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5226 *Logging list of font related actions and results.
5227 The value t means to suppress the logging.
5228 The initial value is set to nil if the environment variable
5229 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5232 #ifdef HAVE_WINDOW_SYSTEM
5233 #ifdef HAVE_FREETYPE
5235 #ifdef HAVE_X_WINDOWS
5240 #endif /* HAVE_XFT */
5241 #endif /* HAVE_X_WINDOWS */
5242 #else /* not HAVE_FREETYPE */
5243 #ifdef HAVE_X_WINDOWS
5245 #endif /* HAVE_X_WINDOWS */
5246 #endif /* not HAVE_FREETYPE */
5249 #endif /* HAVE_BDFFONT */
5252 #endif /* WINDOWSNT */
5255 #endif /* HAVE_NS */
5256 #endif /* HAVE_WINDOW_SYSTEM */
5259 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5260 (do not change this comment) */