1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
3 Copyright (C) 2006, 2007, 2008, 2009, 2010
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/>. */
32 #include "dispextern.h"
34 #include "character.h"
35 #include "composite.h"
41 #endif /* HAVE_X_WINDOWS */
45 #endif /* HAVE_NTGUI */
52 extern Lisp_Object Qfontsize
;
55 Lisp_Object Qopentype
;
57 /* Important character set strings. */
58 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
60 #define DEFAULT_ENCODING Qiso8859_1
62 /* Unicode category `Cf'. */
63 static Lisp_Object QCf
;
65 /* Special vector of zero length. This is repeatedly used by (struct
66 font_driver *)->list when a specified font is not found. */
67 static Lisp_Object null_vector
;
69 static Lisp_Object Vfont_weight_table
, Vfont_slant_table
, Vfont_width_table
;
71 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
72 static Lisp_Object font_style_table
;
74 /* Structure used for tables mapping weight, slant, and width numeric
75 values and their names. */
80 /* The first one is a valid name as a face attribute.
81 The second one (if any) is a typical name in XLFD field. */
85 /* Table of weight numeric values and their names. This table must be
86 sorted by numeric values in ascending order. */
88 static const struct table_entry weight_table
[] =
91 { 20, { "ultra-light", "ultralight" }},
92 { 40, { "extra-light", "extralight" }},
94 { 75, { "semi-light", "semilight", "demilight", "book" }},
95 { 100, { "normal", "medium", "regular", "unspecified" }},
96 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
98 { 205, { "extra-bold", "extrabold" }},
99 { 210, { "ultra-bold", "ultrabold", "black" }}
102 /* Table of slant numeric values and their names. This table must be
103 sorted by numeric values in ascending order. */
105 static const struct table_entry slant_table
[] =
107 { 0, { "reverse-oblique", "ro" }},
108 { 10, { "reverse-italic", "ri" }},
109 { 100, { "normal", "r", "unspecified" }},
110 { 200, { "italic" ,"i", "ot" }},
111 { 210, { "oblique", "o" }}
114 /* Table of width numeric values and their names. This table must be
115 sorted by numeric values in ascending order. */
117 static const struct table_entry width_table
[] =
119 { 50, { "ultra-condensed", "ultracondensed" }},
120 { 63, { "extra-condensed", "extracondensed" }},
121 { 75, { "condensed", "compressed", "narrow" }},
122 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
123 { 100, { "normal", "medium", "regular", "unspecified" }},
124 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
125 { 125, { "expanded" }},
126 { 150, { "extra-expanded", "extraexpanded" }},
127 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
130 extern Lisp_Object Qnormal
;
132 /* Symbols representing keys of normal font properties. */
133 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
;
134 extern Lisp_Object QCheight
, QCsize
, QCname
;
136 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
;
137 /* Symbols representing keys of font extra info. */
138 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
139 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
140 /* Symbols representing values of font spacing property. */
141 Lisp_Object Qc
, Qm
, Qp
, Qd
;
142 /* Special ADSTYLE properties to avoid fonts used for Latin
143 characters; used in xfont.c and ftfont.c. */
144 Lisp_Object Qja
, Qko
;
146 Lisp_Object QCuser_spec
;
148 Lisp_Object Vfont_encoding_alist
;
150 /* Alist of font registry symbol and the corresponding charsets
151 information. The information is retrieved from
152 Vfont_encoding_alist on demand.
154 Eash element has the form:
155 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
159 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
160 encodes a character code to a glyph code of a font, and
161 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
162 character is supported by a font.
164 The latter form means that the information for REGISTRY couldn't be
166 static Lisp_Object font_charset_alist
;
168 /* List of all font drivers. Each font-backend (XXXfont.c) calls
169 register_font_driver in syms_of_XXXfont to register its font-driver
171 static struct font_driver_list
*font_driver_list
;
175 /* Creaters of font-related Lisp object. */
178 font_make_spec (void)
180 Lisp_Object font_spec
;
181 struct font_spec
*spec
182 = ((struct font_spec
*)
183 allocate_pseudovector (VECSIZE (struct font_spec
),
184 FONT_SPEC_MAX
, PVEC_FONT
));
185 XSETFONT (font_spec
, spec
);
190 font_make_entity (void)
192 Lisp_Object font_entity
;
193 struct font_entity
*entity
194 = ((struct font_entity
*)
195 allocate_pseudovector (VECSIZE (struct font_entity
),
196 FONT_ENTITY_MAX
, PVEC_FONT
));
197 XSETFONT (font_entity
, entity
);
201 /* Create a font-object whose structure size is SIZE. If ENTITY is
202 not nil, copy properties from ENTITY to the font-object. If
203 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
205 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
207 Lisp_Object font_object
;
209 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
212 XSETFONT (font_object
, font
);
216 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
217 font
->props
[i
] = AREF (entity
, i
);
218 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
219 font
->props
[FONT_EXTRA_INDEX
]
220 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
223 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
229 static int font_pixel_size (FRAME_PTR f
, Lisp_Object
);
230 static Lisp_Object
font_open_entity (FRAME_PTR
, Lisp_Object
, int);
231 static Lisp_Object
font_matching_entity (FRAME_PTR
, Lisp_Object
*,
234 /* Number of registered font drivers. */
235 static int num_font_drivers
;
238 /* Return a Lispy value of a font property value at STR and LEN bytes.
239 If STR is "*", it returns nil.
240 If FORCE_SYMBOL is zero and all characters in STR are digits, it
241 returns an integer. Otherwise, it returns a symbol interned from
245 font_intern_prop (char *str
, int len
, int force_symbol
)
252 if (len
== 1 && *str
== '*')
254 if (!force_symbol
&& len
>=1 && isdigit (*str
))
256 for (i
= 1; i
< len
; i
++)
257 if (! isdigit (str
[i
]))
260 return make_number (atoi (str
));
263 /* The following code is copied from the function intern (in
264 lread.c), and modified to suite our purpose. */
266 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
267 obarray
= check_obarray (obarray
);
268 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
269 if (len
== nchars
|| len
!= nbytes
)
270 /* CONTENTS contains no multibyte sequences or contains an invalid
271 multibyte sequence. We'll make a unibyte string. */
272 tem
= oblookup (obarray
, str
, len
, len
);
274 tem
= oblookup (obarray
, str
, nchars
, len
);
277 if (len
== nchars
|| len
!= nbytes
)
278 tem
= make_unibyte_string (str
, len
);
280 tem
= make_multibyte_string (str
, nchars
, len
);
281 return Fintern (tem
, obarray
);
284 /* Return a pixel size of font-spec SPEC on frame F. */
287 font_pixel_size (FRAME_PTR f
, Lisp_Object spec
)
289 #ifdef HAVE_WINDOW_SYSTEM
290 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
299 font_assert (FLOATP (size
));
300 point_size
= XFLOAT_DATA (size
);
301 val
= AREF (spec
, FONT_DPI_INDEX
);
306 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
314 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
315 font vector. If VAL is not valid (i.e. not registered in
316 font_style_table), return -1 if NOERROR is zero, and return a
317 proper index if NOERROR is nonzero. In that case, register VAL in
318 font_style_table if VAL is a symbol, and return a closest index if
319 VAL is an integer. */
322 font_style_to_value (enum font_property_index prop
, Lisp_Object val
, int noerror
)
324 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
325 int len
= ASIZE (table
);
331 Lisp_Object args
[2], elt
;
333 /* At first try exact match. */
334 for (i
= 0; i
< len
; i
++)
335 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
336 if (EQ (val
, AREF (AREF (table
, i
), j
)))
337 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
338 | (i
<< 4) | (j
- 1));
339 /* Try also with case-folding match. */
340 s
= SDATA (SYMBOL_NAME (val
));
341 for (i
= 0; i
< len
; i
++)
342 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
344 elt
= AREF (AREF (table
, i
), j
);
345 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
346 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
347 | (i
<< 4) | (j
- 1));
353 elt
= Fmake_vector (make_number (2), make_number (100));
356 args
[1] = Fmake_vector (make_number (1), elt
);
357 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
358 return (100 << 8) | (i
<< 4);
363 int numeric
= XINT (val
);
365 for (i
= 0, last_n
= -1; i
< len
; i
++)
367 int n
= XINT (AREF (AREF (table
, i
), 0));
370 return (n
<< 8) | (i
<< 4);
375 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
376 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
382 return ((last_n
<< 8) | ((i
- 1) << 4));
387 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
, int for_face
)
389 Lisp_Object val
= AREF (font
, prop
);
390 Lisp_Object table
, elt
;
395 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
396 i
= XINT (val
) & 0xFF;
397 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
398 elt
= AREF (table
, ((i
>> 4) & 0xF));
399 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
400 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
403 extern Lisp_Object Vface_alternative_font_family_alist
;
405 extern Lisp_Object
find_font_encoding (Lisp_Object
);
408 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
409 FONTNAME. ENCODING is a charset symbol that specifies the encoding
410 of the font. REPERTORY is a charset symbol or nil. */
413 find_font_encoding (Lisp_Object fontname
)
415 Lisp_Object tail
, elt
;
417 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
421 && STRINGP (XCAR (elt
))
422 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
423 && (SYMBOLP (XCDR (elt
))
424 ? CHARSETP (XCDR (elt
))
425 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
431 /* Return encoding charset and repertory charset for REGISTRY in
432 ENCODING and REPERTORY correspondingly. If correct information for
433 REGISTRY is available, return 0. Otherwise return -1. */
436 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
439 int encoding_id
, repertory_id
;
441 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
447 encoding_id
= XINT (XCAR (val
));
448 repertory_id
= XINT (XCDR (val
));
452 val
= find_font_encoding (SYMBOL_NAME (registry
));
453 if (SYMBOLP (val
) && CHARSETP (val
))
455 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
457 else if (CONSP (val
))
459 if (! CHARSETP (XCAR (val
)))
461 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
462 if (NILP (XCDR (val
)))
466 if (! CHARSETP (XCDR (val
)))
468 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
473 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
475 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
479 *encoding
= CHARSET_FROM_ID (encoding_id
);
481 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
486 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
491 /* Font property value validaters. See the comment of
492 font_property_table for the meaning of the arguments. */
494 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
495 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
496 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
497 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
498 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
499 static int get_font_prop_index (Lisp_Object
);
502 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
505 val
= Fintern (val
, Qnil
);
508 else if (EQ (prop
, QCregistry
))
509 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
515 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
517 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
518 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
525 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
529 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
531 if ((n
& 0xF) + 1 >= ASIZE (elt
))
533 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
537 else if (SYMBOLP (val
))
539 int n
= font_style_to_value (prop
, val
, 0);
541 val
= n
>= 0 ? make_number (n
) : Qerror
;
549 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
551 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
556 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
558 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
560 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
562 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
564 if (spacing
== 'c' || spacing
== 'C')
565 return make_number (FONT_SPACING_CHARCELL
);
566 if (spacing
== 'm' || spacing
== 'M')
567 return make_number (FONT_SPACING_MONO
);
568 if (spacing
== 'p' || spacing
== 'P')
569 return make_number (FONT_SPACING_PROPORTIONAL
);
570 if (spacing
== 'd' || spacing
== 'D')
571 return make_number (FONT_SPACING_DUAL
);
577 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
579 Lisp_Object tail
, tmp
;
582 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
583 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
584 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
587 if (! SYMBOLP (XCAR (val
)))
592 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
594 for (i
= 0; i
< 2; i
++)
601 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
602 if (! SYMBOLP (XCAR (tmp
)))
610 /* Structure of known font property keys and validater of the
614 /* Pointer to the key symbol. */
616 /* Function to validate PROP's value VAL, or NULL if any value is
617 ok. The value is VAL or its regularized value if VAL is valid,
618 and Qerror if not. */
619 Lisp_Object (*validater
) (Lisp_Object prop
, Lisp_Object val
);
620 } font_property_table
[] =
621 { { &QCtype
, font_prop_validate_symbol
},
622 { &QCfoundry
, font_prop_validate_symbol
},
623 { &QCfamily
, font_prop_validate_symbol
},
624 { &QCadstyle
, font_prop_validate_symbol
},
625 { &QCregistry
, font_prop_validate_symbol
},
626 { &QCweight
, font_prop_validate_style
},
627 { &QCslant
, font_prop_validate_style
},
628 { &QCwidth
, font_prop_validate_style
},
629 { &QCsize
, font_prop_validate_non_neg
},
630 { &QCdpi
, font_prop_validate_non_neg
},
631 { &QCspacing
, font_prop_validate_spacing
},
632 { &QCavgwidth
, font_prop_validate_non_neg
},
633 /* The order of the above entries must match with enum
634 font_property_index. */
635 { &QClang
, font_prop_validate_symbol
},
636 { &QCscript
, font_prop_validate_symbol
},
637 { &QCotf
, font_prop_validate_otf
}
640 /* Size (number of elements) of the above table. */
641 #define FONT_PROPERTY_TABLE_SIZE \
642 ((sizeof font_property_table) / (sizeof *font_property_table))
644 /* Return an index number of font property KEY or -1 if KEY is not an
645 already known property. */
648 get_font_prop_index (Lisp_Object key
)
652 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
653 if (EQ (key
, *font_property_table
[i
].key
))
658 /* Validate the font property. The property key is specified by the
659 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
660 signal an error. The value is VAL or the regularized one. */
663 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
665 Lisp_Object validated
;
670 prop
= *font_property_table
[idx
].key
;
673 idx
= get_font_prop_index (prop
);
677 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
678 if (EQ (validated
, Qerror
))
679 signal_error ("invalid font property", Fcons (prop
, val
));
684 /* Store VAL as a value of extra font property PROP in FONT while
685 keeping the sorting order. Don't check the validity of VAL. */
688 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
690 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
691 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
695 Lisp_Object prev
= Qnil
;
698 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
699 prev
= extra
, extra
= XCDR (extra
);
702 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
704 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
710 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
715 /* Font name parser and unparser */
717 static int parse_matrix (char *);
718 static int font_expand_wildcards (Lisp_Object
*, int);
719 static int font_parse_name (char *, Lisp_Object
);
721 /* An enumerator for each field of an XLFD font name. */
722 enum xlfd_field_index
741 /* An enumerator for mask bit corresponding to each XLFD field. */
744 XLFD_FOUNDRY_MASK
= 0x0001,
745 XLFD_FAMILY_MASK
= 0x0002,
746 XLFD_WEIGHT_MASK
= 0x0004,
747 XLFD_SLANT_MASK
= 0x0008,
748 XLFD_SWIDTH_MASK
= 0x0010,
749 XLFD_ADSTYLE_MASK
= 0x0020,
750 XLFD_PIXEL_MASK
= 0x0040,
751 XLFD_POINT_MASK
= 0x0080,
752 XLFD_RESX_MASK
= 0x0100,
753 XLFD_RESY_MASK
= 0x0200,
754 XLFD_SPACING_MASK
= 0x0400,
755 XLFD_AVGWIDTH_MASK
= 0x0800,
756 XLFD_REGISTRY_MASK
= 0x1000,
757 XLFD_ENCODING_MASK
= 0x2000
761 /* Parse P pointing the pixel/point size field of the form
762 `[A B C D]' which specifies a transformation matrix:
768 by which all glyphs of the font are transformed. The spec says
769 that scalar value N for the pixel/point size is equivalent to:
770 A = N * resx/resy, B = C = 0, D = N.
772 Return the scalar value N if the form is valid. Otherwise return
776 parse_matrix (char *p
)
782 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
785 matrix
[i
] = - strtod (p
+ 1, &end
);
787 matrix
[i
] = strtod (p
, &end
);
790 return (i
== 4 ? (int) matrix
[3] : -1);
793 /* Expand a wildcard field in FIELD (the first N fields are filled) to
794 multiple fields to fill in all 14 XLFD fields while restring a
795 field position by its contents. */
798 font_expand_wildcards (Lisp_Object
*field
, int n
)
801 Lisp_Object tmp
[XLFD_LAST_INDEX
];
802 /* Array of information about where this element can go. Nth
803 element is for Nth element of FIELD. */
805 /* Minimum possible field. */
807 /* Maxinum possible field. */
809 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
811 } range
[XLFD_LAST_INDEX
];
813 int range_from
, range_to
;
816 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
817 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
818 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
819 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
820 | XLFD_AVGWIDTH_MASK)
821 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
823 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
824 field. The value is shifted to left one bit by one in the
826 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
827 range_mask
= (range_mask
<< 1) | 1;
829 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
830 position-based retriction for FIELD[I]. */
831 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
832 i
++, range_from
++, range_to
++, range_mask
<<= 1)
834 Lisp_Object val
= field
[i
];
840 range
[i
].from
= range_from
;
841 range
[i
].to
= range_to
;
842 range
[i
].mask
= range_mask
;
846 /* The triplet FROM, TO, and MASK is a value-based
847 retriction for FIELD[I]. */
853 int numeric
= XINT (val
);
856 from
= to
= XLFD_ENCODING_INDEX
,
857 mask
= XLFD_ENCODING_MASK
;
858 else if (numeric
== 0)
859 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
860 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
861 else if (numeric
<= 48)
862 from
= to
= XLFD_PIXEL_INDEX
,
863 mask
= XLFD_PIXEL_MASK
;
865 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
866 mask
= XLFD_LARGENUM_MASK
;
868 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
869 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
870 mask
= XLFD_NULL_MASK
;
872 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
875 Lisp_Object name
= SYMBOL_NAME (val
);
877 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
878 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
879 mask
= XLFD_REGENC_MASK
;
881 from
= to
= XLFD_ENCODING_INDEX
,
882 mask
= XLFD_ENCODING_MASK
;
884 else if (range_from
<= XLFD_WEIGHT_INDEX
885 && range_to
>= XLFD_WEIGHT_INDEX
886 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
887 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
888 else if (range_from
<= XLFD_SLANT_INDEX
889 && range_to
>= XLFD_SLANT_INDEX
890 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
891 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
892 else if (range_from
<= XLFD_SWIDTH_INDEX
893 && range_to
>= XLFD_SWIDTH_INDEX
894 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
895 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
898 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
899 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
901 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
902 mask
= XLFD_SYMBOL_MASK
;
905 /* Merge position-based and value-based restrictions. */
907 while (from
< range_from
)
908 mask
&= ~(1 << from
++);
909 while (from
< 14 && ! (mask
& (1 << from
)))
911 while (to
> range_to
)
912 mask
&= ~(1 << to
--);
913 while (to
>= 0 && ! (mask
& (1 << to
)))
917 range
[i
].from
= from
;
919 range
[i
].mask
= mask
;
921 if (from
> range_from
|| to
< range_to
)
923 /* The range is narrowed by value-based restrictions.
924 Reflect it to the other fields. */
926 /* Following fields should be after FROM. */
928 /* Preceding fields should be before TO. */
929 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
931 /* Check FROM for non-wildcard field. */
932 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
934 while (range
[j
].from
< from
)
935 range
[j
].mask
&= ~(1 << range
[j
].from
++);
936 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
938 range
[j
].from
= from
;
941 from
= range
[j
].from
;
942 if (range
[j
].to
> to
)
944 while (range
[j
].to
> to
)
945 range
[j
].mask
&= ~(1 << range
[j
].to
--);
946 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
959 /* Decide all fileds from restrictions in RANGE. */
960 for (i
= j
= 0; i
< n
; i
++)
962 if (j
< range
[i
].from
)
964 if (i
== 0 || ! NILP (tmp
[i
- 1]))
965 /* None of TMP[X] corresponds to Jth field. */
967 for (; j
< range
[i
].from
; j
++)
972 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
974 for (; j
< XLFD_LAST_INDEX
; j
++)
976 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
977 field
[XLFD_ENCODING_INDEX
]
978 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
983 /* Parse NAME (null terminated) as XLFD and store information in FONT
984 (font-spec or font-entity). Size property of FONT is set as
986 specified XLFD fields FONT property
987 --------------------- -------------
988 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
989 POINT_SIZE and RESY calculated pixel size (Lisp integer)
990 POINT_SIZE POINT_SIZE/10 (Lisp float)
992 If NAME is successfully parsed, return 0. Otherwise return -1.
994 FONT is usually a font-spec, but when this function is called from
995 X font backend driver, it is a font-entity. In that case, NAME is
996 a fully specified XLFD. */
999 font_parse_xlfd (char *name
, Lisp_Object font
)
1001 int len
= strlen (name
);
1003 char *f
[XLFD_LAST_INDEX
+ 1];
1007 if (len
> 255 || !len
)
1008 /* Maximum XLFD name length is 255. */
1010 /* Accept "*-.." as a fully specified XLFD. */
1011 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1012 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1015 for (p
= name
+ i
; *p
; p
++)
1019 if (i
== XLFD_LAST_INDEX
)
1024 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1025 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1027 if (i
== XLFD_LAST_INDEX
)
1029 /* Fully specified XLFD. */
1032 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1033 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1034 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1035 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1037 val
= INTERN_FIELD_SYM (i
);
1040 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1042 ASET (font
, j
, make_number (n
));
1045 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1046 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1047 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1049 ASET (font
, FONT_REGISTRY_INDEX
,
1050 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1051 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1053 p
= f
[XLFD_PIXEL_INDEX
];
1054 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1055 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1058 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1060 ASET (font
, FONT_SIZE_INDEX
, val
);
1061 else if (FONT_ENTITY_P (font
))
1065 double point_size
= -1;
1067 font_assert (FONT_SPEC_P (font
));
1068 p
= f
[XLFD_POINT_INDEX
];
1070 point_size
= parse_matrix (p
);
1071 else if (isdigit (*p
))
1072 point_size
= atoi (p
), point_size
/= 10;
1073 if (point_size
>= 0)
1074 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1078 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1079 if (! NILP (val
) && ! INTEGERP (val
))
1081 ASET (font
, FONT_DPI_INDEX
, val
);
1082 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1085 val
= font_prop_validate_spacing (QCspacing
, val
);
1086 if (! INTEGERP (val
))
1088 ASET (font
, FONT_SPACING_INDEX
, val
);
1090 p
= f
[XLFD_AVGWIDTH_INDEX
];
1093 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1094 if (! NILP (val
) && ! INTEGERP (val
))
1096 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1100 int wild_card_found
= 0;
1101 Lisp_Object prop
[XLFD_LAST_INDEX
];
1103 if (FONT_ENTITY_P (font
))
1105 for (j
= 0; j
< i
; j
++)
1109 if (f
[j
][1] && f
[j
][1] != '-')
1112 wild_card_found
= 1;
1115 prop
[j
] = INTERN_FIELD (j
);
1117 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1119 if (! wild_card_found
)
1121 if (font_expand_wildcards (prop
, i
) < 0)
1124 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1125 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1126 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1127 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1128 if (! NILP (prop
[i
]))
1130 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1132 ASET (font
, j
, make_number (n
));
1134 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1135 val
= prop
[XLFD_REGISTRY_INDEX
];
1138 val
= prop
[XLFD_ENCODING_INDEX
];
1140 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1142 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1143 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1145 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1146 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1148 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1150 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1151 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1152 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1154 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1156 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1159 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1160 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1161 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1163 val
= font_prop_validate_spacing (QCspacing
,
1164 prop
[XLFD_SPACING_INDEX
]);
1165 if (! INTEGERP (val
))
1167 ASET (font
, FONT_SPACING_INDEX
, val
);
1169 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1170 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1176 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1177 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1178 0, use PIXEL_SIZE instead. */
1181 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1183 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1187 font_assert (FONTP (font
));
1189 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1192 if (i
== FONT_ADSTYLE_INDEX
)
1193 j
= XLFD_ADSTYLE_INDEX
;
1194 else if (i
== FONT_REGISTRY_INDEX
)
1195 j
= XLFD_REGISTRY_INDEX
;
1196 val
= AREF (font
, i
);
1199 if (j
== XLFD_REGISTRY_INDEX
)
1200 f
[j
] = "*-*", len
+= 4;
1202 f
[j
] = "*", len
+= 2;
1207 val
= SYMBOL_NAME (val
);
1208 if (j
== XLFD_REGISTRY_INDEX
1209 && ! strchr ((char *) SDATA (val
), '-'))
1211 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1212 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1214 f
[j
] = alloca (SBYTES (val
) + 3);
1215 sprintf (f
[j
], "%s-*", SDATA (val
));
1216 len
+= SBYTES (val
) + 3;
1220 f
[j
] = alloca (SBYTES (val
) + 4);
1221 sprintf (f
[j
], "%s*-*", SDATA (val
));
1222 len
+= SBYTES (val
) + 4;
1226 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1230 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1233 val
= font_style_symbolic (font
, i
, 0);
1235 f
[j
] = "*", len
+= 2;
1238 val
= SYMBOL_NAME (val
);
1239 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1243 val
= AREF (font
, FONT_SIZE_INDEX
);
1244 font_assert (NUMBERP (val
) || NILP (val
));
1252 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1253 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1256 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1258 else if (FLOATP (val
))
1260 i
= XFLOAT_DATA (val
) * 10;
1261 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1262 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1265 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1267 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1269 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1270 f
[XLFD_RESX_INDEX
] = alloca (22);
1271 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1275 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1276 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1278 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1280 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1281 : spacing
<= FONT_SPACING_DUAL
? "d"
1282 : spacing
<= FONT_SPACING_MONO
? "m"
1287 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1288 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1290 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1291 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
], "%ld",
1292 (long) XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1295 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1296 len
++; /* for terminating '\0'. */
1299 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1300 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1301 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1302 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1303 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1304 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1305 f
[XLFD_REGISTRY_INDEX
]);
1308 /* Parse NAME (null terminated) and store information in FONT
1309 (font-spec or font-entity). NAME is supplied in either the
1310 Fontconfig or GTK font name format. If NAME is successfully
1311 parsed, return 0. Otherwise return -1.
1313 The fontconfig format is
1315 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1319 FAMILY [PROPS...] [SIZE]
1321 This function tries to guess which format it is. */
1324 font_parse_fcname (char *name
, Lisp_Object font
)
1327 char *size_beg
= NULL
, *size_end
= NULL
;
1328 char *props_beg
= NULL
, *family_end
= NULL
;
1329 int len
= strlen (name
);
1334 for (p
= name
; *p
; p
++)
1336 if (*p
== '\\' && p
[1])
1340 props_beg
= family_end
= p
;
1345 int decimal
= 0, size_found
= 1;
1346 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1349 if (*q
!= '.' || decimal
)
1368 Lisp_Object extra_props
= Qnil
;
1370 /* A fontconfig name with size and/or property data. */
1371 if (family_end
> name
)
1374 family
= font_intern_prop (name
, family_end
- name
, 1);
1375 ASET (font
, FONT_FAMILY_INDEX
, family
);
1379 double point_size
= strtod (size_beg
, &size_end
);
1380 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1381 if (*size_end
== ':' && size_end
[1])
1382 props_beg
= size_end
;
1386 /* Now parse ":KEY=VAL" patterns. */
1389 for (p
= props_beg
; *p
; p
= q
)
1391 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1394 /* Must be an enumerated value. */
1398 val
= font_intern_prop (p
, q
- p
, 1);
1400 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1402 if (PROP_MATCH ("light", 5)
1403 || PROP_MATCH ("medium", 6)
1404 || PROP_MATCH ("demibold", 8)
1405 || PROP_MATCH ("bold", 4)
1406 || PROP_MATCH ("black", 5))
1407 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1408 else if (PROP_MATCH ("roman", 5)
1409 || PROP_MATCH ("italic", 6)
1410 || PROP_MATCH ("oblique", 7))
1411 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1412 else if (PROP_MATCH ("charcell", 8))
1413 ASET (font
, FONT_SPACING_INDEX
,
1414 make_number (FONT_SPACING_CHARCELL
));
1415 else if (PROP_MATCH ("mono", 4))
1416 ASET (font
, FONT_SPACING_INDEX
,
1417 make_number (FONT_SPACING_MONO
));
1418 else if (PROP_MATCH ("proportional", 12))
1419 ASET (font
, FONT_SPACING_INDEX
,
1420 make_number (FONT_SPACING_PROPORTIONAL
));
1429 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1430 prop
= FONT_SIZE_INDEX
;
1433 key
= font_intern_prop (p
, q
- p
, 1);
1434 prop
= get_font_prop_index (key
);
1438 for (q
= p
; *q
&& *q
!= ':'; q
++);
1439 val
= font_intern_prop (p
, q
- p
, 0);
1441 if (prop
>= FONT_FOUNDRY_INDEX
1442 && prop
< FONT_EXTRA_INDEX
)
1443 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1446 extra_props
= nconc2 (extra_props
,
1447 Fcons (Fcons (key
, val
), Qnil
));
1454 if (! NILP (extra_props
))
1456 struct font_driver_list
*driver_list
= font_driver_list
;
1457 for ( ; driver_list
; driver_list
= driver_list
->next
)
1458 if (driver_list
->driver
->filter_properties
)
1459 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1465 /* Either a fontconfig-style name with no size and property
1466 data, or a GTK-style name. */
1468 int word_len
, prop_found
= 0;
1470 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1476 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1477 if (! isdigit (*q
) && *q
!= '.')
1484 double point_size
= strtod (p
, &q
);
1485 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1490 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1491 if (*q
== '\\' && q
[1])
1495 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1497 if (PROP_MATCH ("Ultra-Light", 11))
1500 prop
= font_intern_prop ("ultra-light", 11, 1);
1501 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1503 else if (PROP_MATCH ("Light", 5))
1506 prop
= font_intern_prop ("light", 5, 1);
1507 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1509 else if (PROP_MATCH ("Book", 4))
1512 prop
= font_intern_prop ("book", 4, 1);
1513 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1515 else if (PROP_MATCH ("Medium", 6))
1518 prop
= font_intern_prop ("medium", 6, 1);
1519 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1521 else if (PROP_MATCH ("Semi-Bold", 9))
1524 prop
= font_intern_prop ("semi-bold", 9, 1);
1525 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1527 else if (PROP_MATCH ("Bold", 4))
1530 prop
= font_intern_prop ("bold", 4, 1);
1531 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1533 else if (PROP_MATCH ("Italic", 6))
1536 prop
= font_intern_prop ("italic", 4, 1);
1537 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1539 else if (PROP_MATCH ("Oblique", 7))
1542 prop
= font_intern_prop ("oblique", 7, 1);
1543 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1545 else if (PROP_MATCH ("Semi-Condensed", 14))
1548 prop
= font_intern_prop ("semi-condensed", 14, 1);
1549 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, prop
);
1551 else if (PROP_MATCH ("Condensed", 9))
1554 prop
= font_intern_prop ("condensed", 9, 1);
1555 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, prop
);
1559 return -1; /* Unknown property in GTK-style font name. */
1568 family
= font_intern_prop (name
, family_end
- name
, 1);
1569 ASET (font
, FONT_FAMILY_INDEX
, family
);
1576 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1577 NAME (NBYTES length), and return the name length. If
1578 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1581 font_unparse_fcname (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1583 Lisp_Object family
, foundry
;
1584 Lisp_Object tail
, val
;
1588 Lisp_Object styles
[3];
1589 char *style_names
[3] = { "weight", "slant", "width" };
1592 family
= AREF (font
, FONT_FAMILY_INDEX
);
1593 if (! NILP (family
))
1595 if (SYMBOLP (family
))
1597 family
= SYMBOL_NAME (family
);
1598 len
+= SBYTES (family
);
1604 val
= AREF (font
, FONT_SIZE_INDEX
);
1607 if (XINT (val
) != 0)
1608 pixel_size
= XINT (val
);
1610 len
+= 21; /* for ":pixelsize=NUM" */
1612 else if (FLOATP (val
))
1615 point_size
= (int) XFLOAT_DATA (val
);
1616 len
+= 11; /* for "-NUM" */
1619 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1620 if (! NILP (foundry
))
1622 if (SYMBOLP (foundry
))
1624 foundry
= SYMBOL_NAME (foundry
);
1625 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1631 for (i
= 0; i
< 3; i
++)
1633 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1634 if (! NILP (styles
[i
]))
1635 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1636 SDATA (SYMBOL_NAME (styles
[i
])));
1639 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1640 len
+= sprintf (work
, ":dpi=%ld", (long)XINT (AREF (font
, FONT_DPI_INDEX
)));
1641 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1642 len
+= strlen (":spacing=100");
1643 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1644 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1645 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1647 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1649 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1651 len
+= SBYTES (val
);
1652 else if (INTEGERP (val
))
1653 len
+= sprintf (work
, "%ld", (long) XINT (val
));
1654 else if (SYMBOLP (val
))
1655 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1661 if (! NILP (family
))
1662 p
+= sprintf (p
, "%s", SDATA (family
));
1666 p
+= sprintf (p
, "%d", point_size
);
1668 p
+= sprintf (p
, "-%d", point_size
);
1670 else if (pixel_size
> 0)
1671 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1672 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1673 p
+= sprintf (p
, ":foundry=%s",
1674 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1675 for (i
= 0; i
< 3; i
++)
1676 if (! NILP (styles
[i
]))
1677 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1678 SDATA (SYMBOL_NAME (styles
[i
])));
1679 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1680 p
+= sprintf (p
, ":dpi=%ld", (long) XINT (AREF (font
, FONT_DPI_INDEX
)));
1681 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1682 p
+= sprintf (p
, ":spacing=%ld",
1683 (long) XINT (AREF (font
, FONT_SPACING_INDEX
)));
1684 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1686 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1687 p
+= sprintf (p
, ":scalable=true");
1689 p
+= sprintf (p
, ":scalable=false");
1694 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1695 NAME (NBYTES length), and return the name length. F is the frame
1696 on which the font is displayed; it is used to calculate the point
1700 font_unparse_gtkname (Lisp_Object font
, struct frame
*f
, char *name
, int nbytes
)
1704 Lisp_Object family
, weight
, slant
, size
;
1705 int point_size
= -1;
1707 family
= AREF (font
, FONT_FAMILY_INDEX
);
1708 if (! NILP (family
))
1710 if (! SYMBOLP (family
))
1712 family
= SYMBOL_NAME (family
);
1713 len
+= SBYTES (family
);
1716 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1717 if (EQ (weight
, Qnormal
))
1719 else if (! NILP (weight
))
1721 weight
= SYMBOL_NAME (weight
);
1722 len
+= SBYTES (weight
);
1725 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1726 if (EQ (slant
, Qnormal
))
1728 else if (! NILP (slant
))
1730 slant
= SYMBOL_NAME (slant
);
1731 len
+= SBYTES (slant
);
1734 size
= AREF (font
, FONT_SIZE_INDEX
);
1735 /* Convert pixel size to point size. */
1736 if (INTEGERP (size
))
1738 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1740 if (INTEGERP (font_dpi
))
1741 dpi
= XINT (font_dpi
);
1744 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1747 else if (FLOATP (size
))
1749 point_size
= (int) XFLOAT_DATA (size
);
1756 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1758 if (! NILP (weight
))
1761 p
+= sprintf (p
, " %s", SDATA (weight
));
1762 q
[1] = toupper (q
[1]);
1768 p
+= sprintf (p
, " %s", SDATA (slant
));
1769 q
[1] = toupper (q
[1]);
1773 p
+= sprintf (p
, " %d", point_size
);
1778 /* Parse NAME (null terminated) and store information in FONT
1779 (font-spec or font-entity). If NAME is successfully parsed, return
1780 0. Otherwise return -1. */
1783 font_parse_name (char *name
, Lisp_Object font
)
1785 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1786 return font_parse_xlfd (name
, font
);
1787 return font_parse_fcname (name
, font
);
1791 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1792 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1796 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1802 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1804 CHECK_STRING (family
);
1805 len
= SBYTES (family
);
1806 p0
= (char *) SDATA (family
);
1807 p1
= strchr (p0
, '-');
1810 if ((*p0
!= '*' && p1
- p0
> 0)
1811 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1812 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1815 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1818 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1820 if (! NILP (registry
))
1822 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1823 CHECK_STRING (registry
);
1824 len
= SBYTES (registry
);
1825 p0
= (char *) SDATA (registry
);
1826 p1
= strchr (p0
, '-');
1829 if (SDATA (registry
)[len
- 1] == '*')
1830 registry
= concat2 (registry
, build_string ("-*"));
1832 registry
= concat2 (registry
, build_string ("*-*"));
1834 registry
= Fdowncase (registry
);
1835 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1840 /* This part (through the next ^L) is still experimental and not
1841 tested much. We may drastically change codes. */
1847 #define LGSTRING_HEADER_SIZE 6
1848 #define LGSTRING_GLYPH_SIZE 8
1851 check_gstring (gstring
)
1852 Lisp_Object gstring
;
1857 CHECK_VECTOR (gstring
);
1858 val
= AREF (gstring
, 0);
1860 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1862 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1863 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1864 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1865 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1866 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1867 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1868 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1869 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1870 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1871 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1872 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1874 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1876 val
= LGSTRING_GLYPH (gstring
, i
);
1878 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1880 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1882 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1883 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1884 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1885 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1886 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1887 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1888 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1889 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1891 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1893 if (ASIZE (val
) < 3)
1895 for (j
= 0; j
< 3; j
++)
1896 CHECK_NUMBER (AREF (val
, j
));
1901 error ("Invalid glyph-string format");
1906 check_otf_features (otf_features
)
1907 Lisp_Object otf_features
;
1911 CHECK_CONS (otf_features
);
1912 CHECK_SYMBOL (XCAR (otf_features
));
1913 otf_features
= XCDR (otf_features
);
1914 CHECK_CONS (otf_features
);
1915 CHECK_SYMBOL (XCAR (otf_features
));
1916 otf_features
= XCDR (otf_features
);
1917 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1919 CHECK_SYMBOL (Fcar (val
));
1920 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1921 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1923 otf_features
= XCDR (otf_features
);
1924 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1926 CHECK_SYMBOL (Fcar (val
));
1927 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1928 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1935 Lisp_Object otf_list
;
1938 otf_tag_symbol (tag
)
1943 OTF_tag_name (tag
, name
);
1944 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1951 Lisp_Object val
= Fassoc (file
, otf_list
);
1955 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1958 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1959 val
= make_save_value (otf
, 0);
1960 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1966 /* Return a list describing which scripts/languages FONT supports by
1967 which GSUB/GPOS features of OpenType tables. See the comment of
1968 (struct font_driver).otf_capability. */
1971 font_otf_capability (font
)
1975 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1978 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1981 for (i
= 0; i
< 2; i
++)
1983 OTF_GSUB_GPOS
*gsub_gpos
;
1984 Lisp_Object script_list
= Qnil
;
1987 if (OTF_get_features (otf
, i
== 0) < 0)
1989 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1990 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1992 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1993 Lisp_Object langsys_list
= Qnil
;
1994 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1997 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1999 OTF_LangSys
*langsys
;
2000 Lisp_Object feature_list
= Qnil
;
2001 Lisp_Object langsys_tag
;
2004 if (k
== script
->LangSysCount
)
2006 langsys
= &script
->DefaultLangSys
;
2011 langsys
= script
->LangSys
+ k
;
2013 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2015 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2017 OTF_Feature
*feature
2018 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2019 Lisp_Object feature_tag
2020 = otf_tag_symbol (feature
->FeatureTag
);
2022 feature_list
= Fcons (feature_tag
, feature_list
);
2024 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2027 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2032 XSETCAR (capability
, script_list
);
2034 XSETCDR (capability
, script_list
);
2040 /* Parse OTF features in SPEC and write a proper features spec string
2041 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2042 assured that the sufficient memory has already allocated for
2046 generate_otf_features (spec
, features
)
2056 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2062 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2067 else if (! asterisk
)
2069 val
= SYMBOL_NAME (val
);
2070 p
+= sprintf (p
, "%s", SDATA (val
));
2074 val
= SYMBOL_NAME (val
);
2075 p
+= sprintf (p
, "~%s", SDATA (val
));
2079 error ("OTF spec too long");
2083 font_otf_DeviceTable (device_table
)
2084 OTF_DeviceTable
*device_table
;
2086 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2088 return Fcons (make_number (len
),
2089 make_unibyte_string (device_table
->DeltaValue
, len
));
2093 font_otf_ValueRecord (value_format
, value_record
)
2095 OTF_ValueRecord
*value_record
;
2097 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2099 if (value_format
& OTF_XPlacement
)
2100 ASET (val
, 0, make_number (value_record
->XPlacement
));
2101 if (value_format
& OTF_YPlacement
)
2102 ASET (val
, 1, make_number (value_record
->YPlacement
));
2103 if (value_format
& OTF_XAdvance
)
2104 ASET (val
, 2, make_number (value_record
->XAdvance
));
2105 if (value_format
& OTF_YAdvance
)
2106 ASET (val
, 3, make_number (value_record
->YAdvance
));
2107 if (value_format
& OTF_XPlaDevice
)
2108 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2109 if (value_format
& OTF_YPlaDevice
)
2110 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2111 if (value_format
& OTF_XAdvDevice
)
2112 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2113 if (value_format
& OTF_YAdvDevice
)
2114 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2119 font_otf_Anchor (anchor
)
2124 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2125 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2126 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2127 if (anchor
->AnchorFormat
== 2)
2128 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2131 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2132 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2136 #endif /* HAVE_LIBOTF */
2142 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
2143 static int font_compare (const void *, const void *);
2144 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
2147 /* Return a rescaling ratio of FONT_ENTITY. */
2148 extern Lisp_Object Vface_font_rescale_alist
;
2151 font_rescale_ratio (Lisp_Object font_entity
)
2153 Lisp_Object tail
, elt
;
2154 Lisp_Object name
= Qnil
;
2156 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2159 if (FLOATP (XCDR (elt
)))
2161 if (STRINGP (XCAR (elt
)))
2164 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2165 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2166 return XFLOAT_DATA (XCDR (elt
));
2168 else if (FONT_SPEC_P (XCAR (elt
)))
2170 if (font_match_p (XCAR (elt
), font_entity
))
2171 return XFLOAT_DATA (XCDR (elt
));
2178 /* We sort fonts by scoring each of them against a specified
2179 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2180 the value is, the closer the font is to the font-spec.
2182 The lowest 2 bits of the score is used for driver type. The font
2183 available by the most preferred font driver is 0.
2185 Each 7-bit in the higher 28 bits are used for numeric properties
2186 WEIGHT, SLANT, WIDTH, and SIZE. */
2188 /* How many bits to shift to store the difference value of each font
2189 property in a score. Note that flots for FONT_TYPE_INDEX and
2190 FONT_REGISTRY_INDEX are not used. */
2191 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2193 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2194 The return value indicates how different ENTITY is compared with
2198 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2203 /* Score three style numeric fields. Maximum difference is 127. */
2204 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2205 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2207 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2212 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2215 /* Score the size. Maximum difference is 127. */
2216 i
= FONT_SIZE_INDEX
;
2217 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2218 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2220 /* We use the higher 6-bit for the actual size difference. The
2221 lowest bit is set if the DPI is different. */
2223 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2225 if (CONSP (Vface_font_rescale_alist
))
2226 pixel_size
*= font_rescale_ratio (entity
);
2227 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2231 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2232 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2234 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2235 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2237 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2244 /* Concatenate all elements of LIST into one vector. LIST is a list
2245 of font-entity vectors. */
2248 font_vconcat_entity_vectors (Lisp_Object list
)
2250 int nargs
= XINT (Flength (list
));
2251 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2254 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2255 args
[i
] = XCAR (list
);
2256 return Fvconcat (nargs
, args
);
2260 /* The structure for elements being sorted by qsort. */
2261 struct font_sort_data
2264 int font_driver_preference
;
2269 /* The comparison function for qsort. */
2272 font_compare (const void *d1
, const void *d2
)
2274 const struct font_sort_data
*data1
= d1
;
2275 const struct font_sort_data
*data2
= d2
;
2277 if (data1
->score
< data2
->score
)
2279 else if (data1
->score
> data2
->score
)
2281 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2285 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2286 If PREFER specifies a point-size, calculate the corresponding
2287 pixel-size from QCdpi property of PREFER or from the Y-resolution
2288 of FRAME before sorting.
2290 If BEST-ONLY is nonzero, return the best matching entity (that
2291 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2292 if BEST-ONLY is negative). Otherwise, return the sorted result as
2293 a single vector of font-entities.
2295 This function does no optimization for the case that the total
2296 number of elements is 1. The caller should avoid calling this in
2300 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2302 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2304 struct font_sort_data
*data
;
2305 unsigned best_score
;
2306 Lisp_Object best_entity
;
2307 struct frame
*f
= XFRAME (frame
);
2308 Lisp_Object tail
, vec
;
2311 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2312 prefer_prop
[i
] = AREF (prefer
, i
);
2313 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2314 prefer_prop
[FONT_SIZE_INDEX
]
2315 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2317 if (NILP (XCDR (list
)))
2319 /* What we have to take care of is this single vector. */
2321 maxlen
= ASIZE (vec
);
2325 /* We don't have to perform sort, so there's no need of creating
2326 a single vector. But, we must find the length of the longest
2329 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2330 if (maxlen
< ASIZE (XCAR (tail
)))
2331 maxlen
= ASIZE (XCAR (tail
));
2335 /* We have to create a single vector to sort it. */
2336 vec
= font_vconcat_entity_vectors (list
);
2337 maxlen
= ASIZE (vec
);
2340 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2341 best_score
= 0xFFFFFFFF;
2344 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2346 int font_driver_preference
= 0;
2347 Lisp_Object current_font_driver
;
2353 /* We are sure that the length of VEC > 0. */
2354 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2355 /* Score the elements. */
2356 for (i
= 0; i
< len
; i
++)
2358 data
[i
].entity
= AREF (vec
, i
);
2360 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2362 ? font_score (data
[i
].entity
, prefer_prop
)
2364 if (best_only
&& best_score
> data
[i
].score
)
2366 best_score
= data
[i
].score
;
2367 best_entity
= data
[i
].entity
;
2368 if (best_score
== 0)
2371 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2373 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2374 font_driver_preference
++;
2376 data
[i
].font_driver_preference
= font_driver_preference
;
2379 /* Sort if necessary. */
2382 qsort (data
, len
, sizeof *data
, font_compare
);
2383 for (i
= 0; i
< len
; i
++)
2384 ASET (vec
, i
, data
[i
].entity
);
2393 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2398 /* API of Font Service Layer. */
2400 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2401 sort_shift_bits. Finternal_set_font_selection_order calls this
2402 function with font_sort_order after setting up it. */
2405 font_update_sort_order (int *order
)
2409 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2411 int xlfd_idx
= order
[i
];
2413 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2414 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2415 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2416 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2417 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2418 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2420 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2425 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
, Lisp_Object features
, Lisp_Object table
)
2430 table
= assq_no_quit (script
, table
);
2433 table
= XCDR (table
);
2434 if (! NILP (langsys
))
2436 table
= assq_no_quit (langsys
, table
);
2442 val
= assq_no_quit (Qnil
, table
);
2444 table
= XCAR (table
);
2448 table
= XCDR (table
);
2449 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2451 if (NILP (XCAR (features
)))
2456 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2462 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2465 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2467 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2469 script
= XCAR (spec
);
2473 langsys
= XCAR (spec
);
2484 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2485 XCAR (otf_capability
)))
2487 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2488 XCDR (otf_capability
)))
2495 /* Check if FONT (font-entity or font-object) matches with the font
2496 specification SPEC. */
2499 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2501 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2502 Lisp_Object extra
, font_extra
;
2505 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2506 if (! NILP (AREF (spec
, i
))
2507 && ! NILP (AREF (font
, i
))
2508 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2510 props
= XFONT_SPEC (spec
)->props
;
2511 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2513 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2514 prop
[i
] = AREF (spec
, i
);
2515 prop
[FONT_SIZE_INDEX
]
2516 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2520 if (font_score (font
, props
) > 0)
2522 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2523 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2524 for (; CONSP (extra
); extra
= XCDR (extra
))
2526 Lisp_Object key
= XCAR (XCAR (extra
));
2527 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2529 if (EQ (key
, QClang
))
2531 val2
= assq_no_quit (key
, font_extra
);
2540 if (NILP (Fmemq (val
, val2
)))
2545 ? NILP (Fmemq (val
, XCDR (val2
)))
2549 else if (EQ (key
, QCscript
))
2551 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2557 /* All characters in the list must be supported. */
2558 for (; CONSP (val2
); val2
= XCDR (val2
))
2560 if (! NATNUMP (XCAR (val2
)))
2562 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2563 == FONT_INVALID_CODE
)
2567 else if (VECTORP (val2
))
2569 /* At most one character in the vector must be supported. */
2570 for (i
= 0; i
< ASIZE (val2
); i
++)
2572 if (! NATNUMP (AREF (val2
, i
)))
2574 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2575 != FONT_INVALID_CODE
)
2578 if (i
== ASIZE (val2
))
2583 else if (EQ (key
, QCotf
))
2587 if (! FONT_OBJECT_P (font
))
2589 fontp
= XFONT_OBJECT (font
);
2590 if (! fontp
->driver
->otf_capability
)
2592 val2
= fontp
->driver
->otf_capability (fontp
);
2593 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2604 Each font backend has the callback function get_cache, and it
2605 returns a cons cell of which cdr part can be freely used for
2606 caching fonts. The cons cell may be shared by multiple frames
2607 and/or multiple font drivers. So, we arrange the cdr part as this:
2609 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2611 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2612 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2613 cons (FONT-SPEC FONT-ENTITY ...). */
2615 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2616 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2617 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2618 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2619 struct font_driver
*);
2622 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2624 Lisp_Object cache
, val
;
2626 cache
= driver
->get_cache (f
);
2628 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2632 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2633 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2637 val
= XCDR (XCAR (val
));
2638 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2644 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2646 Lisp_Object cache
, val
, tmp
;
2649 cache
= driver
->get_cache (f
);
2651 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2652 cache
= val
, val
= XCDR (val
);
2653 font_assert (! NILP (val
));
2654 tmp
= XCDR (XCAR (val
));
2655 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2656 if (XINT (XCAR (tmp
)) == 0)
2658 font_clear_cache (f
, XCAR (val
), driver
);
2659 XSETCDR (cache
, XCDR (val
));
2665 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2667 Lisp_Object val
= driver
->get_cache (f
);
2668 Lisp_Object type
= driver
->type
;
2670 font_assert (CONSP (val
));
2671 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2672 font_assert (CONSP (val
));
2673 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2674 val
= XCDR (XCAR (val
));
2678 static int num_fonts
;
2681 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2683 Lisp_Object tail
, elt
;
2684 Lisp_Object tail2
, entity
;
2686 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2687 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2690 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2691 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2693 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2695 entity
= XCAR (tail2
);
2697 if (FONT_ENTITY_P (entity
)
2698 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2700 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2702 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2704 Lisp_Object val
= XCAR (objlist
);
2705 struct font
*font
= XFONT_OBJECT (val
);
2707 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2709 font_assert (font
&& driver
== font
->driver
);
2710 driver
->close (f
, font
);
2714 if (driver
->free_entity
)
2715 driver
->free_entity (entity
);
2720 XSETCDR (cache
, Qnil
);
2724 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2726 /* Check each font-entity in VEC, and return a list of font-entities
2727 that satisfy this condition:
2728 (1) matches with SPEC and SIZE if SPEC is not nil, and
2729 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2732 extern Lisp_Object Vface_ignored_fonts
;
2735 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2737 Lisp_Object entity
, val
;
2738 enum font_property_index prop
;
2741 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2743 entity
= AREF (vec
, i
);
2744 if (! NILP (Vface_ignored_fonts
))
2747 Lisp_Object tail
, regexp
;
2749 if (font_unparse_xlfd (entity
, 0, name
, 256) >= 0)
2751 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2753 regexp
= XCAR (tail
);
2754 if (STRINGP (regexp
)
2755 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
2764 val
= Fcons (entity
, val
);
2767 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2768 if (INTEGERP (AREF (spec
, prop
))
2769 && ((XINT (AREF (spec
, prop
)) >> 8)
2770 != (XINT (AREF (entity
, prop
)) >> 8)))
2771 prop
= FONT_SPEC_MAX
;
2772 if (prop
< FONT_SPEC_MAX
2774 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2776 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2779 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2780 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2781 prop
= FONT_SPEC_MAX
;
2783 if (prop
< FONT_SPEC_MAX
2784 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2785 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2786 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2787 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2788 prop
= FONT_SPEC_MAX
;
2789 if (prop
< FONT_SPEC_MAX
2790 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2791 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2792 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2793 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2794 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2795 prop
= FONT_SPEC_MAX
;
2796 if (prop
< FONT_SPEC_MAX
)
2797 val
= Fcons (entity
, val
);
2799 return (Fvconcat (1, &val
));
2803 /* Return a list of vectors of font-entities matching with SPEC on
2804 FRAME. Each elements in the list is a vector of entities from the
2805 same font-driver. */
2808 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2810 FRAME_PTR f
= XFRAME (frame
);
2811 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2812 Lisp_Object ftype
, val
;
2813 Lisp_Object list
= Qnil
;
2815 int need_filtering
= 0;
2818 font_assert (FONT_SPEC_P (spec
));
2820 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2821 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2822 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2823 size
= font_pixel_size (f
, spec
);
2827 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2828 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2829 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2830 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2832 ASET (scratch_font_spec
, i
, Qnil
);
2833 if (! NILP (AREF (spec
, i
)))
2835 if (i
== FONT_DPI_INDEX
)
2836 /* Skip FONT_SPACING_INDEX */
2839 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2840 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2842 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2844 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2846 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2848 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2849 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2856 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2860 val
= Fvconcat (1, &val
);
2861 copy
= Fcopy_font_spec (scratch_font_spec
);
2862 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2863 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2867 || ! NILP (Vface_ignored_fonts
)))
2868 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2869 if (ASIZE (val
) > 0)
2870 list
= Fcons (val
, list
);
2873 list
= Fnreverse (list
);
2874 FONT_ADD_LOG ("list", spec
, list
);
2879 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2880 nil, is an array of face's attributes, which specifies preferred
2881 font-related attributes. */
2884 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2886 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2887 Lisp_Object ftype
, size
, entity
;
2889 Lisp_Object work
= Fcopy_font_spec (spec
);
2891 XSETFRAME (frame
, f
);
2892 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2893 size
= AREF (spec
, FONT_SIZE_INDEX
);
2896 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2897 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2898 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2899 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2902 for (; driver_list
; driver_list
= driver_list
->next
)
2904 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2906 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2909 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2910 entity
= assoc_no_quit (work
, XCDR (cache
));
2912 entity
= XCDR (entity
);
2915 entity
= driver_list
->driver
->match (frame
, work
);
2916 copy
= Fcopy_font_spec (work
);
2917 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2918 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2920 if (! NILP (entity
))
2923 FONT_ADD_LOG ("match", work
, entity
);
2928 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2929 opened font object. */
2932 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2934 struct font_driver_list
*driver_list
;
2935 Lisp_Object objlist
, size
, val
, font_object
;
2937 int min_width
, height
;
2938 int scaled_pixel_size
;
2940 font_assert (FONT_ENTITY_P (entity
));
2941 size
= AREF (entity
, FONT_SIZE_INDEX
);
2942 if (XINT (size
) != 0)
2943 scaled_pixel_size
= pixel_size
= XINT (size
);
2944 else if (CONSP (Vface_font_rescale_alist
))
2945 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2947 val
= AREF (entity
, FONT_TYPE_INDEX
);
2948 for (driver_list
= f
->font_driver_list
;
2949 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2950 driver_list
= driver_list
->next
);
2954 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2955 objlist
= XCDR (objlist
))
2957 Lisp_Object fn
= XCAR (objlist
);
2958 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2959 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2961 if (driver_list
->driver
->cached_font_ok
== NULL
2962 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2967 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2968 if (!NILP (font_object
))
2969 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2970 FONT_ADD_LOG ("open", entity
, font_object
);
2971 if (NILP (font_object
))
2973 ASET (entity
, FONT_OBJLIST_INDEX
,
2974 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2977 font
= XFONT_OBJECT (font_object
);
2978 min_width
= (font
->min_width
? font
->min_width
2979 : font
->average_width
? font
->average_width
2980 : font
->space_width
? font
->space_width
2982 height
= (font
->height
? font
->height
: 1);
2983 #ifdef HAVE_WINDOW_SYSTEM
2984 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2985 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2987 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2988 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2989 fonts_changed_p
= 1;
2993 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2994 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2995 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2996 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
3004 /* Close FONT_OBJECT that is opened on frame F. */
3007 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
3009 struct font
*font
= XFONT_OBJECT (font_object
);
3011 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
3012 /* Already closed. */
3014 FONT_ADD_LOG ("close", font_object
, Qnil
);
3015 font
->driver
->close (f
, font
);
3016 #ifdef HAVE_WINDOW_SYSTEM
3017 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
3018 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
3024 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
3025 FONT is a font-entity and it must be opened to check. */
3028 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
3032 if (FONT_ENTITY_P (font
))
3034 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
3035 struct font_driver_list
*driver_list
;
3037 for (driver_list
= f
->font_driver_list
;
3038 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
3039 driver_list
= driver_list
->next
);
3042 if (! driver_list
->driver
->has_char
)
3044 return driver_list
->driver
->has_char (font
, c
);
3047 font_assert (FONT_OBJECT_P (font
));
3048 fontp
= XFONT_OBJECT (font
);
3049 if (fontp
->driver
->has_char
)
3051 int result
= fontp
->driver
->has_char (font
, c
);
3056 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
3060 /* Return the glyph ID of FONT_OBJECT for character C. */
3063 font_encode_char (Lisp_Object font_object
, int c
)
3067 font_assert (FONT_OBJECT_P (font_object
));
3068 font
= XFONT_OBJECT (font_object
);
3069 return font
->driver
->encode_char (font
, c
);
3073 /* Return the name of FONT_OBJECT. */
3076 font_get_name (Lisp_Object font_object
)
3078 font_assert (FONT_OBJECT_P (font_object
));
3079 return AREF (font_object
, FONT_NAME_INDEX
);
3083 /* Return the specification of FONT_OBJECT. */
3086 font_get_spec (Lisp_Object font_object
)
3088 Lisp_Object spec
= font_make_spec ();
3091 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
3092 ASET (spec
, i
, AREF (font_object
, i
));
3093 ASET (spec
, FONT_SIZE_INDEX
,
3094 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
3099 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3100 could not be parsed by font_parse_name, return Qnil. */
3103 font_spec_from_name (Lisp_Object font_name
)
3105 Lisp_Object spec
= Ffont_spec (0, NULL
);
3107 CHECK_STRING (font_name
);
3108 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3110 font_put_extra (spec
, QCname
, font_name
);
3111 font_put_extra (spec
, QCuser_spec
, font_name
);
3117 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
3119 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3124 if (! NILP (Ffont_get (font
, QCname
)))
3126 font
= Fcopy_font_spec (font
);
3127 font_put_extra (font
, QCname
, Qnil
);
3130 if (NILP (AREF (font
, prop
))
3131 && prop
!= FONT_FAMILY_INDEX
3132 && prop
!= FONT_FOUNDRY_INDEX
3133 && prop
!= FONT_WIDTH_INDEX
3134 && prop
!= FONT_SIZE_INDEX
)
3136 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3137 font
= Fcopy_font_spec (font
);
3138 ASET (font
, prop
, Qnil
);
3139 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3141 if (prop
== FONT_FAMILY_INDEX
)
3143 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3144 /* If we are setting the font family, we must also clear
3145 FONT_WIDTH_INDEX to avoid rejecting families that lack
3146 support for some widths. */
3147 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3149 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3150 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3151 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3152 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3153 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3154 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3156 else if (prop
== FONT_SIZE_INDEX
)
3158 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3159 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3160 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3162 else if (prop
== FONT_WIDTH_INDEX
)
3163 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3164 attrs
[LFACE_FONT_INDEX
] = font
;
3168 font_update_lface (FRAME_PTR f
, Lisp_Object
*attrs
)
3172 spec
= attrs
[LFACE_FONT_INDEX
];
3173 if (! FONT_SPEC_P (spec
))
3176 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3177 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3178 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3179 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3180 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3181 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3182 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3183 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);
3184 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3185 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3186 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3190 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3195 val
= Ffont_get (spec
, QCdpi
);
3198 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3200 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3202 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3204 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3205 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3211 /* Selecte a font from ENTITIES (list of font-entity vectors) that
3212 supports C and matches best with ATTRS and PIXEL_SIZE. */
3215 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
3217 Lisp_Object font_entity
;
3220 FRAME_PTR f
= XFRAME (frame
);
3222 if (NILP (XCDR (entities
))
3223 && ASIZE (XCAR (entities
)) == 1)
3225 font_entity
= AREF (XCAR (entities
), 0);
3227 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3232 /* Sort fonts by properties specified in ATTRS. */
3233 prefer
= scratch_font_prefer
;
3235 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3236 ASET (prefer
, i
, Qnil
);
3237 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3239 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3241 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3242 ASET (prefer
, i
, AREF (face_font
, i
));
3244 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3245 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3246 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3247 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3248 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3249 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3250 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3252 return font_sort_entities (entities
, prefer
, frame
, c
);
3255 /* Return a font-entity satisfying SPEC and best matching with face's
3256 font related attributes in ATTRS. C, if not negative, is a
3257 character that the entity must support. */
3260 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3263 Lisp_Object frame
, entities
, val
;
3264 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3268 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3269 if (NILP (registry
[0]))
3271 registry
[0] = DEFAULT_ENCODING
;
3272 registry
[1] = Qascii_0
;
3273 registry
[2] = null_vector
;
3276 registry
[1] = null_vector
;
3278 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3280 struct charset
*encoding
, *repertory
;
3282 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3283 &encoding
, &repertory
) < 0)
3286 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3288 else if (c
> encoding
->max_char
)
3292 work
= Fcopy_font_spec (spec
);
3293 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3294 XSETFRAME (frame
, f
);
3295 size
= AREF (spec
, FONT_SIZE_INDEX
);
3296 pixel_size
= font_pixel_size (f
, spec
);
3297 if (pixel_size
== 0)
3299 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3301 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3303 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3304 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3305 if (! NILP (foundry
[0]))
3306 foundry
[1] = null_vector
;
3307 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3309 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3310 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3312 foundry
[2] = null_vector
;
3315 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3317 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3318 if (! NILP (adstyle
[0]))
3319 adstyle
[1] = null_vector
;
3320 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3322 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3324 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3326 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3328 adstyle
[2] = null_vector
;
3331 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3334 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3337 val
= AREF (work
, FONT_FAMILY_INDEX
);
3338 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3340 val
= attrs
[LFACE_FAMILY_INDEX
];
3341 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3345 family
= alloca ((sizeof family
[0]) * 2);
3347 family
[1] = null_vector
; /* terminator. */
3352 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3353 /* Font family names are case-sensitive under NS. */
3361 if (! NILP (alters
))
3363 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3364 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3365 family
[i
] = XCAR (alters
);
3366 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3368 family
[i
] = null_vector
;
3372 family
= alloca ((sizeof family
[0]) * 3);
3375 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3377 family
[i
] = null_vector
;
3381 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3383 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3384 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3386 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3387 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3389 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3390 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3392 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3393 entities
= font_list_entities (frame
, work
);
3394 if (! NILP (entities
))
3396 val
= font_select_entity (frame
, entities
,
3397 attrs
, pixel_size
, c
);
3410 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3414 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3415 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3416 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3417 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3418 size
= font_pixel_size (f
, spec
);
3422 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3423 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3426 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3427 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3428 if (INTEGERP (height
))
3431 abort(); /* We should never end up here. */
3435 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3439 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3440 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3444 return font_open_entity (f
, entity
, size
);
3448 /* Find a font satisfying SPEC and best matching with face's
3449 attributes in ATTRS on FRAME, and return the opened
3453 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3455 Lisp_Object entity
, name
;
3457 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3460 /* No font is listed for SPEC, but each font-backend may have
3461 the different criteria about "font matching". So, try
3463 entity
= font_matching_entity (f
, attrs
, spec
);
3467 /* Don't loose the original name that was put in initially. We need
3468 it to re-apply the font when font parameters (like hinting or dpi) have
3470 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3473 name
= Ffont_get (spec
, QCuser_spec
);
3474 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3480 /* Make FACE on frame F ready to use the font opened for FACE. */
3483 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3485 if (face
->font
->driver
->prepare_face
)
3486 face
->font
->driver
->prepare_face (f
, face
);
3490 /* Make FACE on frame F stop using the font opened for FACE. */
3493 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3495 if (face
->font
->driver
->done_face
)
3496 face
->font
->driver
->done_face (f
, face
);
3501 /* Open a font matching with font-spec SPEC on frame F. If no proper
3502 font is found, return Qnil. */
3505 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3507 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3509 /* We set up the default font-related attributes of a face to prefer
3511 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3512 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3513 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3515 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3517 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3519 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3521 return font_load_for_lface (f
, attrs
, spec
);
3525 /* Open a font matching with NAME on frame F. If no proper font is
3526 found, return Qnil. */
3529 font_open_by_name (FRAME_PTR f
, char *name
)
3531 Lisp_Object args
[2];
3532 Lisp_Object spec
, ret
;
3535 args
[1] = make_unibyte_string (name
, strlen (name
));
3536 spec
= Ffont_spec (2, args
);
3537 ret
= font_open_by_spec (f
, spec
);
3538 /* Do not loose name originally put in. */
3540 font_put_extra (ret
, QCuser_spec
, args
[1]);
3546 /* Register font-driver DRIVER. This function is used in two ways.
3548 The first is with frame F non-NULL. In this case, make DRIVER
3549 available (but not yet activated) on F. All frame creaters
3550 (e.g. Fx_create_frame) must call this function at least once with
3551 an available font-driver.
3553 The second is with frame F NULL. In this case, DRIVER is globally
3554 registered in the variable `font_driver_list'. All font-driver
3555 implementations must call this function in its syms_of_XXXX
3556 (e.g. syms_of_xfont). */
3559 register_font_driver (struct font_driver
*driver
, FRAME_PTR f
)
3561 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3562 struct font_driver_list
*prev
, *list
;
3564 if (f
&& ! driver
->draw
)
3565 error ("Unusable font driver for a frame: %s",
3566 SDATA (SYMBOL_NAME (driver
->type
)));
3568 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3569 if (EQ (list
->driver
->type
, driver
->type
))
3570 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3572 list
= xmalloc (sizeof (struct font_driver_list
));
3574 list
->driver
= driver
;
3579 f
->font_driver_list
= list
;
3581 font_driver_list
= list
;
3587 free_font_driver_list (FRAME_PTR f
)
3589 struct font_driver_list
*list
, *next
;
3591 for (list
= f
->font_driver_list
; list
; list
= next
)
3596 f
->font_driver_list
= NULL
;
3600 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3601 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3602 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3604 A caller must free all realized faces if any in advance. The
3605 return value is a list of font backends actually made used on
3609 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3611 Lisp_Object active_drivers
= Qnil
;
3612 struct font_driver
*driver
;
3613 struct font_driver_list
*list
;
3615 /* At first, turn off non-requested drivers, and turn on requested
3617 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3619 driver
= list
->driver
;
3620 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3625 if (driver
->end_for_frame
)
3626 driver
->end_for_frame (f
);
3627 font_finish_cache (f
, driver
);
3632 if (! driver
->start_for_frame
3633 || driver
->start_for_frame (f
) == 0)
3635 font_prepare_cache (f
, driver
);
3642 if (NILP (new_drivers
))
3645 if (! EQ (new_drivers
, Qt
))
3647 /* Re-order the driver list according to new_drivers. */
3648 struct font_driver_list
**list_table
, **next
;
3652 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3653 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3655 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3656 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3659 list_table
[i
++] = list
;
3661 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3663 list_table
[i
++] = list
;
3664 list_table
[i
] = NULL
;
3666 next
= &f
->font_driver_list
;
3667 for (i
= 0; list_table
[i
]; i
++)
3669 *next
= list_table
[i
];
3670 next
= &(*next
)->next
;
3674 if (! f
->font_driver_list
->on
)
3675 { /* None of the drivers is enabled: enable them all.
3676 Happens if you set the list of drivers to (xft x) in your .emacs
3677 and then use it under w32 or ns. */
3678 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3680 struct font_driver
*driver
= list
->driver
;
3681 eassert (! list
->on
);
3682 if (! driver
->start_for_frame
3683 || driver
->start_for_frame (f
) == 0)
3685 font_prepare_cache (f
, driver
);
3692 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3694 active_drivers
= nconc2 (active_drivers
,
3695 Fcons (list
->driver
->type
, Qnil
));
3696 return active_drivers
;
3700 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3702 struct font_data_list
*list
, *prev
;
3704 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3705 prev
= list
, list
= list
->next
)
3706 if (list
->driver
== driver
)
3713 prev
->next
= list
->next
;
3715 f
->font_data_list
= list
->next
;
3723 list
= xmalloc (sizeof (struct font_data_list
));
3724 list
->driver
= driver
;
3725 list
->next
= f
->font_data_list
;
3726 f
->font_data_list
= list
;
3734 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3736 struct font_data_list
*list
;
3738 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3739 if (list
->driver
== driver
)
3747 /* Return the font used to draw character C by FACE at buffer position
3748 POS in window W. If STRING is non-nil, it is a string containing C
3749 at index POS. If C is negative, get C from the current buffer or
3753 font_at (int c
, EMACS_INT pos
, struct face
*face
, struct window
*w
, Lisp_Object string
)
3757 Lisp_Object font_object
;
3759 multibyte
= (NILP (string
)
3760 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3761 : STRING_MULTIBYTE (string
));
3768 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3770 c
= FETCH_CHAR (pos_byte
);
3773 c
= FETCH_BYTE (pos
);
3779 multibyte
= STRING_MULTIBYTE (string
);
3782 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3784 str
= SDATA (string
) + pos_byte
;
3785 c
= STRING_CHAR (str
);
3788 c
= SDATA (string
)[pos
];
3792 f
= XFRAME (w
->frame
);
3793 if (! FRAME_WINDOW_P (f
))
3800 if (STRINGP (string
))
3801 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3802 DEFAULT_FACE_ID
, 0);
3804 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3806 face
= FACE_FROM_ID (f
, face_id
);
3810 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3811 face
= FACE_FROM_ID (f
, face_id
);
3816 XSETFONT (font_object
, face
->font
);
3821 #ifdef HAVE_WINDOW_SYSTEM
3823 /* Check how many characters after POS (at most to *LIMIT) can be
3824 displayed by the same font on the window W. FACE, if non-NULL, is
3825 the face selected for the character at POS. If STRING is not nil,
3826 it is the string to check instead of the current buffer. In that
3827 case, FACE must be not NULL.
3829 The return value is the font-object for the character at POS.
3830 *LIMIT is set to the position where that font can't be used.
3832 It is assured that the current buffer (or STRING) is multibyte. */
3835 font_range (EMACS_INT pos
, EMACS_INT
*limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3837 EMACS_INT pos_byte
, ignore
;
3839 Lisp_Object font_object
= Qnil
;
3843 pos_byte
= CHAR_TO_BYTE (pos
);
3848 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3850 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3856 pos_byte
= string_char_to_byte (string
, pos
);
3859 while (pos
< *limit
)
3861 Lisp_Object category
;
3864 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3866 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3867 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3868 if (EQ (category
, QCf
)
3869 || CHAR_VARIATION_SELECTOR_P (c
))
3871 if (NILP (font_object
))
3873 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3874 if (NILP (font_object
))
3878 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3888 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3889 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3890 Return nil otherwise.
3891 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3892 which kind of font it is. It must be one of `font-spec', `font-entity',
3894 (Lisp_Object object
, Lisp_Object extra_type
)
3896 if (NILP (extra_type
))
3897 return (FONTP (object
) ? Qt
: Qnil
);
3898 if (EQ (extra_type
, Qfont_spec
))
3899 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3900 if (EQ (extra_type
, Qfont_entity
))
3901 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3902 if (EQ (extra_type
, Qfont_object
))
3903 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3904 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3907 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3908 doc
: /* Return a newly created font-spec with arguments as properties.
3910 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3911 valid font property name listed below:
3913 `:family', `:weight', `:slant', `:width'
3915 They are the same as face attributes of the same name. See
3916 `set-face-attribute'.
3920 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3924 VALUE must be a string or a symbol specifying the additional
3925 typographic style information of a font, e.g. ``sans''.
3929 VALUE must be a string or a symbol specifying the charset registry and
3930 encoding of a font, e.g. ``iso8859-1''.
3934 VALUE must be a non-negative integer or a floating point number
3935 specifying the font size. It specifies the font size in pixels (if
3936 VALUE is an integer), or in points (if VALUE is a float).
3940 VALUE must be a string of XLFD-style or fontconfig-style font name.
3944 VALUE must be a symbol representing a script that the font must
3945 support. It may be a symbol representing a subgroup of a script
3946 listed in the variable `script-representative-chars'.
3950 VALUE must be a symbol of two-letter ISO-639 language names,
3955 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3956 required OpenType features.
3958 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3959 LANGSYS-TAG: OpenType language system tag symbol,
3960 or nil for the default language system.
3961 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3962 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3964 GSUB and GPOS may contain `nil' element. In such a case, the font
3965 must not have any of the remaining elements.
3967 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3968 be an OpenType font, and whose GPOS table of `thai' script's default
3969 language system must contain `mark' feature.
3971 usage: (font-spec ARGS...) */)
3972 (int nargs
, Lisp_Object
*args
)
3974 Lisp_Object spec
= font_make_spec ();
3977 for (i
= 0; i
< nargs
; i
+= 2)
3979 Lisp_Object key
= args
[i
], val
;
3983 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3986 if (EQ (key
, QCname
))
3989 font_parse_name ((char *) SDATA (val
), spec
);
3990 font_put_extra (spec
, key
, val
);
3994 int idx
= get_font_prop_index (key
);
3998 val
= font_prop_validate (idx
, Qnil
, val
);
3999 if (idx
< FONT_EXTRA_INDEX
)
4000 ASET (spec
, idx
, val
);
4002 font_put_extra (spec
, key
, val
);
4005 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
4011 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
4012 doc
: /* Return a copy of FONT as a font-spec. */)
4015 Lisp_Object new_spec
, tail
, prev
, extra
;
4019 new_spec
= font_make_spec ();
4020 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
4021 ASET (new_spec
, i
, AREF (font
, i
));
4022 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
4023 /* We must remove :font-entity property. */
4024 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
4025 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
4028 extra
= XCDR (extra
);
4030 XSETCDR (prev
, XCDR (tail
));
4033 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
4037 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
4038 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
4039 Every specified properties in FROM override the corresponding
4040 properties in TO. */)
4041 (Lisp_Object from
, Lisp_Object to
)
4043 Lisp_Object extra
, tail
;
4048 to
= Fcopy_font_spec (to
);
4049 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
4050 ASET (to
, i
, AREF (from
, i
));
4051 extra
= AREF (to
, FONT_EXTRA_INDEX
);
4052 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
4053 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
4055 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
4058 XSETCDR (slot
, XCDR (XCAR (tail
)));
4060 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
4062 ASET (to
, FONT_EXTRA_INDEX
, extra
);
4066 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
4067 doc
: /* Return the value of FONT's property KEY.
4068 FONT is a font-spec, a font-entity, or a font-object.
4069 KEY is any symbol, but these are reserved for specific meanings:
4070 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4071 :size, :name, :script, :otf
4072 See the documentation of `font-spec' for their meanings.
4073 In addition, if FONT is a font-entity or a font-object, values of
4074 :script and :otf are different from those of a font-spec as below:
4076 The value of :script may be a list of scripts that are supported by the font.
4078 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
4079 representing the OpenType features supported by the font by this form:
4080 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4081 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
4083 (Lisp_Object font
, Lisp_Object key
)
4091 idx
= get_font_prop_index (key
);
4092 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4093 return font_style_symbolic (font
, idx
, 0);
4094 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4095 return AREF (font
, idx
);
4096 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
4097 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
4099 struct font
*fontp
= XFONT_OBJECT (font
);
4101 if (fontp
->driver
->otf_capability
)
4102 val
= fontp
->driver
->otf_capability (fontp
);
4104 val
= Fcons (Qnil
, Qnil
);
4105 font_put_extra (font
, QCotf
, val
);
4112 #ifdef HAVE_WINDOW_SYSTEM
4114 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4115 doc
: /* Return a plist of face attributes generated by FONT.
4116 FONT is a font name, a font-spec, a font-entity, or a font-object.
4117 The return value is a list of the form
4119 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4121 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4122 compatible with `set-face-attribute'. Some of these key-attribute pairs
4123 may be omitted from the list if they are not specified by FONT.
4125 The optional argument FRAME specifies the frame that the face attributes
4126 are to be displayed on. If omitted, the selected frame is used. */)
4127 (Lisp_Object font
, Lisp_Object frame
)
4130 Lisp_Object plist
[10];
4135 frame
= selected_frame
;
4136 CHECK_LIVE_FRAME (frame
);
4141 int fontset
= fs_query_fontset (font
, 0);
4142 Lisp_Object name
= font
;
4144 font
= fontset_ascii (fontset
);
4145 font
= font_spec_from_name (name
);
4147 signal_error ("Invalid font name", name
);
4149 else if (! FONTP (font
))
4150 signal_error ("Invalid font object", font
);
4152 val
= AREF (font
, FONT_FAMILY_INDEX
);
4155 plist
[n
++] = QCfamily
;
4156 plist
[n
++] = SYMBOL_NAME (val
);
4159 val
= AREF (font
, FONT_SIZE_INDEX
);
4162 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4163 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4164 plist
[n
++] = QCheight
;
4165 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4167 else if (FLOATP (val
))
4169 plist
[n
++] = QCheight
;
4170 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4173 val
= FONT_WEIGHT_FOR_FACE (font
);
4176 plist
[n
++] = QCweight
;
4180 val
= FONT_SLANT_FOR_FACE (font
);
4183 plist
[n
++] = QCslant
;
4187 val
= FONT_WIDTH_FOR_FACE (font
);
4190 plist
[n
++] = QCwidth
;
4194 return Flist (n
, plist
);
4199 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4200 doc
: /* Set one property of FONT: give property KEY value VAL.
4201 FONT is a font-spec, a font-entity, or a font-object.
4203 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4204 accepted by the function `font-spec' (which see), VAL must be what
4205 allowed in `font-spec'.
4207 If FONT is a font-entity or a font-object, KEY must not be the one
4208 accepted by `font-spec'. */)
4209 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4213 idx
= get_font_prop_index (prop
);
4214 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4216 CHECK_FONT_SPEC (font
);
4217 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4221 if (EQ (prop
, QCname
)
4222 || EQ (prop
, QCscript
)
4223 || EQ (prop
, QClang
)
4224 || EQ (prop
, QCotf
))
4225 CHECK_FONT_SPEC (font
);
4228 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4233 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4234 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4235 Optional 2nd argument FRAME specifies the target frame.
4236 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4237 Optional 4th argument PREFER, if non-nil, is a font-spec to
4238 control the order of the returned list. Fonts are sorted by
4239 how close they are to PREFER. */)
4240 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4242 Lisp_Object vec
, list
;
4246 frame
= selected_frame
;
4247 CHECK_LIVE_FRAME (frame
);
4248 CHECK_FONT_SPEC (font_spec
);
4256 if (! NILP (prefer
))
4257 CHECK_FONT_SPEC (prefer
);
4259 list
= font_list_entities (frame
, font_spec
);
4262 if (NILP (XCDR (list
))
4263 && ASIZE (XCAR (list
)) == 1)
4264 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4266 if (! NILP (prefer
))
4267 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4269 vec
= font_vconcat_entity_vectors (list
);
4270 if (n
== 0 || n
>= ASIZE (vec
))
4272 Lisp_Object args
[2];
4276 list
= Fappend (2, args
);
4280 for (list
= Qnil
, n
--; n
>= 0; n
--)
4281 list
= Fcons (AREF (vec
, n
), list
);
4286 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4287 doc
: /* List available font families on the current frame.
4288 Optional argument FRAME, if non-nil, specifies the target frame. */)
4292 struct font_driver_list
*driver_list
;
4296 frame
= selected_frame
;
4297 CHECK_LIVE_FRAME (frame
);
4300 for (driver_list
= f
->font_driver_list
; driver_list
;
4301 driver_list
= driver_list
->next
)
4302 if (driver_list
->driver
->list_family
)
4304 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4305 Lisp_Object tail
= list
;
4307 for (; CONSP (val
); val
= XCDR (val
))
4308 if (NILP (Fmemq (XCAR (val
), tail
))
4309 && SYMBOLP (XCAR (val
)))
4310 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4315 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4316 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4317 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4318 (Lisp_Object font_spec
, Lisp_Object frame
)
4320 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4327 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4328 doc
: /* Return XLFD name of FONT.
4329 FONT is a font-spec, font-entity, or font-object.
4330 If the name is too long for XLFD (maximum 255 chars), return nil.
4331 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4332 the consecutive wildcards are folded to one. */)
4333 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4340 if (FONT_OBJECT_P (font
))
4342 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4344 if (STRINGP (font_name
)
4345 && SDATA (font_name
)[0] == '-')
4347 if (NILP (fold_wildcards
))
4349 strcpy (name
, (char *) SDATA (font_name
));
4352 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4354 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4357 if (! NILP (fold_wildcards
))
4359 char *p0
= name
, *p1
;
4361 while ((p1
= strstr (p0
, "-*-*")))
4363 strcpy (p1
, p1
+ 2);
4368 return build_string (name
);
4371 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4372 doc
: /* Clear font cache. */)
4375 Lisp_Object list
, frame
;
4377 FOR_EACH_FRAME (list
, frame
)
4379 FRAME_PTR f
= XFRAME (frame
);
4380 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4382 for (; driver_list
; driver_list
= driver_list
->next
)
4383 if (driver_list
->on
)
4385 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4386 Lisp_Object val
, tmp
;
4390 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4392 font_assert (! NILP (val
));
4393 tmp
= XCDR (XCAR (val
));
4394 if (XINT (XCAR (tmp
)) == 0)
4396 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4397 XSETCDR (cache
, XCDR (val
));
4407 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4409 struct font
*font
= XFONT_OBJECT (font_object
);
4411 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4412 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4413 struct font_metrics metrics
;
4415 LGLYPH_SET_CODE (glyph
, ecode
);
4417 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4418 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4419 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4420 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4421 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4422 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4426 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4427 doc
: /* Shape the glyph-string GSTRING.
4428 Shaping means substituting glyphs and/or adjusting positions of glyphs
4429 to get the correct visual image of character sequences set in the
4430 header of the glyph-string.
4432 If the shaping was successful, the value is GSTRING itself or a newly
4433 created glyph-string. Otherwise, the value is nil. */)
4434 (Lisp_Object gstring
)
4437 Lisp_Object font_object
, n
, glyph
;
4440 if (! composition_gstring_p (gstring
))
4441 signal_error ("Invalid glyph-string: ", gstring
);
4442 if (! NILP (LGSTRING_ID (gstring
)))
4444 font_object
= LGSTRING_FONT (gstring
);
4445 CHECK_FONT_OBJECT (font_object
);
4446 font
= XFONT_OBJECT (font_object
);
4447 if (! font
->driver
->shape
)
4450 /* Try at most three times with larger gstring each time. */
4451 for (i
= 0; i
< 3; i
++)
4453 n
= font
->driver
->shape (gstring
);
4456 gstring
= larger_vector (gstring
,
4457 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4460 if (i
== 3 || XINT (n
) == 0)
4462 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4463 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4465 glyph
= LGSTRING_GLYPH (gstring
, 0);
4466 from
= LGLYPH_FROM (glyph
);
4467 to
= LGLYPH_TO (glyph
);
4468 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4470 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4474 if (NILP (LGLYPH_ADJUSTMENT (this)))
4479 glyph
= LGSTRING_GLYPH (gstring
, j
);
4480 LGLYPH_SET_FROM (glyph
, from
);
4481 LGLYPH_SET_TO (glyph
, to
);
4483 from
= LGLYPH_FROM (this);
4484 to
= LGLYPH_TO (this);
4489 if (from
> LGLYPH_FROM (this))
4490 from
= LGLYPH_FROM (this);
4491 if (to
< LGLYPH_TO (this))
4492 to
= LGLYPH_TO (this);
4498 glyph
= LGSTRING_GLYPH (gstring
, j
);
4499 LGLYPH_SET_FROM (glyph
, from
);
4500 LGLYPH_SET_TO (glyph
, to
);
4502 return composition_gstring_put_cache (gstring
, XINT (n
));
4505 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4507 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4508 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4510 VARIATION-SELECTOR is a chracter code of variation selection
4511 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4512 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4513 (Lisp_Object font_object
, Lisp_Object character
)
4515 unsigned variations
[256];
4520 CHECK_FONT_OBJECT (font_object
);
4521 CHECK_CHARACTER (character
);
4522 font
= XFONT_OBJECT (font_object
);
4523 if (! font
->driver
->get_variation_glyphs
)
4525 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4529 for (i
= 0; i
< 255; i
++)
4533 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4534 /* Stops GCC whining about limited range of data type. */
4535 EMACS_INT var
= variations
[i
];
4537 if (var
> MOST_POSITIVE_FIXNUM
)
4538 code
= Fcons (make_number ((variations
[i
]) >> 16),
4539 make_number ((variations
[i
]) & 0xFFFF));
4541 code
= make_number (variations
[i
]);
4542 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4549 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4550 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4551 OTF-FEATURES specifies which features to apply in this format:
4552 (SCRIPT LANGSYS GSUB GPOS)
4554 SCRIPT is a symbol specifying a script tag of OpenType,
4555 LANGSYS is a symbol specifying a langsys tag of OpenType,
4556 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4558 If LANGYS is nil, the default langsys is selected.
4560 The features are applied in the order they appear in the list. The
4561 symbol `*' means to apply all available features not present in this
4562 list, and the remaining features are ignored. For instance, (vatu
4563 pstf * haln) is to apply vatu and pstf in this order, then to apply
4564 all available features other than vatu, pstf, and haln.
4566 The features are applied to the glyphs in the range FROM and TO of
4567 the glyph-string GSTRING-IN.
4569 If some feature is actually applicable, the resulting glyphs are
4570 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4571 this case, the value is the number of produced glyphs.
4573 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4576 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4577 produced in GSTRING-OUT, and the value is nil.
4579 See the documentation of `font-make-gstring' for the format of
4581 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4583 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4588 check_otf_features (otf_features
);
4589 CHECK_FONT_OBJECT (font_object
);
4590 font
= XFONT_OBJECT (font_object
);
4591 if (! font
->driver
->otf_drive
)
4592 error ("Font backend %s can't drive OpenType GSUB table",
4593 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4594 CHECK_CONS (otf_features
);
4595 CHECK_SYMBOL (XCAR (otf_features
));
4596 val
= XCDR (otf_features
);
4597 CHECK_SYMBOL (XCAR (val
));
4598 val
= XCDR (otf_features
);
4601 len
= check_gstring (gstring_in
);
4602 CHECK_VECTOR (gstring_out
);
4603 CHECK_NATNUM (from
);
4605 CHECK_NATNUM (index
);
4607 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4608 args_out_of_range_3 (from
, to
, make_number (len
));
4609 if (XINT (index
) >= ASIZE (gstring_out
))
4610 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4611 num
= font
->driver
->otf_drive (font
, otf_features
,
4612 gstring_in
, XINT (from
), XINT (to
),
4613 gstring_out
, XINT (index
), 0);
4616 return make_number (num
);
4619 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4621 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4622 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4624 (SCRIPT LANGSYS FEATURE ...)
4625 See the documentation of `font-drive-otf' for more detail.
4627 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4628 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4629 character code corresponding to the glyph or nil if there's no
4630 corresponding character. */)
4631 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4634 Lisp_Object gstring_in
, gstring_out
, g
;
4635 Lisp_Object alternates
;
4638 CHECK_FONT_GET_OBJECT (font_object
, font
);
4639 if (! font
->driver
->otf_drive
)
4640 error ("Font backend %s can't drive OpenType GSUB table",
4641 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4642 CHECK_CHARACTER (character
);
4643 CHECK_CONS (otf_features
);
4645 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4646 g
= LGSTRING_GLYPH (gstring_in
, 0);
4647 LGLYPH_SET_CHAR (g
, XINT (character
));
4648 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4649 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4650 gstring_out
, 0, 1)) < 0)
4651 gstring_out
= Ffont_make_gstring (font_object
,
4652 make_number (ASIZE (gstring_out
) * 2));
4654 for (i
= 0; i
< num
; i
++)
4656 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4657 int c
= LGLYPH_CHAR (g
);
4658 unsigned code
= LGLYPH_CODE (g
);
4660 alternates
= Fcons (Fcons (make_number (code
),
4661 c
> 0 ? make_number (c
) : Qnil
),
4664 return Fnreverse (alternates
);
4670 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4671 doc
: /* Open FONT-ENTITY. */)
4672 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4676 CHECK_FONT_ENTITY (font_entity
);
4678 frame
= selected_frame
;
4679 CHECK_LIVE_FRAME (frame
);
4682 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4685 CHECK_NUMBER_OR_FLOAT (size
);
4687 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4689 isize
= XINT (size
);
4693 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4696 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4697 doc
: /* Close FONT-OBJECT. */)
4698 (Lisp_Object font_object
, Lisp_Object frame
)
4700 CHECK_FONT_OBJECT (font_object
);
4702 frame
= selected_frame
;
4703 CHECK_LIVE_FRAME (frame
);
4704 font_close_object (XFRAME (frame
), font_object
);
4708 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4709 doc
: /* Return information about FONT-OBJECT.
4710 The value is a vector:
4711 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4714 NAME is a string of the font name (or nil if the font backend doesn't
4717 FILENAME is a string of the font file (or nil if the font backend
4718 doesn't provide a file name).
4720 PIXEL-SIZE is a pixel size by which the font is opened.
4722 SIZE is a maximum advance width of the font in pixels.
4724 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4727 CAPABILITY is a list whose first element is a symbol representing the
4728 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4729 remaining elements describe the details of the font capability.
4731 If the font is OpenType font, the form of the list is
4732 \(opentype GSUB GPOS)
4733 where GSUB shows which "GSUB" features the font supports, and GPOS
4734 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4735 lists of the format:
4736 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4738 If the font is not OpenType font, currently the length of the form is
4741 SCRIPT is a symbol representing OpenType script tag.
4743 LANGSYS is a symbol representing OpenType langsys tag, or nil
4744 representing the default langsys.
4746 FEATURE is a symbol representing OpenType feature tag.
4748 If the font is not OpenType font, CAPABILITY is nil. */)
4749 (Lisp_Object font_object
)
4754 CHECK_FONT_GET_OBJECT (font_object
, font
);
4756 val
= Fmake_vector (make_number (9), Qnil
);
4757 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4758 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4759 ASET (val
, 2, make_number (font
->pixel_size
));
4760 ASET (val
, 3, make_number (font
->max_width
));
4761 ASET (val
, 4, make_number (font
->ascent
));
4762 ASET (val
, 5, make_number (font
->descent
));
4763 ASET (val
, 6, make_number (font
->space_width
));
4764 ASET (val
, 7, make_number (font
->average_width
));
4765 if (font
->driver
->otf_capability
)
4766 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4770 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4772 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4773 FROM and TO are positions (integers or markers) specifying a region
4774 of the current buffer.
4775 If the optional fourth arg OBJECT is not nil, it is a string or a
4776 vector containing the target characters.
4778 Each element is a vector containing information of a glyph in this format:
4779 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4781 FROM is an index numbers of a character the glyph corresponds to.
4782 TO is the same as FROM.
4783 C is the character of the glyph.
4784 CODE is the glyph-code of C in FONT-OBJECT.
4785 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4786 ADJUSTMENT is always nil.
4787 If FONT-OBJECT doesn't have a glyph for a character,
4788 the corresponding element is nil. */)
4789 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4794 Lisp_Object
*chars
, vec
;
4797 CHECK_FONT_GET_OBJECT (font_object
, font
);
4800 EMACS_INT charpos
, bytepos
;
4802 validate_region (&from
, &to
);
4805 len
= XFASTINT (to
) - XFASTINT (from
);
4806 SAFE_ALLOCA_LISP (chars
, len
);
4807 charpos
= XFASTINT (from
);
4808 bytepos
= CHAR_TO_BYTE (charpos
);
4809 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4811 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4812 chars
[i
] = make_number (c
);
4815 else if (STRINGP (object
))
4817 const unsigned char *p
;
4819 CHECK_NUMBER (from
);
4821 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4822 || XINT (to
) > SCHARS (object
))
4823 args_out_of_range_3 (object
, from
, to
);
4826 len
= XFASTINT (to
) - XFASTINT (from
);
4827 SAFE_ALLOCA_LISP (chars
, len
);
4829 if (STRING_MULTIBYTE (object
))
4830 for (i
= 0; i
< len
; i
++)
4832 c
= STRING_CHAR_ADVANCE (p
);
4833 chars
[i
] = make_number (c
);
4836 for (i
= 0; i
< len
; i
++)
4837 chars
[i
] = make_number (p
[i
]);
4841 CHECK_VECTOR (object
);
4842 CHECK_NUMBER (from
);
4844 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4845 || XINT (to
) > ASIZE (object
))
4846 args_out_of_range_3 (object
, from
, to
);
4849 len
= XFASTINT (to
) - XFASTINT (from
);
4850 for (i
= 0; i
< len
; i
++)
4852 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4853 CHECK_CHARACTER (elt
);
4855 chars
= &(AREF (object
, XFASTINT (from
)));
4858 vec
= Fmake_vector (make_number (len
), Qnil
);
4859 for (i
= 0; i
< len
; i
++)
4862 int c
= XFASTINT (chars
[i
]);
4865 struct font_metrics metrics
;
4867 cod
= code
= font
->driver
->encode_char (font
, c
);
4868 if (code
== FONT_INVALID_CODE
)
4870 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4871 LGLYPH_SET_FROM (g
, i
);
4872 LGLYPH_SET_TO (g
, i
);
4873 LGLYPH_SET_CHAR (g
, c
);
4874 LGLYPH_SET_CODE (g
, code
);
4875 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4876 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4877 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4878 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4879 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4880 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4883 if (! VECTORP (object
))
4888 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4889 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4890 FONT is a font-spec, font-entity, or font-object. */)
4891 (Lisp_Object spec
, Lisp_Object font
)
4893 CHECK_FONT_SPEC (spec
);
4896 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4899 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4900 doc
: /* Return a font-object for displaying a character at POSITION.
4901 Optional second arg WINDOW, if non-nil, is a window displaying
4902 the current buffer. It defaults to the currently selected window. */)
4903 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4910 CHECK_NUMBER_COERCE_MARKER (position
);
4911 pos
= XINT (position
);
4912 if (pos
< BEGV
|| pos
>= ZV
)
4913 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4917 CHECK_NUMBER (position
);
4918 CHECK_STRING (string
);
4919 pos
= XINT (position
);
4920 if (pos
< 0 || pos
>= SCHARS (string
))
4921 args_out_of_range (string
, position
);
4924 window
= selected_window
;
4925 CHECK_LIVE_WINDOW (window
);
4926 w
= XWINDOW (window
);
4928 return font_at (-1, pos
, NULL
, w
, string
);
4932 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4933 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4934 The value is a number of glyphs drawn.
4935 Type C-l to recover what previously shown. */)
4936 (Lisp_Object font_object
, Lisp_Object string
)
4938 Lisp_Object frame
= selected_frame
;
4939 FRAME_PTR f
= XFRAME (frame
);
4945 CHECK_FONT_GET_OBJECT (font_object
, font
);
4946 CHECK_STRING (string
);
4947 len
= SCHARS (string
);
4948 code
= alloca (sizeof (unsigned) * len
);
4949 for (i
= 0; i
< len
; i
++)
4951 Lisp_Object ch
= Faref (string
, make_number (i
));
4955 code
[i
] = font
->driver
->encode_char (font
, c
);
4956 if (code
[i
] == FONT_INVALID_CODE
)
4959 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4961 if (font
->driver
->prepare_face
)
4962 font
->driver
->prepare_face (f
, face
);
4963 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4964 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4965 if (font
->driver
->done_face
)
4966 font
->driver
->done_face (f
, face
);
4968 return make_number (len
);
4972 #endif /* FONT_DEBUG */
4974 #ifdef HAVE_WINDOW_SYSTEM
4976 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4977 doc
: /* Return information about a font named NAME on frame FRAME.
4978 If FRAME is omitted or nil, use the selected frame.
4979 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4980 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4982 OPENED-NAME is the name used for opening the font,
4983 FULL-NAME is the full name of the font,
4984 SIZE is the pixelsize of the font,
4985 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4986 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4987 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4988 how to compose characters.
4989 If the named font is not yet loaded, return nil. */)
4990 (Lisp_Object name
, Lisp_Object frame
)
4995 Lisp_Object font_object
;
4997 (*check_window_system_func
) ();
5000 CHECK_STRING (name
);
5002 frame
= selected_frame
;
5003 CHECK_LIVE_FRAME (frame
);
5008 int fontset
= fs_query_fontset (name
, 0);
5011 name
= fontset_ascii (fontset
);
5012 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
5014 else if (FONT_OBJECT_P (name
))
5016 else if (FONT_ENTITY_P (name
))
5017 font_object
= font_open_entity (f
, name
, 0);
5020 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5021 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
5023 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
5025 if (NILP (font_object
))
5027 font
= XFONT_OBJECT (font_object
);
5029 info
= Fmake_vector (make_number (7), Qnil
);
5030 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
5031 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
5032 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
5033 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
5034 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
5035 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
5036 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
5039 /* As font_object is still in FONT_OBJLIST of the entity, we can't
5040 close it now. Perhaps, we should manage font-objects
5041 by `reference-count'. */
5042 font_close_object (f
, font_object
);
5049 #define BUILD_STYLE_TABLE(TBL) \
5050 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
5053 build_style_table (const struct table_entry
*entry
, int nelement
)
5056 Lisp_Object table
, elt
;
5058 table
= Fmake_vector (make_number (nelement
), Qnil
);
5059 for (i
= 0; i
< nelement
; i
++)
5061 for (j
= 0; entry
[i
].names
[j
]; j
++);
5062 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
5063 ASET (elt
, 0, make_number (entry
[i
].numeric
));
5064 for (j
= 0; entry
[i
].names
[j
]; j
++)
5065 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
5066 ASET (table
, i
, elt
);
5071 Lisp_Object Vfont_log
;
5073 /* The deferred font-log data of the form [ACTION ARG RESULT].
5074 If ACTION is not nil, that is added to the log when font_add_log is
5075 called next time. At that time, ACTION is set back to nil. */
5076 static Lisp_Object Vfont_log_deferred
;
5078 /* Prepend the font-related logging data in Vfont_log if it is not
5079 `t'. ACTION describes a kind of font-related action (e.g. listing,
5080 opening), ARG is the argument for the action, and RESULT is the
5081 result of the action. */
5083 font_add_log (char *action
, Lisp_Object arg
, Lisp_Object result
)
5085 Lisp_Object tail
, val
;
5088 if (EQ (Vfont_log
, Qt
))
5090 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5092 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
5094 ASET (Vfont_log_deferred
, 0, Qnil
);
5095 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5096 AREF (Vfont_log_deferred
, 2));
5101 Lisp_Object tail
, elt
;
5102 Lisp_Object equalstr
= build_string ("=");
5104 val
= Ffont_xlfd_name (arg
, Qt
);
5105 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5109 if (EQ (XCAR (elt
), QCscript
)
5110 && SYMBOLP (XCDR (elt
)))
5111 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5112 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5113 else if (EQ (XCAR (elt
), QClang
)
5114 && SYMBOLP (XCDR (elt
)))
5115 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5116 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5117 else if (EQ (XCAR (elt
), QCotf
)
5118 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5119 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5121 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5127 && VECTORP (XCAR (result
))
5128 && ASIZE (XCAR (result
)) > 0
5129 && FONTP (AREF (XCAR (result
), 0)))
5130 result
= font_vconcat_entity_vectors (result
);
5133 val
= Ffont_xlfd_name (result
, Qt
);
5134 if (! FONT_SPEC_P (result
))
5135 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5136 build_string (":"), val
);
5139 else if (CONSP (result
))
5141 result
= Fcopy_sequence (result
);
5142 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5146 val
= Ffont_xlfd_name (val
, Qt
);
5147 XSETCAR (tail
, val
);
5150 else if (VECTORP (result
))
5152 result
= Fcopy_sequence (result
);
5153 for (i
= 0; i
< ASIZE (result
); i
++)
5155 val
= AREF (result
, i
);
5157 val
= Ffont_xlfd_name (val
, Qt
);
5158 ASET (result
, i
, val
);
5161 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5164 /* Record a font-related logging data to be added to Vfont_log when
5165 font_add_log is called next time. ACTION, ARG, RESULT are the same
5169 font_deferred_log (char *action
, Lisp_Object arg
, Lisp_Object result
)
5171 if (EQ (Vfont_log
, Qt
))
5173 ASET (Vfont_log_deferred
, 0, build_string (action
));
5174 ASET (Vfont_log_deferred
, 1, arg
);
5175 ASET (Vfont_log_deferred
, 2, result
);
5178 extern void syms_of_ftfont (void);
5179 extern void syms_of_xfont (void);
5180 extern void syms_of_xftfont (void);
5181 extern void syms_of_ftxfont (void);
5182 extern void syms_of_bdffont (void);
5183 extern void syms_of_w32font (void);
5184 extern void syms_of_atmfont (void);
5185 extern void syms_of_nsfont (void);
5190 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5191 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5192 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5193 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5194 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5195 /* Note that the other elements in sort_shift_bits are not used. */
5197 staticpro (&font_charset_alist
);
5198 font_charset_alist
= Qnil
;
5200 DEFSYM (Qopentype
, "opentype");
5202 DEFSYM (Qascii_0
, "ascii-0");
5203 DEFSYM (Qiso8859_1
, "iso8859-1");
5204 DEFSYM (Qiso10646_1
, "iso10646-1");
5205 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5206 DEFSYM (Qunicode_sip
, "unicode-sip");
5210 DEFSYM (QCotf
, ":otf");
5211 DEFSYM (QClang
, ":lang");
5212 DEFSYM (QCscript
, ":script");
5213 DEFSYM (QCantialias
, ":antialias");
5215 DEFSYM (QCfoundry
, ":foundry");
5216 DEFSYM (QCadstyle
, ":adstyle");
5217 DEFSYM (QCregistry
, ":registry");
5218 DEFSYM (QCspacing
, ":spacing");
5219 DEFSYM (QCdpi
, ":dpi");
5220 DEFSYM (QCscalable
, ":scalable");
5221 DEFSYM (QCavgwidth
, ":avgwidth");
5222 DEFSYM (QCfont_entity
, ":font-entity");
5223 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5233 DEFSYM (QCuser_spec
, "user-spec");
5235 staticpro (&null_vector
);
5236 null_vector
= Fmake_vector (make_number (0), Qnil
);
5238 staticpro (&scratch_font_spec
);
5239 scratch_font_spec
= Ffont_spec (0, NULL
);
5240 staticpro (&scratch_font_prefer
);
5241 scratch_font_prefer
= Ffont_spec (0, NULL
);
5243 staticpro (&Vfont_log_deferred
);
5244 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5248 staticpro (&otf_list
);
5250 #endif /* HAVE_LIBOTF */
5254 defsubr (&Sfont_spec
);
5255 defsubr (&Sfont_get
);
5256 #ifdef HAVE_WINDOW_SYSTEM
5257 defsubr (&Sfont_face_attributes
);
5259 defsubr (&Sfont_put
);
5260 defsubr (&Slist_fonts
);
5261 defsubr (&Sfont_family_list
);
5262 defsubr (&Sfind_font
);
5263 defsubr (&Sfont_xlfd_name
);
5264 defsubr (&Sclear_font_cache
);
5265 defsubr (&Sfont_shape_gstring
);
5266 defsubr (&Sfont_variation_glyphs
);
5268 defsubr (&Sfont_drive_otf
);
5269 defsubr (&Sfont_otf_alternates
);
5273 defsubr (&Sopen_font
);
5274 defsubr (&Sclose_font
);
5275 defsubr (&Squery_font
);
5276 defsubr (&Sfont_get_glyphs
);
5277 defsubr (&Sfont_match_p
);
5278 defsubr (&Sfont_at
);
5280 defsubr (&Sdraw_string
);
5282 #endif /* FONT_DEBUG */
5283 #ifdef HAVE_WINDOW_SYSTEM
5284 defsubr (&Sfont_info
);
5287 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5289 Alist of fontname patterns vs the corresponding encoding and repertory info.
5290 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5291 where ENCODING is a charset or a char-table,
5292 and REPERTORY is a charset, a char-table, or nil.
5294 If ENCODING and REPERTORY are the same, the element can have the form
5295 \(REGEXP . ENCODING).
5297 ENCODING is for converting a character to a glyph code of the font.
5298 If ENCODING is a charset, encoding a character by the charset gives
5299 the corresponding glyph code. If ENCODING is a char-table, looking up
5300 the table by a character gives the corresponding glyph code.
5302 REPERTORY specifies a repertory of characters supported by the font.
5303 If REPERTORY is a charset, all characters beloging to the charset are
5304 supported. If REPERTORY is a char-table, all characters who have a
5305 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5306 gets the repertory information by an opened font and ENCODING. */);
5307 Vfont_encoding_alist
= Qnil
;
5309 /* FIXME: These 3 vars are not quite what they appear: setq on them
5310 won't have any effect other than disconnect them from the style
5311 table used by the font display code. So we make them read-only,
5312 to avoid this confusing situation. */
5314 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5315 doc
: /* Vector of valid font weight values.
5316 Each element has the form:
5317 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5318 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5319 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5320 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5322 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5323 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5324 See `font-weight-table' for the format of the vector. */);
5325 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5326 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5328 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5329 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5330 See `font-weight-table' for the format of the vector. */);
5331 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5332 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5334 staticpro (&font_style_table
);
5335 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5336 ASET (font_style_table
, 0, Vfont_weight_table
);
5337 ASET (font_style_table
, 1, Vfont_slant_table
);
5338 ASET (font_style_table
, 2, Vfont_width_table
);
5340 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5341 *Logging list of font related actions and results.
5342 The value t means to suppress the logging.
5343 The initial value is set to nil if the environment variable
5344 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5347 #ifdef HAVE_WINDOW_SYSTEM
5348 #ifdef HAVE_FREETYPE
5350 #ifdef HAVE_X_WINDOWS
5355 #endif /* HAVE_XFT */
5356 #endif /* HAVE_X_WINDOWS */
5357 #else /* not HAVE_FREETYPE */
5358 #ifdef HAVE_X_WINDOWS
5360 #endif /* HAVE_X_WINDOWS */
5361 #endif /* not HAVE_FREETYPE */
5364 #endif /* HAVE_BDFFONT */
5367 #endif /* WINDOWSNT */
5370 #endif /* HAVE_NS */
5371 #endif /* HAVE_WINDOW_SYSTEM */
5377 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
5380 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5381 (do not change this comment) */