1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
3 Copyright (C) 2006, 2007, 2008, 2009
4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H13PRO009
7 This file is part of GNU Emacs.
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
31 #include "dispextern.h"
33 #include "character.h"
34 #include "composite.h"
40 #endif /* HAVE_X_WINDOWS */
44 #endif /* HAVE_NTGUI */
51 extern Lisp_Object Qfontsize
;
54 Lisp_Object Qopentype
;
56 /* Important character set strings. */
57 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
60 #define DEFAULT_ENCODING Qiso10646_1
62 #define DEFAULT_ENCODING Qiso8859_1
65 /* Unicode category `Cf'. */
66 static Lisp_Object QCf
;
68 /* Special vector of zero length. This is repeatedly used by (struct
69 font_driver *)->list when a specified font is not found. */
70 static Lisp_Object null_vector
;
72 static Lisp_Object Vfont_weight_table
, Vfont_slant_table
, Vfont_width_table
;
74 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
75 static Lisp_Object font_style_table
;
77 /* Structure used for tables mapping weight, slant, and width numeric
78 values and their names. */
83 /* The first one is a valid name as a face attribute.
84 The second one (if any) is a typical name in XLFD field. */
89 /* Table of weight numeric values and their names. This table must be
90 sorted by numeric values in ascending order. */
92 static struct table_entry weight_table
[] =
95 { 20, { "ultra-light", "ultralight" }},
96 { 40, { "extra-light", "extralight" }},
98 { 75, { "semi-light", "semilight", "demilight", "book" }},
99 { 100, { "normal", "medium", "regular", "unspecified" }},
100 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
102 { 205, { "extra-bold", "extrabold" }},
103 { 210, { "ultra-bold", "ultrabold", "black" }}
106 /* Table of slant numeric values and their names. This table must be
107 sorted by numeric values in ascending order. */
109 static struct table_entry slant_table
[] =
111 { 0, { "reverse-oblique", "ro" }},
112 { 10, { "reverse-italic", "ri" }},
113 { 100, { "normal", "r", "unspecified" }},
114 { 200, { "italic" ,"i", "ot" }},
115 { 210, { "oblique", "o" }}
118 /* Table of width numeric values and their names. This table must be
119 sorted by numeric values in ascending order. */
121 static struct table_entry width_table
[] =
123 { 50, { "ultra-condensed", "ultracondensed" }},
124 { 63, { "extra-condensed", "extracondensed" }},
125 { 75, { "condensed", "compressed", "narrow" }},
126 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
127 { 100, { "normal", "medium", "regular", "unspecified" }},
128 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
129 { 125, { "expanded" }},
130 { 150, { "extra-expanded", "extraexpanded" }},
131 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
134 extern Lisp_Object Qnormal
;
136 /* Symbols representing keys of normal font properties. */
137 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
;
138 extern Lisp_Object QCheight
, QCsize
, QCname
;
140 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
;
141 /* Symbols representing keys of font extra info. */
142 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
143 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
144 /* Symbols representing values of font spacing property. */
145 Lisp_Object Qc
, Qm
, Qp
, Qd
;
147 Lisp_Object Vfont_encoding_alist
;
149 /* Alist of font registry symbol and the corresponding charsets
150 information. The information is retrieved from
151 Vfont_encoding_alist on demand.
153 Eash element has the form:
154 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
158 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
159 encodes a character code to a glyph code of a font, and
160 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
161 character is supported by a font.
163 The latter form means that the information for REGISTRY couldn't be
165 static Lisp_Object font_charset_alist
;
167 /* List of all font drivers. Each font-backend (XXXfont.c) calls
168 register_font_driver in syms_of_XXXfont to register its font-driver
170 static struct font_driver_list
*font_driver_list
;
174 /* Creaters of font-related Lisp object. */
179 Lisp_Object font_spec
;
180 struct font_spec
*spec
181 = ((struct font_spec
*)
182 allocate_pseudovector (VECSIZE (struct font_spec
),
183 FONT_SPEC_MAX
, PVEC_FONT
));
184 XSETFONT (font_spec
, spec
);
191 Lisp_Object font_entity
;
192 struct font_entity
*entity
193 = ((struct font_entity
*)
194 allocate_pseudovector (VECSIZE (struct font_entity
),
195 FONT_ENTITY_MAX
, PVEC_FONT
));
196 XSETFONT (font_entity
, entity
);
200 /* Create a font-object whose structure size is SIZE. If ENTITY is
201 not nil, copy properties from ENTITY to the font-object. If
202 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
204 font_make_object (size
, entity
, pixelsize
)
209 Lisp_Object font_object
;
211 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
214 XSETFONT (font_object
, font
);
218 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
219 font
->props
[i
] = AREF (entity
, i
);
220 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
221 font
->props
[FONT_EXTRA_INDEX
]
222 = Fcopy_sequence (AREF (entity
, FONT_EXTRA_INDEX
));
225 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
231 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
232 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
233 static Lisp_Object font_matching_entity
P_ ((FRAME_PTR
, Lisp_Object
*,
236 /* Number of registered font drivers. */
237 static int num_font_drivers
;
240 /* Return a Lispy value of a font property value at STR and LEN bytes.
241 If STR is "*", it returns nil.
242 If FORCE_SYMBOL is zero and all characters in STR are digits, it
243 returns an integer. Otherwise, it returns a symbol interned from
247 font_intern_prop (str
, len
, force_symbol
)
257 if (len
== 1 && *str
== '*')
259 if (!force_symbol
&& len
>=1 && isdigit (*str
))
261 for (i
= 1; i
< len
; i
++)
262 if (! isdigit (str
[i
]))
265 return make_number (atoi (str
));
268 /* The following code is copied from the function intern (in
269 lread.c), and modified to suite our purpose. */
271 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
272 obarray
= check_obarray (obarray
);
273 parse_str_as_multibyte (str
, len
, &nchars
, &nbytes
);
274 if (len
== nchars
|| len
!= nbytes
)
275 /* CONTENTS contains no multibyte sequences or contains an invalid
276 multibyte sequence. We'll make a unibyte string. */
277 tem
= oblookup (obarray
, str
, len
, len
);
279 tem
= oblookup (obarray
, str
, nchars
, len
);
282 if (len
== nchars
|| len
!= nbytes
)
283 tem
= make_unibyte_string (str
, len
);
285 tem
= make_multibyte_string (str
, nchars
, len
);
286 return Fintern (tem
, obarray
);
289 /* Return a pixel size of font-spec SPEC on frame F. */
292 font_pixel_size (f
, spec
)
296 #ifdef HAVE_WINDOW_SYSTEM
297 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
306 font_assert (FLOATP (size
));
307 point_size
= XFLOAT_DATA (size
);
308 val
= AREF (spec
, FONT_DPI_INDEX
);
313 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
321 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
322 font vector. If VAL is not valid (i.e. not registered in
323 font_style_table), return -1 if NOERROR is zero, and return a
324 proper index if NOERROR is nonzero. In that case, register VAL in
325 font_style_table if VAL is a symbol, and return a closest index if
326 VAL is an integer. */
329 font_style_to_value (prop
, val
, noerror
)
330 enum font_property_index prop
;
334 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
335 int len
= ASIZE (table
);
341 Lisp_Object args
[2], elt
;
343 /* At first try exact match. */
344 for (i
= 0; i
< len
; i
++)
345 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
346 if (EQ (val
, AREF (AREF (table
, i
), j
)))
347 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
348 | (i
<< 4) | (j
- 1));
349 /* Try also with case-folding match. */
350 s
= SDATA (SYMBOL_NAME (val
));
351 for (i
= 0; i
< len
; i
++)
352 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
354 elt
= AREF (AREF (table
, i
), j
);
355 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
356 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
357 | (i
<< 4) | (j
- 1));
363 elt
= Fmake_vector (make_number (2), make_number (100));
366 args
[1] = Fmake_vector (make_number (1), elt
);
367 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
368 return (100 << 8) | (i
<< 4);
373 int numeric
= XINT (val
);
375 for (i
= 0, last_n
= -1; i
< len
; i
++)
377 int n
= XINT (AREF (AREF (table
, i
), 0));
380 return (n
<< 8) | (i
<< 4);
385 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
386 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
392 return ((last_n
<< 8) | ((i
- 1) << 4));
397 font_style_symbolic (font
, prop
, for_face
)
399 enum font_property_index prop
;
402 Lisp_Object val
= AREF (font
, prop
);
403 Lisp_Object table
, elt
;
408 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
409 i
= XINT (val
) & 0xFF;
410 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
411 elt
= AREF (table
, ((i
>> 4) & 0xF));
412 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
413 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
416 extern Lisp_Object Vface_alternative_font_family_alist
;
418 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
421 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
422 FONTNAME. ENCODING is a charset symbol that specifies the encoding
423 of the font. REPERTORY is a charset symbol or nil. */
426 find_font_encoding (fontname
)
427 Lisp_Object fontname
;
429 Lisp_Object tail
, elt
;
431 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
435 && STRINGP (XCAR (elt
))
436 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
437 && (SYMBOLP (XCDR (elt
))
438 ? CHARSETP (XCDR (elt
))
439 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
445 /* Return encoding charset and repertory charset for REGISTRY in
446 ENCODING and REPERTORY correspondingly. If correct information for
447 REGISTRY is available, return 0. Otherwise return -1. */
450 font_registry_charsets (registry
, encoding
, repertory
)
451 Lisp_Object registry
;
452 struct charset
**encoding
, **repertory
;
455 int encoding_id
, repertory_id
;
457 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
463 encoding_id
= XINT (XCAR (val
));
464 repertory_id
= XINT (XCDR (val
));
468 val
= find_font_encoding (SYMBOL_NAME (registry
));
469 if (SYMBOLP (val
) && CHARSETP (val
))
471 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
473 else if (CONSP (val
))
475 if (! CHARSETP (XCAR (val
)))
477 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
478 if (NILP (XCDR (val
)))
482 if (! CHARSETP (XCDR (val
)))
484 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
489 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
491 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
495 *encoding
= CHARSET_FROM_ID (encoding_id
);
497 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
502 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
507 /* Font property value validaters. See the comment of
508 font_property_table for the meaning of the arguments. */
510 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
511 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
512 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
513 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
514 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
515 static int get_font_prop_index
P_ ((Lisp_Object
));
518 font_prop_validate_symbol (prop
, val
)
519 Lisp_Object prop
, val
;
522 val
= Fintern (val
, Qnil
);
525 else if (EQ (prop
, QCregistry
))
526 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
532 font_prop_validate_style (style
, val
)
533 Lisp_Object style
, val
;
535 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
536 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
543 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
547 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
549 if ((n
& 0xF) + 1 >= ASIZE (elt
))
551 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
555 else if (SYMBOLP (val
))
557 int n
= font_style_to_value (prop
, val
, 0);
559 val
= n
>= 0 ? make_number (n
) : Qerror
;
567 font_prop_validate_non_neg (prop
, val
)
568 Lisp_Object prop
, val
;
570 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
575 font_prop_validate_spacing (prop
, val
)
576 Lisp_Object prop
, val
;
578 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
580 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
582 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
584 if (spacing
== 'c' || spacing
== 'C')
585 return make_number (FONT_SPACING_CHARCELL
);
586 if (spacing
== 'm' || spacing
== 'M')
587 return make_number (FONT_SPACING_MONO
);
588 if (spacing
== 'p' || spacing
== 'P')
589 return make_number (FONT_SPACING_PROPORTIONAL
);
590 if (spacing
== 'd' || spacing
== 'D')
591 return make_number (FONT_SPACING_DUAL
);
597 font_prop_validate_otf (prop
, val
)
598 Lisp_Object prop
, val
;
600 Lisp_Object tail
, tmp
;
603 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
604 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
605 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
608 if (! SYMBOLP (XCAR (val
)))
613 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
615 for (i
= 0; i
< 2; i
++)
622 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
623 if (! SYMBOLP (XCAR (tmp
)))
631 /* Structure of known font property keys and validater of the
635 /* Pointer to the key symbol. */
637 /* Function to validate PROP's value VAL, or NULL if any value is
638 ok. The value is VAL or its regularized value if VAL is valid,
639 and Qerror if not. */
640 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
641 } font_property_table
[] =
642 { { &QCtype
, font_prop_validate_symbol
},
643 { &QCfoundry
, font_prop_validate_symbol
},
644 { &QCfamily
, font_prop_validate_symbol
},
645 { &QCadstyle
, font_prop_validate_symbol
},
646 { &QCregistry
, font_prop_validate_symbol
},
647 { &QCweight
, font_prop_validate_style
},
648 { &QCslant
, font_prop_validate_style
},
649 { &QCwidth
, font_prop_validate_style
},
650 { &QCsize
, font_prop_validate_non_neg
},
651 { &QCdpi
, font_prop_validate_non_neg
},
652 { &QCspacing
, font_prop_validate_spacing
},
653 { &QCavgwidth
, font_prop_validate_non_neg
},
654 /* The order of the above entries must match with enum
655 font_property_index. */
656 { &QClang
, font_prop_validate_symbol
},
657 { &QCscript
, font_prop_validate_symbol
},
658 { &QCotf
, font_prop_validate_otf
}
661 /* Size (number of elements) of the above table. */
662 #define FONT_PROPERTY_TABLE_SIZE \
663 ((sizeof font_property_table) / (sizeof *font_property_table))
665 /* Return an index number of font property KEY or -1 if KEY is not an
666 already known property. */
669 get_font_prop_index (key
)
674 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
675 if (EQ (key
, *font_property_table
[i
].key
))
680 /* Validate the font property. The property key is specified by the
681 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
682 signal an error. The value is VAL or the regularized one. */
685 font_prop_validate (idx
, prop
, val
)
687 Lisp_Object prop
, val
;
689 Lisp_Object validated
;
694 prop
= *font_property_table
[idx
].key
;
697 idx
= get_font_prop_index (prop
);
701 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
702 if (EQ (validated
, Qerror
))
703 signal_error ("invalid font property", Fcons (prop
, val
));
708 /* Store VAL as a value of extra font property PROP in FONT while
709 keeping the sorting order. Don't check the validity of VAL. */
712 font_put_extra (font
, prop
, val
)
713 Lisp_Object font
, prop
, val
;
715 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
716 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
720 Lisp_Object prev
= Qnil
;
723 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
724 prev
= extra
, extra
= XCDR (extra
);
726 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
728 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
736 /* Font name parser and unparser */
738 static int parse_matrix
P_ ((char *));
739 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
740 static int font_parse_name
P_ ((char *, Lisp_Object
));
742 /* An enumerator for each field of an XLFD font name. */
743 enum xlfd_field_index
762 /* An enumerator for mask bit corresponding to each XLFD field. */
765 XLFD_FOUNDRY_MASK
= 0x0001,
766 XLFD_FAMILY_MASK
= 0x0002,
767 XLFD_WEIGHT_MASK
= 0x0004,
768 XLFD_SLANT_MASK
= 0x0008,
769 XLFD_SWIDTH_MASK
= 0x0010,
770 XLFD_ADSTYLE_MASK
= 0x0020,
771 XLFD_PIXEL_MASK
= 0x0040,
772 XLFD_POINT_MASK
= 0x0080,
773 XLFD_RESX_MASK
= 0x0100,
774 XLFD_RESY_MASK
= 0x0200,
775 XLFD_SPACING_MASK
= 0x0400,
776 XLFD_AVGWIDTH_MASK
= 0x0800,
777 XLFD_REGISTRY_MASK
= 0x1000,
778 XLFD_ENCODING_MASK
= 0x2000
782 /* Parse P pointing the pixel/point size field of the form
783 `[A B C D]' which specifies a transformation matrix:
789 by which all glyphs of the font are transformed. The spec says
790 that scalar value N for the pixel/point size is equivalent to:
791 A = N * resx/resy, B = C = 0, D = N.
793 Return the scalar value N if the form is valid. Otherwise return
804 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
807 matrix
[i
] = - strtod (p
+ 1, &end
);
809 matrix
[i
] = strtod (p
, &end
);
812 return (i
== 4 ? (int) matrix
[3] : -1);
815 /* Expand a wildcard field in FIELD (the first N fields are filled) to
816 multiple fields to fill in all 14 XLFD fields while restring a
817 field position by its contents. */
820 font_expand_wildcards (field
, n
)
821 Lisp_Object field
[XLFD_LAST_INDEX
];
825 Lisp_Object tmp
[XLFD_LAST_INDEX
];
826 /* Array of information about where this element can go. Nth
827 element is for Nth element of FIELD. */
829 /* Minimum possible field. */
831 /* Maxinum possible field. */
833 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
835 } range
[XLFD_LAST_INDEX
];
837 int range_from
, range_to
;
840 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
841 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
842 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
843 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
844 | XLFD_AVGWIDTH_MASK)
845 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
847 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
848 field. The value is shifted to left one bit by one in the
850 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
851 range_mask
= (range_mask
<< 1) | 1;
853 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
854 position-based retriction for FIELD[I]. */
855 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
856 i
++, range_from
++, range_to
++, range_mask
<<= 1)
858 Lisp_Object val
= field
[i
];
864 range
[i
].from
= range_from
;
865 range
[i
].to
= range_to
;
866 range
[i
].mask
= range_mask
;
870 /* The triplet FROM, TO, and MASK is a value-based
871 retriction for FIELD[I]. */
877 int numeric
= XINT (val
);
880 from
= to
= XLFD_ENCODING_INDEX
,
881 mask
= XLFD_ENCODING_MASK
;
882 else if (numeric
== 0)
883 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
884 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
885 else if (numeric
<= 48)
886 from
= to
= XLFD_PIXEL_INDEX
,
887 mask
= XLFD_PIXEL_MASK
;
889 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
890 mask
= XLFD_LARGENUM_MASK
;
892 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
893 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
894 mask
= XLFD_NULL_MASK
;
896 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
899 Lisp_Object name
= SYMBOL_NAME (val
);
901 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
902 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
903 mask
= XLFD_REGENC_MASK
;
905 from
= to
= XLFD_ENCODING_INDEX
,
906 mask
= XLFD_ENCODING_MASK
;
908 else if (range_from
<= XLFD_WEIGHT_INDEX
909 && range_to
>= XLFD_WEIGHT_INDEX
910 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
911 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
912 else if (range_from
<= XLFD_SLANT_INDEX
913 && range_to
>= XLFD_SLANT_INDEX
914 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
915 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
916 else if (range_from
<= XLFD_SWIDTH_INDEX
917 && range_to
>= XLFD_SWIDTH_INDEX
918 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
919 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
922 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
923 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
925 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
926 mask
= XLFD_SYMBOL_MASK
;
929 /* Merge position-based and value-based restrictions. */
931 while (from
< range_from
)
932 mask
&= ~(1 << from
++);
933 while (from
< 14 && ! (mask
& (1 << from
)))
935 while (to
> range_to
)
936 mask
&= ~(1 << to
--);
937 while (to
>= 0 && ! (mask
& (1 << to
)))
941 range
[i
].from
= from
;
943 range
[i
].mask
= mask
;
945 if (from
> range_from
|| to
< range_to
)
947 /* The range is narrowed by value-based restrictions.
948 Reflect it to the other fields. */
950 /* Following fields should be after FROM. */
952 /* Preceding fields should be before TO. */
953 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
955 /* Check FROM for non-wildcard field. */
956 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
958 while (range
[j
].from
< from
)
959 range
[j
].mask
&= ~(1 << range
[j
].from
++);
960 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
962 range
[j
].from
= from
;
965 from
= range
[j
].from
;
966 if (range
[j
].to
> to
)
968 while (range
[j
].to
> to
)
969 range
[j
].mask
&= ~(1 << range
[j
].to
--);
970 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
983 /* Decide all fileds from restrictions in RANGE. */
984 for (i
= j
= 0; i
< n
; i
++)
986 if (j
< range
[i
].from
)
988 if (i
== 0 || ! NILP (tmp
[i
- 1]))
989 /* None of TMP[X] corresponds to Jth field. */
991 for (; j
< range
[i
].from
; j
++)
996 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
998 for (; j
< XLFD_LAST_INDEX
; j
++)
1000 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
1001 field
[XLFD_ENCODING_INDEX
]
1002 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1007 #ifdef ENABLE_CHECKING
1008 /* Match a 14-field XLFD pattern against a full XLFD font name. */
1010 font_match_xlfd (char *pattern
, char *name
)
1012 while (*pattern
&& *name
)
1014 if (*pattern
== *name
)
1016 else if (*pattern
== '*')
1017 if (*name
== pattern
[1])
1028 /* Make sure the font object matches the XLFD font name. */
1030 font_check_xlfd_parse (Lisp_Object font
, char *name
)
1032 char name_check
[256];
1033 font_unparse_xlfd (font
, 0, name_check
, 255);
1034 return font_match_xlfd (name_check
, name
);
1040 /* Parse NAME (null terminated) as XLFD and store information in FONT
1041 (font-spec or font-entity). Size property of FONT is set as
1043 specified XLFD fields FONT property
1044 --------------------- -------------
1045 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1046 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1047 POINT_SIZE POINT_SIZE/10 (Lisp float)
1049 If NAME is successfully parsed, return 0. Otherwise return -1.
1051 FONT is usually a font-spec, but when this function is called from
1052 X font backend driver, it is a font-entity. In that case, NAME is
1053 a fully specified XLFD. */
1056 font_parse_xlfd (name
, font
)
1060 int len
= strlen (name
);
1062 char *f
[XLFD_LAST_INDEX
+ 1];
1066 if (len
> 255 || !len
)
1067 /* Maximum XLFD name length is 255. */
1069 /* Accept "*-.." as a fully specified XLFD. */
1070 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1071 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1074 for (p
= name
+ i
; *p
; p
++)
1078 if (i
== XLFD_LAST_INDEX
)
1083 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1084 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1086 if (i
== XLFD_LAST_INDEX
)
1088 /* Fully specified XLFD. */
1091 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1092 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1093 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1094 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1096 val
= INTERN_FIELD_SYM (i
);
1099 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1101 ASET (font
, j
, make_number (n
));
1104 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1105 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1106 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1108 ASET (font
, FONT_REGISTRY_INDEX
,
1109 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1110 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1112 p
= f
[XLFD_PIXEL_INDEX
];
1113 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1114 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1117 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1119 ASET (font
, FONT_SIZE_INDEX
, val
);
1122 double point_size
= -1;
1124 font_assert (FONT_SPEC_P (font
));
1125 p
= f
[XLFD_POINT_INDEX
];
1127 point_size
= parse_matrix (p
);
1128 else if (isdigit (*p
))
1129 point_size
= atoi (p
), point_size
/= 10;
1130 if (point_size
>= 0)
1131 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1135 ASET (font
, FONT_DPI_INDEX
, INTERN_FIELD (XLFD_RESY_INDEX
));
1136 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1139 val
= font_prop_validate_spacing (QCspacing
, val
);
1140 if (! INTEGERP (val
))
1142 ASET (font
, FONT_SPACING_INDEX
, val
);
1144 p
= f
[XLFD_AVGWIDTH_INDEX
];
1147 ASET (font
, FONT_AVGWIDTH_INDEX
,
1148 font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0));
1152 int wild_card_found
= 0;
1153 Lisp_Object prop
[XLFD_LAST_INDEX
];
1155 if (FONT_ENTITY_P (font
))
1157 for (j
= 0; j
< i
; j
++)
1161 if (f
[j
][1] && f
[j
][1] != '-')
1164 wild_card_found
= 1;
1167 prop
[j
] = INTERN_FIELD (j
);
1169 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1171 if (! wild_card_found
)
1173 if (font_expand_wildcards (prop
, i
) < 0)
1176 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1177 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1178 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1179 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1180 if (! NILP (prop
[i
]))
1182 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1184 ASET (font
, j
, make_number (n
));
1186 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1187 val
= prop
[XLFD_REGISTRY_INDEX
];
1190 val
= prop
[XLFD_ENCODING_INDEX
];
1192 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1194 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1195 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1197 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1198 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1200 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1202 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1203 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1204 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1206 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1208 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1211 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1212 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1213 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1215 val
= font_prop_validate_spacing (QCspacing
,
1216 prop
[XLFD_SPACING_INDEX
]);
1217 if (! INTEGERP (val
))
1219 ASET (font
, FONT_SPACING_INDEX
, val
);
1221 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1222 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1228 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1229 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1230 0, use PIXEL_SIZE instead. */
1233 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1239 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1243 font_assert (FONTP (font
));
1245 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1248 if (i
== FONT_ADSTYLE_INDEX
)
1249 j
= XLFD_ADSTYLE_INDEX
;
1250 else if (i
== FONT_REGISTRY_INDEX
)
1251 j
= XLFD_REGISTRY_INDEX
;
1252 val
= AREF (font
, i
);
1255 if (j
== XLFD_REGISTRY_INDEX
)
1256 f
[j
] = "*-*", len
+= 4;
1258 f
[j
] = "*", len
+= 2;
1263 val
= SYMBOL_NAME (val
);
1264 if (j
== XLFD_REGISTRY_INDEX
1265 && ! strchr ((char *) SDATA (val
), '-'))
1267 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1268 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1270 f
[j
] = alloca (SBYTES (val
) + 3);
1271 sprintf (f
[j
], "%s-*", SDATA (val
));
1272 len
+= SBYTES (val
) + 3;
1276 f
[j
] = alloca (SBYTES (val
) + 4);
1277 sprintf (f
[j
], "%s*-*", SDATA (val
));
1278 len
+= SBYTES (val
) + 4;
1282 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1286 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1289 val
= font_style_symbolic (font
, i
, 0);
1291 f
[j
] = "*", len
+= 2;
1294 val
= SYMBOL_NAME (val
);
1295 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1299 val
= AREF (font
, FONT_SIZE_INDEX
);
1300 font_assert (NUMBERP (val
) || NILP (val
));
1308 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1309 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1312 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1314 else if (FLOATP (val
))
1316 i
= XFLOAT_DATA (val
) * 10;
1317 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1318 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1321 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1323 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1325 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1326 f
[XLFD_RESX_INDEX
] = alloca (22);
1327 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1331 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1332 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1334 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1336 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1337 : spacing
<= FONT_SPACING_DUAL
? "d"
1338 : spacing
<= FONT_SPACING_MONO
? "m"
1343 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1344 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1346 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1347 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
],
1348 "%d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1351 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1352 len
++; /* for terminating '\0'. */
1355 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1356 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1357 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1358 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1359 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1360 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1361 f
[XLFD_REGISTRY_INDEX
]);
1364 /* Parse NAME (null terminated) and store information in FONT
1365 (font-spec or font-entity). NAME is supplied in either the
1366 Fontconfig or GTK font name format. If NAME is successfully
1367 parsed, return 0. Otherwise return -1.
1369 The fontconfig format is
1371 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1375 FAMILY [PROPS...] [SIZE]
1377 This function tries to guess which format it is. */
1380 font_parse_fcname (name
, font
)
1385 char *size_beg
= NULL
, *size_end
= NULL
;
1386 char *props_beg
= NULL
, *family_end
= NULL
;
1387 int len
= strlen (name
);
1392 for (p
= name
; *p
; p
++)
1394 if (*p
== '\\' && p
[1])
1398 props_beg
= family_end
= p
;
1403 int decimal
= 0, size_found
= 1;
1404 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1407 if (*q
!= '.' || decimal
)
1426 /* A fontconfig name with size and/or property data. */
1427 if (family_end
> name
)
1430 family
= font_intern_prop (name
, family_end
- name
, 1);
1431 ASET (font
, FONT_FAMILY_INDEX
, family
);
1435 double point_size
= strtod (size_beg
, &size_end
);
1436 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1437 if (*size_end
== ':' && size_end
[1])
1438 props_beg
= size_end
;
1442 /* Now parse ":KEY=VAL" patterns. */
1445 for (p
= props_beg
; *p
; p
= q
)
1447 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1450 /* Must be an enumerated value. */
1454 val
= font_intern_prop (p
, q
- p
, 1);
1456 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1458 if (PROP_MATCH ("light", 5)
1459 || PROP_MATCH ("medium", 6)
1460 || PROP_MATCH ("demibold", 8)
1461 || PROP_MATCH ("bold", 4)
1462 || PROP_MATCH ("black", 5))
1463 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1464 else if (PROP_MATCH ("roman", 5)
1465 || PROP_MATCH ("italic", 6)
1466 || PROP_MATCH ("oblique", 7))
1467 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1468 else if (PROP_MATCH ("charcell", 8))
1469 ASET (font
, FONT_SPACING_INDEX
,
1470 make_number (FONT_SPACING_CHARCELL
));
1471 else if (PROP_MATCH ("mono", 4))
1472 ASET (font
, FONT_SPACING_INDEX
,
1473 make_number (FONT_SPACING_MONO
));
1474 else if (PROP_MATCH ("proportional", 12))
1475 ASET (font
, FONT_SPACING_INDEX
,
1476 make_number (FONT_SPACING_PROPORTIONAL
));
1485 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1486 prop
= FONT_SIZE_INDEX
;
1489 key
= font_intern_prop (p
, q
- p
, 1);
1490 prop
= get_font_prop_index (key
);
1494 for (q
= p
; *q
&& *q
!= ':'; q
++);
1495 val
= font_intern_prop (p
, q
- p
, 0);
1497 if (prop
>= FONT_FOUNDRY_INDEX
1498 && prop
< FONT_EXTRA_INDEX
)
1499 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1501 Ffont_put (font
, key
, val
);
1509 /* Either a fontconfig-style name with no size and property
1510 data, or a GTK-style name. */
1512 int word_len
, prop_found
= 0;
1514 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1520 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1528 double point_size
= strtod (p
, &q
);
1529 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1534 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1535 if (*q
== '\\' && q
[1])
1539 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1541 if (PROP_MATCH ("Ultra-Light", 11))
1544 prop
= font_intern_prop ("ultra-light", 11, 1);
1545 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1547 else if (PROP_MATCH ("Light", 5))
1550 prop
= font_intern_prop ("light", 5, 1);
1551 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1553 else if (PROP_MATCH ("Semi-Bold", 9))
1556 prop
= font_intern_prop ("semi-bold", 9, 1);
1557 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1559 else if (PROP_MATCH ("Bold", 4))
1562 prop
= font_intern_prop ("bold", 4, 1);
1563 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1565 else if (PROP_MATCH ("Italic", 6))
1568 prop
= font_intern_prop ("italic", 4, 1);
1569 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1571 else if (PROP_MATCH ("Oblique", 7))
1574 prop
= font_intern_prop ("oblique", 7, 1);
1575 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1579 return -1; /* Unknown property in GTK-style font name. */
1588 family
= font_intern_prop (name
, family_end
- name
, 1);
1589 ASET (font
, FONT_FAMILY_INDEX
, family
);
1596 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1597 NAME (NBYTES length), and return the name length. If
1598 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1601 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1607 Lisp_Object family
, foundry
;
1608 Lisp_Object tail
, val
;
1612 Lisp_Object styles
[3];
1613 char *style_names
[3] = { "weight", "slant", "width" };
1616 family
= AREF (font
, FONT_FAMILY_INDEX
);
1617 if (! NILP (family
))
1619 if (SYMBOLP (family
))
1621 family
= SYMBOL_NAME (family
);
1622 len
+= SBYTES (family
);
1628 val
= AREF (font
, FONT_SIZE_INDEX
);
1631 if (XINT (val
) != 0)
1632 pixel_size
= XINT (val
);
1634 len
+= 21; /* for ":pixelsize=NUM" */
1636 else if (FLOATP (val
))
1639 point_size
= (int) XFLOAT_DATA (val
);
1640 len
+= 11; /* for "-NUM" */
1643 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1644 if (! NILP (foundry
))
1646 if (SYMBOLP (foundry
))
1648 foundry
= SYMBOL_NAME (foundry
);
1649 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1655 for (i
= 0; i
< 3; i
++)
1657 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1658 if (! NILP (styles
[i
]))
1659 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1660 SDATA (SYMBOL_NAME (styles
[i
])));
1663 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1664 len
+= sprintf (work
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1665 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1666 len
+= strlen (":spacing=100");
1667 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1668 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1669 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1671 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1673 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1675 len
+= SBYTES (val
);
1676 else if (INTEGERP (val
))
1677 len
+= sprintf (work
, "%d", XINT (val
));
1678 else if (SYMBOLP (val
))
1679 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1685 if (! NILP (family
))
1686 p
+= sprintf (p
, "%s", SDATA (family
));
1690 p
+= sprintf (p
, "%d", point_size
);
1692 p
+= sprintf (p
, "-%d", point_size
);
1694 else if (pixel_size
> 0)
1695 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1696 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1697 p
+= sprintf (p
, ":foundry=%s",
1698 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1699 for (i
= 0; i
< 3; i
++)
1700 if (! NILP (styles
[i
]))
1701 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1702 SDATA (SYMBOL_NAME (styles
[i
])));
1703 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1704 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1705 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1706 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1707 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1709 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1710 p
+= sprintf (p
, ":scalable=true");
1712 p
+= sprintf (p
, ":scalable=false");
1717 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1718 NAME (NBYTES length), and return the name length. F is the frame
1719 on which the font is displayed; it is used to calculate the point
1723 font_unparse_gtkname (font
, f
, name
, nbytes
)
1731 Lisp_Object family
, weight
, slant
, size
;
1732 int point_size
= -1;
1734 family
= AREF (font
, FONT_FAMILY_INDEX
);
1735 if (! NILP (family
))
1737 if (! SYMBOLP (family
))
1739 family
= SYMBOL_NAME (family
);
1740 len
+= SBYTES (family
);
1743 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1744 if (EQ (weight
, Qnormal
))
1746 else if (! NILP (weight
))
1748 weight
= SYMBOL_NAME (weight
);
1749 len
+= SBYTES (weight
);
1752 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1753 if (EQ (slant
, Qnormal
))
1755 else if (! NILP (slant
))
1757 slant
= SYMBOL_NAME (slant
);
1758 len
+= SBYTES (slant
);
1761 size
= AREF (font
, FONT_SIZE_INDEX
);
1762 /* Convert pixel size to point size. */
1763 if (INTEGERP (size
))
1765 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1767 if (INTEGERP (font_dpi
))
1768 dpi
= XINT (font_dpi
);
1771 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1774 else if (FLOATP (size
))
1776 point_size
= (int) XFLOAT_DATA (size
);
1783 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1785 if (! NILP (weight
))
1788 p
+= sprintf (p
, " %s", SDATA (weight
));
1789 q
[1] = toupper (q
[1]);
1795 p
+= sprintf (p
, " %s", SDATA (slant
));
1796 q
[1] = toupper (q
[1]);
1800 p
+= sprintf (p
, " %d", point_size
);
1805 /* Parse NAME (null terminated) and store information in FONT
1806 (font-spec or font-entity). If NAME is successfully parsed, return
1807 0. Otherwise return -1. */
1810 font_parse_name (name
, font
)
1814 if (name
[0] == '-' || index (name
, '*') || index (name
, '?'))
1815 return font_parse_xlfd (name
, font
);
1816 return font_parse_fcname (name
, font
);
1820 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1821 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1825 font_parse_family_registry (family
, registry
, font_spec
)
1826 Lisp_Object family
, registry
, font_spec
;
1832 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1834 CHECK_STRING (family
);
1835 len
= SBYTES (family
);
1836 p0
= (char *) SDATA (family
);
1837 p1
= index (p0
, '-');
1840 if ((*p0
!= '*' || p1
- p0
> 1)
1841 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1842 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1845 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1848 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1850 if (! NILP (registry
))
1852 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1853 CHECK_STRING (registry
);
1854 len
= SBYTES (registry
);
1855 p0
= (char *) SDATA (registry
);
1856 p1
= index (p0
, '-');
1859 if (SDATA (registry
)[len
- 1] == '*')
1860 registry
= concat2 (registry
, build_string ("-*"));
1862 registry
= concat2 (registry
, build_string ("*-*"));
1864 registry
= Fdowncase (registry
);
1865 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1870 /* This part (through the next ^L) is still experimental and not
1871 tested much. We may drastically change codes. */
1877 #define LGSTRING_HEADER_SIZE 6
1878 #define LGSTRING_GLYPH_SIZE 8
1881 check_gstring (gstring
)
1882 Lisp_Object gstring
;
1887 CHECK_VECTOR (gstring
);
1888 val
= AREF (gstring
, 0);
1890 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1892 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1893 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1894 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1895 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1896 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1897 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1898 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1899 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1900 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1901 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1902 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1904 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1906 val
= LGSTRING_GLYPH (gstring
, i
);
1908 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1910 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1912 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1913 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1914 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1915 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1916 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1917 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1918 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1919 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1921 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1923 if (ASIZE (val
) < 3)
1925 for (j
= 0; j
< 3; j
++)
1926 CHECK_NUMBER (AREF (val
, j
));
1931 error ("Invalid glyph-string format");
1936 check_otf_features (otf_features
)
1937 Lisp_Object otf_features
;
1941 CHECK_CONS (otf_features
);
1942 CHECK_SYMBOL (XCAR (otf_features
));
1943 otf_features
= XCDR (otf_features
);
1944 CHECK_CONS (otf_features
);
1945 CHECK_SYMBOL (XCAR (otf_features
));
1946 otf_features
= XCDR (otf_features
);
1947 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1949 CHECK_SYMBOL (Fcar (val
));
1950 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1951 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1953 otf_features
= XCDR (otf_features
);
1954 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1956 CHECK_SYMBOL (Fcar (val
));
1957 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1958 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1965 Lisp_Object otf_list
;
1968 otf_tag_symbol (tag
)
1973 OTF_tag_name (tag
, name
);
1974 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1981 Lisp_Object val
= Fassoc (file
, otf_list
);
1985 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1988 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1989 val
= make_save_value (otf
, 0);
1990 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1996 /* Return a list describing which scripts/languages FONT supports by
1997 which GSUB/GPOS features of OpenType tables. See the comment of
1998 (struct font_driver).otf_capability. */
2001 font_otf_capability (font
)
2005 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
2008 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
2011 for (i
= 0; i
< 2; i
++)
2013 OTF_GSUB_GPOS
*gsub_gpos
;
2014 Lisp_Object script_list
= Qnil
;
2017 if (OTF_get_features (otf
, i
== 0) < 0)
2019 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2020 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2022 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2023 Lisp_Object langsys_list
= Qnil
;
2024 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2027 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2029 OTF_LangSys
*langsys
;
2030 Lisp_Object feature_list
= Qnil
;
2031 Lisp_Object langsys_tag
;
2034 if (k
== script
->LangSysCount
)
2036 langsys
= &script
->DefaultLangSys
;
2041 langsys
= script
->LangSys
+ k
;
2043 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2045 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2047 OTF_Feature
*feature
2048 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2049 Lisp_Object feature_tag
2050 = otf_tag_symbol (feature
->FeatureTag
);
2052 feature_list
= Fcons (feature_tag
, feature_list
);
2054 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2057 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2062 XSETCAR (capability
, script_list
);
2064 XSETCDR (capability
, script_list
);
2070 /* Parse OTF features in SPEC and write a proper features spec string
2071 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2072 assured that the sufficient memory has already allocated for
2076 generate_otf_features (spec
, features
)
2086 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2092 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2097 else if (! asterisk
)
2099 val
= SYMBOL_NAME (val
);
2100 p
+= sprintf (p
, "%s", SDATA (val
));
2104 val
= SYMBOL_NAME (val
);
2105 p
+= sprintf (p
, "~%s", SDATA (val
));
2109 error ("OTF spec too long");
2113 font_otf_DeviceTable (device_table
)
2114 OTF_DeviceTable
*device_table
;
2116 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2118 return Fcons (make_number (len
),
2119 make_unibyte_string (device_table
->DeltaValue
, len
));
2123 font_otf_ValueRecord (value_format
, value_record
)
2125 OTF_ValueRecord
*value_record
;
2127 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2129 if (value_format
& OTF_XPlacement
)
2130 ASET (val
, 0, make_number (value_record
->XPlacement
));
2131 if (value_format
& OTF_YPlacement
)
2132 ASET (val
, 1, make_number (value_record
->YPlacement
));
2133 if (value_format
& OTF_XAdvance
)
2134 ASET (val
, 2, make_number (value_record
->XAdvance
));
2135 if (value_format
& OTF_YAdvance
)
2136 ASET (val
, 3, make_number (value_record
->YAdvance
));
2137 if (value_format
& OTF_XPlaDevice
)
2138 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2139 if (value_format
& OTF_YPlaDevice
)
2140 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2141 if (value_format
& OTF_XAdvDevice
)
2142 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2143 if (value_format
& OTF_YAdvDevice
)
2144 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2149 font_otf_Anchor (anchor
)
2154 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2155 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2156 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2157 if (anchor
->AnchorFormat
== 2)
2158 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2161 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2162 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2166 #endif /* HAVE_LIBOTF */
2172 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2173 static int font_compare
P_ ((const void *, const void *));
2174 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
2177 /* Return a rescaling ratio of FONT_ENTITY. */
2178 extern Lisp_Object Vface_font_rescale_alist
;
2181 font_rescale_ratio (font_entity
)
2182 Lisp_Object font_entity
;
2184 Lisp_Object tail
, elt
;
2185 Lisp_Object name
= Qnil
;
2187 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2190 if (FLOATP (XCDR (elt
)))
2192 if (STRINGP (XCAR (elt
)))
2195 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2196 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2197 return XFLOAT_DATA (XCDR (elt
));
2199 else if (FONT_SPEC_P (XCAR (elt
)))
2201 if (font_match_p (XCAR (elt
), font_entity
))
2202 return XFLOAT_DATA (XCDR (elt
));
2209 /* We sort fonts by scoring each of them against a specified
2210 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2211 the value is, the closer the font is to the font-spec.
2213 The lowest 2 bits of the score is used for driver type. The font
2214 available by the most preferred font driver is 0.
2216 Each 7-bit in the higher 28 bits are used for numeric properties
2217 WEIGHT, SLANT, WIDTH, and SIZE. */
2219 /* How many bits to shift to store the difference value of each font
2220 property in a score. Note that flots for FONT_TYPE_INDEX and
2221 FONT_REGISTRY_INDEX are not used. */
2222 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2224 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2225 The return value indicates how different ENTITY is compared with
2229 font_score (entity
, spec_prop
)
2230 Lisp_Object entity
, *spec_prop
;
2235 /* Score three style numeric fields. Maximum difference is 127. */
2236 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2237 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2239 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2244 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2247 /* Score the size. Maximum difference is 127. */
2248 i
= FONT_SIZE_INDEX
;
2249 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2250 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2252 /* We use the higher 6-bit for the actual size difference. The
2253 lowest bit is set if the DPI is different. */
2255 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2257 if (CONSP (Vface_font_rescale_alist
))
2258 pixel_size
*= font_rescale_ratio (entity
);
2259 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2263 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2264 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2266 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2273 /* The comparison function for qsort. */
2276 font_compare (d1
, d2
)
2277 const void *d1
, *d2
;
2279 return (*(unsigned *) d1
- *(unsigned *) d2
);
2283 /* The structure for elements being sorted by qsort. */
2284 struct font_sort_data
2291 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2292 If PREFER specifies a point-size, calculate the corresponding
2293 pixel-size from QCdpi property of PREFER or from the Y-resolution
2294 of FRAME before sorting.
2296 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2297 return the sorted VEC. */
2300 font_sort_entites (vec
, prefer
, frame
, best_only
)
2301 Lisp_Object vec
, prefer
, frame
;
2304 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2306 struct font_sort_data
*data
;
2307 unsigned best_score
;
2308 Lisp_Object best_entity
, driver_type
;
2310 struct frame
*f
= XFRAME (frame
);
2311 struct font_driver_list
*list
;
2316 return best_only
? AREF (vec
, 0) : vec
;
2318 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_DPI_INDEX
; i
++)
2319 prefer_prop
[i
] = AREF (prefer
, i
);
2320 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2321 prefer_prop
[FONT_SIZE_INDEX
]
2322 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2324 /* Scoring and sorting. */
2325 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2326 best_score
= 0xFFFFFFFF;
2327 /* We are sure that the length of VEC > 1. */
2328 driver_type
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2329 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2330 driver_order
++, list
= list
->next
)
2331 if (EQ (driver_type
, list
->driver
->type
))
2333 best_entity
= data
[0].entity
= AREF (vec
, 0);
2334 best_score
= data
[0].score
2335 = font_score (data
[0].entity
, prefer_prop
) | driver_order
;
2336 for (i
= 0; i
< len
; i
++)
2338 if (!EQ (driver_type
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2339 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2340 driver_order
++, list
= list
->next
)
2341 if (EQ (driver_type
, list
->driver
->type
))
2343 data
[i
].entity
= AREF (vec
, i
);
2344 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
) | driver_order
;
2345 if (best_only
&& best_score
> data
[i
].score
)
2347 best_score
= data
[i
].score
;
2348 best_entity
= data
[i
].entity
;
2349 if (best_score
== 0)
2355 qsort (data
, len
, sizeof *data
, font_compare
);
2356 for (i
= 0; i
< len
; i
++)
2357 ASET (vec
, i
, data
[i
].entity
);
2363 font_add_log ("sort-by", prefer
, vec
);
2368 /* API of Font Service Layer. */
2370 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2371 sort_shift_bits. Finternal_set_font_selection_order calls this
2372 function with font_sort_order after setting up it. */
2375 font_update_sort_order (order
)
2380 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2382 int xlfd_idx
= order
[i
];
2384 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2385 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2386 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2387 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2388 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2389 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2391 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2396 font_check_otf_features (script
, langsys
, features
, table
)
2397 Lisp_Object script
, langsys
, features
, table
;
2402 table
= assq_no_quit (script
, table
);
2405 table
= XCDR (table
);
2406 if (! NILP (langsys
))
2408 table
= assq_no_quit (langsys
, table
);
2414 val
= assq_no_quit (Qnil
, table
);
2416 table
= XCAR (table
);
2420 table
= XCDR (table
);
2421 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2423 if (NILP (XCAR (features
)))
2428 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2434 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2437 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2439 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2441 script
= XCAR (spec
);
2445 langsys
= XCAR (spec
);
2456 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2457 XCAR (otf_capability
)))
2459 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2460 XCDR (otf_capability
)))
2467 /* Check if FONT (font-entity or font-object) matches with the font
2468 specification SPEC. */
2471 font_match_p (spec
, font
)
2472 Lisp_Object spec
, font
;
2474 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2475 Lisp_Object extra
, font_extra
;
2478 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2479 if (! NILP (AREF (spec
, i
))
2480 && ! NILP (AREF (font
, i
))
2481 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2483 props
= XFONT_SPEC (spec
)->props
;
2484 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2486 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2487 prop
[i
] = AREF (spec
, i
);
2488 prop
[FONT_SIZE_INDEX
]
2489 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2493 if (font_score (font
, props
) > 0)
2495 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2496 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2497 for (; CONSP (extra
); extra
= XCDR (extra
))
2499 Lisp_Object key
= XCAR (XCAR (extra
));
2500 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2502 if (EQ (key
, QClang
))
2504 val2
= assq_no_quit (key
, font_extra
);
2513 if (NILP (Fmemq (val
, val2
)))
2518 ? NILP (Fmemq (val
, XCDR (val2
)))
2522 else if (EQ (key
, QCscript
))
2524 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2530 /* All characters in the list must be supported. */
2531 for (; CONSP (val2
); val2
= XCDR (val2
))
2533 if (! NATNUMP (XCAR (val2
)))
2535 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2536 == FONT_INVALID_CODE
)
2540 else if (VECTORP (val2
))
2542 /* At most one character in the vector must be supported. */
2543 for (i
= 0; i
< ASIZE (val2
); i
++)
2545 if (! NATNUMP (AREF (val2
, i
)))
2547 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2548 != FONT_INVALID_CODE
)
2551 if (i
== ASIZE (val2
))
2556 else if (EQ (key
, QCotf
))
2560 if (! FONT_OBJECT_P (font
))
2562 fontp
= XFONT_OBJECT (font
);
2563 if (! fontp
->driver
->otf_capability
)
2565 val2
= fontp
->driver
->otf_capability (fontp
);
2566 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2577 Each font backend has the callback function get_cache, and it
2578 returns a cons cell of which cdr part can be freely used for
2579 caching fonts. The cons cell may be shared by multiple frames
2580 and/or multiple font drivers. So, we arrange the cdr part as this:
2582 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2584 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2585 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2586 cons (FONT-SPEC FONT-ENTITY ...). */
2588 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2589 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2590 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2591 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2592 struct font_driver
*));
2595 font_prepare_cache (f
, driver
)
2597 struct font_driver
*driver
;
2599 Lisp_Object cache
, val
;
2601 cache
= driver
->get_cache (f
);
2603 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2607 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2608 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2612 val
= XCDR (XCAR (val
));
2613 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2619 font_finish_cache (f
, driver
)
2621 struct font_driver
*driver
;
2623 Lisp_Object cache
, val
, tmp
;
2626 cache
= driver
->get_cache (f
);
2628 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2629 cache
= val
, val
= XCDR (val
);
2630 font_assert (! NILP (val
));
2631 tmp
= XCDR (XCAR (val
));
2632 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2633 if (XINT (XCAR (tmp
)) == 0)
2635 font_clear_cache (f
, XCAR (val
), driver
);
2636 XSETCDR (cache
, XCDR (val
));
2642 font_get_cache (f
, driver
)
2644 struct font_driver
*driver
;
2646 Lisp_Object val
= driver
->get_cache (f
);
2647 Lisp_Object type
= driver
->type
;
2649 font_assert (CONSP (val
));
2650 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2651 font_assert (CONSP (val
));
2652 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2653 val
= XCDR (XCAR (val
));
2657 static int num_fonts
;
2660 font_clear_cache (f
, cache
, driver
)
2663 struct font_driver
*driver
;
2665 Lisp_Object tail
, elt
;
2666 Lisp_Object tail2
, entity
;
2668 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2669 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2672 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2673 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2675 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2677 entity
= XCAR (tail2
);
2679 if (FONT_ENTITY_P (entity
)
2680 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2682 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2684 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2686 Lisp_Object val
= XCAR (objlist
);
2687 struct font
*font
= XFONT_OBJECT (val
);
2689 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2691 font_assert (font
&& driver
== font
->driver
);
2692 driver
->close (f
, font
);
2696 if (driver
->free_entity
)
2697 driver
->free_entity (entity
);
2702 XSETCDR (cache
, Qnil
);
2706 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2709 font_delete_unmatched (list
, spec
, size
)
2710 Lisp_Object list
, spec
;
2713 Lisp_Object entity
, val
;
2714 enum font_property_index prop
;
2716 for (val
= Qnil
; CONSP (list
); list
= XCDR (list
))
2718 entity
= XCAR (list
);
2719 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2720 if (INTEGERP (AREF (spec
, prop
))
2721 && ((XINT (AREF (spec
, prop
)) >> 8)
2722 != (XINT (AREF (entity
, prop
)) >> 8)))
2723 prop
= FONT_SPEC_MAX
;
2724 if (prop
< FONT_SPEC_MAX
2726 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2728 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2731 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2732 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2733 prop
= FONT_SPEC_MAX
;
2735 if (prop
< FONT_SPEC_MAX
2736 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2737 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2738 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2739 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2740 prop
= FONT_SPEC_MAX
;
2741 if (prop
< FONT_SPEC_MAX
2742 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2743 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2744 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2745 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2746 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2747 prop
= FONT_SPEC_MAX
;
2748 if (prop
< FONT_SPEC_MAX
)
2749 val
= Fcons (entity
, val
);
2755 /* Return a vector of font-entities matching with SPEC on FRAME. */
2758 font_list_entities (frame
, spec
)
2759 Lisp_Object frame
, spec
;
2761 FRAME_PTR f
= XFRAME (frame
);
2762 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2763 Lisp_Object ftype
, val
;
2766 int need_filtering
= 0;
2769 font_assert (FONT_SPEC_P (spec
));
2771 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2772 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2773 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2774 size
= font_pixel_size (f
, spec
);
2778 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2779 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2780 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2781 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2783 ASET (scratch_font_spec
, i
, Qnil
);
2784 if (! NILP (AREF (spec
, i
)))
2786 if (i
== FONT_DPI_INDEX
)
2787 /* Skip FONT_SPACING_INDEX */
2790 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2791 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2793 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2797 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2799 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2801 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2803 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2804 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2811 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2812 copy
= Fcopy_font_spec (scratch_font_spec
);
2813 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2814 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2816 if (! NILP (val
) && need_filtering
)
2817 val
= font_delete_unmatched (val
, spec
, size
);
2822 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2823 font_add_log ("list", spec
, val
);
2828 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2829 nil, is an array of face's attributes, which specifies preferred
2830 font-related attributes. */
2833 font_matching_entity (f
, attrs
, spec
)
2835 Lisp_Object
*attrs
, spec
;
2837 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2838 Lisp_Object ftype
, size
, entity
;
2840 Lisp_Object work
= Fcopy_font_spec (spec
);
2842 XSETFRAME (frame
, f
);
2843 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2844 size
= AREF (spec
, FONT_SIZE_INDEX
);
2847 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2848 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2849 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2850 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2853 for (; driver_list
; driver_list
= driver_list
->next
)
2855 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2857 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2860 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2861 entity
= assoc_no_quit (work
, XCDR (cache
));
2863 entity
= XCDR (entity
);
2866 entity
= driver_list
->driver
->match (frame
, work
);
2867 copy
= Fcopy_font_spec (work
);
2868 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2869 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2871 if (! NILP (entity
))
2874 font_add_log ("match", work
, entity
);
2879 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2880 opened font object. */
2883 font_open_entity (f
, entity
, pixel_size
)
2888 struct font_driver_list
*driver_list
;
2889 Lisp_Object objlist
, size
, val
, font_object
;
2891 int min_width
, height
;
2892 int scaled_pixel_size
;
2894 font_assert (FONT_ENTITY_P (entity
));
2895 size
= AREF (entity
, FONT_SIZE_INDEX
);
2896 if (XINT (size
) != 0)
2897 scaled_pixel_size
= pixel_size
= XINT (size
);
2898 else if (CONSP (Vface_font_rescale_alist
))
2899 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2901 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2902 objlist
= XCDR (objlist
))
2903 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2904 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2905 return XCAR (objlist
);
2907 val
= AREF (entity
, FONT_TYPE_INDEX
);
2908 for (driver_list
= f
->font_driver_list
;
2909 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2910 driver_list
= driver_list
->next
);
2914 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2915 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2916 font_add_log ("open", entity
, font_object
);
2917 if (NILP (font_object
))
2919 ASET (entity
, FONT_OBJLIST_INDEX
,
2920 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2921 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
2924 font
= XFONT_OBJECT (font_object
);
2925 min_width
= (font
->min_width
? font
->min_width
2926 : font
->average_width
? font
->average_width
2927 : font
->space_width
? font
->space_width
2929 height
= (font
->height
? font
->height
: 1);
2930 #ifdef HAVE_WINDOW_SYSTEM
2931 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2932 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2934 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2935 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2936 fonts_changed_p
= 1;
2940 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2941 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2942 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2943 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2951 /* Close FONT_OBJECT that is opened on frame F. */
2954 font_close_object (f
, font_object
)
2956 Lisp_Object font_object
;
2958 struct font
*font
= XFONT_OBJECT (font_object
);
2960 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2961 /* Already closed. */
2963 font_add_log ("close", font_object
, Qnil
);
2964 font
->driver
->close (f
, font
);
2965 #ifdef HAVE_WINDOW_SYSTEM
2966 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2967 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2973 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2974 FONT is a font-entity and it must be opened to check. */
2977 font_has_char (f
, font
, c
)
2984 if (FONT_ENTITY_P (font
))
2986 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2987 struct font_driver_list
*driver_list
;
2989 for (driver_list
= f
->font_driver_list
;
2990 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2991 driver_list
= driver_list
->next
);
2994 if (! driver_list
->driver
->has_char
)
2996 return driver_list
->driver
->has_char (font
, c
);
2999 font_assert (FONT_OBJECT_P (font
));
3000 fontp
= XFONT_OBJECT (font
);
3001 if (fontp
->driver
->has_char
)
3003 int result
= fontp
->driver
->has_char (font
, c
);
3008 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
3012 /* Return the glyph ID of FONT_OBJECT for character C. */
3015 font_encode_char (font_object
, c
)
3016 Lisp_Object font_object
;
3021 font_assert (FONT_OBJECT_P (font_object
));
3022 font
= XFONT_OBJECT (font_object
);
3023 return font
->driver
->encode_char (font
, c
);
3027 /* Return the name of FONT_OBJECT. */
3030 font_get_name (font_object
)
3031 Lisp_Object font_object
;
3033 font_assert (FONT_OBJECT_P (font_object
));
3034 return AREF (font_object
, FONT_NAME_INDEX
);
3038 /* Return the specification of FONT_OBJECT. */
3041 font_get_spec (font_object
)
3042 Lisp_Object font_object
;
3044 Lisp_Object spec
= font_make_spec ();
3047 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
3048 ASET (spec
, i
, AREF (font_object
, i
));
3049 ASET (spec
, FONT_SIZE_INDEX
,
3050 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
3055 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3056 could not be parsed by font_parse_name, return Qnil. */
3059 font_spec_from_name (font_name
)
3060 Lisp_Object font_name
;
3062 Lisp_Object spec
= Ffont_spec (0, NULL
);
3064 CHECK_STRING (font_name
);
3065 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3067 font_put_extra (spec
, QCname
, font_name
);
3073 font_clear_prop (attrs
, prop
)
3075 enum font_property_index prop
;
3077 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3081 if (NILP (AREF (font
, prop
))
3082 && prop
!= FONT_FAMILY_INDEX
3083 && prop
!= FONT_FOUNDRY_INDEX
3084 && prop
!= FONT_WIDTH_INDEX
3085 && prop
!= FONT_SIZE_INDEX
)
3087 font
= Fcopy_font_spec (font
);
3088 ASET (font
, prop
, Qnil
);
3089 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3091 if (prop
== FONT_FAMILY_INDEX
)
3093 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3094 /* If we are setting the font family, we must also clear
3095 FONT_WIDTH_INDEX to avoid rejecting families that lack
3096 support for some widths. */
3097 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3099 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3100 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3101 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3102 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3103 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3104 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3106 else if (prop
== FONT_SIZE_INDEX
)
3108 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3109 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3110 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3112 else if (prop
== FONT_WIDTH_INDEX
)
3113 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3114 attrs
[LFACE_FONT_INDEX
] = font
;
3118 font_update_lface (f
, attrs
)
3124 spec
= attrs
[LFACE_FONT_INDEX
];
3125 if (! FONT_SPEC_P (spec
))
3128 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3129 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3130 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3131 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3132 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3133 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3134 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3135 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);
3136 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3137 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3138 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3142 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3147 val
= Ffont_get (spec
, QCdpi
);
3150 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3152 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3154 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3156 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3157 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3163 /* Selecte a font from ENTITIES that supports C and matches best with
3164 ATTRS and PIXEL_SIZE. */
3167 font_select_entity (frame
, entities
, attrs
, pixel_size
, c
)
3168 Lisp_Object frame
, entities
, *attrs
;
3171 Lisp_Object font_entity
;
3173 Lisp_Object props
[FONT_REGISTRY_INDEX
+ 1] ;
3175 FRAME_PTR f
= XFRAME (frame
);
3177 if (ASIZE (entities
) == 1)
3179 font_entity
= AREF (entities
, 0);
3181 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3186 /* Sort fonts by properties specified in ATTRS. */
3187 prefer
= scratch_font_prefer
;
3189 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3190 ASET (prefer
, i
, Qnil
);
3191 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3193 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3195 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3196 ASET (prefer
, i
, AREF (face_font
, i
));
3198 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3199 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3200 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3201 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3202 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3203 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3204 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3205 entities
= font_sort_entites (entities
, prefer
, frame
, c
< 0);
3210 for (i
= 0; i
< ASIZE (entities
); i
++)
3214 font_entity
= AREF (entities
, i
);
3217 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3218 if (! EQ (AREF (font_entity
, j
), props
[j
]))
3220 if (j
> FONT_REGISTRY_INDEX
)
3223 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3224 props
[j
] = AREF (font_entity
, j
);
3225 result
= font_has_char (f
, font_entity
, c
);
3232 /* Return a font-entity satisfying SPEC and best matching with face's
3233 font related attributes in ATTRS. C, if not negative, is a
3234 character that the entity must support. */
3237 font_find_for_lface (f
, attrs
, spec
, c
)
3244 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
3245 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3247 int i
, j
, k
, l
, result
;
3249 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3250 if (NILP (registry
[0]))
3252 registry
[0] = DEFAULT_ENCODING
;
3253 registry
[1] = Qascii_0
;
3254 registry
[2] = null_vector
;
3257 registry
[1] = null_vector
;
3259 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3261 struct charset
*encoding
, *repertory
;
3263 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3264 &encoding
, &repertory
) < 0)
3268 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3270 /* Any font of this registry support C. So, let's
3271 suppress the further checking. */
3274 else if (c
> encoding
->max_char
)
3278 work
= Fcopy_font_spec (spec
);
3279 XSETFRAME (frame
, f
);
3280 size
= AREF (spec
, FONT_SIZE_INDEX
);
3281 pixel_size
= font_pixel_size (f
, spec
);
3282 if (pixel_size
== 0)
3284 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3286 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3288 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3289 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3290 if (! NILP (foundry
[0]))
3291 foundry
[1] = null_vector
;
3292 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3294 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3295 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3297 foundry
[2] = null_vector
;
3300 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3302 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3303 if (! NILP (adstyle
[0]))
3304 adstyle
[1] = null_vector
;
3305 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3307 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3309 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3311 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3313 adstyle
[2] = null_vector
;
3316 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3319 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3322 val
= AREF (work
, FONT_FAMILY_INDEX
);
3323 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3325 val
= attrs
[LFACE_FAMILY_INDEX
];
3326 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3330 family
= alloca ((sizeof family
[0]) * 2);
3332 family
[1] = null_vector
; /* terminator. */
3337 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3345 if (! NILP (alters
))
3347 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3348 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3349 family
[i
] = XCAR (alters
);
3350 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3352 family
[i
] = null_vector
;
3356 family
= alloca ((sizeof family
[0]) * 3);
3359 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3361 family
[i
] = null_vector
;
3365 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3367 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3368 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3370 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3371 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3373 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3374 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3376 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3377 entities
= font_list_entities (frame
, work
);
3378 if (ASIZE (entities
) > 0)
3380 val
= font_select_entity (frame
, entities
,
3381 attrs
, pixel_size
, c
);
3394 font_open_for_lface (f
, entity
, attrs
, spec
)
3402 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3403 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3404 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3405 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3406 size
= font_pixel_size (f
, spec
);
3410 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3411 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3414 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3415 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3416 if (INTEGERP (height
))
3419 abort(); /* We should never end up here. */
3423 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3427 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3428 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3432 return font_open_entity (f
, entity
, size
);
3436 /* Find a font satisfying SPEC and best matching with face's
3437 attributes in ATTRS on FRAME, and return the opened
3441 font_load_for_lface (f
, attrs
, spec
)
3443 Lisp_Object
*attrs
, spec
;
3447 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3450 /* No font is listed for SPEC, but each font-backend may have
3451 the different criteria about "font matching". So, try
3453 entity
= font_matching_entity (f
, attrs
, spec
);
3457 return font_open_for_lface (f
, entity
, attrs
, spec
);
3461 /* Make FACE on frame F ready to use the font opened for FACE. */
3464 font_prepare_for_face (f
, face
)
3468 if (face
->font
->driver
->prepare_face
)
3469 face
->font
->driver
->prepare_face (f
, face
);
3473 /* Make FACE on frame F stop using the font opened for FACE. */
3476 font_done_for_face (f
, face
)
3480 if (face
->font
->driver
->done_face
)
3481 face
->font
->driver
->done_face (f
, face
);
3486 /* Open a font matching with font-spec SPEC on frame F. If no proper
3487 font is found, return Qnil. */
3490 font_open_by_spec (f
, spec
)
3494 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3496 /* We set up the default font-related attributes of a face to prefer
3498 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3499 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3500 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3502 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3504 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3506 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3508 return font_load_for_lface (f
, attrs
, spec
);
3512 /* Open a font matching with NAME on frame F. If no proper font is
3513 found, return Qnil. */
3516 font_open_by_name (f
, name
)
3520 Lisp_Object args
[2];
3524 args
[1] = make_unibyte_string (name
, strlen (name
));
3525 spec
= Ffont_spec (2, args
);
3526 return font_open_by_spec (f
, spec
);
3530 /* Register font-driver DRIVER. This function is used in two ways.
3532 The first is with frame F non-NULL. In this case, make DRIVER
3533 available (but not yet activated) on F. All frame creaters
3534 (e.g. Fx_create_frame) must call this function at least once with
3535 an available font-driver.
3537 The second is with frame F NULL. In this case, DRIVER is globally
3538 registered in the variable `font_driver_list'. All font-driver
3539 implementations must call this function in its syms_of_XXXX
3540 (e.g. syms_of_xfont). */
3543 register_font_driver (driver
, f
)
3544 struct font_driver
*driver
;
3547 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3548 struct font_driver_list
*prev
, *list
;
3550 if (f
&& ! driver
->draw
)
3551 error ("Unusable font driver for a frame: %s",
3552 SDATA (SYMBOL_NAME (driver
->type
)));
3554 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3555 if (EQ (list
->driver
->type
, driver
->type
))
3556 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3558 list
= xmalloc (sizeof (struct font_driver_list
));
3560 list
->driver
= driver
;
3565 f
->font_driver_list
= list
;
3567 font_driver_list
= list
;
3573 free_font_driver_list (f
)
3576 struct font_driver_list
*list
, *next
;
3578 for (list
= f
->font_driver_list
; list
; list
= next
)
3583 f
->font_driver_list
= NULL
;
3587 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3588 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3589 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3591 A caller must free all realized faces if any in advance. The
3592 return value is a list of font backends actually made used on
3596 font_update_drivers (f
, new_drivers
)
3598 Lisp_Object new_drivers
;
3600 Lisp_Object active_drivers
= Qnil
;
3601 struct font_driver
*driver
;
3602 struct font_driver_list
*list
;
3604 /* At first, turn off non-requested drivers, and turn on requested
3606 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3608 driver
= list
->driver
;
3609 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3614 if (driver
->end_for_frame
)
3615 driver
->end_for_frame (f
);
3616 font_finish_cache (f
, driver
);
3621 if (! driver
->start_for_frame
3622 || driver
->start_for_frame (f
) == 0)
3624 font_prepare_cache (f
, driver
);
3631 if (NILP (new_drivers
))
3634 if (! EQ (new_drivers
, Qt
))
3636 /* Re-order the driver list according to new_drivers. */
3637 struct font_driver_list
**list_table
, **next
;
3641 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3642 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3644 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3645 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3648 list_table
[i
++] = list
;
3650 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3652 list_table
[i
++] = list
;
3653 list_table
[i
] = NULL
;
3655 next
= &f
->font_driver_list
;
3656 for (i
= 0; list_table
[i
]; i
++)
3658 *next
= list_table
[i
];
3659 next
= &(*next
)->next
;
3664 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3666 active_drivers
= nconc2 (active_drivers
,
3667 Fcons (list
->driver
->type
, Qnil
));
3668 return active_drivers
;
3672 font_put_frame_data (f
, driver
, data
)
3674 struct font_driver
*driver
;
3677 struct font_data_list
*list
, *prev
;
3679 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3680 prev
= list
, list
= list
->next
)
3681 if (list
->driver
== driver
)
3688 prev
->next
= list
->next
;
3690 f
->font_data_list
= list
->next
;
3698 list
= xmalloc (sizeof (struct font_data_list
));
3699 list
->driver
= driver
;
3700 list
->next
= f
->font_data_list
;
3701 f
->font_data_list
= list
;
3709 font_get_frame_data (f
, driver
)
3711 struct font_driver
*driver
;
3713 struct font_data_list
*list
;
3715 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3716 if (list
->driver
== driver
)
3724 /* Return the font used to draw character C by FACE at buffer position
3725 POS in window W. If STRING is non-nil, it is a string containing C
3726 at index POS. If C is negative, get C from the current buffer or
3730 font_at (c
, pos
, face
, w
, string
)
3739 Lisp_Object font_object
;
3741 multibyte
= (NILP (string
)
3742 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3743 : STRING_MULTIBYTE (string
));
3750 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3752 c
= FETCH_CHAR (pos_byte
);
3755 c
= FETCH_BYTE (pos
);
3761 multibyte
= STRING_MULTIBYTE (string
);
3764 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3766 str
= SDATA (string
) + pos_byte
;
3767 c
= STRING_CHAR (str
, 0);
3770 c
= SDATA (string
)[pos
];
3774 f
= XFRAME (w
->frame
);
3775 if (! FRAME_WINDOW_P (f
))
3782 if (STRINGP (string
))
3783 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3784 DEFAULT_FACE_ID
, 0);
3786 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3788 face
= FACE_FROM_ID (f
, face_id
);
3792 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3793 face
= FACE_FROM_ID (f
, face_id
);
3798 XSETFONT (font_object
, face
->font
);
3803 #ifdef HAVE_WINDOW_SYSTEM
3805 /* Check how many characters after POS (at most to *LIMIT) can be
3806 displayed by the same font on the window W. FACE, if non-NULL, is
3807 the face selected for the character at POS. If STRING is not nil,
3808 it is the string to check instead of the current buffer. In that
3809 case, FACE must be not NULL.
3811 The return value is the font-object for the character at POS.
3812 *LIMIT is set to the position where that font can't be used.
3814 It is assured that the current buffer (or STRING) is multibyte. */
3817 font_range (pos
, limit
, w
, face
, string
)
3818 EMACS_INT pos
, *limit
;
3823 EMACS_INT pos_byte
, ignore
, start
, start_byte
;
3825 Lisp_Object font_object
= Qnil
;
3829 pos_byte
= CHAR_TO_BYTE (pos
);
3834 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
, *limit
, 0);
3835 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3841 pos_byte
= string_char_to_byte (string
, pos
);
3844 start
= pos
, start_byte
= pos_byte
;
3845 while (pos
< *limit
)
3847 Lisp_Object category
;
3850 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3852 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3853 if (NILP (font_object
))
3855 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3856 if (NILP (font_object
))
3861 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3862 if (! EQ (category
, QCf
)
3863 && ! CHAR_VARIATION_SELECTOR_P (c
)
3864 && font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3866 Lisp_Object f
= font_for_char (face
, c
, pos
- 1, string
);
3867 EMACS_INT i
, i_byte
;
3875 i
= start
, i_byte
= start_byte
;
3880 FETCH_CHAR_ADVANCE_NO_CHECK (c
, i
, i_byte
);
3882 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, i
, i_byte
);
3883 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3884 if (! EQ (category
, QCf
)
3885 && ! CHAR_VARIATION_SELECTOR_P (c
)
3886 && font_encode_char (f
, c
) == FONT_INVALID_CODE
)
3902 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3903 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3904 Return nil otherwise.
3905 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3906 which kind of font it is. It must be one of `font-spec', `font-entity',
3908 (object
, extra_type
)
3909 Lisp_Object object
, extra_type
;
3911 if (NILP (extra_type
))
3912 return (FONTP (object
) ? Qt
: Qnil
);
3913 if (EQ (extra_type
, Qfont_spec
))
3914 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3915 if (EQ (extra_type
, Qfont_entity
))
3916 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3917 if (EQ (extra_type
, Qfont_object
))
3918 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3919 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3922 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3923 doc
: /* Return a newly created font-spec with arguments as properties.
3925 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3926 valid font property name listed below:
3928 `:family', `:weight', `:slant', `:width'
3930 They are the same as face attributes of the same name. See
3931 `set-face-attribute'.
3935 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3939 VALUE must be a string or a symbol specifying the additional
3940 typographic style information of a font, e.g. ``sans''.
3944 VALUE must be a string or a symbol specifying the charset registry and
3945 encoding of a font, e.g. ``iso8859-1''.
3949 VALUE must be a non-negative integer or a floating point number
3950 specifying the font size. It specifies the font size in pixels (if
3951 VALUE is an integer), or in points (if VALUE is a float).
3955 VALUE must be a string of XLFD-style or fontconfig-style font name.
3959 VALUE must be a symbol representing a script that the font must
3960 support. It may be a symbol representing a subgroup of a script
3961 listed in the variable `script-representative-chars'.
3965 VALUE must be a symbol of two-letter ISO-639 language names,
3970 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3971 required OpenType features.
3973 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3974 LANGSYS-TAG: OpenType language system tag symbol,
3975 or nil for the default language system.
3976 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3977 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3979 GSUB and GPOS may contain `nil' element. In such a case, the font
3980 must not have any of the remaining elements.
3982 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3983 be an OpenType font, and whose GPOS table of `thai' script's default
3984 language system must contain `mark' feature.
3986 usage: (font-spec ARGS...) */)
3991 Lisp_Object spec
= font_make_spec ();
3994 for (i
= 0; i
< nargs
; i
+= 2)
3996 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3998 if (EQ (key
, QCname
))
4001 font_parse_name ((char *) SDATA (val
), spec
);
4002 font_put_extra (spec
, key
, val
);
4006 int idx
= get_font_prop_index (key
);
4010 val
= font_prop_validate (idx
, Qnil
, val
);
4011 if (idx
< FONT_EXTRA_INDEX
)
4012 ASET (spec
, idx
, val
);
4014 font_put_extra (spec
, key
, val
);
4017 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
4023 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
4024 doc
: /* Return a copy of FONT as a font-spec. */)
4028 Lisp_Object new_spec
, tail
, prev
, extra
;
4032 new_spec
= font_make_spec ();
4033 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
4034 ASET (new_spec
, i
, AREF (font
, i
));
4035 extra
= Fcopy_sequence (AREF (font
, FONT_EXTRA_INDEX
));
4036 /* We must remove :font-entity property. */
4037 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
4038 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
4041 extra
= XCDR (extra
);
4043 XSETCDR (prev
, XCDR (tail
));
4046 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
4050 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
4051 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
4052 Every specified properties in FROM override the corresponding
4053 properties in TO. */)
4055 Lisp_Object from
, to
;
4057 Lisp_Object extra
, tail
;
4062 to
= Fcopy_font_spec (to
);
4063 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
4064 ASET (to
, i
, AREF (from
, i
));
4065 extra
= AREF (to
, FONT_EXTRA_INDEX
);
4066 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
4067 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
4069 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
4072 XSETCDR (slot
, XCDR (XCAR (tail
)));
4074 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
4076 ASET (to
, FONT_EXTRA_INDEX
, extra
);
4080 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
4081 doc
: /* Return the value of FONT's property KEY.
4082 FONT is a font-spec, a font-entity, or a font-object.
4083 KEY must be one of these symbols:
4084 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4085 :size, :name, :script
4086 See the documentation of `font-spec' for their meanings.
4087 If FONT is a font-entity or font-object, the value of :script may be
4088 a list of scripts that are supported by the font. */)
4090 Lisp_Object font
, key
;
4097 idx
= get_font_prop_index (key
);
4098 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4099 return font_style_symbolic (font
, idx
, 0);
4100 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4101 return AREF (font
, idx
);
4102 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
4105 #ifdef HAVE_WINDOW_SYSTEM
4107 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4108 doc
: /* Return a plist of face attributes generated by FONT.
4109 FONT is a font name, a font-spec, a font-entity, or a font-object.
4110 The return value is a list of the form
4112 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4114 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4115 compatible with `set-face-attribute'. Some of these key-attribute pairs
4116 may be omitted from the list if they are not specified by FONT.
4118 The optional argument FRAME specifies the frame that the face attributes
4119 are to be displayed on. If omitted, the selected frame is used. */)
4121 Lisp_Object font
, frame
;
4124 Lisp_Object plist
[10];
4129 frame
= selected_frame
;
4130 CHECK_LIVE_FRAME (frame
);
4135 int fontset
= fs_query_fontset (font
, 0);
4136 Lisp_Object name
= font
;
4138 font
= fontset_ascii (fontset
);
4139 font
= font_spec_from_name (name
);
4141 signal_error ("Invalid font name", name
);
4143 else if (! FONTP (font
))
4144 signal_error ("Invalid font object", font
);
4146 val
= AREF (font
, FONT_FAMILY_INDEX
);
4149 plist
[n
++] = QCfamily
;
4150 plist
[n
++] = SYMBOL_NAME (val
);
4153 val
= AREF (font
, FONT_SIZE_INDEX
);
4156 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4157 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4158 plist
[n
++] = QCheight
;
4159 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4161 else if (FLOATP (val
))
4163 plist
[n
++] = QCheight
;
4164 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4167 val
= FONT_WEIGHT_FOR_FACE (font
);
4170 plist
[n
++] = QCweight
;
4174 val
= FONT_SLANT_FOR_FACE (font
);
4177 plist
[n
++] = QCslant
;
4181 val
= FONT_WIDTH_FOR_FACE (font
);
4184 plist
[n
++] = QCwidth
;
4188 return Flist (n
, plist
);
4193 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4194 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
4195 (font_spec
, prop
, val
)
4196 Lisp_Object font_spec
, prop
, val
;
4200 CHECK_FONT_SPEC (font_spec
);
4201 idx
= get_font_prop_index (prop
);
4202 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4203 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
4205 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
4209 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4210 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4211 Optional 2nd argument FRAME specifies the target frame.
4212 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4213 Optional 4th argument PREFER, if non-nil, is a font-spec to
4214 control the order of the returned list. Fonts are sorted by
4215 how close they are to PREFER. */)
4216 (font_spec
, frame
, num
, prefer
)
4217 Lisp_Object font_spec
, frame
, num
, prefer
;
4219 Lisp_Object vec
, list
, tail
;
4223 frame
= selected_frame
;
4224 CHECK_LIVE_FRAME (frame
);
4225 CHECK_FONT_SPEC (font_spec
);
4233 if (! NILP (prefer
))
4234 CHECK_FONT_SPEC (prefer
);
4236 vec
= font_list_entities (frame
, font_spec
);
4241 return Fcons (AREF (vec
, 0), Qnil
);
4243 if (! NILP (prefer
))
4244 vec
= font_sort_entites (vec
, prefer
, frame
, 0);
4246 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
4247 if (n
== 0 || n
> len
)
4249 for (i
= 1; i
< n
; i
++)
4251 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
4253 XSETCDR (tail
, val
);
4259 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4260 doc
: /* List available font families on the current frame.
4261 Optional argument FRAME, if non-nil, specifies the target frame. */)
4266 struct font_driver_list
*driver_list
;
4270 frame
= selected_frame
;
4271 CHECK_LIVE_FRAME (frame
);
4274 for (driver_list
= f
->font_driver_list
; driver_list
;
4275 driver_list
= driver_list
->next
)
4276 if (driver_list
->driver
->list_family
)
4278 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4279 Lisp_Object tail
= list
;
4281 for (; CONSP (val
); val
= XCDR (val
))
4282 if (NILP (Fmemq (XCAR (val
), tail
))
4283 && SYMBOLP (XCAR (val
)))
4284 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4289 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4290 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4291 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4293 Lisp_Object font_spec
, frame
;
4295 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4302 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4303 doc
: /* Return XLFD name of FONT.
4304 FONT is a font-spec, font-entity, or font-object.
4305 If the name is too long for XLFD (maximum 255 chars), return nil.
4306 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4307 the consecutive wildcards are folded to one. */)
4308 (font
, fold_wildcards
)
4309 Lisp_Object font
, fold_wildcards
;
4316 if (FONT_OBJECT_P (font
))
4318 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4320 if (STRINGP (font_name
)
4321 && SDATA (font_name
)[0] == '-')
4323 if (NILP (fold_wildcards
))
4325 strcpy (name
, (char *) SDATA (font_name
));
4328 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4330 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4333 if (! NILP (fold_wildcards
))
4335 char *p0
= name
, *p1
;
4337 while ((p1
= strstr (p0
, "-*-*")))
4339 strcpy (p1
, p1
+ 2);
4344 return build_string (name
);
4347 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4348 doc
: /* Clear font cache. */)
4351 Lisp_Object list
, frame
;
4353 FOR_EACH_FRAME (list
, frame
)
4355 FRAME_PTR f
= XFRAME (frame
);
4356 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4358 for (; driver_list
; driver_list
= driver_list
->next
)
4359 if (driver_list
->on
)
4361 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4366 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4368 font_assert (! NILP (val
));
4369 val
= XCDR (XCAR (val
));
4370 if (XINT (XCAR (val
)) == 0)
4372 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4373 XSETCDR (cache
, XCDR (val
));
4383 font_fill_lglyph_metrics (glyph
, font_object
)
4384 Lisp_Object glyph
, font_object
;
4386 struct font
*font
= XFONT_OBJECT (font_object
);
4388 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4389 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4390 struct font_metrics metrics
;
4392 LGLYPH_SET_CODE (glyph
, ecode
);
4394 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4395 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4396 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4397 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4398 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4399 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4403 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4404 doc
: /* Shape the glyph-string GSTRING.
4405 Shaping means substituting glyphs and/or adjusting positions of glyphs
4406 to get the correct visual image of character sequences set in the
4407 header of the glyph-string.
4409 If the shaping was successful, the value is GSTRING itself or a newly
4410 created glyph-string. Otherwise, the value is nil. */)
4412 Lisp_Object gstring
;
4415 Lisp_Object font_object
, n
, glyph
;
4418 if (! composition_gstring_p (gstring
))
4419 signal_error ("Invalid glyph-string: ", gstring
);
4420 if (! NILP (LGSTRING_ID (gstring
)))
4422 font_object
= LGSTRING_FONT (gstring
);
4423 CHECK_FONT_OBJECT (font_object
);
4424 font
= XFONT_OBJECT (font_object
);
4425 if (! font
->driver
->shape
)
4428 /* Try at most three times with larger gstring each time. */
4429 for (i
= 0; i
< 3; i
++)
4431 n
= font
->driver
->shape (gstring
);
4434 gstring
= larger_vector (gstring
,
4435 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4438 if (i
== 3 || XINT (n
) == 0)
4441 glyph
= LGSTRING_GLYPH (gstring
, 0);
4442 from
= LGLYPH_FROM (glyph
);
4443 to
= LGLYPH_TO (glyph
);
4444 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4446 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4450 if (NILP (LGLYPH_ADJUSTMENT (this)))
4455 glyph
= LGSTRING_GLYPH (gstring
, j
);
4456 LGLYPH_SET_FROM (glyph
, from
);
4457 LGLYPH_SET_TO (glyph
, to
);
4459 from
= LGLYPH_FROM (this);
4460 to
= LGLYPH_TO (this);
4465 if (from
> LGLYPH_FROM (this))
4466 from
= LGLYPH_FROM (this);
4467 if (to
< LGLYPH_TO (this))
4468 to
= LGLYPH_TO (this);
4474 glyph
= LGSTRING_GLYPH (gstring
, j
);
4475 LGLYPH_SET_FROM (glyph
, from
);
4476 LGLYPH_SET_TO (glyph
, to
);
4478 return composition_gstring_put_cache (gstring
, XINT (n
));
4481 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4483 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4484 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4486 VARIATION-SELECTOR is a chracter code of variation selection
4487 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4488 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4489 (font_object
, character
)
4490 Lisp_Object font_object
, character
;
4492 unsigned variations
[256];
4497 CHECK_FONT_OBJECT (font_object
);
4498 CHECK_CHARACTER (character
);
4499 font
= XFONT_OBJECT (font_object
);
4500 if (! font
->driver
->get_variation_glyphs
)
4502 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4506 for (i
= 0; i
< 255; i
++)
4510 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4511 /* Stops GCC whining about limited range of data type. */
4512 EMACS_INT var
= variations
[i
];
4514 if (var
> MOST_POSITIVE_FIXNUM
)
4515 code
= Fcons (make_number ((variations
[i
]) >> 16),
4516 make_number ((variations
[i
]) & 0xFFFF));
4518 code
= make_number (variations
[i
]);
4519 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4526 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4527 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4528 OTF-FEATURES specifies which features to apply in this format:
4529 (SCRIPT LANGSYS GSUB GPOS)
4531 SCRIPT is a symbol specifying a script tag of OpenType,
4532 LANGSYS is a symbol specifying a langsys tag of OpenType,
4533 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4535 If LANGYS is nil, the default langsys is selected.
4537 The features are applied in the order they appear in the list. The
4538 symbol `*' means to apply all available features not present in this
4539 list, and the remaining features are ignored. For instance, (vatu
4540 pstf * haln) is to apply vatu and pstf in this order, then to apply
4541 all available features other than vatu, pstf, and haln.
4543 The features are applied to the glyphs in the range FROM and TO of
4544 the glyph-string GSTRING-IN.
4546 If some feature is actually applicable, the resulting glyphs are
4547 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4548 this case, the value is the number of produced glyphs.
4550 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4553 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4554 produced in GSTRING-OUT, and the value is nil.
4556 See the documentation of `font-make-gstring' for the format of
4558 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4559 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4561 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4566 check_otf_features (otf_features
);
4567 CHECK_FONT_OBJECT (font_object
);
4568 font
= XFONT_OBJECT (font_object
);
4569 if (! font
->driver
->otf_drive
)
4570 error ("Font backend %s can't drive OpenType GSUB table",
4571 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4572 CHECK_CONS (otf_features
);
4573 CHECK_SYMBOL (XCAR (otf_features
));
4574 val
= XCDR (otf_features
);
4575 CHECK_SYMBOL (XCAR (val
));
4576 val
= XCDR (otf_features
);
4579 len
= check_gstring (gstring_in
);
4580 CHECK_VECTOR (gstring_out
);
4581 CHECK_NATNUM (from
);
4583 CHECK_NATNUM (index
);
4585 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4586 args_out_of_range_3 (from
, to
, make_number (len
));
4587 if (XINT (index
) >= ASIZE (gstring_out
))
4588 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4589 num
= font
->driver
->otf_drive (font
, otf_features
,
4590 gstring_in
, XINT (from
), XINT (to
),
4591 gstring_out
, XINT (index
), 0);
4594 return make_number (num
);
4597 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4599 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4600 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4602 (SCRIPT LANGSYS FEATURE ...)
4603 See the documentation of `font-drive-otf' for more detail.
4605 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4606 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4607 character code corresponding to the glyph or nil if there's no
4608 corresponding character. */)
4609 (font_object
, character
, otf_features
)
4610 Lisp_Object font_object
, character
, otf_features
;
4613 Lisp_Object gstring_in
, gstring_out
, g
;
4614 Lisp_Object alternates
;
4617 CHECK_FONT_GET_OBJECT (font_object
, font
);
4618 if (! font
->driver
->otf_drive
)
4619 error ("Font backend %s can't drive OpenType GSUB table",
4620 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4621 CHECK_CHARACTER (character
);
4622 CHECK_CONS (otf_features
);
4624 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4625 g
= LGSTRING_GLYPH (gstring_in
, 0);
4626 LGLYPH_SET_CHAR (g
, XINT (character
));
4627 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4628 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4629 gstring_out
, 0, 1)) < 0)
4630 gstring_out
= Ffont_make_gstring (font_object
,
4631 make_number (ASIZE (gstring_out
) * 2));
4633 for (i
= 0; i
< num
; i
++)
4635 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4636 int c
= LGLYPH_CHAR (g
);
4637 unsigned code
= LGLYPH_CODE (g
);
4639 alternates
= Fcons (Fcons (make_number (code
),
4640 c
> 0 ? make_number (c
) : Qnil
),
4643 return Fnreverse (alternates
);
4649 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4650 doc
: /* Open FONT-ENTITY. */)
4651 (font_entity
, size
, frame
)
4652 Lisp_Object font_entity
;
4658 CHECK_FONT_ENTITY (font_entity
);
4660 frame
= selected_frame
;
4661 CHECK_LIVE_FRAME (frame
);
4664 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4667 CHECK_NUMBER_OR_FLOAT (size
);
4669 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4671 isize
= XINT (size
);
4675 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4678 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4679 doc
: /* Close FONT-OBJECT. */)
4680 (font_object
, frame
)
4681 Lisp_Object font_object
, frame
;
4683 CHECK_FONT_OBJECT (font_object
);
4685 frame
= selected_frame
;
4686 CHECK_LIVE_FRAME (frame
);
4687 font_close_object (XFRAME (frame
), font_object
);
4691 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4692 doc
: /* Return information about FONT-OBJECT.
4693 The value is a vector:
4694 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4697 NAME is a string of the font name (or nil if the font backend doesn't
4700 FILENAME is a string of the font file (or nil if the font backend
4701 doesn't provide a file name).
4703 PIXEL-SIZE is a pixel size by which the font is opened.
4705 SIZE is a maximum advance width of the font in pixels.
4707 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4710 CAPABILITY is a list whose first element is a symbol representing the
4711 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4712 remaining elements describe the details of the font capability.
4714 If the font is OpenType font, the form of the list is
4715 \(opentype GSUB GPOS)
4716 where GSUB shows which "GSUB" features the font supports, and GPOS
4717 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4718 lists of the format:
4719 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4721 If the font is not OpenType font, currently the length of the form is
4724 SCRIPT is a symbol representing OpenType script tag.
4726 LANGSYS is a symbol representing OpenType langsys tag, or nil
4727 representing the default langsys.
4729 FEATURE is a symbol representing OpenType feature tag.
4731 If the font is not OpenType font, CAPABILITY is nil. */)
4733 Lisp_Object font_object
;
4738 CHECK_FONT_GET_OBJECT (font_object
, font
);
4740 val
= Fmake_vector (make_number (9), Qnil
);
4741 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4742 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4743 ASET (val
, 2, make_number (font
->pixel_size
));
4744 ASET (val
, 3, make_number (font
->max_width
));
4745 ASET (val
, 4, make_number (font
->ascent
));
4746 ASET (val
, 5, make_number (font
->descent
));
4747 ASET (val
, 6, make_number (font
->space_width
));
4748 ASET (val
, 7, make_number (font
->average_width
));
4749 if (font
->driver
->otf_capability
)
4750 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4754 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4755 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4756 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4757 (font_object
, string
)
4758 Lisp_Object font_object
, string
;
4764 CHECK_FONT_GET_OBJECT (font_object
, font
);
4765 CHECK_STRING (string
);
4766 len
= SCHARS (string
);
4767 vec
= Fmake_vector (make_number (len
), Qnil
);
4768 for (i
= 0; i
< len
; i
++)
4770 Lisp_Object ch
= Faref (string
, make_number (i
));
4775 struct font_metrics metrics
;
4777 cod
= code
= font
->driver
->encode_char (font
, c
);
4778 if (code
== FONT_INVALID_CODE
)
4780 val
= Fmake_vector (make_number (6), Qnil
);
4781 if (cod
<= MOST_POSITIVE_FIXNUM
)
4782 ASET (val
, 0, make_number (code
));
4784 ASET (val
, 0, Fcons (make_number (code
>> 16),
4785 make_number (code
& 0xFFFF)));
4786 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4787 ASET (val
, 1, make_number (metrics
.lbearing
));
4788 ASET (val
, 2, make_number (metrics
.rbearing
));
4789 ASET (val
, 3, make_number (metrics
.width
));
4790 ASET (val
, 4, make_number (metrics
.ascent
));
4791 ASET (val
, 5, make_number (metrics
.descent
));
4797 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4798 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4799 FONT is a font-spec, font-entity, or font-object. */)
4801 Lisp_Object spec
, font
;
4803 CHECK_FONT_SPEC (spec
);
4806 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4809 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4810 doc
: /* Return a font-object for displaying a character at POSITION.
4811 Optional second arg WINDOW, if non-nil, is a window displaying
4812 the current buffer. It defaults to the currently selected window. */)
4813 (position
, window
, string
)
4814 Lisp_Object position
, window
, string
;
4821 CHECK_NUMBER_COERCE_MARKER (position
);
4822 pos
= XINT (position
);
4823 if (pos
< BEGV
|| pos
>= ZV
)
4824 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4828 CHECK_NUMBER (position
);
4829 CHECK_STRING (string
);
4830 pos
= XINT (position
);
4831 if (pos
< 0 || pos
>= SCHARS (string
))
4832 args_out_of_range (string
, position
);
4835 window
= selected_window
;
4836 CHECK_LIVE_WINDOW (window
);
4837 w
= XWINDOW (window
);
4839 return font_at (-1, pos
, NULL
, w
, string
);
4843 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4844 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4845 The value is a number of glyphs drawn.
4846 Type C-l to recover what previously shown. */)
4847 (font_object
, string
)
4848 Lisp_Object font_object
, string
;
4850 Lisp_Object frame
= selected_frame
;
4851 FRAME_PTR f
= XFRAME (frame
);
4857 CHECK_FONT_GET_OBJECT (font_object
, font
);
4858 CHECK_STRING (string
);
4859 len
= SCHARS (string
);
4860 code
= alloca (sizeof (unsigned) * len
);
4861 for (i
= 0; i
< len
; i
++)
4863 Lisp_Object ch
= Faref (string
, make_number (i
));
4867 code
[i
] = font
->driver
->encode_char (font
, c
);
4868 if (code
[i
] == FONT_INVALID_CODE
)
4871 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4873 if (font
->driver
->prepare_face
)
4874 font
->driver
->prepare_face (f
, face
);
4875 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4876 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4877 if (font
->driver
->done_face
)
4878 font
->driver
->done_face (f
, face
);
4880 return make_number (len
);
4884 #endif /* FONT_DEBUG */
4886 #ifdef HAVE_WINDOW_SYSTEM
4888 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4889 doc
: /* Return information about a font named NAME on frame FRAME.
4890 If FRAME is omitted or nil, use the selected frame.
4891 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4892 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4894 OPENED-NAME is the name used for opening the font,
4895 FULL-NAME is the full name of the font,
4896 SIZE is the maximum bound width of the font,
4897 HEIGHT is the height of the font,
4898 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4899 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4900 how to compose characters.
4901 If the named font is not yet loaded, return nil. */)
4903 Lisp_Object name
, frame
;
4908 Lisp_Object font_object
;
4910 (*check_window_system_func
) ();
4913 CHECK_STRING (name
);
4915 frame
= selected_frame
;
4916 CHECK_LIVE_FRAME (frame
);
4921 int fontset
= fs_query_fontset (name
, 0);
4924 name
= fontset_ascii (fontset
);
4925 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4927 else if (FONT_OBJECT_P (name
))
4929 else if (FONT_ENTITY_P (name
))
4930 font_object
= font_open_entity (f
, name
, 0);
4933 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4934 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4936 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4938 if (NILP (font_object
))
4940 font
= XFONT_OBJECT (font_object
);
4942 info
= Fmake_vector (make_number (7), Qnil
);
4943 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4944 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4945 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4946 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4947 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4948 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4949 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4952 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4953 close it now. Perhaps, we should manage font-objects
4954 by `reference-count'. */
4955 font_close_object (f
, font_object
);
4962 #define BUILD_STYLE_TABLE(TBL) \
4963 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4966 build_style_table (entry
, nelement
)
4967 struct table_entry
*entry
;
4971 Lisp_Object table
, elt
;
4973 table
= Fmake_vector (make_number (nelement
), Qnil
);
4974 for (i
= 0; i
< nelement
; i
++)
4976 for (j
= 0; entry
[i
].names
[j
]; j
++);
4977 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4978 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4979 for (j
= 0; entry
[i
].names
[j
]; j
++)
4980 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4981 ASET (table
, i
, elt
);
4986 static Lisp_Object Vfont_log
;
4987 static int font_log_env_checked
;
4989 /* The deferred font-log data of the form [ACTION ARG RESULT].
4990 If ACTION is not nil, that is added to the log when font_add_log is
4991 called next time. At that time, ACTION is set back to nil. */
4992 static Lisp_Object Vfont_log_deferred
;
4994 /* Prepend the font-related logging data in Vfont_log if it is not
4995 `t'. ACTION describes a kind of font-related action (e.g. listing,
4996 opening), ARG is the argument for the action, and RESULT is the
4997 result of the action. */
4999 font_add_log (action
, arg
, result
)
5001 Lisp_Object arg
, result
;
5003 Lisp_Object tail
, val
;
5006 if (! font_log_env_checked
)
5008 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
5009 font_log_env_checked
= 1;
5011 if (EQ (Vfont_log
, Qt
))
5013 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5015 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
5017 ASET (Vfont_log_deferred
, 0, Qnil
);
5018 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5019 AREF (Vfont_log_deferred
, 2));
5024 Lisp_Object tail
, elt
;
5025 Lisp_Object equalstr
= build_string ("=");
5027 val
= Ffont_xlfd_name (arg
, Qt
);
5028 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5032 if (EQ (XCAR (elt
), QCscript
)
5033 && SYMBOLP (XCDR (elt
)))
5034 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5035 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5036 else if (EQ (XCAR (elt
), QClang
)
5037 && SYMBOLP (XCDR (elt
)))
5038 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5039 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5040 else if (EQ (XCAR (elt
), QCotf
)
5041 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5042 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5044 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5050 val
= Ffont_xlfd_name (result
, Qt
);
5051 if (! FONT_SPEC_P (result
))
5052 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5053 build_string (":"), val
);
5056 else if (CONSP (result
))
5058 result
= Fcopy_sequence (result
);
5059 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5063 val
= Ffont_xlfd_name (val
, Qt
);
5064 XSETCAR (tail
, val
);
5067 else if (VECTORP (result
))
5069 result
= Fcopy_sequence (result
);
5070 for (i
= 0; i
< ASIZE (result
); i
++)
5072 val
= AREF (result
, i
);
5074 val
= Ffont_xlfd_name (val
, Qt
);
5075 ASET (result
, i
, val
);
5078 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5081 /* Record a font-related logging data to be added to Vfont_log when
5082 font_add_log is called next time. ACTION, ARG, RESULT are the same
5086 font_deferred_log (action
, arg
, result
)
5088 Lisp_Object arg
, result
;
5090 ASET (Vfont_log_deferred
, 0, build_string (action
));
5091 ASET (Vfont_log_deferred
, 1, arg
);
5092 ASET (Vfont_log_deferred
, 2, result
);
5095 extern void syms_of_ftfont
P_ (());
5096 extern void syms_of_xfont
P_ (());
5097 extern void syms_of_xftfont
P_ (());
5098 extern void syms_of_ftxfont
P_ (());
5099 extern void syms_of_bdffont
P_ (());
5100 extern void syms_of_w32font
P_ (());
5101 extern void syms_of_atmfont
P_ (());
5102 extern void syms_of_nsfont
P_ (());
5107 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5108 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5109 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5110 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5111 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5112 /* Note that the other elements in sort_shift_bits are not used. */
5114 staticpro (&font_charset_alist
);
5115 font_charset_alist
= Qnil
;
5117 DEFSYM (Qopentype
, "opentype");
5119 DEFSYM (Qascii_0
, "ascii-0");
5120 DEFSYM (Qiso8859_1
, "iso8859-1");
5121 DEFSYM (Qiso10646_1
, "iso10646-1");
5122 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5123 DEFSYM (Qunicode_sip
, "unicode-sip");
5127 DEFSYM (QCotf
, ":otf");
5128 DEFSYM (QClang
, ":lang");
5129 DEFSYM (QCscript
, ":script");
5130 DEFSYM (QCantialias
, ":antialias");
5132 DEFSYM (QCfoundry
, ":foundry");
5133 DEFSYM (QCadstyle
, ":adstyle");
5134 DEFSYM (QCregistry
, ":registry");
5135 DEFSYM (QCspacing
, ":spacing");
5136 DEFSYM (QCdpi
, ":dpi");
5137 DEFSYM (QCscalable
, ":scalable");
5138 DEFSYM (QCavgwidth
, ":avgwidth");
5139 DEFSYM (QCfont_entity
, ":font-entity");
5140 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5147 staticpro (&null_vector
);
5148 null_vector
= Fmake_vector (make_number (0), Qnil
);
5150 staticpro (&scratch_font_spec
);
5151 scratch_font_spec
= Ffont_spec (0, NULL
);
5152 staticpro (&scratch_font_prefer
);
5153 scratch_font_prefer
= Ffont_spec (0, NULL
);
5155 staticpro (&Vfont_log_deferred
);
5156 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5160 staticpro (&otf_list
);
5162 #endif /* HAVE_LIBOTF */
5166 defsubr (&Sfont_spec
);
5167 defsubr (&Sfont_get
);
5168 #ifdef HAVE_WINDOW_SYSTEM
5169 defsubr (&Sfont_face_attributes
);
5171 defsubr (&Sfont_put
);
5172 defsubr (&Slist_fonts
);
5173 defsubr (&Sfont_family_list
);
5174 defsubr (&Sfind_font
);
5175 defsubr (&Sfont_xlfd_name
);
5176 defsubr (&Sclear_font_cache
);
5177 defsubr (&Sfont_shape_gstring
);
5178 defsubr (&Sfont_variation_glyphs
);
5180 defsubr (&Sfont_drive_otf
);
5181 defsubr (&Sfont_otf_alternates
);
5185 defsubr (&Sopen_font
);
5186 defsubr (&Sclose_font
);
5187 defsubr (&Squery_font
);
5188 defsubr (&Sget_font_glyphs
);
5189 defsubr (&Sfont_match_p
);
5190 defsubr (&Sfont_at
);
5192 defsubr (&Sdraw_string
);
5194 #endif /* FONT_DEBUG */
5195 #ifdef HAVE_WINDOW_SYSTEM
5196 defsubr (&Sfont_info
);
5199 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5201 Alist of fontname patterns vs the corresponding encoding and repertory info.
5202 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5203 where ENCODING is a charset or a char-table,
5204 and REPERTORY is a charset, a char-table, or nil.
5206 If ENCODING and REPERTORY are the same, the element can have the form
5207 \(REGEXP . ENCODING).
5209 ENCODING is for converting a character to a glyph code of the font.
5210 If ENCODING is a charset, encoding a character by the charset gives
5211 the corresponding glyph code. If ENCODING is a char-table, looking up
5212 the table by a character gives the corresponding glyph code.
5214 REPERTORY specifies a repertory of characters supported by the font.
5215 If REPERTORY is a charset, all characters beloging to the charset are
5216 supported. If REPERTORY is a char-table, all characters who have a
5217 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5218 gets the repertory information by an opened font and ENCODING. */);
5219 Vfont_encoding_alist
= Qnil
;
5221 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5222 doc
: /* Vector of valid font weight values.
5223 Each element has the form:
5224 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5225 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5226 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5228 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5229 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5230 See `font-weight-table' for the format of the vector. */);
5231 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5233 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5234 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5235 See `font-weight-table' for the format of the vector. */);
5236 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5238 staticpro (&font_style_table
);
5239 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5240 ASET (font_style_table
, 0, Vfont_weight_table
);
5241 ASET (font_style_table
, 1, Vfont_slant_table
);
5242 ASET (font_style_table
, 2, Vfont_width_table
);
5244 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5245 *Logging list of font related actions and results.
5246 The value t means to suppress the logging.
5247 The initial value is set to nil if the environment variable
5248 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5251 #ifdef HAVE_WINDOW_SYSTEM
5252 #ifdef HAVE_FREETYPE
5254 #ifdef HAVE_X_WINDOWS
5259 #endif /* HAVE_XFT */
5260 #endif /* HAVE_X_WINDOWS */
5261 #else /* not HAVE_FREETYPE */
5262 #ifdef HAVE_X_WINDOWS
5264 #endif /* HAVE_X_WINDOWS */
5265 #endif /* not HAVE_FREETYPE */
5268 #endif /* HAVE_BDFFONT */
5271 #endif /* WINDOWSNT */
5274 #endif /* HAVE_NS */
5275 #endif /* HAVE_WINDOW_SYSTEM */
5278 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5279 (do not change this comment) */