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
;
725 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
726 prev
= extra
, extra
= XCDR (extra
);
728 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
730 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
735 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
740 /* Font name parser and unparser */
742 static int parse_matrix
P_ ((char *));
743 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
744 static int font_parse_name
P_ ((char *, Lisp_Object
));
746 /* An enumerator for each field of an XLFD font name. */
747 enum xlfd_field_index
766 /* An enumerator for mask bit corresponding to each XLFD field. */
769 XLFD_FOUNDRY_MASK
= 0x0001,
770 XLFD_FAMILY_MASK
= 0x0002,
771 XLFD_WEIGHT_MASK
= 0x0004,
772 XLFD_SLANT_MASK
= 0x0008,
773 XLFD_SWIDTH_MASK
= 0x0010,
774 XLFD_ADSTYLE_MASK
= 0x0020,
775 XLFD_PIXEL_MASK
= 0x0040,
776 XLFD_POINT_MASK
= 0x0080,
777 XLFD_RESX_MASK
= 0x0100,
778 XLFD_RESY_MASK
= 0x0200,
779 XLFD_SPACING_MASK
= 0x0400,
780 XLFD_AVGWIDTH_MASK
= 0x0800,
781 XLFD_REGISTRY_MASK
= 0x1000,
782 XLFD_ENCODING_MASK
= 0x2000
786 /* Parse P pointing the pixel/point size field of the form
787 `[A B C D]' which specifies a transformation matrix:
793 by which all glyphs of the font are transformed. The spec says
794 that scalar value N for the pixel/point size is equivalent to:
795 A = N * resx/resy, B = C = 0, D = N.
797 Return the scalar value N if the form is valid. Otherwise return
808 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
811 matrix
[i
] = - strtod (p
+ 1, &end
);
813 matrix
[i
] = strtod (p
, &end
);
816 return (i
== 4 ? (int) matrix
[3] : -1);
819 /* Expand a wildcard field in FIELD (the first N fields are filled) to
820 multiple fields to fill in all 14 XLFD fields while restring a
821 field position by its contents. */
824 font_expand_wildcards (field
, n
)
825 Lisp_Object field
[XLFD_LAST_INDEX
];
829 Lisp_Object tmp
[XLFD_LAST_INDEX
];
830 /* Array of information about where this element can go. Nth
831 element is for Nth element of FIELD. */
833 /* Minimum possible field. */
835 /* Maxinum possible field. */
837 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
839 } range
[XLFD_LAST_INDEX
];
841 int range_from
, range_to
;
844 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
845 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
846 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
847 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
848 | XLFD_AVGWIDTH_MASK)
849 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
851 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
852 field. The value is shifted to left one bit by one in the
854 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
855 range_mask
= (range_mask
<< 1) | 1;
857 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
858 position-based retriction for FIELD[I]. */
859 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
860 i
++, range_from
++, range_to
++, range_mask
<<= 1)
862 Lisp_Object val
= field
[i
];
868 range
[i
].from
= range_from
;
869 range
[i
].to
= range_to
;
870 range
[i
].mask
= range_mask
;
874 /* The triplet FROM, TO, and MASK is a value-based
875 retriction for FIELD[I]. */
881 int numeric
= XINT (val
);
884 from
= to
= XLFD_ENCODING_INDEX
,
885 mask
= XLFD_ENCODING_MASK
;
886 else if (numeric
== 0)
887 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
888 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
889 else if (numeric
<= 48)
890 from
= to
= XLFD_PIXEL_INDEX
,
891 mask
= XLFD_PIXEL_MASK
;
893 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
894 mask
= XLFD_LARGENUM_MASK
;
896 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
897 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
898 mask
= XLFD_NULL_MASK
;
900 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
903 Lisp_Object name
= SYMBOL_NAME (val
);
905 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
906 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
907 mask
= XLFD_REGENC_MASK
;
909 from
= to
= XLFD_ENCODING_INDEX
,
910 mask
= XLFD_ENCODING_MASK
;
912 else if (range_from
<= XLFD_WEIGHT_INDEX
913 && range_to
>= XLFD_WEIGHT_INDEX
914 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
915 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
916 else if (range_from
<= XLFD_SLANT_INDEX
917 && range_to
>= XLFD_SLANT_INDEX
918 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
919 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
920 else if (range_from
<= XLFD_SWIDTH_INDEX
921 && range_to
>= XLFD_SWIDTH_INDEX
922 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
923 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
926 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
927 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
929 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
930 mask
= XLFD_SYMBOL_MASK
;
933 /* Merge position-based and value-based restrictions. */
935 while (from
< range_from
)
936 mask
&= ~(1 << from
++);
937 while (from
< 14 && ! (mask
& (1 << from
)))
939 while (to
> range_to
)
940 mask
&= ~(1 << to
--);
941 while (to
>= 0 && ! (mask
& (1 << to
)))
945 range
[i
].from
= from
;
947 range
[i
].mask
= mask
;
949 if (from
> range_from
|| to
< range_to
)
951 /* The range is narrowed by value-based restrictions.
952 Reflect it to the other fields. */
954 /* Following fields should be after FROM. */
956 /* Preceding fields should be before TO. */
957 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
959 /* Check FROM for non-wildcard field. */
960 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
962 while (range
[j
].from
< from
)
963 range
[j
].mask
&= ~(1 << range
[j
].from
++);
964 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
966 range
[j
].from
= from
;
969 from
= range
[j
].from
;
970 if (range
[j
].to
> to
)
972 while (range
[j
].to
> to
)
973 range
[j
].mask
&= ~(1 << range
[j
].to
--);
974 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
987 /* Decide all fileds from restrictions in RANGE. */
988 for (i
= j
= 0; i
< n
; i
++)
990 if (j
< range
[i
].from
)
992 if (i
== 0 || ! NILP (tmp
[i
- 1]))
993 /* None of TMP[X] corresponds to Jth field. */
995 for (; j
< range
[i
].from
; j
++)
1000 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
1002 for (; j
< XLFD_LAST_INDEX
; j
++)
1004 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
1005 field
[XLFD_ENCODING_INDEX
]
1006 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1011 #ifdef ENABLE_CHECKING
1012 /* Match a 14-field XLFD pattern against a full XLFD font name. */
1014 font_match_xlfd (char *pattern
, char *name
)
1016 while (*pattern
&& *name
)
1018 if (*pattern
== *name
)
1020 else if (*pattern
== '*')
1021 if (*name
== pattern
[1])
1032 /* Make sure the font object matches the XLFD font name. */
1034 font_check_xlfd_parse (Lisp_Object font
, char *name
)
1036 char name_check
[256];
1037 font_unparse_xlfd (font
, 0, name_check
, 255);
1038 return font_match_xlfd (name_check
, name
);
1044 /* Parse NAME (null terminated) as XLFD and store information in FONT
1045 (font-spec or font-entity). Size property of FONT is set as
1047 specified XLFD fields FONT property
1048 --------------------- -------------
1049 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1050 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1051 POINT_SIZE POINT_SIZE/10 (Lisp float)
1053 If NAME is successfully parsed, return 0. Otherwise return -1.
1055 FONT is usually a font-spec, but when this function is called from
1056 X font backend driver, it is a font-entity. In that case, NAME is
1057 a fully specified XLFD. */
1060 font_parse_xlfd (name
, font
)
1064 int len
= strlen (name
);
1066 char *f
[XLFD_LAST_INDEX
+ 1];
1070 if (len
> 255 || !len
)
1071 /* Maximum XLFD name length is 255. */
1073 /* Accept "*-.." as a fully specified XLFD. */
1074 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1075 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1078 for (p
= name
+ i
; *p
; p
++)
1082 if (i
== XLFD_LAST_INDEX
)
1087 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1088 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1090 if (i
== XLFD_LAST_INDEX
)
1092 /* Fully specified XLFD. */
1095 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1096 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1097 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1098 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1100 val
= INTERN_FIELD_SYM (i
);
1103 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1105 ASET (font
, j
, make_number (n
));
1108 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1109 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1110 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1112 ASET (font
, FONT_REGISTRY_INDEX
,
1113 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1114 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1116 p
= f
[XLFD_PIXEL_INDEX
];
1117 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1118 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1121 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1123 ASET (font
, FONT_SIZE_INDEX
, val
);
1126 double point_size
= -1;
1128 font_assert (FONT_SPEC_P (font
));
1129 p
= f
[XLFD_POINT_INDEX
];
1131 point_size
= parse_matrix (p
);
1132 else if (isdigit (*p
))
1133 point_size
= atoi (p
), point_size
/= 10;
1134 if (point_size
>= 0)
1135 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1139 ASET (font
, FONT_DPI_INDEX
, INTERN_FIELD (XLFD_RESY_INDEX
));
1140 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1143 val
= font_prop_validate_spacing (QCspacing
, val
);
1144 if (! INTEGERP (val
))
1146 ASET (font
, FONT_SPACING_INDEX
, val
);
1148 p
= f
[XLFD_AVGWIDTH_INDEX
];
1151 ASET (font
, FONT_AVGWIDTH_INDEX
,
1152 font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0));
1156 int wild_card_found
= 0;
1157 Lisp_Object prop
[XLFD_LAST_INDEX
];
1159 if (FONT_ENTITY_P (font
))
1161 for (j
= 0; j
< i
; j
++)
1165 if (f
[j
][1] && f
[j
][1] != '-')
1168 wild_card_found
= 1;
1171 prop
[j
] = INTERN_FIELD (j
);
1173 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1175 if (! wild_card_found
)
1177 if (font_expand_wildcards (prop
, i
) < 0)
1180 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1181 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1182 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1183 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1184 if (! NILP (prop
[i
]))
1186 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1188 ASET (font
, j
, make_number (n
));
1190 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1191 val
= prop
[XLFD_REGISTRY_INDEX
];
1194 val
= prop
[XLFD_ENCODING_INDEX
];
1196 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1198 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1199 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1201 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1202 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1204 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1206 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1207 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1208 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1210 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1212 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1215 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1216 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1217 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1219 val
= font_prop_validate_spacing (QCspacing
,
1220 prop
[XLFD_SPACING_INDEX
]);
1221 if (! INTEGERP (val
))
1223 ASET (font
, FONT_SPACING_INDEX
, val
);
1225 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1226 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1232 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1233 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1234 0, use PIXEL_SIZE instead. */
1237 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1243 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1247 font_assert (FONTP (font
));
1249 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1252 if (i
== FONT_ADSTYLE_INDEX
)
1253 j
= XLFD_ADSTYLE_INDEX
;
1254 else if (i
== FONT_REGISTRY_INDEX
)
1255 j
= XLFD_REGISTRY_INDEX
;
1256 val
= AREF (font
, i
);
1259 if (j
== XLFD_REGISTRY_INDEX
)
1260 f
[j
] = "*-*", len
+= 4;
1262 f
[j
] = "*", len
+= 2;
1267 val
= SYMBOL_NAME (val
);
1268 if (j
== XLFD_REGISTRY_INDEX
1269 && ! strchr ((char *) SDATA (val
), '-'))
1271 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1272 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1274 f
[j
] = alloca (SBYTES (val
) + 3);
1275 sprintf (f
[j
], "%s-*", SDATA (val
));
1276 len
+= SBYTES (val
) + 3;
1280 f
[j
] = alloca (SBYTES (val
) + 4);
1281 sprintf (f
[j
], "%s*-*", SDATA (val
));
1282 len
+= SBYTES (val
) + 4;
1286 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1290 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1293 val
= font_style_symbolic (font
, i
, 0);
1295 f
[j
] = "*", len
+= 2;
1298 val
= SYMBOL_NAME (val
);
1299 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1303 val
= AREF (font
, FONT_SIZE_INDEX
);
1304 font_assert (NUMBERP (val
) || NILP (val
));
1312 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1313 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1316 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1318 else if (FLOATP (val
))
1320 i
= XFLOAT_DATA (val
) * 10;
1321 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1322 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1325 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1327 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1329 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1330 f
[XLFD_RESX_INDEX
] = alloca (22);
1331 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1335 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1336 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1338 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1340 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1341 : spacing
<= FONT_SPACING_DUAL
? "d"
1342 : spacing
<= FONT_SPACING_MONO
? "m"
1347 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1348 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1350 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1351 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
],
1352 "%d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1355 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1356 len
++; /* for terminating '\0'. */
1359 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1360 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1361 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1362 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1363 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1364 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1365 f
[XLFD_REGISTRY_INDEX
]);
1368 /* Parse NAME (null terminated) and store information in FONT
1369 (font-spec or font-entity). NAME is supplied in either the
1370 Fontconfig or GTK font name format. If NAME is successfully
1371 parsed, return 0. Otherwise return -1.
1373 The fontconfig format is
1375 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1379 FAMILY [PROPS...] [SIZE]
1381 This function tries to guess which format it is. */
1384 font_parse_fcname (name
, font
)
1389 char *size_beg
= NULL
, *size_end
= NULL
;
1390 char *props_beg
= NULL
, *family_end
= NULL
;
1391 int len
= strlen (name
);
1396 for (p
= name
; *p
; p
++)
1398 if (*p
== '\\' && p
[1])
1402 props_beg
= family_end
= p
;
1407 int decimal
= 0, size_found
= 1;
1408 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1411 if (*q
!= '.' || decimal
)
1430 /* A fontconfig name with size and/or property data. */
1431 if (family_end
> name
)
1434 family
= font_intern_prop (name
, family_end
- name
, 1);
1435 ASET (font
, FONT_FAMILY_INDEX
, family
);
1439 double point_size
= strtod (size_beg
, &size_end
);
1440 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1441 if (*size_end
== ':' && size_end
[1])
1442 props_beg
= size_end
;
1446 /* Now parse ":KEY=VAL" patterns. */
1449 for (p
= props_beg
; *p
; p
= q
)
1451 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1454 /* Must be an enumerated value. */
1458 val
= font_intern_prop (p
, q
- p
, 1);
1460 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1462 if (PROP_MATCH ("light", 5)
1463 || PROP_MATCH ("medium", 6)
1464 || PROP_MATCH ("demibold", 8)
1465 || PROP_MATCH ("bold", 4)
1466 || PROP_MATCH ("black", 5))
1467 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1468 else if (PROP_MATCH ("roman", 5)
1469 || PROP_MATCH ("italic", 6)
1470 || PROP_MATCH ("oblique", 7))
1471 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1472 else if (PROP_MATCH ("charcell", 8))
1473 ASET (font
, FONT_SPACING_INDEX
,
1474 make_number (FONT_SPACING_CHARCELL
));
1475 else if (PROP_MATCH ("mono", 4))
1476 ASET (font
, FONT_SPACING_INDEX
,
1477 make_number (FONT_SPACING_MONO
));
1478 else if (PROP_MATCH ("proportional", 12))
1479 ASET (font
, FONT_SPACING_INDEX
,
1480 make_number (FONT_SPACING_PROPORTIONAL
));
1489 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1490 prop
= FONT_SIZE_INDEX
;
1493 key
= font_intern_prop (p
, q
- p
, 1);
1494 prop
= get_font_prop_index (key
);
1498 for (q
= p
; *q
&& *q
!= ':'; q
++);
1499 val
= font_intern_prop (p
, q
- p
, 0);
1501 if (prop
>= FONT_FOUNDRY_INDEX
1502 && prop
< FONT_EXTRA_INDEX
)
1503 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1505 Ffont_put (font
, key
, val
);
1513 /* Either a fontconfig-style name with no size and property
1514 data, or a GTK-style name. */
1516 int word_len
, prop_found
= 0;
1518 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1524 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1532 double point_size
= strtod (p
, &q
);
1533 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1538 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1539 if (*q
== '\\' && q
[1])
1543 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1545 if (PROP_MATCH ("Ultra-Light", 11))
1548 prop
= font_intern_prop ("ultra-light", 11, 1);
1549 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1551 else if (PROP_MATCH ("Light", 5))
1554 prop
= font_intern_prop ("light", 5, 1);
1555 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1557 else if (PROP_MATCH ("Semi-Bold", 9))
1560 prop
= font_intern_prop ("semi-bold", 9, 1);
1561 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1563 else if (PROP_MATCH ("Bold", 4))
1566 prop
= font_intern_prop ("bold", 4, 1);
1567 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1569 else if (PROP_MATCH ("Italic", 6))
1572 prop
= font_intern_prop ("italic", 4, 1);
1573 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1575 else if (PROP_MATCH ("Oblique", 7))
1578 prop
= font_intern_prop ("oblique", 7, 1);
1579 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1583 return -1; /* Unknown property in GTK-style font name. */
1592 family
= font_intern_prop (name
, family_end
- name
, 1);
1593 ASET (font
, FONT_FAMILY_INDEX
, family
);
1600 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1601 NAME (NBYTES length), and return the name length. If
1602 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1605 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1611 Lisp_Object family
, foundry
;
1612 Lisp_Object tail
, val
;
1616 Lisp_Object styles
[3];
1617 char *style_names
[3] = { "weight", "slant", "width" };
1620 family
= AREF (font
, FONT_FAMILY_INDEX
);
1621 if (! NILP (family
))
1623 if (SYMBOLP (family
))
1625 family
= SYMBOL_NAME (family
);
1626 len
+= SBYTES (family
);
1632 val
= AREF (font
, FONT_SIZE_INDEX
);
1635 if (XINT (val
) != 0)
1636 pixel_size
= XINT (val
);
1638 len
+= 21; /* for ":pixelsize=NUM" */
1640 else if (FLOATP (val
))
1643 point_size
= (int) XFLOAT_DATA (val
);
1644 len
+= 11; /* for "-NUM" */
1647 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1648 if (! NILP (foundry
))
1650 if (SYMBOLP (foundry
))
1652 foundry
= SYMBOL_NAME (foundry
);
1653 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1659 for (i
= 0; i
< 3; i
++)
1661 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1662 if (! NILP (styles
[i
]))
1663 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1664 SDATA (SYMBOL_NAME (styles
[i
])));
1667 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1668 len
+= sprintf (work
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1669 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1670 len
+= strlen (":spacing=100");
1671 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1672 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1673 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1675 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1677 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1679 len
+= SBYTES (val
);
1680 else if (INTEGERP (val
))
1681 len
+= sprintf (work
, "%d", XINT (val
));
1682 else if (SYMBOLP (val
))
1683 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1689 if (! NILP (family
))
1690 p
+= sprintf (p
, "%s", SDATA (family
));
1694 p
+= sprintf (p
, "%d", point_size
);
1696 p
+= sprintf (p
, "-%d", point_size
);
1698 else if (pixel_size
> 0)
1699 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1700 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1701 p
+= sprintf (p
, ":foundry=%s",
1702 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1703 for (i
= 0; i
< 3; i
++)
1704 if (! NILP (styles
[i
]))
1705 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1706 SDATA (SYMBOL_NAME (styles
[i
])));
1707 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1708 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1709 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1710 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1711 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1713 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1714 p
+= sprintf (p
, ":scalable=true");
1716 p
+= sprintf (p
, ":scalable=false");
1721 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1722 NAME (NBYTES length), and return the name length. F is the frame
1723 on which the font is displayed; it is used to calculate the point
1727 font_unparse_gtkname (font
, f
, name
, nbytes
)
1735 Lisp_Object family
, weight
, slant
, size
;
1736 int point_size
= -1;
1738 family
= AREF (font
, FONT_FAMILY_INDEX
);
1739 if (! NILP (family
))
1741 if (! SYMBOLP (family
))
1743 family
= SYMBOL_NAME (family
);
1744 len
+= SBYTES (family
);
1747 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1748 if (EQ (weight
, Qnormal
))
1750 else if (! NILP (weight
))
1752 weight
= SYMBOL_NAME (weight
);
1753 len
+= SBYTES (weight
);
1756 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1757 if (EQ (slant
, Qnormal
))
1759 else if (! NILP (slant
))
1761 slant
= SYMBOL_NAME (slant
);
1762 len
+= SBYTES (slant
);
1765 size
= AREF (font
, FONT_SIZE_INDEX
);
1766 /* Convert pixel size to point size. */
1767 if (INTEGERP (size
))
1769 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1771 if (INTEGERP (font_dpi
))
1772 dpi
= XINT (font_dpi
);
1775 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1778 else if (FLOATP (size
))
1780 point_size
= (int) XFLOAT_DATA (size
);
1787 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1789 if (! NILP (weight
))
1792 p
+= sprintf (p
, " %s", SDATA (weight
));
1793 q
[1] = toupper (q
[1]);
1799 p
+= sprintf (p
, " %s", SDATA (slant
));
1800 q
[1] = toupper (q
[1]);
1804 p
+= sprintf (p
, " %d", point_size
);
1809 /* Parse NAME (null terminated) and store information in FONT
1810 (font-spec or font-entity). If NAME is successfully parsed, return
1811 0. Otherwise return -1. */
1814 font_parse_name (name
, font
)
1818 if (name
[0] == '-' || index (name
, '*') || index (name
, '?'))
1819 return font_parse_xlfd (name
, font
);
1820 return font_parse_fcname (name
, font
);
1824 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1825 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1829 font_parse_family_registry (family
, registry
, font_spec
)
1830 Lisp_Object family
, registry
, font_spec
;
1836 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1838 CHECK_STRING (family
);
1839 len
= SBYTES (family
);
1840 p0
= (char *) SDATA (family
);
1841 p1
= index (p0
, '-');
1844 if ((*p0
!= '*' || p1
- p0
> 1)
1845 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1846 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1849 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1852 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1854 if (! NILP (registry
))
1856 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1857 CHECK_STRING (registry
);
1858 len
= SBYTES (registry
);
1859 p0
= (char *) SDATA (registry
);
1860 p1
= index (p0
, '-');
1863 if (SDATA (registry
)[len
- 1] == '*')
1864 registry
= concat2 (registry
, build_string ("-*"));
1866 registry
= concat2 (registry
, build_string ("*-*"));
1868 registry
= Fdowncase (registry
);
1869 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1874 /* This part (through the next ^L) is still experimental and not
1875 tested much. We may drastically change codes. */
1881 #define LGSTRING_HEADER_SIZE 6
1882 #define LGSTRING_GLYPH_SIZE 8
1885 check_gstring (gstring
)
1886 Lisp_Object gstring
;
1891 CHECK_VECTOR (gstring
);
1892 val
= AREF (gstring
, 0);
1894 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1896 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1897 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1898 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1899 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1900 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1901 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1902 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1903 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1904 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1905 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1906 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1908 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1910 val
= LGSTRING_GLYPH (gstring
, i
);
1912 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1914 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1916 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1917 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1918 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1919 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1920 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1921 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1922 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1923 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1925 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1927 if (ASIZE (val
) < 3)
1929 for (j
= 0; j
< 3; j
++)
1930 CHECK_NUMBER (AREF (val
, j
));
1935 error ("Invalid glyph-string format");
1940 check_otf_features (otf_features
)
1941 Lisp_Object otf_features
;
1945 CHECK_CONS (otf_features
);
1946 CHECK_SYMBOL (XCAR (otf_features
));
1947 otf_features
= XCDR (otf_features
);
1948 CHECK_CONS (otf_features
);
1949 CHECK_SYMBOL (XCAR (otf_features
));
1950 otf_features
= XCDR (otf_features
);
1951 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1953 CHECK_SYMBOL (Fcar (val
));
1954 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1955 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1957 otf_features
= XCDR (otf_features
);
1958 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1960 CHECK_SYMBOL (Fcar (val
));
1961 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1962 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1969 Lisp_Object otf_list
;
1972 otf_tag_symbol (tag
)
1977 OTF_tag_name (tag
, name
);
1978 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1985 Lisp_Object val
= Fassoc (file
, otf_list
);
1989 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1992 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1993 val
= make_save_value (otf
, 0);
1994 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
2000 /* Return a list describing which scripts/languages FONT supports by
2001 which GSUB/GPOS features of OpenType tables. See the comment of
2002 (struct font_driver).otf_capability. */
2005 font_otf_capability (font
)
2009 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
2012 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
2015 for (i
= 0; i
< 2; i
++)
2017 OTF_GSUB_GPOS
*gsub_gpos
;
2018 Lisp_Object script_list
= Qnil
;
2021 if (OTF_get_features (otf
, i
== 0) < 0)
2023 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2024 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2026 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2027 Lisp_Object langsys_list
= Qnil
;
2028 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2031 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2033 OTF_LangSys
*langsys
;
2034 Lisp_Object feature_list
= Qnil
;
2035 Lisp_Object langsys_tag
;
2038 if (k
== script
->LangSysCount
)
2040 langsys
= &script
->DefaultLangSys
;
2045 langsys
= script
->LangSys
+ k
;
2047 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2049 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2051 OTF_Feature
*feature
2052 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2053 Lisp_Object feature_tag
2054 = otf_tag_symbol (feature
->FeatureTag
);
2056 feature_list
= Fcons (feature_tag
, feature_list
);
2058 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2061 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2066 XSETCAR (capability
, script_list
);
2068 XSETCDR (capability
, script_list
);
2074 /* Parse OTF features in SPEC and write a proper features spec string
2075 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2076 assured that the sufficient memory has already allocated for
2080 generate_otf_features (spec
, features
)
2090 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2096 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2101 else if (! asterisk
)
2103 val
= SYMBOL_NAME (val
);
2104 p
+= sprintf (p
, "%s", SDATA (val
));
2108 val
= SYMBOL_NAME (val
);
2109 p
+= sprintf (p
, "~%s", SDATA (val
));
2113 error ("OTF spec too long");
2117 font_otf_DeviceTable (device_table
)
2118 OTF_DeviceTable
*device_table
;
2120 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2122 return Fcons (make_number (len
),
2123 make_unibyte_string (device_table
->DeltaValue
, len
));
2127 font_otf_ValueRecord (value_format
, value_record
)
2129 OTF_ValueRecord
*value_record
;
2131 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2133 if (value_format
& OTF_XPlacement
)
2134 ASET (val
, 0, make_number (value_record
->XPlacement
));
2135 if (value_format
& OTF_YPlacement
)
2136 ASET (val
, 1, make_number (value_record
->YPlacement
));
2137 if (value_format
& OTF_XAdvance
)
2138 ASET (val
, 2, make_number (value_record
->XAdvance
));
2139 if (value_format
& OTF_YAdvance
)
2140 ASET (val
, 3, make_number (value_record
->YAdvance
));
2141 if (value_format
& OTF_XPlaDevice
)
2142 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2143 if (value_format
& OTF_YPlaDevice
)
2144 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2145 if (value_format
& OTF_XAdvDevice
)
2146 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2147 if (value_format
& OTF_YAdvDevice
)
2148 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2153 font_otf_Anchor (anchor
)
2158 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2159 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2160 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2161 if (anchor
->AnchorFormat
== 2)
2162 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2165 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2166 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2170 #endif /* HAVE_LIBOTF */
2176 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2177 static int font_compare
P_ ((const void *, const void *));
2178 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
2181 /* Return a rescaling ratio of FONT_ENTITY. */
2182 extern Lisp_Object Vface_font_rescale_alist
;
2185 font_rescale_ratio (font_entity
)
2186 Lisp_Object font_entity
;
2188 Lisp_Object tail
, elt
;
2189 Lisp_Object name
= Qnil
;
2191 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2194 if (FLOATP (XCDR (elt
)))
2196 if (STRINGP (XCAR (elt
)))
2199 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2200 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2201 return XFLOAT_DATA (XCDR (elt
));
2203 else if (FONT_SPEC_P (XCAR (elt
)))
2205 if (font_match_p (XCAR (elt
), font_entity
))
2206 return XFLOAT_DATA (XCDR (elt
));
2213 /* We sort fonts by scoring each of them against a specified
2214 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2215 the value is, the closer the font is to the font-spec.
2217 The lowest 2 bits of the score is used for driver type. The font
2218 available by the most preferred font driver is 0.
2220 Each 7-bit in the higher 28 bits are used for numeric properties
2221 WEIGHT, SLANT, WIDTH, and SIZE. */
2223 /* How many bits to shift to store the difference value of each font
2224 property in a score. Note that flots for FONT_TYPE_INDEX and
2225 FONT_REGISTRY_INDEX are not used. */
2226 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2228 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2229 The return value indicates how different ENTITY is compared with
2233 font_score (entity
, spec_prop
)
2234 Lisp_Object entity
, *spec_prop
;
2239 /* Score three style numeric fields. Maximum difference is 127. */
2240 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2241 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2243 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2248 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2251 /* Score the size. Maximum difference is 127. */
2252 i
= FONT_SIZE_INDEX
;
2253 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2254 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2256 /* We use the higher 6-bit for the actual size difference. The
2257 lowest bit is set if the DPI is different. */
2259 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2261 if (CONSP (Vface_font_rescale_alist
))
2262 pixel_size
*= font_rescale_ratio (entity
);
2263 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2267 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2268 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2270 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2277 /* The comparison function for qsort. */
2280 font_compare (d1
, d2
)
2281 const void *d1
, *d2
;
2283 return (*(unsigned *) d1
- *(unsigned *) d2
);
2287 /* The structure for elements being sorted by qsort. */
2288 struct font_sort_data
2295 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2296 If PREFER specifies a point-size, calculate the corresponding
2297 pixel-size from QCdpi property of PREFER or from the Y-resolution
2298 of FRAME before sorting.
2300 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2301 return the sorted VEC. */
2304 font_sort_entites (vec
, prefer
, frame
, best_only
)
2305 Lisp_Object vec
, prefer
, frame
;
2308 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2310 struct font_sort_data
*data
;
2311 unsigned best_score
;
2312 Lisp_Object best_entity
, driver_type
;
2314 struct frame
*f
= XFRAME (frame
);
2315 struct font_driver_list
*list
;
2320 return best_only
? AREF (vec
, 0) : vec
;
2322 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_DPI_INDEX
; i
++)
2323 prefer_prop
[i
] = AREF (prefer
, i
);
2324 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2325 prefer_prop
[FONT_SIZE_INDEX
]
2326 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2328 /* Scoring and sorting. */
2329 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2330 best_score
= 0xFFFFFFFF;
2331 /* We are sure that the length of VEC > 1. */
2332 driver_type
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2333 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2334 driver_order
++, list
= list
->next
)
2335 if (EQ (driver_type
, list
->driver
->type
))
2337 best_entity
= data
[0].entity
= AREF (vec
, 0);
2338 best_score
= data
[0].score
2339 = font_score (data
[0].entity
, prefer_prop
) | driver_order
;
2340 for (i
= 0; i
< len
; i
++)
2342 if (!EQ (driver_type
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2343 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2344 driver_order
++, list
= list
->next
)
2345 if (EQ (driver_type
, list
->driver
->type
))
2347 data
[i
].entity
= AREF (vec
, i
);
2348 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
) | driver_order
;
2349 if (best_only
&& best_score
> data
[i
].score
)
2351 best_score
= data
[i
].score
;
2352 best_entity
= data
[i
].entity
;
2353 if (best_score
== 0)
2359 qsort (data
, len
, sizeof *data
, font_compare
);
2360 for (i
= 0; i
< len
; i
++)
2361 ASET (vec
, i
, data
[i
].entity
);
2367 font_add_log ("sort-by", prefer
, vec
);
2372 /* API of Font Service Layer. */
2374 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2375 sort_shift_bits. Finternal_set_font_selection_order calls this
2376 function with font_sort_order after setting up it. */
2379 font_update_sort_order (order
)
2384 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2386 int xlfd_idx
= order
[i
];
2388 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2389 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2390 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2391 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2392 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2393 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2395 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2400 font_check_otf_features (script
, langsys
, features
, table
)
2401 Lisp_Object script
, langsys
, features
, table
;
2406 table
= assq_no_quit (script
, table
);
2409 table
= XCDR (table
);
2410 if (! NILP (langsys
))
2412 table
= assq_no_quit (langsys
, table
);
2418 val
= assq_no_quit (Qnil
, table
);
2420 table
= XCAR (table
);
2424 table
= XCDR (table
);
2425 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2427 if (NILP (XCAR (features
)))
2432 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2438 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2441 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2443 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2445 script
= XCAR (spec
);
2449 langsys
= XCAR (spec
);
2460 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2461 XCAR (otf_capability
)))
2463 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2464 XCDR (otf_capability
)))
2471 /* Check if FONT (font-entity or font-object) matches with the font
2472 specification SPEC. */
2475 font_match_p (spec
, font
)
2476 Lisp_Object spec
, font
;
2478 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2479 Lisp_Object extra
, font_extra
;
2482 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2483 if (! NILP (AREF (spec
, i
))
2484 && ! NILP (AREF (font
, i
))
2485 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2487 props
= XFONT_SPEC (spec
)->props
;
2488 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2490 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2491 prop
[i
] = AREF (spec
, i
);
2492 prop
[FONT_SIZE_INDEX
]
2493 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2497 if (font_score (font
, props
) > 0)
2499 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2500 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2501 for (; CONSP (extra
); extra
= XCDR (extra
))
2503 Lisp_Object key
= XCAR (XCAR (extra
));
2504 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2506 if (EQ (key
, QClang
))
2508 val2
= assq_no_quit (key
, font_extra
);
2517 if (NILP (Fmemq (val
, val2
)))
2522 ? NILP (Fmemq (val
, XCDR (val2
)))
2526 else if (EQ (key
, QCscript
))
2528 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2534 /* All characters in the list must be supported. */
2535 for (; CONSP (val2
); val2
= XCDR (val2
))
2537 if (! NATNUMP (XCAR (val2
)))
2539 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2540 == FONT_INVALID_CODE
)
2544 else if (VECTORP (val2
))
2546 /* At most one character in the vector must be supported. */
2547 for (i
= 0; i
< ASIZE (val2
); i
++)
2549 if (! NATNUMP (AREF (val2
, i
)))
2551 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2552 != FONT_INVALID_CODE
)
2555 if (i
== ASIZE (val2
))
2560 else if (EQ (key
, QCotf
))
2564 if (! FONT_OBJECT_P (font
))
2566 fontp
= XFONT_OBJECT (font
);
2567 if (! fontp
->driver
->otf_capability
)
2569 val2
= fontp
->driver
->otf_capability (fontp
);
2570 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2581 Each font backend has the callback function get_cache, and it
2582 returns a cons cell of which cdr part can be freely used for
2583 caching fonts. The cons cell may be shared by multiple frames
2584 and/or multiple font drivers. So, we arrange the cdr part as this:
2586 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2588 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2589 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2590 cons (FONT-SPEC FONT-ENTITY ...). */
2592 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2593 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2594 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2595 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2596 struct font_driver
*));
2599 font_prepare_cache (f
, driver
)
2601 struct font_driver
*driver
;
2603 Lisp_Object cache
, val
;
2605 cache
= driver
->get_cache (f
);
2607 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2611 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2612 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2616 val
= XCDR (XCAR (val
));
2617 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2623 font_finish_cache (f
, driver
)
2625 struct font_driver
*driver
;
2627 Lisp_Object cache
, val
, tmp
;
2630 cache
= driver
->get_cache (f
);
2632 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2633 cache
= val
, val
= XCDR (val
);
2634 font_assert (! NILP (val
));
2635 tmp
= XCDR (XCAR (val
));
2636 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2637 if (XINT (XCAR (tmp
)) == 0)
2639 font_clear_cache (f
, XCAR (val
), driver
);
2640 XSETCDR (cache
, XCDR (val
));
2646 font_get_cache (f
, driver
)
2648 struct font_driver
*driver
;
2650 Lisp_Object val
= driver
->get_cache (f
);
2651 Lisp_Object type
= driver
->type
;
2653 font_assert (CONSP (val
));
2654 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2655 font_assert (CONSP (val
));
2656 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2657 val
= XCDR (XCAR (val
));
2661 static int num_fonts
;
2664 font_clear_cache (f
, cache
, driver
)
2667 struct font_driver
*driver
;
2669 Lisp_Object tail
, elt
;
2670 Lisp_Object tail2
, entity
;
2672 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2673 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2676 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2677 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2679 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2681 entity
= XCAR (tail2
);
2683 if (FONT_ENTITY_P (entity
)
2684 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2686 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2688 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2690 Lisp_Object val
= XCAR (objlist
);
2691 struct font
*font
= XFONT_OBJECT (val
);
2693 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2695 font_assert (font
&& driver
== font
->driver
);
2696 driver
->close (f
, font
);
2700 if (driver
->free_entity
)
2701 driver
->free_entity (entity
);
2706 XSETCDR (cache
, Qnil
);
2710 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2713 font_delete_unmatched (list
, spec
, size
)
2714 Lisp_Object list
, spec
;
2717 Lisp_Object entity
, val
;
2718 enum font_property_index prop
;
2720 for (val
= Qnil
; CONSP (list
); list
= XCDR (list
))
2722 entity
= XCAR (list
);
2723 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2724 if (INTEGERP (AREF (spec
, prop
))
2725 && ((XINT (AREF (spec
, prop
)) >> 8)
2726 != (XINT (AREF (entity
, prop
)) >> 8)))
2727 prop
= FONT_SPEC_MAX
;
2728 if (prop
< FONT_SPEC_MAX
2730 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2732 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2735 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2736 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2737 prop
= FONT_SPEC_MAX
;
2739 if (prop
< FONT_SPEC_MAX
2740 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2741 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2742 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2743 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2744 prop
= FONT_SPEC_MAX
;
2745 if (prop
< FONT_SPEC_MAX
2746 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2747 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2748 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2749 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2750 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2751 prop
= FONT_SPEC_MAX
;
2752 if (prop
< FONT_SPEC_MAX
)
2753 val
= Fcons (entity
, val
);
2759 /* Return a vector of font-entities matching with SPEC on FRAME. */
2762 font_list_entities (frame
, spec
)
2763 Lisp_Object frame
, spec
;
2765 FRAME_PTR f
= XFRAME (frame
);
2766 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2767 Lisp_Object ftype
, val
;
2770 int need_filtering
= 0;
2773 font_assert (FONT_SPEC_P (spec
));
2775 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2776 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2777 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2778 size
= font_pixel_size (f
, spec
);
2782 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2783 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2784 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2785 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2787 ASET (scratch_font_spec
, i
, Qnil
);
2788 if (! NILP (AREF (spec
, i
)))
2790 if (i
== FONT_DPI_INDEX
)
2791 /* Skip FONT_SPACING_INDEX */
2794 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2795 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2797 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2801 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2803 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2805 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2807 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2808 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2815 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2816 copy
= Fcopy_font_spec (scratch_font_spec
);
2817 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2818 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2820 if (! NILP (val
) && need_filtering
)
2821 val
= font_delete_unmatched (val
, spec
, size
);
2826 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2827 font_add_log ("list", spec
, val
);
2832 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2833 nil, is an array of face's attributes, which specifies preferred
2834 font-related attributes. */
2837 font_matching_entity (f
, attrs
, spec
)
2839 Lisp_Object
*attrs
, spec
;
2841 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2842 Lisp_Object ftype
, size
, entity
;
2844 Lisp_Object work
= Fcopy_font_spec (spec
);
2846 XSETFRAME (frame
, f
);
2847 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2848 size
= AREF (spec
, FONT_SIZE_INDEX
);
2851 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2852 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2853 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2854 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2857 for (; driver_list
; driver_list
= driver_list
->next
)
2859 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2861 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2864 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2865 entity
= assoc_no_quit (work
, XCDR (cache
));
2867 entity
= XCDR (entity
);
2870 entity
= driver_list
->driver
->match (frame
, work
);
2871 copy
= Fcopy_font_spec (work
);
2872 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2873 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2875 if (! NILP (entity
))
2878 font_add_log ("match", work
, entity
);
2883 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2884 opened font object. */
2887 font_open_entity (f
, entity
, pixel_size
)
2892 struct font_driver_list
*driver_list
;
2893 Lisp_Object objlist
, size
, val
, font_object
;
2895 int min_width
, height
;
2896 int scaled_pixel_size
;
2898 font_assert (FONT_ENTITY_P (entity
));
2899 size
= AREF (entity
, FONT_SIZE_INDEX
);
2900 if (XINT (size
) != 0)
2901 scaled_pixel_size
= pixel_size
= XINT (size
);
2902 else if (CONSP (Vface_font_rescale_alist
))
2903 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2905 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2906 objlist
= XCDR (objlist
))
2907 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2908 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2909 return XCAR (objlist
);
2911 val
= AREF (entity
, FONT_TYPE_INDEX
);
2912 for (driver_list
= f
->font_driver_list
;
2913 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2914 driver_list
= driver_list
->next
);
2918 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2919 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2920 font_add_log ("open", entity
, font_object
);
2921 if (NILP (font_object
))
2923 ASET (entity
, FONT_OBJLIST_INDEX
,
2924 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2925 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
2928 font
= XFONT_OBJECT (font_object
);
2929 min_width
= (font
->min_width
? font
->min_width
2930 : font
->average_width
? font
->average_width
2931 : font
->space_width
? font
->space_width
2933 height
= (font
->height
? font
->height
: 1);
2934 #ifdef HAVE_WINDOW_SYSTEM
2935 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2936 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2938 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2939 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2940 fonts_changed_p
= 1;
2944 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2945 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2946 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2947 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2955 /* Close FONT_OBJECT that is opened on frame F. */
2958 font_close_object (f
, font_object
)
2960 Lisp_Object font_object
;
2962 struct font
*font
= XFONT_OBJECT (font_object
);
2964 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2965 /* Already closed. */
2967 font_add_log ("close", font_object
, Qnil
);
2968 font
->driver
->close (f
, font
);
2969 #ifdef HAVE_WINDOW_SYSTEM
2970 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2971 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2977 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2978 FONT is a font-entity and it must be opened to check. */
2981 font_has_char (f
, font
, c
)
2988 if (FONT_ENTITY_P (font
))
2990 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2991 struct font_driver_list
*driver_list
;
2993 for (driver_list
= f
->font_driver_list
;
2994 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2995 driver_list
= driver_list
->next
);
2998 if (! driver_list
->driver
->has_char
)
3000 return driver_list
->driver
->has_char (font
, c
);
3003 font_assert (FONT_OBJECT_P (font
));
3004 fontp
= XFONT_OBJECT (font
);
3005 if (fontp
->driver
->has_char
)
3007 int result
= fontp
->driver
->has_char (font
, c
);
3012 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
3016 /* Return the glyph ID of FONT_OBJECT for character C. */
3019 font_encode_char (font_object
, c
)
3020 Lisp_Object font_object
;
3025 font_assert (FONT_OBJECT_P (font_object
));
3026 font
= XFONT_OBJECT (font_object
);
3027 return font
->driver
->encode_char (font
, c
);
3031 /* Return the name of FONT_OBJECT. */
3034 font_get_name (font_object
)
3035 Lisp_Object font_object
;
3037 font_assert (FONT_OBJECT_P (font_object
));
3038 return AREF (font_object
, FONT_NAME_INDEX
);
3042 /* Return the specification of FONT_OBJECT. */
3045 font_get_spec (font_object
)
3046 Lisp_Object font_object
;
3048 Lisp_Object spec
= font_make_spec ();
3051 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
3052 ASET (spec
, i
, AREF (font_object
, i
));
3053 ASET (spec
, FONT_SIZE_INDEX
,
3054 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
3059 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3060 could not be parsed by font_parse_name, return Qnil. */
3063 font_spec_from_name (font_name
)
3064 Lisp_Object font_name
;
3066 Lisp_Object spec
= Ffont_spec (0, NULL
);
3068 CHECK_STRING (font_name
);
3069 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3071 font_put_extra (spec
, QCname
, font_name
);
3077 font_clear_prop (attrs
, prop
)
3079 enum font_property_index prop
;
3081 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3085 if (! NILP (Ffont_get (font
, QCname
)))
3087 font
= Fcopy_font_spec (font
);
3088 font_put_extra (font
, QCname
, Qnil
);
3091 if (NILP (AREF (font
, prop
))
3092 && prop
!= FONT_FAMILY_INDEX
3093 && prop
!= FONT_FOUNDRY_INDEX
3094 && prop
!= FONT_WIDTH_INDEX
3095 && prop
!= FONT_SIZE_INDEX
)
3097 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3098 font
= Fcopy_font_spec (font
);
3099 ASET (font
, prop
, Qnil
);
3100 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3102 if (prop
== FONT_FAMILY_INDEX
)
3104 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3105 /* If we are setting the font family, we must also clear
3106 FONT_WIDTH_INDEX to avoid rejecting families that lack
3107 support for some widths. */
3108 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3110 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3111 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3112 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3113 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3114 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3115 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3117 else if (prop
== FONT_SIZE_INDEX
)
3119 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3120 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3121 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3123 else if (prop
== FONT_WIDTH_INDEX
)
3124 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3125 attrs
[LFACE_FONT_INDEX
] = font
;
3129 font_update_lface (f
, attrs
)
3135 spec
= attrs
[LFACE_FONT_INDEX
];
3136 if (! FONT_SPEC_P (spec
))
3139 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3140 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3141 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3142 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3143 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3144 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3145 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3146 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);
3147 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3148 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3149 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3153 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3158 val
= Ffont_get (spec
, QCdpi
);
3161 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3163 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3165 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3167 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3168 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3174 /* Selecte a font from ENTITIES that supports C and matches best with
3175 ATTRS and PIXEL_SIZE. */
3178 font_select_entity (frame
, entities
, attrs
, pixel_size
, c
)
3179 Lisp_Object frame
, entities
, *attrs
;
3182 Lisp_Object font_entity
;
3184 Lisp_Object props
[FONT_REGISTRY_INDEX
+ 1] ;
3186 FRAME_PTR f
= XFRAME (frame
);
3188 if (ASIZE (entities
) == 1)
3190 font_entity
= AREF (entities
, 0);
3192 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3197 /* Sort fonts by properties specified in ATTRS. */
3198 prefer
= scratch_font_prefer
;
3200 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3201 ASET (prefer
, i
, Qnil
);
3202 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3204 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3206 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3207 ASET (prefer
, i
, AREF (face_font
, i
));
3209 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3210 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3211 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3212 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3213 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3214 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3215 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3216 entities
= font_sort_entites (entities
, prefer
, frame
, c
< 0);
3221 for (i
= 0; i
< ASIZE (entities
); i
++)
3225 font_entity
= AREF (entities
, i
);
3228 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3229 if (! EQ (AREF (font_entity
, j
), props
[j
]))
3231 if (j
> FONT_REGISTRY_INDEX
)
3234 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3235 props
[j
] = AREF (font_entity
, j
);
3236 result
= font_has_char (f
, font_entity
, c
);
3243 /* Return a font-entity satisfying SPEC and best matching with face's
3244 font related attributes in ATTRS. C, if not negative, is a
3245 character that the entity must support. */
3248 font_find_for_lface (f
, attrs
, spec
, c
)
3255 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
3256 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3258 int i
, j
, k
, l
, result
;
3260 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3261 if (NILP (registry
[0]))
3263 registry
[0] = DEFAULT_ENCODING
;
3264 registry
[1] = Qascii_0
;
3265 registry
[2] = null_vector
;
3268 registry
[1] = null_vector
;
3270 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3272 struct charset
*encoding
, *repertory
;
3274 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3275 &encoding
, &repertory
) < 0)
3279 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3281 /* Any font of this registry support C. So, let's
3282 suppress the further checking. */
3285 else if (c
> encoding
->max_char
)
3289 work
= Fcopy_font_spec (spec
);
3290 XSETFRAME (frame
, f
);
3291 size
= AREF (spec
, FONT_SIZE_INDEX
);
3292 pixel_size
= font_pixel_size (f
, spec
);
3293 if (pixel_size
== 0)
3295 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3297 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3299 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3300 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3301 if (! NILP (foundry
[0]))
3302 foundry
[1] = null_vector
;
3303 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3305 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3306 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3308 foundry
[2] = null_vector
;
3311 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3313 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3314 if (! NILP (adstyle
[0]))
3315 adstyle
[1] = null_vector
;
3316 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3318 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3320 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3322 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3324 adstyle
[2] = null_vector
;
3327 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3330 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3333 val
= AREF (work
, FONT_FAMILY_INDEX
);
3334 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3336 val
= attrs
[LFACE_FAMILY_INDEX
];
3337 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3341 family
= alloca ((sizeof family
[0]) * 2);
3343 family
[1] = null_vector
; /* terminator. */
3348 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3356 if (! NILP (alters
))
3358 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3359 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3360 family
[i
] = XCAR (alters
);
3361 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3363 family
[i
] = null_vector
;
3367 family
= alloca ((sizeof family
[0]) * 3);
3370 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3372 family
[i
] = null_vector
;
3376 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3378 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3379 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3381 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3382 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3384 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3385 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3387 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3388 entities
= font_list_entities (frame
, work
);
3389 if (ASIZE (entities
) > 0)
3391 val
= font_select_entity (frame
, entities
,
3392 attrs
, pixel_size
, c
);
3405 font_open_for_lface (f
, entity
, attrs
, spec
)
3413 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3414 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3415 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3416 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3417 size
= font_pixel_size (f
, spec
);
3421 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3422 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3425 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3426 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3427 if (INTEGERP (height
))
3430 abort(); /* We should never end up here. */
3434 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3438 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3439 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3443 return font_open_entity (f
, entity
, size
);
3447 /* Find a font satisfying SPEC and best matching with face's
3448 attributes in ATTRS on FRAME, and return the opened
3452 font_load_for_lface (f
, attrs
, spec
)
3454 Lisp_Object
*attrs
, spec
;
3458 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3461 /* No font is listed for SPEC, but each font-backend may have
3462 the different criteria about "font matching". So, try
3464 entity
= font_matching_entity (f
, attrs
, spec
);
3468 return font_open_for_lface (f
, entity
, attrs
, spec
);
3472 /* Make FACE on frame F ready to use the font opened for FACE. */
3475 font_prepare_for_face (f
, face
)
3479 if (face
->font
->driver
->prepare_face
)
3480 face
->font
->driver
->prepare_face (f
, face
);
3484 /* Make FACE on frame F stop using the font opened for FACE. */
3487 font_done_for_face (f
, face
)
3491 if (face
->font
->driver
->done_face
)
3492 face
->font
->driver
->done_face (f
, face
);
3497 /* Open a font matching with font-spec SPEC on frame F. If no proper
3498 font is found, return Qnil. */
3501 font_open_by_spec (f
, spec
)
3505 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3507 /* We set up the default font-related attributes of a face to prefer
3509 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3510 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3511 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3513 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3515 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3517 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3519 return font_load_for_lface (f
, attrs
, spec
);
3523 /* Open a font matching with NAME on frame F. If no proper font is
3524 found, return Qnil. */
3527 font_open_by_name (f
, name
)
3531 Lisp_Object args
[2];
3535 args
[1] = make_unibyte_string (name
, strlen (name
));
3536 spec
= Ffont_spec (2, args
);
3537 return font_open_by_spec (f
, spec
);
3541 /* Register font-driver DRIVER. This function is used in two ways.
3543 The first is with frame F non-NULL. In this case, make DRIVER
3544 available (but not yet activated) on F. All frame creaters
3545 (e.g. Fx_create_frame) must call this function at least once with
3546 an available font-driver.
3548 The second is with frame F NULL. In this case, DRIVER is globally
3549 registered in the variable `font_driver_list'. All font-driver
3550 implementations must call this function in its syms_of_XXXX
3551 (e.g. syms_of_xfont). */
3554 register_font_driver (driver
, f
)
3555 struct font_driver
*driver
;
3558 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3559 struct font_driver_list
*prev
, *list
;
3561 if (f
&& ! driver
->draw
)
3562 error ("Unusable font driver for a frame: %s",
3563 SDATA (SYMBOL_NAME (driver
->type
)));
3565 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3566 if (EQ (list
->driver
->type
, driver
->type
))
3567 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3569 list
= xmalloc (sizeof (struct font_driver_list
));
3571 list
->driver
= driver
;
3576 f
->font_driver_list
= list
;
3578 font_driver_list
= list
;
3584 free_font_driver_list (f
)
3587 struct font_driver_list
*list
, *next
;
3589 for (list
= f
->font_driver_list
; list
; list
= next
)
3594 f
->font_driver_list
= NULL
;
3598 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3599 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3600 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3602 A caller must free all realized faces if any in advance. The
3603 return value is a list of font backends actually made used on
3607 font_update_drivers (f
, new_drivers
)
3609 Lisp_Object new_drivers
;
3611 Lisp_Object active_drivers
= Qnil
;
3612 struct font_driver
*driver
;
3613 struct font_driver_list
*list
;
3615 /* At first, turn off non-requested drivers, and turn on requested
3617 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3619 driver
= list
->driver
;
3620 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3625 if (driver
->end_for_frame
)
3626 driver
->end_for_frame (f
);
3627 font_finish_cache (f
, driver
);
3632 if (! driver
->start_for_frame
3633 || driver
->start_for_frame (f
) == 0)
3635 font_prepare_cache (f
, driver
);
3642 if (NILP (new_drivers
))
3645 if (! EQ (new_drivers
, Qt
))
3647 /* Re-order the driver list according to new_drivers. */
3648 struct font_driver_list
**list_table
, **next
;
3652 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3653 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3655 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3656 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3659 list_table
[i
++] = list
;
3661 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3663 list_table
[i
++] = list
;
3664 list_table
[i
] = NULL
;
3666 next
= &f
->font_driver_list
;
3667 for (i
= 0; list_table
[i
]; i
++)
3669 *next
= list_table
[i
];
3670 next
= &(*next
)->next
;
3675 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3677 active_drivers
= nconc2 (active_drivers
,
3678 Fcons (list
->driver
->type
, Qnil
));
3679 return active_drivers
;
3683 font_put_frame_data (f
, driver
, data
)
3685 struct font_driver
*driver
;
3688 struct font_data_list
*list
, *prev
;
3690 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3691 prev
= list
, list
= list
->next
)
3692 if (list
->driver
== driver
)
3699 prev
->next
= list
->next
;
3701 f
->font_data_list
= list
->next
;
3709 list
= xmalloc (sizeof (struct font_data_list
));
3710 list
->driver
= driver
;
3711 list
->next
= f
->font_data_list
;
3712 f
->font_data_list
= list
;
3720 font_get_frame_data (f
, driver
)
3722 struct font_driver
*driver
;
3724 struct font_data_list
*list
;
3726 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3727 if (list
->driver
== driver
)
3735 /* Return the font used to draw character C by FACE at buffer position
3736 POS in window W. If STRING is non-nil, it is a string containing C
3737 at index POS. If C is negative, get C from the current buffer or
3741 font_at (c
, pos
, face
, w
, string
)
3750 Lisp_Object font_object
;
3752 multibyte
= (NILP (string
)
3753 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3754 : STRING_MULTIBYTE (string
));
3761 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3763 c
= FETCH_CHAR (pos_byte
);
3766 c
= FETCH_BYTE (pos
);
3772 multibyte
= STRING_MULTIBYTE (string
);
3775 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3777 str
= SDATA (string
) + pos_byte
;
3778 c
= STRING_CHAR (str
, 0);
3781 c
= SDATA (string
)[pos
];
3785 f
= XFRAME (w
->frame
);
3786 if (! FRAME_WINDOW_P (f
))
3793 if (STRINGP (string
))
3794 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3795 DEFAULT_FACE_ID
, 0);
3797 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3799 face
= FACE_FROM_ID (f
, face_id
);
3803 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3804 face
= FACE_FROM_ID (f
, face_id
);
3809 XSETFONT (font_object
, face
->font
);
3814 #ifdef HAVE_WINDOW_SYSTEM
3816 /* Check how many characters after POS (at most to *LIMIT) can be
3817 displayed by the same font on the window W. FACE, if non-NULL, is
3818 the face selected for the character at POS. If STRING is not nil,
3819 it is the string to check instead of the current buffer. In that
3820 case, FACE must be not NULL.
3822 The return value is the font-object for the character at POS.
3823 *LIMIT is set to the position where that font can't be used.
3825 It is assured that the current buffer (or STRING) is multibyte. */
3828 font_range (pos
, limit
, w
, face
, string
)
3829 EMACS_INT pos
, *limit
;
3834 EMACS_INT pos_byte
, ignore
, start
, start_byte
;
3836 Lisp_Object font_object
= Qnil
;
3840 pos_byte
= CHAR_TO_BYTE (pos
);
3845 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
, *limit
, 0);
3846 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3852 pos_byte
= string_char_to_byte (string
, pos
);
3855 start
= pos
, start_byte
= pos_byte
;
3856 while (pos
< *limit
)
3858 Lisp_Object category
;
3861 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3863 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3864 if (NILP (font_object
))
3866 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3867 if (NILP (font_object
))
3872 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3873 if (! EQ (category
, QCf
)
3874 && ! CHAR_VARIATION_SELECTOR_P (c
)
3875 && font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3877 Lisp_Object f
= font_for_char (face
, c
, pos
- 1, string
);
3878 EMACS_INT i
, i_byte
;
3886 i
= start
, i_byte
= start_byte
;
3891 FETCH_CHAR_ADVANCE_NO_CHECK (c
, i
, i_byte
);
3893 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, i
, i_byte
);
3894 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3895 if (! EQ (category
, QCf
)
3896 && ! CHAR_VARIATION_SELECTOR_P (c
)
3897 && font_encode_char (f
, c
) == FONT_INVALID_CODE
)
3913 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3914 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3915 Return nil otherwise.
3916 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3917 which kind of font it is. It must be one of `font-spec', `font-entity',
3919 (object
, extra_type
)
3920 Lisp_Object object
, extra_type
;
3922 if (NILP (extra_type
))
3923 return (FONTP (object
) ? Qt
: Qnil
);
3924 if (EQ (extra_type
, Qfont_spec
))
3925 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3926 if (EQ (extra_type
, Qfont_entity
))
3927 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3928 if (EQ (extra_type
, Qfont_object
))
3929 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3930 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3933 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3934 doc
: /* Return a newly created font-spec with arguments as properties.
3936 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3937 valid font property name listed below:
3939 `:family', `:weight', `:slant', `:width'
3941 They are the same as face attributes of the same name. See
3942 `set-face-attribute'.
3946 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3950 VALUE must be a string or a symbol specifying the additional
3951 typographic style information of a font, e.g. ``sans''.
3955 VALUE must be a string or a symbol specifying the charset registry and
3956 encoding of a font, e.g. ``iso8859-1''.
3960 VALUE must be a non-negative integer or a floating point number
3961 specifying the font size. It specifies the font size in pixels (if
3962 VALUE is an integer), or in points (if VALUE is a float).
3966 VALUE must be a string of XLFD-style or fontconfig-style font name.
3970 VALUE must be a symbol representing a script that the font must
3971 support. It may be a symbol representing a subgroup of a script
3972 listed in the variable `script-representative-chars'.
3976 VALUE must be a symbol of two-letter ISO-639 language names,
3981 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3982 required OpenType features.
3984 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3985 LANGSYS-TAG: OpenType language system tag symbol,
3986 or nil for the default language system.
3987 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3988 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3990 GSUB and GPOS may contain `nil' element. In such a case, the font
3991 must not have any of the remaining elements.
3993 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3994 be an OpenType font, and whose GPOS table of `thai' script's default
3995 language system must contain `mark' feature.
3997 usage: (font-spec ARGS...) */)
4002 Lisp_Object spec
= font_make_spec ();
4005 for (i
= 0; i
< nargs
; i
+= 2)
4007 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
4009 if (EQ (key
, QCname
))
4012 font_parse_name ((char *) SDATA (val
), spec
);
4013 font_put_extra (spec
, key
, val
);
4017 int idx
= get_font_prop_index (key
);
4021 val
= font_prop_validate (idx
, Qnil
, val
);
4022 if (idx
< FONT_EXTRA_INDEX
)
4023 ASET (spec
, idx
, val
);
4025 font_put_extra (spec
, key
, val
);
4028 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
4034 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
4035 doc
: /* Return a copy of FONT as a font-spec. */)
4039 Lisp_Object new_spec
, tail
, prev
, extra
;
4043 new_spec
= font_make_spec ();
4044 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
4045 ASET (new_spec
, i
, AREF (font
, i
));
4046 extra
= Fcopy_sequence (AREF (font
, FONT_EXTRA_INDEX
));
4047 /* We must remove :font-entity property. */
4048 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
4049 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
4052 extra
= XCDR (extra
);
4054 XSETCDR (prev
, XCDR (tail
));
4057 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
4061 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
4062 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
4063 Every specified properties in FROM override the corresponding
4064 properties in TO. */)
4066 Lisp_Object from
, to
;
4068 Lisp_Object extra
, tail
;
4073 to
= Fcopy_font_spec (to
);
4074 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
4075 ASET (to
, i
, AREF (from
, i
));
4076 extra
= AREF (to
, FONT_EXTRA_INDEX
);
4077 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
4078 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
4080 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
4083 XSETCDR (slot
, XCDR (XCAR (tail
)));
4085 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
4087 ASET (to
, FONT_EXTRA_INDEX
, extra
);
4091 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
4092 doc
: /* Return the value of FONT's property KEY.
4093 FONT is a font-spec, a font-entity, or a font-object.
4094 KEY must be one of these symbols:
4095 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4096 :size, :name, :script
4097 See the documentation of `font-spec' for their meanings.
4098 If FONT is a font-entity or font-object, the value of :script may be
4099 a list of scripts that are supported by the font. */)
4101 Lisp_Object font
, key
;
4108 idx
= get_font_prop_index (key
);
4109 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4110 return font_style_symbolic (font
, idx
, 0);
4111 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4112 return AREF (font
, idx
);
4113 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
4116 #ifdef HAVE_WINDOW_SYSTEM
4118 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4119 doc
: /* Return a plist of face attributes generated by FONT.
4120 FONT is a font name, a font-spec, a font-entity, or a font-object.
4121 The return value is a list of the form
4123 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4125 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4126 compatible with `set-face-attribute'. Some of these key-attribute pairs
4127 may be omitted from the list if they are not specified by FONT.
4129 The optional argument FRAME specifies the frame that the face attributes
4130 are to be displayed on. If omitted, the selected frame is used. */)
4132 Lisp_Object font
, frame
;
4135 Lisp_Object plist
[10];
4140 frame
= selected_frame
;
4141 CHECK_LIVE_FRAME (frame
);
4146 int fontset
= fs_query_fontset (font
, 0);
4147 Lisp_Object name
= font
;
4149 font
= fontset_ascii (fontset
);
4150 font
= font_spec_from_name (name
);
4152 signal_error ("Invalid font name", name
);
4154 else if (! FONTP (font
))
4155 signal_error ("Invalid font object", font
);
4157 val
= AREF (font
, FONT_FAMILY_INDEX
);
4160 plist
[n
++] = QCfamily
;
4161 plist
[n
++] = SYMBOL_NAME (val
);
4164 val
= AREF (font
, FONT_SIZE_INDEX
);
4167 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4168 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4169 plist
[n
++] = QCheight
;
4170 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4172 else if (FLOATP (val
))
4174 plist
[n
++] = QCheight
;
4175 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4178 val
= FONT_WEIGHT_FOR_FACE (font
);
4181 plist
[n
++] = QCweight
;
4185 val
= FONT_SLANT_FOR_FACE (font
);
4188 plist
[n
++] = QCslant
;
4192 val
= FONT_WIDTH_FOR_FACE (font
);
4195 plist
[n
++] = QCwidth
;
4199 return Flist (n
, plist
);
4204 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4205 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
4206 (font_spec
, prop
, val
)
4207 Lisp_Object font_spec
, prop
, val
;
4211 CHECK_FONT_SPEC (font_spec
);
4212 idx
= get_font_prop_index (prop
);
4213 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4214 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
4216 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
4220 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4221 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4222 Optional 2nd argument FRAME specifies the target frame.
4223 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4224 Optional 4th argument PREFER, if non-nil, is a font-spec to
4225 control the order of the returned list. Fonts are sorted by
4226 how close they are to PREFER. */)
4227 (font_spec
, frame
, num
, prefer
)
4228 Lisp_Object font_spec
, frame
, num
, prefer
;
4230 Lisp_Object vec
, list
, tail
;
4234 frame
= selected_frame
;
4235 CHECK_LIVE_FRAME (frame
);
4236 CHECK_FONT_SPEC (font_spec
);
4244 if (! NILP (prefer
))
4245 CHECK_FONT_SPEC (prefer
);
4247 vec
= font_list_entities (frame
, font_spec
);
4252 return Fcons (AREF (vec
, 0), Qnil
);
4254 if (! NILP (prefer
))
4255 vec
= font_sort_entites (vec
, prefer
, frame
, 0);
4257 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
4258 if (n
== 0 || n
> len
)
4260 for (i
= 1; i
< n
; i
++)
4262 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
4264 XSETCDR (tail
, val
);
4270 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4271 doc
: /* List available font families on the current frame.
4272 Optional argument FRAME, if non-nil, specifies the target frame. */)
4277 struct font_driver_list
*driver_list
;
4281 frame
= selected_frame
;
4282 CHECK_LIVE_FRAME (frame
);
4285 for (driver_list
= f
->font_driver_list
; driver_list
;
4286 driver_list
= driver_list
->next
)
4287 if (driver_list
->driver
->list_family
)
4289 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4290 Lisp_Object tail
= list
;
4292 for (; CONSP (val
); val
= XCDR (val
))
4293 if (NILP (Fmemq (XCAR (val
), tail
))
4294 && SYMBOLP (XCAR (val
)))
4295 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4300 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4301 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4302 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4304 Lisp_Object font_spec
, frame
;
4306 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4313 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4314 doc
: /* Return XLFD name of FONT.
4315 FONT is a font-spec, font-entity, or font-object.
4316 If the name is too long for XLFD (maximum 255 chars), return nil.
4317 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4318 the consecutive wildcards are folded to one. */)
4319 (font
, fold_wildcards
)
4320 Lisp_Object font
, fold_wildcards
;
4327 if (FONT_OBJECT_P (font
))
4329 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4331 if (STRINGP (font_name
)
4332 && SDATA (font_name
)[0] == '-')
4334 if (NILP (fold_wildcards
))
4336 strcpy (name
, (char *) SDATA (font_name
));
4339 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4341 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4344 if (! NILP (fold_wildcards
))
4346 char *p0
= name
, *p1
;
4348 while ((p1
= strstr (p0
, "-*-*")))
4350 strcpy (p1
, p1
+ 2);
4355 return build_string (name
);
4358 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4359 doc
: /* Clear font cache. */)
4362 Lisp_Object list
, frame
;
4364 FOR_EACH_FRAME (list
, frame
)
4366 FRAME_PTR f
= XFRAME (frame
);
4367 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4369 for (; driver_list
; driver_list
= driver_list
->next
)
4370 if (driver_list
->on
)
4372 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4377 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4379 font_assert (! NILP (val
));
4380 val
= XCDR (XCAR (val
));
4381 if (XINT (XCAR (val
)) == 0)
4383 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4384 XSETCDR (cache
, XCDR (val
));
4394 font_fill_lglyph_metrics (glyph
, font_object
)
4395 Lisp_Object glyph
, font_object
;
4397 struct font
*font
= XFONT_OBJECT (font_object
);
4399 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4400 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4401 struct font_metrics metrics
;
4403 LGLYPH_SET_CODE (glyph
, ecode
);
4405 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4406 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4407 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4408 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4409 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4410 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4414 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4415 doc
: /* Shape the glyph-string GSTRING.
4416 Shaping means substituting glyphs and/or adjusting positions of glyphs
4417 to get the correct visual image of character sequences set in the
4418 header of the glyph-string.
4420 If the shaping was successful, the value is GSTRING itself or a newly
4421 created glyph-string. Otherwise, the value is nil. */)
4423 Lisp_Object gstring
;
4426 Lisp_Object font_object
, n
, glyph
;
4429 if (! composition_gstring_p (gstring
))
4430 signal_error ("Invalid glyph-string: ", gstring
);
4431 if (! NILP (LGSTRING_ID (gstring
)))
4433 font_object
= LGSTRING_FONT (gstring
);
4434 CHECK_FONT_OBJECT (font_object
);
4435 font
= XFONT_OBJECT (font_object
);
4436 if (! font
->driver
->shape
)
4439 /* Try at most three times with larger gstring each time. */
4440 for (i
= 0; i
< 3; i
++)
4442 n
= font
->driver
->shape (gstring
);
4445 gstring
= larger_vector (gstring
,
4446 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4449 if (i
== 3 || XINT (n
) == 0)
4452 glyph
= LGSTRING_GLYPH (gstring
, 0);
4453 from
= LGLYPH_FROM (glyph
);
4454 to
= LGLYPH_TO (glyph
);
4455 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4457 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4461 if (NILP (LGLYPH_ADJUSTMENT (this)))
4466 glyph
= LGSTRING_GLYPH (gstring
, j
);
4467 LGLYPH_SET_FROM (glyph
, from
);
4468 LGLYPH_SET_TO (glyph
, to
);
4470 from
= LGLYPH_FROM (this);
4471 to
= LGLYPH_TO (this);
4476 if (from
> LGLYPH_FROM (this))
4477 from
= LGLYPH_FROM (this);
4478 if (to
< LGLYPH_TO (this))
4479 to
= LGLYPH_TO (this);
4485 glyph
= LGSTRING_GLYPH (gstring
, j
);
4486 LGLYPH_SET_FROM (glyph
, from
);
4487 LGLYPH_SET_TO (glyph
, to
);
4489 return composition_gstring_put_cache (gstring
, XINT (n
));
4492 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4494 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4495 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4497 VARIATION-SELECTOR is a chracter code of variation selection
4498 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4499 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4500 (font_object
, character
)
4501 Lisp_Object font_object
, character
;
4503 unsigned variations
[256];
4508 CHECK_FONT_OBJECT (font_object
);
4509 CHECK_CHARACTER (character
);
4510 font
= XFONT_OBJECT (font_object
);
4511 if (! font
->driver
->get_variation_glyphs
)
4513 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4517 for (i
= 0; i
< 255; i
++)
4521 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4522 /* Stops GCC whining about limited range of data type. */
4523 EMACS_INT var
= variations
[i
];
4525 if (var
> MOST_POSITIVE_FIXNUM
)
4526 code
= Fcons (make_number ((variations
[i
]) >> 16),
4527 make_number ((variations
[i
]) & 0xFFFF));
4529 code
= make_number (variations
[i
]);
4530 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4537 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4538 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4539 OTF-FEATURES specifies which features to apply in this format:
4540 (SCRIPT LANGSYS GSUB GPOS)
4542 SCRIPT is a symbol specifying a script tag of OpenType,
4543 LANGSYS is a symbol specifying a langsys tag of OpenType,
4544 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4546 If LANGYS is nil, the default langsys is selected.
4548 The features are applied in the order they appear in the list. The
4549 symbol `*' means to apply all available features not present in this
4550 list, and the remaining features are ignored. For instance, (vatu
4551 pstf * haln) is to apply vatu and pstf in this order, then to apply
4552 all available features other than vatu, pstf, and haln.
4554 The features are applied to the glyphs in the range FROM and TO of
4555 the glyph-string GSTRING-IN.
4557 If some feature is actually applicable, the resulting glyphs are
4558 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4559 this case, the value is the number of produced glyphs.
4561 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4564 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4565 produced in GSTRING-OUT, and the value is nil.
4567 See the documentation of `font-make-gstring' for the format of
4569 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4570 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4572 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4577 check_otf_features (otf_features
);
4578 CHECK_FONT_OBJECT (font_object
);
4579 font
= XFONT_OBJECT (font_object
);
4580 if (! font
->driver
->otf_drive
)
4581 error ("Font backend %s can't drive OpenType GSUB table",
4582 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4583 CHECK_CONS (otf_features
);
4584 CHECK_SYMBOL (XCAR (otf_features
));
4585 val
= XCDR (otf_features
);
4586 CHECK_SYMBOL (XCAR (val
));
4587 val
= XCDR (otf_features
);
4590 len
= check_gstring (gstring_in
);
4591 CHECK_VECTOR (gstring_out
);
4592 CHECK_NATNUM (from
);
4594 CHECK_NATNUM (index
);
4596 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4597 args_out_of_range_3 (from
, to
, make_number (len
));
4598 if (XINT (index
) >= ASIZE (gstring_out
))
4599 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4600 num
= font
->driver
->otf_drive (font
, otf_features
,
4601 gstring_in
, XINT (from
), XINT (to
),
4602 gstring_out
, XINT (index
), 0);
4605 return make_number (num
);
4608 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4610 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4611 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4613 (SCRIPT LANGSYS FEATURE ...)
4614 See the documentation of `font-drive-otf' for more detail.
4616 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4617 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4618 character code corresponding to the glyph or nil if there's no
4619 corresponding character. */)
4620 (font_object
, character
, otf_features
)
4621 Lisp_Object font_object
, character
, otf_features
;
4624 Lisp_Object gstring_in
, gstring_out
, g
;
4625 Lisp_Object alternates
;
4628 CHECK_FONT_GET_OBJECT (font_object
, font
);
4629 if (! font
->driver
->otf_drive
)
4630 error ("Font backend %s can't drive OpenType GSUB table",
4631 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4632 CHECK_CHARACTER (character
);
4633 CHECK_CONS (otf_features
);
4635 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4636 g
= LGSTRING_GLYPH (gstring_in
, 0);
4637 LGLYPH_SET_CHAR (g
, XINT (character
));
4638 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4639 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4640 gstring_out
, 0, 1)) < 0)
4641 gstring_out
= Ffont_make_gstring (font_object
,
4642 make_number (ASIZE (gstring_out
) * 2));
4644 for (i
= 0; i
< num
; i
++)
4646 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4647 int c
= LGLYPH_CHAR (g
);
4648 unsigned code
= LGLYPH_CODE (g
);
4650 alternates
= Fcons (Fcons (make_number (code
),
4651 c
> 0 ? make_number (c
) : Qnil
),
4654 return Fnreverse (alternates
);
4660 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4661 doc
: /* Open FONT-ENTITY. */)
4662 (font_entity
, size
, frame
)
4663 Lisp_Object font_entity
;
4669 CHECK_FONT_ENTITY (font_entity
);
4671 frame
= selected_frame
;
4672 CHECK_LIVE_FRAME (frame
);
4675 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4678 CHECK_NUMBER_OR_FLOAT (size
);
4680 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4682 isize
= XINT (size
);
4686 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4689 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4690 doc
: /* Close FONT-OBJECT. */)
4691 (font_object
, frame
)
4692 Lisp_Object font_object
, frame
;
4694 CHECK_FONT_OBJECT (font_object
);
4696 frame
= selected_frame
;
4697 CHECK_LIVE_FRAME (frame
);
4698 font_close_object (XFRAME (frame
), font_object
);
4702 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4703 doc
: /* Return information about FONT-OBJECT.
4704 The value is a vector:
4705 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4708 NAME is a string of the font name (or nil if the font backend doesn't
4711 FILENAME is a string of the font file (or nil if the font backend
4712 doesn't provide a file name).
4714 PIXEL-SIZE is a pixel size by which the font is opened.
4716 SIZE is a maximum advance width of the font in pixels.
4718 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4721 CAPABILITY is a list whose first element is a symbol representing the
4722 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4723 remaining elements describe the details of the font capability.
4725 If the font is OpenType font, the form of the list is
4726 \(opentype GSUB GPOS)
4727 where GSUB shows which "GSUB" features the font supports, and GPOS
4728 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4729 lists of the format:
4730 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4732 If the font is not OpenType font, currently the length of the form is
4735 SCRIPT is a symbol representing OpenType script tag.
4737 LANGSYS is a symbol representing OpenType langsys tag, or nil
4738 representing the default langsys.
4740 FEATURE is a symbol representing OpenType feature tag.
4742 If the font is not OpenType font, CAPABILITY is nil. */)
4744 Lisp_Object font_object
;
4749 CHECK_FONT_GET_OBJECT (font_object
, font
);
4751 val
= Fmake_vector (make_number (9), Qnil
);
4752 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4753 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4754 ASET (val
, 2, make_number (font
->pixel_size
));
4755 ASET (val
, 3, make_number (font
->max_width
));
4756 ASET (val
, 4, make_number (font
->ascent
));
4757 ASET (val
, 5, make_number (font
->descent
));
4758 ASET (val
, 6, make_number (font
->space_width
));
4759 ASET (val
, 7, make_number (font
->average_width
));
4760 if (font
->driver
->otf_capability
)
4761 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4765 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4766 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4767 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4768 (font_object
, string
)
4769 Lisp_Object font_object
, string
;
4775 CHECK_FONT_GET_OBJECT (font_object
, font
);
4776 CHECK_STRING (string
);
4777 len
= SCHARS (string
);
4778 vec
= Fmake_vector (make_number (len
), Qnil
);
4779 for (i
= 0; i
< len
; i
++)
4781 Lisp_Object ch
= Faref (string
, make_number (i
));
4786 struct font_metrics metrics
;
4788 cod
= code
= font
->driver
->encode_char (font
, c
);
4789 if (code
== FONT_INVALID_CODE
)
4791 val
= Fmake_vector (make_number (6), Qnil
);
4792 if (cod
<= MOST_POSITIVE_FIXNUM
)
4793 ASET (val
, 0, make_number (code
));
4795 ASET (val
, 0, Fcons (make_number (code
>> 16),
4796 make_number (code
& 0xFFFF)));
4797 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4798 ASET (val
, 1, make_number (metrics
.lbearing
));
4799 ASET (val
, 2, make_number (metrics
.rbearing
));
4800 ASET (val
, 3, make_number (metrics
.width
));
4801 ASET (val
, 4, make_number (metrics
.ascent
));
4802 ASET (val
, 5, make_number (metrics
.descent
));
4808 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4809 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4810 FONT is a font-spec, font-entity, or font-object. */)
4812 Lisp_Object spec
, font
;
4814 CHECK_FONT_SPEC (spec
);
4817 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4820 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4821 doc
: /* Return a font-object for displaying a character at POSITION.
4822 Optional second arg WINDOW, if non-nil, is a window displaying
4823 the current buffer. It defaults to the currently selected window. */)
4824 (position
, window
, string
)
4825 Lisp_Object position
, window
, string
;
4832 CHECK_NUMBER_COERCE_MARKER (position
);
4833 pos
= XINT (position
);
4834 if (pos
< BEGV
|| pos
>= ZV
)
4835 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4839 CHECK_NUMBER (position
);
4840 CHECK_STRING (string
);
4841 pos
= XINT (position
);
4842 if (pos
< 0 || pos
>= SCHARS (string
))
4843 args_out_of_range (string
, position
);
4846 window
= selected_window
;
4847 CHECK_LIVE_WINDOW (window
);
4848 w
= XWINDOW (window
);
4850 return font_at (-1, pos
, NULL
, w
, string
);
4854 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4855 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4856 The value is a number of glyphs drawn.
4857 Type C-l to recover what previously shown. */)
4858 (font_object
, string
)
4859 Lisp_Object font_object
, string
;
4861 Lisp_Object frame
= selected_frame
;
4862 FRAME_PTR f
= XFRAME (frame
);
4868 CHECK_FONT_GET_OBJECT (font_object
, font
);
4869 CHECK_STRING (string
);
4870 len
= SCHARS (string
);
4871 code
= alloca (sizeof (unsigned) * len
);
4872 for (i
= 0; i
< len
; i
++)
4874 Lisp_Object ch
= Faref (string
, make_number (i
));
4878 code
[i
] = font
->driver
->encode_char (font
, c
);
4879 if (code
[i
] == FONT_INVALID_CODE
)
4882 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4884 if (font
->driver
->prepare_face
)
4885 font
->driver
->prepare_face (f
, face
);
4886 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4887 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4888 if (font
->driver
->done_face
)
4889 font
->driver
->done_face (f
, face
);
4891 return make_number (len
);
4895 #endif /* FONT_DEBUG */
4897 #ifdef HAVE_WINDOW_SYSTEM
4899 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4900 doc
: /* Return information about a font named NAME on frame FRAME.
4901 If FRAME is omitted or nil, use the selected frame.
4902 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4903 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4905 OPENED-NAME is the name used for opening the font,
4906 FULL-NAME is the full name of the font,
4907 SIZE is the maximum bound width of the font,
4908 HEIGHT is the height of the font,
4909 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4910 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4911 how to compose characters.
4912 If the named font is not yet loaded, return nil. */)
4914 Lisp_Object name
, frame
;
4919 Lisp_Object font_object
;
4921 (*check_window_system_func
) ();
4924 CHECK_STRING (name
);
4926 frame
= selected_frame
;
4927 CHECK_LIVE_FRAME (frame
);
4932 int fontset
= fs_query_fontset (name
, 0);
4935 name
= fontset_ascii (fontset
);
4936 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4938 else if (FONT_OBJECT_P (name
))
4940 else if (FONT_ENTITY_P (name
))
4941 font_object
= font_open_entity (f
, name
, 0);
4944 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4945 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4947 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4949 if (NILP (font_object
))
4951 font
= XFONT_OBJECT (font_object
);
4953 info
= Fmake_vector (make_number (7), Qnil
);
4954 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4955 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4956 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4957 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4958 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4959 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4960 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4963 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4964 close it now. Perhaps, we should manage font-objects
4965 by `reference-count'. */
4966 font_close_object (f
, font_object
);
4973 #define BUILD_STYLE_TABLE(TBL) \
4974 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4977 build_style_table (entry
, nelement
)
4978 struct table_entry
*entry
;
4982 Lisp_Object table
, elt
;
4984 table
= Fmake_vector (make_number (nelement
), Qnil
);
4985 for (i
= 0; i
< nelement
; i
++)
4987 for (j
= 0; entry
[i
].names
[j
]; j
++);
4988 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4989 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4990 for (j
= 0; entry
[i
].names
[j
]; j
++)
4991 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4992 ASET (table
, i
, elt
);
4997 static Lisp_Object Vfont_log
;
4998 static int font_log_env_checked
;
5000 /* The deferred font-log data of the form [ACTION ARG RESULT].
5001 If ACTION is not nil, that is added to the log when font_add_log is
5002 called next time. At that time, ACTION is set back to nil. */
5003 static Lisp_Object Vfont_log_deferred
;
5005 /* Prepend the font-related logging data in Vfont_log if it is not
5006 `t'. ACTION describes a kind of font-related action (e.g. listing,
5007 opening), ARG is the argument for the action, and RESULT is the
5008 result of the action. */
5010 font_add_log (action
, arg
, result
)
5012 Lisp_Object arg
, result
;
5014 Lisp_Object tail
, val
;
5017 if (! font_log_env_checked
)
5019 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
5020 font_log_env_checked
= 1;
5022 if (EQ (Vfont_log
, Qt
))
5024 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5026 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
5028 ASET (Vfont_log_deferred
, 0, Qnil
);
5029 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5030 AREF (Vfont_log_deferred
, 2));
5035 Lisp_Object tail
, elt
;
5036 Lisp_Object equalstr
= build_string ("=");
5038 val
= Ffont_xlfd_name (arg
, Qt
);
5039 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5043 if (EQ (XCAR (elt
), QCscript
)
5044 && SYMBOLP (XCDR (elt
)))
5045 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5046 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5047 else if (EQ (XCAR (elt
), QClang
)
5048 && SYMBOLP (XCDR (elt
)))
5049 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5050 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5051 else if (EQ (XCAR (elt
), QCotf
)
5052 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5053 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5055 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5061 val
= Ffont_xlfd_name (result
, Qt
);
5062 if (! FONT_SPEC_P (result
))
5063 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5064 build_string (":"), val
);
5067 else if (CONSP (result
))
5069 result
= Fcopy_sequence (result
);
5070 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5074 val
= Ffont_xlfd_name (val
, Qt
);
5075 XSETCAR (tail
, val
);
5078 else if (VECTORP (result
))
5080 result
= Fcopy_sequence (result
);
5081 for (i
= 0; i
< ASIZE (result
); i
++)
5083 val
= AREF (result
, i
);
5085 val
= Ffont_xlfd_name (val
, Qt
);
5086 ASET (result
, i
, val
);
5089 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5092 /* Record a font-related logging data to be added to Vfont_log when
5093 font_add_log is called next time. ACTION, ARG, RESULT are the same
5097 font_deferred_log (action
, arg
, result
)
5099 Lisp_Object arg
, result
;
5101 ASET (Vfont_log_deferred
, 0, build_string (action
));
5102 ASET (Vfont_log_deferred
, 1, arg
);
5103 ASET (Vfont_log_deferred
, 2, result
);
5106 extern void syms_of_ftfont
P_ (());
5107 extern void syms_of_xfont
P_ (());
5108 extern void syms_of_xftfont
P_ (());
5109 extern void syms_of_ftxfont
P_ (());
5110 extern void syms_of_bdffont
P_ (());
5111 extern void syms_of_w32font
P_ (());
5112 extern void syms_of_atmfont
P_ (());
5113 extern void syms_of_nsfont
P_ (());
5118 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5119 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5120 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5121 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5122 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5123 /* Note that the other elements in sort_shift_bits are not used. */
5125 staticpro (&font_charset_alist
);
5126 font_charset_alist
= Qnil
;
5128 DEFSYM (Qopentype
, "opentype");
5130 DEFSYM (Qascii_0
, "ascii-0");
5131 DEFSYM (Qiso8859_1
, "iso8859-1");
5132 DEFSYM (Qiso10646_1
, "iso10646-1");
5133 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5134 DEFSYM (Qunicode_sip
, "unicode-sip");
5138 DEFSYM (QCotf
, ":otf");
5139 DEFSYM (QClang
, ":lang");
5140 DEFSYM (QCscript
, ":script");
5141 DEFSYM (QCantialias
, ":antialias");
5143 DEFSYM (QCfoundry
, ":foundry");
5144 DEFSYM (QCadstyle
, ":adstyle");
5145 DEFSYM (QCregistry
, ":registry");
5146 DEFSYM (QCspacing
, ":spacing");
5147 DEFSYM (QCdpi
, ":dpi");
5148 DEFSYM (QCscalable
, ":scalable");
5149 DEFSYM (QCavgwidth
, ":avgwidth");
5150 DEFSYM (QCfont_entity
, ":font-entity");
5151 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5158 staticpro (&null_vector
);
5159 null_vector
= Fmake_vector (make_number (0), Qnil
);
5161 staticpro (&scratch_font_spec
);
5162 scratch_font_spec
= Ffont_spec (0, NULL
);
5163 staticpro (&scratch_font_prefer
);
5164 scratch_font_prefer
= Ffont_spec (0, NULL
);
5166 staticpro (&Vfont_log_deferred
);
5167 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5171 staticpro (&otf_list
);
5173 #endif /* HAVE_LIBOTF */
5177 defsubr (&Sfont_spec
);
5178 defsubr (&Sfont_get
);
5179 #ifdef HAVE_WINDOW_SYSTEM
5180 defsubr (&Sfont_face_attributes
);
5182 defsubr (&Sfont_put
);
5183 defsubr (&Slist_fonts
);
5184 defsubr (&Sfont_family_list
);
5185 defsubr (&Sfind_font
);
5186 defsubr (&Sfont_xlfd_name
);
5187 defsubr (&Sclear_font_cache
);
5188 defsubr (&Sfont_shape_gstring
);
5189 defsubr (&Sfont_variation_glyphs
);
5191 defsubr (&Sfont_drive_otf
);
5192 defsubr (&Sfont_otf_alternates
);
5196 defsubr (&Sopen_font
);
5197 defsubr (&Sclose_font
);
5198 defsubr (&Squery_font
);
5199 defsubr (&Sget_font_glyphs
);
5200 defsubr (&Sfont_match_p
);
5201 defsubr (&Sfont_at
);
5203 defsubr (&Sdraw_string
);
5205 #endif /* FONT_DEBUG */
5206 #ifdef HAVE_WINDOW_SYSTEM
5207 defsubr (&Sfont_info
);
5210 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5212 Alist of fontname patterns vs the corresponding encoding and repertory info.
5213 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5214 where ENCODING is a charset or a char-table,
5215 and REPERTORY is a charset, a char-table, or nil.
5217 If ENCODING and REPERTORY are the same, the element can have the form
5218 \(REGEXP . ENCODING).
5220 ENCODING is for converting a character to a glyph code of the font.
5221 If ENCODING is a charset, encoding a character by the charset gives
5222 the corresponding glyph code. If ENCODING is a char-table, looking up
5223 the table by a character gives the corresponding glyph code.
5225 REPERTORY specifies a repertory of characters supported by the font.
5226 If REPERTORY is a charset, all characters beloging to the charset are
5227 supported. If REPERTORY is a char-table, all characters who have a
5228 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5229 gets the repertory information by an opened font and ENCODING. */);
5230 Vfont_encoding_alist
= Qnil
;
5232 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5233 doc
: /* Vector of valid font weight values.
5234 Each element has the form:
5235 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5236 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5237 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5239 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5240 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5241 See `font-weight-table' for the format of the vector. */);
5242 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5244 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5245 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5246 See `font-weight-table' for the format of the vector. */);
5247 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5249 staticpro (&font_style_table
);
5250 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5251 ASET (font_style_table
, 0, Vfont_weight_table
);
5252 ASET (font_style_table
, 1, Vfont_slant_table
);
5253 ASET (font_style_table
, 2, Vfont_width_table
);
5255 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5256 *Logging list of font related actions and results.
5257 The value t means to suppress the logging.
5258 The initial value is set to nil if the environment variable
5259 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5262 #ifdef HAVE_WINDOW_SYSTEM
5263 #ifdef HAVE_FREETYPE
5265 #ifdef HAVE_X_WINDOWS
5270 #endif /* HAVE_XFT */
5271 #endif /* HAVE_X_WINDOWS */
5272 #else /* not HAVE_FREETYPE */
5273 #ifdef HAVE_X_WINDOWS
5275 #endif /* HAVE_X_WINDOWS */
5276 #endif /* not HAVE_FREETYPE */
5279 #endif /* HAVE_BDFFONT */
5282 #endif /* WINDOWSNT */
5285 #endif /* HAVE_NS */
5286 #endif /* HAVE_WINDOW_SYSTEM */
5289 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5290 (do not change this comment) */