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
)))))
442 /* We don't know the encoding of this font. Let's assume `ascii'. */
446 /* Return encoding charset and repertory charset for REGISTRY in
447 ENCODING and REPERTORY correspondingly. If correct information for
448 REGISTRY is available, return 0. Otherwise return -1. */
451 font_registry_charsets (registry
, encoding
, repertory
)
452 Lisp_Object registry
;
453 struct charset
**encoding
, **repertory
;
456 int encoding_id
, repertory_id
;
458 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
464 encoding_id
= XINT (XCAR (val
));
465 repertory_id
= XINT (XCDR (val
));
469 val
= find_font_encoding (SYMBOL_NAME (registry
));
470 if (SYMBOLP (val
) && CHARSETP (val
))
472 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
474 else if (CONSP (val
))
476 if (! CHARSETP (XCAR (val
)))
478 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
479 if (NILP (XCDR (val
)))
483 if (! CHARSETP (XCDR (val
)))
485 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
490 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
492 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
496 *encoding
= CHARSET_FROM_ID (encoding_id
);
498 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
503 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
508 /* Font property value validaters. See the comment of
509 font_property_table for the meaning of the arguments. */
511 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
512 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
513 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
514 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
515 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
516 static int get_font_prop_index
P_ ((Lisp_Object
));
519 font_prop_validate_symbol (prop
, val
)
520 Lisp_Object prop
, val
;
523 val
= Fintern (val
, Qnil
);
526 else if (EQ (prop
, QCregistry
))
527 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
533 font_prop_validate_style (style
, val
)
534 Lisp_Object style
, val
;
536 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
537 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
544 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
548 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
550 if ((n
& 0xF) + 1 >= ASIZE (elt
))
552 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
556 else if (SYMBOLP (val
))
558 int n
= font_style_to_value (prop
, val
, 0);
560 val
= n
>= 0 ? make_number (n
) : Qerror
;
568 font_prop_validate_non_neg (prop
, val
)
569 Lisp_Object prop
, val
;
571 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
576 font_prop_validate_spacing (prop
, val
)
577 Lisp_Object prop
, val
;
579 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
581 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
583 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
585 if (spacing
== 'c' || spacing
== 'C')
586 return make_number (FONT_SPACING_CHARCELL
);
587 if (spacing
== 'm' || spacing
== 'M')
588 return make_number (FONT_SPACING_MONO
);
589 if (spacing
== 'p' || spacing
== 'P')
590 return make_number (FONT_SPACING_PROPORTIONAL
);
591 if (spacing
== 'd' || spacing
== 'D')
592 return make_number (FONT_SPACING_DUAL
);
598 font_prop_validate_otf (prop
, val
)
599 Lisp_Object prop
, val
;
601 Lisp_Object tail
, tmp
;
604 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
605 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
606 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
609 if (! SYMBOLP (XCAR (val
)))
614 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
616 for (i
= 0; i
< 2; i
++)
623 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
624 if (! SYMBOLP (XCAR (tmp
)))
632 /* Structure of known font property keys and validater of the
636 /* Pointer to the key symbol. */
638 /* Function to validate PROP's value VAL, or NULL if any value is
639 ok. The value is VAL or its regularized value if VAL is valid,
640 and Qerror if not. */
641 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
642 } font_property_table
[] =
643 { { &QCtype
, font_prop_validate_symbol
},
644 { &QCfoundry
, font_prop_validate_symbol
},
645 { &QCfamily
, font_prop_validate_symbol
},
646 { &QCadstyle
, font_prop_validate_symbol
},
647 { &QCregistry
, font_prop_validate_symbol
},
648 { &QCweight
, font_prop_validate_style
},
649 { &QCslant
, font_prop_validate_style
},
650 { &QCwidth
, font_prop_validate_style
},
651 { &QCsize
, font_prop_validate_non_neg
},
652 { &QCdpi
, font_prop_validate_non_neg
},
653 { &QCspacing
, font_prop_validate_spacing
},
654 { &QCavgwidth
, font_prop_validate_non_neg
},
655 /* The order of the above entries must match with enum
656 font_property_index. */
657 { &QClang
, font_prop_validate_symbol
},
658 { &QCscript
, font_prop_validate_symbol
},
659 { &QCotf
, font_prop_validate_otf
}
662 /* Size (number of elements) of the above table. */
663 #define FONT_PROPERTY_TABLE_SIZE \
664 ((sizeof font_property_table) / (sizeof *font_property_table))
666 /* Return an index number of font property KEY or -1 if KEY is not an
667 already known property. */
670 get_font_prop_index (key
)
675 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
676 if (EQ (key
, *font_property_table
[i
].key
))
681 /* Validate the font property. The property key is specified by the
682 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
683 signal an error. The value is VAL or the regularized one. */
686 font_prop_validate (idx
, prop
, val
)
688 Lisp_Object prop
, val
;
690 Lisp_Object validated
;
695 prop
= *font_property_table
[idx
].key
;
698 idx
= get_font_prop_index (prop
);
702 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
703 if (EQ (validated
, Qerror
))
704 signal_error ("invalid font property", Fcons (prop
, val
));
709 /* Store VAL as a value of extra font property PROP in FONT while
710 keeping the sorting order. Don't check the validity of VAL. */
713 font_put_extra (font
, prop
, val
)
714 Lisp_Object font
, prop
, val
;
716 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
717 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
721 Lisp_Object prev
= Qnil
;
724 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
725 prev
= extra
, extra
= XCDR (extra
);
727 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
729 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
737 /* Font name parser and unparser */
739 static int parse_matrix
P_ ((char *));
740 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
741 static int font_parse_name
P_ ((char *, Lisp_Object
));
743 /* An enumerator for each field of an XLFD font name. */
744 enum xlfd_field_index
763 /* An enumerator for mask bit corresponding to each XLFD field. */
766 XLFD_FOUNDRY_MASK
= 0x0001,
767 XLFD_FAMILY_MASK
= 0x0002,
768 XLFD_WEIGHT_MASK
= 0x0004,
769 XLFD_SLANT_MASK
= 0x0008,
770 XLFD_SWIDTH_MASK
= 0x0010,
771 XLFD_ADSTYLE_MASK
= 0x0020,
772 XLFD_PIXEL_MASK
= 0x0040,
773 XLFD_POINT_MASK
= 0x0080,
774 XLFD_RESX_MASK
= 0x0100,
775 XLFD_RESY_MASK
= 0x0200,
776 XLFD_SPACING_MASK
= 0x0400,
777 XLFD_AVGWIDTH_MASK
= 0x0800,
778 XLFD_REGISTRY_MASK
= 0x1000,
779 XLFD_ENCODING_MASK
= 0x2000
783 /* Parse P pointing the pixel/point size field of the form
784 `[A B C D]' which specifies a transformation matrix:
790 by which all glyphs of the font are transformed. The spec says
791 that scalar value N for the pixel/point size is equivalent to:
792 A = N * resx/resy, B = C = 0, D = N.
794 Return the scalar value N if the form is valid. Otherwise return
805 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
808 matrix
[i
] = - strtod (p
+ 1, &end
);
810 matrix
[i
] = strtod (p
, &end
);
813 return (i
== 4 ? (int) matrix
[3] : -1);
816 /* Expand a wildcard field in FIELD (the first N fields are filled) to
817 multiple fields to fill in all 14 XLFD fields while restring a
818 field position by its contents. */
821 font_expand_wildcards (field
, n
)
822 Lisp_Object field
[XLFD_LAST_INDEX
];
826 Lisp_Object tmp
[XLFD_LAST_INDEX
];
827 /* Array of information about where this element can go. Nth
828 element is for Nth element of FIELD. */
830 /* Minimum possible field. */
832 /* Maxinum possible field. */
834 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
836 } range
[XLFD_LAST_INDEX
];
838 int range_from
, range_to
;
841 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
842 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
843 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
844 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
845 | XLFD_AVGWIDTH_MASK)
846 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
848 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
849 field. The value is shifted to left one bit by one in the
851 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
852 range_mask
= (range_mask
<< 1) | 1;
854 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
855 position-based retriction for FIELD[I]. */
856 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
857 i
++, range_from
++, range_to
++, range_mask
<<= 1)
859 Lisp_Object val
= field
[i
];
865 range
[i
].from
= range_from
;
866 range
[i
].to
= range_to
;
867 range
[i
].mask
= range_mask
;
871 /* The triplet FROM, TO, and MASK is a value-based
872 retriction for FIELD[I]. */
878 int numeric
= XINT (val
);
881 from
= to
= XLFD_ENCODING_INDEX
,
882 mask
= XLFD_ENCODING_MASK
;
883 else if (numeric
== 0)
884 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
885 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
886 else if (numeric
<= 48)
887 from
= to
= XLFD_PIXEL_INDEX
,
888 mask
= XLFD_PIXEL_MASK
;
890 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
891 mask
= XLFD_LARGENUM_MASK
;
893 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
894 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
895 mask
= XLFD_NULL_MASK
;
897 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
900 Lisp_Object name
= SYMBOL_NAME (val
);
902 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
903 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
904 mask
= XLFD_REGENC_MASK
;
906 from
= to
= XLFD_ENCODING_INDEX
,
907 mask
= XLFD_ENCODING_MASK
;
909 else if (range_from
<= XLFD_WEIGHT_INDEX
910 && range_to
>= XLFD_WEIGHT_INDEX
911 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
912 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
913 else if (range_from
<= XLFD_SLANT_INDEX
914 && range_to
>= XLFD_SLANT_INDEX
915 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
916 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
917 else if (range_from
<= XLFD_SWIDTH_INDEX
918 && range_to
>= XLFD_SWIDTH_INDEX
919 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
920 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
923 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
924 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
926 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
927 mask
= XLFD_SYMBOL_MASK
;
930 /* Merge position-based and value-based restrictions. */
932 while (from
< range_from
)
933 mask
&= ~(1 << from
++);
934 while (from
< 14 && ! (mask
& (1 << from
)))
936 while (to
> range_to
)
937 mask
&= ~(1 << to
--);
938 while (to
>= 0 && ! (mask
& (1 << to
)))
942 range
[i
].from
= from
;
944 range
[i
].mask
= mask
;
946 if (from
> range_from
|| to
< range_to
)
948 /* The range is narrowed by value-based restrictions.
949 Reflect it to the other fields. */
951 /* Following fields should be after FROM. */
953 /* Preceding fields should be before TO. */
954 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
956 /* Check FROM for non-wildcard field. */
957 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
959 while (range
[j
].from
< from
)
960 range
[j
].mask
&= ~(1 << range
[j
].from
++);
961 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
963 range
[j
].from
= from
;
966 from
= range
[j
].from
;
967 if (range
[j
].to
> to
)
969 while (range
[j
].to
> to
)
970 range
[j
].mask
&= ~(1 << range
[j
].to
--);
971 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
984 /* Decide all fileds from restrictions in RANGE. */
985 for (i
= j
= 0; i
< n
; i
++)
987 if (j
< range
[i
].from
)
989 if (i
== 0 || ! NILP (tmp
[i
- 1]))
990 /* None of TMP[X] corresponds to Jth field. */
992 for (; j
< range
[i
].from
; j
++)
997 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
999 for (; j
< XLFD_LAST_INDEX
; j
++)
1001 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
1002 field
[XLFD_ENCODING_INDEX
]
1003 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1008 #ifdef ENABLE_CHECKING
1009 /* Match a 14-field XLFD pattern against a full XLFD font name. */
1011 font_match_xlfd (char *pattern
, char *name
)
1013 while (*pattern
&& *name
)
1015 if (*pattern
== *name
)
1017 else if (*pattern
== '*')
1018 if (*name
== pattern
[1])
1029 /* Make sure the font object matches the XLFD font name. */
1031 font_check_xlfd_parse (Lisp_Object font
, char *name
)
1033 char name_check
[256];
1034 font_unparse_xlfd (font
, 0, name_check
, 255);
1035 return font_match_xlfd (name_check
, name
);
1041 /* Parse NAME (null terminated) as XLFD and store information in FONT
1042 (font-spec or font-entity). Size property of FONT is set as
1044 specified XLFD fields FONT property
1045 --------------------- -------------
1046 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1047 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1048 POINT_SIZE POINT_SIZE/10 (Lisp float)
1050 If NAME is successfully parsed, return 0. Otherwise return -1.
1052 FONT is usually a font-spec, but when this function is called from
1053 X font backend driver, it is a font-entity. In that case, NAME is
1054 a fully specified XLFD. */
1057 font_parse_xlfd (name
, font
)
1061 int len
= strlen (name
);
1063 char *f
[XLFD_LAST_INDEX
+ 1];
1067 if (len
> 255 || !len
)
1068 /* Maximum XLFD name length is 255. */
1070 /* Accept "*-.." as a fully specified XLFD. */
1071 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1072 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1075 for (p
= name
+ i
; *p
; p
++)
1079 if (i
== XLFD_LAST_INDEX
)
1084 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1085 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1087 if (i
== XLFD_LAST_INDEX
)
1089 /* Fully specified XLFD. */
1092 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1093 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1094 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1095 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1097 val
= INTERN_FIELD_SYM (i
);
1100 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1102 ASET (font
, j
, make_number (n
));
1105 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1106 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1107 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1109 ASET (font
, FONT_REGISTRY_INDEX
,
1110 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1111 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1113 p
= f
[XLFD_PIXEL_INDEX
];
1114 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1115 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1118 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1120 ASET (font
, FONT_SIZE_INDEX
, val
);
1123 double point_size
= -1;
1125 font_assert (FONT_SPEC_P (font
));
1126 p
= f
[XLFD_POINT_INDEX
];
1128 point_size
= parse_matrix (p
);
1129 else if (isdigit (*p
))
1130 point_size
= atoi (p
), point_size
/= 10;
1131 if (point_size
>= 0)
1132 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1136 ASET (font
, FONT_DPI_INDEX
, INTERN_FIELD (XLFD_RESY_INDEX
));
1137 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1140 val
= font_prop_validate_spacing (QCspacing
, val
);
1141 if (! INTEGERP (val
))
1143 ASET (font
, FONT_SPACING_INDEX
, val
);
1145 p
= f
[XLFD_AVGWIDTH_INDEX
];
1148 ASET (font
, FONT_AVGWIDTH_INDEX
,
1149 font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0));
1153 int wild_card_found
= 0;
1154 Lisp_Object prop
[XLFD_LAST_INDEX
];
1156 if (FONT_ENTITY_P (font
))
1158 for (j
= 0; j
< i
; j
++)
1162 if (f
[j
][1] && f
[j
][1] != '-')
1165 wild_card_found
= 1;
1168 prop
[j
] = INTERN_FIELD (j
);
1170 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1172 if (! wild_card_found
)
1174 if (font_expand_wildcards (prop
, i
) < 0)
1177 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1178 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1179 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1180 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1181 if (! NILP (prop
[i
]))
1183 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1185 ASET (font
, j
, make_number (n
));
1187 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1188 val
= prop
[XLFD_REGISTRY_INDEX
];
1191 val
= prop
[XLFD_ENCODING_INDEX
];
1193 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1195 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1196 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1198 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1199 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1201 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1203 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1204 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1205 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1207 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1209 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1212 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1213 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1214 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1216 val
= font_prop_validate_spacing (QCspacing
,
1217 prop
[XLFD_SPACING_INDEX
]);
1218 if (! INTEGERP (val
))
1220 ASET (font
, FONT_SPACING_INDEX
, val
);
1222 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1223 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1229 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1230 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1231 0, use PIXEL_SIZE instead. */
1234 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1240 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1244 font_assert (FONTP (font
));
1246 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1249 if (i
== FONT_ADSTYLE_INDEX
)
1250 j
= XLFD_ADSTYLE_INDEX
;
1251 else if (i
== FONT_REGISTRY_INDEX
)
1252 j
= XLFD_REGISTRY_INDEX
;
1253 val
= AREF (font
, i
);
1256 if (j
== XLFD_REGISTRY_INDEX
)
1257 f
[j
] = "*-*", len
+= 4;
1259 f
[j
] = "*", len
+= 2;
1264 val
= SYMBOL_NAME (val
);
1265 if (j
== XLFD_REGISTRY_INDEX
1266 && ! strchr ((char *) SDATA (val
), '-'))
1268 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1269 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1271 f
[j
] = alloca (SBYTES (val
) + 3);
1272 sprintf (f
[j
], "%s-*", SDATA (val
));
1273 len
+= SBYTES (val
) + 3;
1277 f
[j
] = alloca (SBYTES (val
) + 4);
1278 sprintf (f
[j
], "%s*-*", SDATA (val
));
1279 len
+= SBYTES (val
) + 4;
1283 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1287 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1290 val
= font_style_symbolic (font
, i
, 0);
1292 f
[j
] = "*", len
+= 2;
1295 val
= SYMBOL_NAME (val
);
1296 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1300 val
= AREF (font
, FONT_SIZE_INDEX
);
1301 font_assert (NUMBERP (val
) || NILP (val
));
1309 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1310 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1313 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1315 else if (FLOATP (val
))
1317 i
= XFLOAT_DATA (val
) * 10;
1318 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1319 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1322 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1324 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1326 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1327 f
[XLFD_RESX_INDEX
] = alloca (22);
1328 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1332 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1333 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1335 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1337 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1338 : spacing
<= FONT_SPACING_DUAL
? "d"
1339 : spacing
<= FONT_SPACING_MONO
? "m"
1344 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1345 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1347 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1348 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
],
1349 "%d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1352 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1353 len
++; /* for terminating '\0'. */
1356 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1357 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1358 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1359 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1360 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1361 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1362 f
[XLFD_REGISTRY_INDEX
]);
1365 /* Parse NAME (null terminated) and store information in FONT
1366 (font-spec or font-entity). NAME is supplied in either the
1367 Fontconfig or GTK font name format. If NAME is successfully
1368 parsed, return 0. Otherwise return -1.
1370 The fontconfig format is
1372 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1376 FAMILY [PROPS...] [SIZE]
1378 This function tries to guess which format it is. */
1381 font_parse_fcname (name
, font
)
1386 char *size_beg
= NULL
, *size_end
= NULL
;
1387 char *props_beg
= NULL
, *family_end
= NULL
;
1388 int len
= strlen (name
);
1393 for (p
= name
; *p
; p
++)
1395 if (*p
== '\\' && p
[1])
1399 props_beg
= family_end
= p
;
1404 int decimal
= 0, size_found
= 1;
1405 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1408 if (*q
!= '.' || decimal
)
1427 /* A fontconfig name with size and/or property data. */
1428 if (family_end
> name
)
1431 family
= font_intern_prop (name
, family_end
- name
, 1);
1432 ASET (font
, FONT_FAMILY_INDEX
, family
);
1436 double point_size
= strtod (size_beg
, &size_end
);
1437 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1438 if (*size_end
== ':' && size_end
[1])
1439 props_beg
= size_end
;
1443 /* Now parse ":KEY=VAL" patterns. */
1446 for (p
= props_beg
; *p
; p
= q
)
1448 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1451 /* Must be an enumerated value. */
1455 val
= font_intern_prop (p
, q
- p
, 1);
1457 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1459 if (PROP_MATCH ("light", 5)
1460 || PROP_MATCH ("medium", 6)
1461 || PROP_MATCH ("demibold", 8)
1462 || PROP_MATCH ("bold", 4)
1463 || PROP_MATCH ("black", 5))
1464 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1465 else if (PROP_MATCH ("roman", 5)
1466 || PROP_MATCH ("italic", 6)
1467 || PROP_MATCH ("oblique", 7))
1468 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1469 else if (PROP_MATCH ("charcell", 8))
1470 ASET (font
, FONT_SPACING_INDEX
,
1471 make_number (FONT_SPACING_CHARCELL
));
1472 else if (PROP_MATCH ("mono", 4))
1473 ASET (font
, FONT_SPACING_INDEX
,
1474 make_number (FONT_SPACING_MONO
));
1475 else if (PROP_MATCH ("proportional", 12))
1476 ASET (font
, FONT_SPACING_INDEX
,
1477 make_number (FONT_SPACING_PROPORTIONAL
));
1486 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1487 prop
= FONT_SIZE_INDEX
;
1490 key
= font_intern_prop (p
, q
- p
, 1);
1491 prop
= get_font_prop_index (key
);
1495 for (q
= p
; *q
&& *q
!= ':'; q
++);
1496 val
= font_intern_prop (p
, q
- p
, 0);
1498 if (prop
>= FONT_FOUNDRY_INDEX
1499 && prop
< FONT_EXTRA_INDEX
)
1500 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1502 Ffont_put (font
, key
, val
);
1510 /* Either a fontconfig-style name with no size and property
1511 data, or a GTK-style name. */
1513 int word_len
, prop_found
= 0;
1515 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1521 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1529 double point_size
= strtod (p
, &q
);
1530 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1535 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1536 if (*q
== '\\' && q
[1])
1540 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1542 if (PROP_MATCH ("Ultra-Light", 11))
1545 prop
= font_intern_prop ("ultra-light", 11, 1);
1546 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1548 else if (PROP_MATCH ("Light", 5))
1551 prop
= font_intern_prop ("light", 5, 1);
1552 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1554 else if (PROP_MATCH ("Semi-Bold", 9))
1557 prop
= font_intern_prop ("semi-bold", 9, 1);
1558 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1560 else if (PROP_MATCH ("Bold", 4))
1563 prop
= font_intern_prop ("bold", 4, 1);
1564 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1566 else if (PROP_MATCH ("Italic", 6))
1569 prop
= font_intern_prop ("italic", 4, 1);
1570 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1572 else if (PROP_MATCH ("Oblique", 7))
1575 prop
= font_intern_prop ("oblique", 7, 1);
1576 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1580 return -1; /* Unknown property in GTK-style font name. */
1589 family
= font_intern_prop (name
, family_end
- name
, 1);
1590 ASET (font
, FONT_FAMILY_INDEX
, family
);
1597 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1598 NAME (NBYTES length), and return the name length. If
1599 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1602 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1608 Lisp_Object family
, foundry
;
1609 Lisp_Object tail
, val
;
1613 Lisp_Object styles
[3];
1614 char *style_names
[3] = { "weight", "slant", "width" };
1617 family
= AREF (font
, FONT_FAMILY_INDEX
);
1618 if (! NILP (family
))
1620 if (SYMBOLP (family
))
1622 family
= SYMBOL_NAME (family
);
1623 len
+= SBYTES (family
);
1629 val
= AREF (font
, FONT_SIZE_INDEX
);
1632 if (XINT (val
) != 0)
1633 pixel_size
= XINT (val
);
1635 len
+= 21; /* for ":pixelsize=NUM" */
1637 else if (FLOATP (val
))
1640 point_size
= (int) XFLOAT_DATA (val
);
1641 len
+= 11; /* for "-NUM" */
1644 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1645 if (! NILP (foundry
))
1647 if (SYMBOLP (foundry
))
1649 foundry
= SYMBOL_NAME (foundry
);
1650 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1656 for (i
= 0; i
< 3; i
++)
1658 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1659 if (! NILP (styles
[i
]))
1660 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1661 SDATA (SYMBOL_NAME (styles
[i
])));
1664 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1665 len
+= sprintf (work
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1666 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1667 len
+= strlen (":spacing=100");
1668 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1669 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1670 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1672 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1674 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1676 len
+= SBYTES (val
);
1677 else if (INTEGERP (val
))
1678 len
+= sprintf (work
, "%d", XINT (val
));
1679 else if (SYMBOLP (val
))
1680 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1686 if (! NILP (family
))
1687 p
+= sprintf (p
, "%s", SDATA (family
));
1691 p
+= sprintf (p
, "%d", point_size
);
1693 p
+= sprintf (p
, "-%d", point_size
);
1695 else if (pixel_size
> 0)
1696 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1697 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1698 p
+= sprintf (p
, ":foundry=%s",
1699 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1700 for (i
= 0; i
< 3; i
++)
1701 if (! NILP (styles
[i
]))
1702 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1703 SDATA (SYMBOL_NAME (styles
[i
])));
1704 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1705 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1706 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1707 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1708 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1710 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1711 p
+= sprintf (p
, ":scalable=true");
1713 p
+= sprintf (p
, ":scalable=false");
1718 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1719 NAME (NBYTES length), and return the name length. F is the frame
1720 on which the font is displayed; it is used to calculate the point
1724 font_unparse_gtkname (font
, f
, name
, nbytes
)
1732 Lisp_Object family
, weight
, slant
, size
;
1733 int point_size
= -1;
1735 family
= AREF (font
, FONT_FAMILY_INDEX
);
1736 if (! NILP (family
))
1738 if (! SYMBOLP (family
))
1740 family
= SYMBOL_NAME (family
);
1741 len
+= SBYTES (family
);
1744 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1745 if (EQ (weight
, Qnormal
))
1747 else if (! NILP (weight
))
1749 weight
= SYMBOL_NAME (weight
);
1750 len
+= SBYTES (weight
);
1753 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1754 if (EQ (slant
, Qnormal
))
1756 else if (! NILP (slant
))
1758 slant
= SYMBOL_NAME (slant
);
1759 len
+= SBYTES (slant
);
1762 size
= AREF (font
, FONT_SIZE_INDEX
);
1763 /* Convert pixel size to point size. */
1764 if (INTEGERP (size
))
1766 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1768 if (INTEGERP (font_dpi
))
1769 dpi
= XINT (font_dpi
);
1772 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1775 else if (FLOATP (size
))
1777 point_size
= (int) XFLOAT_DATA (size
);
1784 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1786 if (! NILP (weight
))
1789 p
+= sprintf (p
, " %s", SDATA (weight
));
1790 q
[1] = toupper (q
[1]);
1796 p
+= sprintf (p
, " %s", SDATA (slant
));
1797 q
[1] = toupper (q
[1]);
1801 p
+= sprintf (p
, " %d", point_size
);
1806 /* Parse NAME (null terminated) and store information in FONT
1807 (font-spec or font-entity). If NAME is successfully parsed, return
1808 0. Otherwise return -1. */
1811 font_parse_name (name
, font
)
1815 if (name
[0] == '-' || index (name
, '*') || index (name
, '?'))
1816 return font_parse_xlfd (name
, font
);
1817 return font_parse_fcname (name
, font
);
1821 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1822 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1826 font_parse_family_registry (family
, registry
, font_spec
)
1827 Lisp_Object family
, registry
, font_spec
;
1833 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1835 CHECK_STRING (family
);
1836 len
= SBYTES (family
);
1837 p0
= (char *) SDATA (family
);
1838 p1
= index (p0
, '-');
1841 if ((*p0
!= '*' || p1
- p0
> 1)
1842 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1843 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1846 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1849 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1851 if (! NILP (registry
))
1853 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1854 CHECK_STRING (registry
);
1855 len
= SBYTES (registry
);
1856 p0
= (char *) SDATA (registry
);
1857 p1
= index (p0
, '-');
1860 if (SDATA (registry
)[len
- 1] == '*')
1861 registry
= concat2 (registry
, build_string ("-*"));
1863 registry
= concat2 (registry
, build_string ("*-*"));
1865 registry
= Fdowncase (registry
);
1866 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1871 /* This part (through the next ^L) is still experimental and not
1872 tested much. We may drastically change codes. */
1878 #define LGSTRING_HEADER_SIZE 6
1879 #define LGSTRING_GLYPH_SIZE 8
1882 check_gstring (gstring
)
1883 Lisp_Object gstring
;
1888 CHECK_VECTOR (gstring
);
1889 val
= AREF (gstring
, 0);
1891 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1893 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1894 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1895 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1896 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1897 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1898 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1899 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1900 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1901 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1902 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1903 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1905 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1907 val
= LGSTRING_GLYPH (gstring
, i
);
1909 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1911 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1913 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1914 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1915 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1916 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1917 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1918 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1919 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1920 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1922 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1924 if (ASIZE (val
) < 3)
1926 for (j
= 0; j
< 3; j
++)
1927 CHECK_NUMBER (AREF (val
, j
));
1932 error ("Invalid glyph-string format");
1937 check_otf_features (otf_features
)
1938 Lisp_Object otf_features
;
1942 CHECK_CONS (otf_features
);
1943 CHECK_SYMBOL (XCAR (otf_features
));
1944 otf_features
= XCDR (otf_features
);
1945 CHECK_CONS (otf_features
);
1946 CHECK_SYMBOL (XCAR (otf_features
));
1947 otf_features
= XCDR (otf_features
);
1948 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1950 CHECK_SYMBOL (Fcar (val
));
1951 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1952 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1954 otf_features
= XCDR (otf_features
);
1955 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1957 CHECK_SYMBOL (Fcar (val
));
1958 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1959 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1966 Lisp_Object otf_list
;
1969 otf_tag_symbol (tag
)
1974 OTF_tag_name (tag
, name
);
1975 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1982 Lisp_Object val
= Fassoc (file
, otf_list
);
1986 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1989 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1990 val
= make_save_value (otf
, 0);
1991 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1997 /* Return a list describing which scripts/languages FONT supports by
1998 which GSUB/GPOS features of OpenType tables. See the comment of
1999 (struct font_driver).otf_capability. */
2002 font_otf_capability (font
)
2006 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
2009 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
2012 for (i
= 0; i
< 2; i
++)
2014 OTF_GSUB_GPOS
*gsub_gpos
;
2015 Lisp_Object script_list
= Qnil
;
2018 if (OTF_get_features (otf
, i
== 0) < 0)
2020 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2021 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2023 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2024 Lisp_Object langsys_list
= Qnil
;
2025 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2028 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2030 OTF_LangSys
*langsys
;
2031 Lisp_Object feature_list
= Qnil
;
2032 Lisp_Object langsys_tag
;
2035 if (k
== script
->LangSysCount
)
2037 langsys
= &script
->DefaultLangSys
;
2042 langsys
= script
->LangSys
+ k
;
2044 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2046 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2048 OTF_Feature
*feature
2049 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2050 Lisp_Object feature_tag
2051 = otf_tag_symbol (feature
->FeatureTag
);
2053 feature_list
= Fcons (feature_tag
, feature_list
);
2055 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2058 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2063 XSETCAR (capability
, script_list
);
2065 XSETCDR (capability
, script_list
);
2071 /* Parse OTF features in SPEC and write a proper features spec string
2072 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2073 assured that the sufficient memory has already allocated for
2077 generate_otf_features (spec
, features
)
2087 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2093 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2098 else if (! asterisk
)
2100 val
= SYMBOL_NAME (val
);
2101 p
+= sprintf (p
, "%s", SDATA (val
));
2105 val
= SYMBOL_NAME (val
);
2106 p
+= sprintf (p
, "~%s", SDATA (val
));
2110 error ("OTF spec too long");
2114 font_otf_DeviceTable (device_table
)
2115 OTF_DeviceTable
*device_table
;
2117 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2119 return Fcons (make_number (len
),
2120 make_unibyte_string (device_table
->DeltaValue
, len
));
2124 font_otf_ValueRecord (value_format
, value_record
)
2126 OTF_ValueRecord
*value_record
;
2128 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2130 if (value_format
& OTF_XPlacement
)
2131 ASET (val
, 0, make_number (value_record
->XPlacement
));
2132 if (value_format
& OTF_YPlacement
)
2133 ASET (val
, 1, make_number (value_record
->YPlacement
));
2134 if (value_format
& OTF_XAdvance
)
2135 ASET (val
, 2, make_number (value_record
->XAdvance
));
2136 if (value_format
& OTF_YAdvance
)
2137 ASET (val
, 3, make_number (value_record
->YAdvance
));
2138 if (value_format
& OTF_XPlaDevice
)
2139 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2140 if (value_format
& OTF_YPlaDevice
)
2141 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2142 if (value_format
& OTF_XAdvDevice
)
2143 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2144 if (value_format
& OTF_YAdvDevice
)
2145 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2150 font_otf_Anchor (anchor
)
2155 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2156 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2157 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2158 if (anchor
->AnchorFormat
== 2)
2159 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2162 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2163 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2167 #endif /* HAVE_LIBOTF */
2173 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2174 static int font_compare
P_ ((const void *, const void *));
2175 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
2178 /* Return a rescaling ratio of FONT_ENTITY. */
2179 extern Lisp_Object Vface_font_rescale_alist
;
2182 font_rescale_ratio (font_entity
)
2183 Lisp_Object font_entity
;
2185 Lisp_Object tail
, elt
;
2186 Lisp_Object name
= Qnil
;
2188 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2191 if (FLOATP (XCDR (elt
)))
2193 if (STRINGP (XCAR (elt
)))
2196 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2197 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2198 return XFLOAT_DATA (XCDR (elt
));
2200 else if (FONT_SPEC_P (XCAR (elt
)))
2202 if (font_match_p (XCAR (elt
), font_entity
))
2203 return XFLOAT_DATA (XCDR (elt
));
2210 /* We sort fonts by scoring each of them against a specified
2211 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2212 the value is, the closer the font is to the font-spec.
2214 The lowest 2 bits of the score is used for driver type. The font
2215 available by the most preferred font driver is 0.
2217 Each 7-bit in the higher 28 bits are used for numeric properties
2218 WEIGHT, SLANT, WIDTH, and SIZE. */
2220 /* How many bits to shift to store the difference value of each font
2221 property in a score. Note that flots for FONT_TYPE_INDEX and
2222 FONT_REGISTRY_INDEX are not used. */
2223 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2225 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2226 The return value indicates how different ENTITY is compared with
2230 font_score (entity
, spec_prop
)
2231 Lisp_Object entity
, *spec_prop
;
2236 /* Score three style numeric fields. Maximum difference is 127. */
2237 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2238 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2240 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2245 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2248 /* Score the size. Maximum difference is 127. */
2249 i
= FONT_SIZE_INDEX
;
2250 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2251 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2253 /* We use the higher 6-bit for the actual size difference. The
2254 lowest bit is set if the DPI is different. */
2256 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2258 if (CONSP (Vface_font_rescale_alist
))
2259 pixel_size
*= font_rescale_ratio (entity
);
2260 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2264 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2265 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2267 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2274 /* The comparison function for qsort. */
2277 font_compare (d1
, d2
)
2278 const void *d1
, *d2
;
2280 return (*(unsigned *) d1
- *(unsigned *) d2
);
2284 /* The structure for elements being sorted by qsort. */
2285 struct font_sort_data
2292 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2293 If PREFER specifies a point-size, calculate the corresponding
2294 pixel-size from QCdpi property of PREFER or from the Y-resolution
2295 of FRAME before sorting.
2297 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2298 return the sorted VEC. */
2301 font_sort_entites (vec
, prefer
, frame
, best_only
)
2302 Lisp_Object vec
, prefer
, frame
;
2305 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2307 struct font_sort_data
*data
;
2308 unsigned best_score
;
2309 Lisp_Object best_entity
, driver_type
;
2311 struct frame
*f
= XFRAME (frame
);
2312 struct font_driver_list
*list
;
2317 return best_only
? AREF (vec
, 0) : vec
;
2319 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_DPI_INDEX
; i
++)
2320 prefer_prop
[i
] = AREF (prefer
, i
);
2321 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2322 prefer_prop
[FONT_SIZE_INDEX
]
2323 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2325 /* Scoring and sorting. */
2326 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2327 best_score
= 0xFFFFFFFF;
2328 /* We are sure that the length of VEC > 1. */
2329 driver_type
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2330 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2331 driver_order
++, list
= list
->next
)
2332 if (EQ (driver_type
, list
->driver
->type
))
2334 best_entity
= data
[0].entity
= AREF (vec
, 0);
2335 best_score
= data
[0].score
2336 = font_score (data
[0].entity
, prefer_prop
) | driver_order
;
2337 for (i
= 0; i
< len
; i
++)
2339 if (!EQ (driver_type
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2340 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2341 driver_order
++, list
= list
->next
)
2342 if (EQ (driver_type
, list
->driver
->type
))
2344 data
[i
].entity
= AREF (vec
, i
);
2345 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
) | driver_order
;
2346 if (best_only
&& best_score
> data
[i
].score
)
2348 best_score
= data
[i
].score
;
2349 best_entity
= data
[i
].entity
;
2350 if (best_score
== 0)
2356 qsort (data
, len
, sizeof *data
, font_compare
);
2357 for (i
= 0; i
< len
; i
++)
2358 ASET (vec
, i
, data
[i
].entity
);
2364 font_add_log ("sort-by", prefer
, vec
);
2369 /* API of Font Service Layer. */
2371 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2372 sort_shift_bits. Finternal_set_font_selection_order calls this
2373 function with font_sort_order after setting up it. */
2376 font_update_sort_order (order
)
2381 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2383 int xlfd_idx
= order
[i
];
2385 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2386 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2387 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2388 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2389 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2390 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2392 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2397 font_check_otf_features (script
, langsys
, features
, table
)
2398 Lisp_Object script
, langsys
, features
, table
;
2403 table
= assq_no_quit (script
, table
);
2406 table
= XCDR (table
);
2407 if (! NILP (langsys
))
2409 table
= assq_no_quit (langsys
, table
);
2415 val
= assq_no_quit (Qnil
, table
);
2417 table
= XCAR (table
);
2421 table
= XCDR (table
);
2422 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2424 if (NILP (XCAR (features
)))
2429 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2435 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2438 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2440 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2442 script
= XCAR (spec
);
2446 langsys
= XCAR (spec
);
2457 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2458 XCAR (otf_capability
)))
2460 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2461 XCDR (otf_capability
)))
2468 /* Check if FONT (font-entity or font-object) matches with the font
2469 specification SPEC. */
2472 font_match_p (spec
, font
)
2473 Lisp_Object spec
, font
;
2475 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2476 Lisp_Object extra
, font_extra
;
2479 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2480 if (! NILP (AREF (spec
, i
))
2481 && ! NILP (AREF (font
, i
))
2482 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2484 props
= XFONT_SPEC (spec
)->props
;
2485 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2487 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2488 prop
[i
] = AREF (spec
, i
);
2489 prop
[FONT_SIZE_INDEX
]
2490 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2494 if (font_score (font
, props
) > 0)
2496 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2497 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2498 for (; CONSP (extra
); extra
= XCDR (extra
))
2500 Lisp_Object key
= XCAR (XCAR (extra
));
2501 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2503 if (EQ (key
, QClang
))
2505 val2
= assq_no_quit (key
, font_extra
);
2514 if (NILP (Fmemq (val
, val2
)))
2519 ? NILP (Fmemq (val
, XCDR (val2
)))
2523 else if (EQ (key
, QCscript
))
2525 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2531 /* All characters in the list must be supported. */
2532 for (; CONSP (val2
); val2
= XCDR (val2
))
2534 if (! NATNUMP (XCAR (val2
)))
2536 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2537 == FONT_INVALID_CODE
)
2541 else if (VECTORP (val2
))
2543 /* At most one character in the vector must be supported. */
2544 for (i
= 0; i
< ASIZE (val2
); i
++)
2546 if (! NATNUMP (AREF (val2
, i
)))
2548 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2549 != FONT_INVALID_CODE
)
2552 if (i
== ASIZE (val2
))
2557 else if (EQ (key
, QCotf
))
2561 if (! FONT_OBJECT_P (font
))
2563 fontp
= XFONT_OBJECT (font
);
2564 if (! fontp
->driver
->otf_capability
)
2566 val2
= fontp
->driver
->otf_capability (fontp
);
2567 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2578 Each font backend has the callback function get_cache, and it
2579 returns a cons cell of which cdr part can be freely used for
2580 caching fonts. The cons cell may be shared by multiple frames
2581 and/or multiple font drivers. So, we arrange the cdr part as this:
2583 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2585 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2586 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2587 cons (FONT-SPEC FONT-ENTITY ...). */
2589 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2590 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2591 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2592 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2593 struct font_driver
*));
2596 font_prepare_cache (f
, driver
)
2598 struct font_driver
*driver
;
2600 Lisp_Object cache
, val
;
2602 cache
= driver
->get_cache (f
);
2604 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2608 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2609 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2613 val
= XCDR (XCAR (val
));
2614 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2620 font_finish_cache (f
, driver
)
2622 struct font_driver
*driver
;
2624 Lisp_Object cache
, val
, tmp
;
2627 cache
= driver
->get_cache (f
);
2629 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2630 cache
= val
, val
= XCDR (val
);
2631 font_assert (! NILP (val
));
2632 tmp
= XCDR (XCAR (val
));
2633 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2634 if (XINT (XCAR (tmp
)) == 0)
2636 font_clear_cache (f
, XCAR (val
), driver
);
2637 XSETCDR (cache
, XCDR (val
));
2643 font_get_cache (f
, driver
)
2645 struct font_driver
*driver
;
2647 Lisp_Object val
= driver
->get_cache (f
);
2648 Lisp_Object type
= driver
->type
;
2650 font_assert (CONSP (val
));
2651 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2652 font_assert (CONSP (val
));
2653 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2654 val
= XCDR (XCAR (val
));
2658 static int num_fonts
;
2661 font_clear_cache (f
, cache
, driver
)
2664 struct font_driver
*driver
;
2666 Lisp_Object tail
, elt
;
2667 Lisp_Object tail2
, entity
;
2669 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2670 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2673 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2674 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2676 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2678 entity
= XCAR (tail2
);
2680 if (FONT_ENTITY_P (entity
)
2681 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2683 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2685 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2687 Lisp_Object val
= XCAR (objlist
);
2688 struct font
*font
= XFONT_OBJECT (val
);
2690 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2692 font_assert (font
&& driver
== font
->driver
);
2693 driver
->close (f
, font
);
2697 if (driver
->free_entity
)
2698 driver
->free_entity (entity
);
2703 XSETCDR (cache
, Qnil
);
2707 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2710 font_delete_unmatched (list
, spec
, size
)
2711 Lisp_Object list
, spec
;
2714 Lisp_Object entity
, val
;
2715 enum font_property_index prop
;
2717 for (val
= Qnil
; CONSP (list
); list
= XCDR (list
))
2719 entity
= XCAR (list
);
2720 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2721 if (INTEGERP (AREF (spec
, prop
))
2722 && ((XINT (AREF (spec
, prop
)) >> 8)
2723 != (XINT (AREF (entity
, prop
)) >> 8)))
2724 prop
= FONT_SPEC_MAX
;
2725 if (prop
< FONT_SPEC_MAX
2727 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2729 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2732 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2733 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2734 prop
= FONT_SPEC_MAX
;
2736 if (prop
< FONT_SPEC_MAX
2737 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2738 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2739 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2740 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2741 prop
= FONT_SPEC_MAX
;
2742 if (prop
< FONT_SPEC_MAX
2743 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2744 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2745 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2746 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2747 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2748 prop
= FONT_SPEC_MAX
;
2749 if (prop
< FONT_SPEC_MAX
)
2750 val
= Fcons (entity
, val
);
2756 /* Return a vector of font-entities matching with SPEC on FRAME. */
2759 font_list_entities (frame
, spec
)
2760 Lisp_Object frame
, spec
;
2762 FRAME_PTR f
= XFRAME (frame
);
2763 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2764 Lisp_Object ftype
, val
;
2767 int need_filtering
= 0;
2770 font_assert (FONT_SPEC_P (spec
));
2772 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2773 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2774 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2775 size
= font_pixel_size (f
, spec
);
2779 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2780 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2781 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2782 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2784 ASET (scratch_font_spec
, i
, Qnil
);
2785 if (! NILP (AREF (spec
, i
)))
2787 if (i
== FONT_DPI_INDEX
)
2788 /* Skip FONT_SPACING_INDEX */
2791 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2792 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2794 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2798 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2800 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2802 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2804 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2805 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2812 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2813 copy
= Fcopy_font_spec (scratch_font_spec
);
2814 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2815 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2817 if (! NILP (val
) && need_filtering
)
2818 val
= font_delete_unmatched (val
, spec
, size
);
2823 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2824 font_add_log ("list", spec
, val
);
2829 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2830 nil, is an array of face's attributes, which specifies preferred
2831 font-related attributes. */
2834 font_matching_entity (f
, attrs
, spec
)
2836 Lisp_Object
*attrs
, spec
;
2838 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2839 Lisp_Object ftype
, size
, entity
;
2841 Lisp_Object work
= Fcopy_font_spec (spec
);
2843 XSETFRAME (frame
, f
);
2844 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2845 size
= AREF (spec
, FONT_SIZE_INDEX
);
2848 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2849 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2850 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2851 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2854 for (; driver_list
; driver_list
= driver_list
->next
)
2856 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2858 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2861 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2862 entity
= assoc_no_quit (work
, XCDR (cache
));
2864 entity
= XCDR (entity
);
2867 entity
= driver_list
->driver
->match (frame
, work
);
2868 copy
= Fcopy_font_spec (work
);
2869 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2870 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2872 if (! NILP (entity
))
2875 font_add_log ("match", work
, entity
);
2880 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2881 opened font object. */
2884 font_open_entity (f
, entity
, pixel_size
)
2889 struct font_driver_list
*driver_list
;
2890 Lisp_Object objlist
, size
, val
, font_object
;
2892 int min_width
, height
;
2893 int scaled_pixel_size
;
2895 font_assert (FONT_ENTITY_P (entity
));
2896 size
= AREF (entity
, FONT_SIZE_INDEX
);
2897 if (XINT (size
) != 0)
2898 scaled_pixel_size
= pixel_size
= XINT (size
);
2899 else if (CONSP (Vface_font_rescale_alist
))
2900 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2902 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2903 objlist
= XCDR (objlist
))
2904 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2905 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2906 return XCAR (objlist
);
2908 val
= AREF (entity
, FONT_TYPE_INDEX
);
2909 for (driver_list
= f
->font_driver_list
;
2910 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2911 driver_list
= driver_list
->next
);
2915 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2916 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2917 font_add_log ("open", entity
, font_object
);
2918 if (NILP (font_object
))
2920 ASET (entity
, FONT_OBJLIST_INDEX
,
2921 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2922 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
2925 font
= XFONT_OBJECT (font_object
);
2926 min_width
= (font
->min_width
? font
->min_width
2927 : font
->average_width
? font
->average_width
2928 : font
->space_width
? font
->space_width
2930 height
= (font
->height
? font
->height
: 1);
2931 #ifdef HAVE_WINDOW_SYSTEM
2932 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2933 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2935 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2936 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2937 fonts_changed_p
= 1;
2941 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2942 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2943 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2944 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2952 /* Close FONT_OBJECT that is opened on frame F. */
2955 font_close_object (f
, font_object
)
2957 Lisp_Object font_object
;
2959 struct font
*font
= XFONT_OBJECT (font_object
);
2961 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2962 /* Already closed. */
2964 font_add_log ("close", font_object
, Qnil
);
2965 font
->driver
->close (f
, font
);
2966 #ifdef HAVE_WINDOW_SYSTEM
2967 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2968 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2974 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2975 FONT is a font-entity and it must be opened to check. */
2978 font_has_char (f
, font
, c
)
2985 if (FONT_ENTITY_P (font
))
2987 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2988 struct font_driver_list
*driver_list
;
2990 for (driver_list
= f
->font_driver_list
;
2991 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2992 driver_list
= driver_list
->next
);
2995 if (! driver_list
->driver
->has_char
)
2997 return driver_list
->driver
->has_char (font
, c
);
3000 font_assert (FONT_OBJECT_P (font
));
3001 fontp
= XFONT_OBJECT (font
);
3002 if (fontp
->driver
->has_char
)
3004 int result
= fontp
->driver
->has_char (font
, c
);
3009 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
3013 /* Return the glyph ID of FONT_OBJECT for character C. */
3016 font_encode_char (font_object
, c
)
3017 Lisp_Object font_object
;
3022 font_assert (FONT_OBJECT_P (font_object
));
3023 font
= XFONT_OBJECT (font_object
);
3024 return font
->driver
->encode_char (font
, c
);
3028 /* Return the name of FONT_OBJECT. */
3031 font_get_name (font_object
)
3032 Lisp_Object font_object
;
3034 font_assert (FONT_OBJECT_P (font_object
));
3035 return AREF (font_object
, FONT_NAME_INDEX
);
3039 /* Return the specification of FONT_OBJECT. */
3042 font_get_spec (font_object
)
3043 Lisp_Object font_object
;
3045 Lisp_Object spec
= font_make_spec ();
3048 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
3049 ASET (spec
, i
, AREF (font_object
, i
));
3050 ASET (spec
, FONT_SIZE_INDEX
,
3051 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
3056 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3057 could not be parsed by font_parse_name, return Qnil. */
3060 font_spec_from_name (font_name
)
3061 Lisp_Object font_name
;
3063 Lisp_Object spec
= Ffont_spec (0, NULL
);
3065 CHECK_STRING (font_name
);
3066 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3068 font_put_extra (spec
, QCname
, font_name
);
3074 font_clear_prop (attrs
, prop
)
3076 enum font_property_index prop
;
3078 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3082 if (NILP (AREF (font
, prop
))
3083 && prop
!= FONT_FAMILY_INDEX
3084 && prop
!= FONT_FOUNDRY_INDEX
3085 && prop
!= FONT_WIDTH_INDEX
3086 && prop
!= FONT_SIZE_INDEX
)
3088 font
= Fcopy_font_spec (font
);
3089 ASET (font
, prop
, Qnil
);
3090 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3092 if (prop
== FONT_FAMILY_INDEX
)
3094 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3095 /* If we are setting the font family, we must also clear
3096 FONT_WIDTH_INDEX to avoid rejecting families that lack
3097 support for some widths. */
3098 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3100 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3101 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3102 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3103 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3104 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3105 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3107 else if (prop
== FONT_SIZE_INDEX
)
3109 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3110 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3111 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3113 else if (prop
== FONT_WIDTH_INDEX
)
3114 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3115 attrs
[LFACE_FONT_INDEX
] = font
;
3119 font_update_lface (f
, attrs
)
3125 spec
= attrs
[LFACE_FONT_INDEX
];
3126 if (! FONT_SPEC_P (spec
))
3129 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3130 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3131 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3132 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3133 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3134 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3135 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3136 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);
3137 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3138 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3139 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3143 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3148 val
= Ffont_get (spec
, QCdpi
);
3151 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3153 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3155 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3157 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3158 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3164 /* Return a font-entity satisfying SPEC and best matching with face's
3165 font related attributes in ATTRS. C, if not negative, is a
3166 character that the entity must support. */
3169 font_find_for_lface (f
, attrs
, spec
, c
)
3176 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
3177 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3179 int i
, j
, k
, l
, result
;
3181 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3182 if (NILP (registry
[0]))
3184 registry
[0] = DEFAULT_ENCODING
;
3185 registry
[1] = Qascii_0
;
3186 registry
[2] = null_vector
;
3189 registry
[1] = null_vector
;
3191 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3193 struct charset
*encoding
, *repertory
;
3195 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3196 &encoding
, &repertory
) < 0)
3200 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3202 /* Any font of this registry support C. So, let's
3203 suppress the further checking. */
3206 else if (c
> encoding
->max_char
)
3210 work
= Fcopy_font_spec (spec
);
3211 XSETFRAME (frame
, f
);
3212 size
= AREF (spec
, FONT_SIZE_INDEX
);
3213 pixel_size
= font_pixel_size (f
, spec
);
3214 if (pixel_size
== 0)
3216 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3218 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3220 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3221 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3222 if (! NILP (foundry
[0]))
3223 foundry
[1] = null_vector
;
3224 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3226 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3227 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3229 foundry
[2] = null_vector
;
3232 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3234 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3235 if (! NILP (adstyle
[0]))
3236 adstyle
[1] = null_vector
;
3237 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3239 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3241 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3243 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3245 adstyle
[2] = null_vector
;
3248 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3251 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3254 val
= AREF (work
, FONT_FAMILY_INDEX
);
3255 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3257 val
= attrs
[LFACE_FAMILY_INDEX
];
3258 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3262 family
= alloca ((sizeof family
[0]) * 2);
3264 family
[1] = null_vector
; /* terminator. */
3269 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3277 if (! NILP (alters
))
3279 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3280 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3281 family
[i
] = XCAR (alters
);
3282 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3284 family
[i
] = null_vector
;
3288 family
= alloca ((sizeof family
[0]) * 3);
3291 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3293 family
[i
] = null_vector
;
3297 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3299 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3300 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3302 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3303 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3305 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3306 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3308 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3309 entities
= font_list_entities (frame
, work
);
3310 if (ASIZE (entities
) > 0)
3318 if (ASIZE (entities
) == 1)
3321 return AREF (entities
, 0);
3325 /* Sort fonts by properties specified in LFACE. */
3326 Lisp_Object prefer
= scratch_font_prefer
;
3328 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3329 ASET (prefer
, i
, AREF (work
, i
));
3330 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3332 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3334 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3335 if (NILP (AREF (prefer
, i
)))
3336 ASET (prefer
, i
, AREF (face_font
, i
));
3338 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3339 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3340 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3341 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3342 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3343 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3344 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3345 entities
= font_sort_entites (entities
, prefer
, frame
, c
< 0);
3350 for (i
= 0; i
< ASIZE (entities
); i
++)
3354 val
= AREF (entities
, i
);
3357 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3358 if (! EQ (AREF (val
, j
), props
[j
]))
3360 if (j
> FONT_REGISTRY_INDEX
)
3363 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3364 props
[j
] = AREF (val
, j
);
3365 result
= font_has_char (f
, val
, c
);
3370 val
= font_open_for_lface (f
, val
, attrs
, spec
);
3373 result
= font_has_char (f
, val
, c
);
3374 font_close_object (f
, val
);
3376 return AREF (entities
, i
);
3383 font_open_for_lface (f
, entity
, attrs
, spec
)
3391 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3392 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3393 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3394 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3395 size
= font_pixel_size (f
, spec
);
3399 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3400 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3403 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3404 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3405 if (INTEGERP (height
))
3408 abort(); /* We should never end up here. */
3412 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3416 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3417 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3421 return font_open_entity (f
, entity
, size
);
3425 /* Find a font satisfying SPEC and best matching with face's
3426 attributes in ATTRS on FRAME, and return the opened
3430 font_load_for_lface (f
, attrs
, spec
)
3432 Lisp_Object
*attrs
, spec
;
3436 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3439 /* No font is listed for SPEC, but each font-backend may have
3440 the different criteria about "font matching". So, try
3442 entity
= font_matching_entity (f
, attrs
, spec
);
3446 return font_open_for_lface (f
, entity
, attrs
, spec
);
3450 /* Make FACE on frame F ready to use the font opened for FACE. */
3453 font_prepare_for_face (f
, face
)
3457 if (face
->font
->driver
->prepare_face
)
3458 face
->font
->driver
->prepare_face (f
, face
);
3462 /* Make FACE on frame F stop using the font opened for FACE. */
3465 font_done_for_face (f
, face
)
3469 if (face
->font
->driver
->done_face
)
3470 face
->font
->driver
->done_face (f
, face
);
3475 /* Open a font best matching with NAME on frame F. If no proper font
3476 is found, return Qnil. */
3479 font_open_by_name (f
, name
)
3483 Lisp_Object args
[2];
3484 Lisp_Object spec
, attrs
[LFACE_VECTOR_SIZE
];
3487 args
[1] = make_unibyte_string (name
, strlen (name
));
3488 spec
= Ffont_spec (2, args
);
3489 /* We set up the default font-related attributes of a face to prefer
3491 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3492 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3493 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3495 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3497 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3499 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3501 return font_load_for_lface (f
, attrs
, spec
);
3505 /* Register font-driver DRIVER. This function is used in two ways.
3507 The first is with frame F non-NULL. In this case, make DRIVER
3508 available (but not yet activated) on F. All frame creaters
3509 (e.g. Fx_create_frame) must call this function at least once with
3510 an available font-driver.
3512 The second is with frame F NULL. In this case, DRIVER is globally
3513 registered in the variable `font_driver_list'. All font-driver
3514 implementations must call this function in its syms_of_XXXX
3515 (e.g. syms_of_xfont). */
3518 register_font_driver (driver
, f
)
3519 struct font_driver
*driver
;
3522 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3523 struct font_driver_list
*prev
, *list
;
3525 if (f
&& ! driver
->draw
)
3526 error ("Unusable font driver for a frame: %s",
3527 SDATA (SYMBOL_NAME (driver
->type
)));
3529 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3530 if (EQ (list
->driver
->type
, driver
->type
))
3531 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3533 list
= xmalloc (sizeof (struct font_driver_list
));
3535 list
->driver
= driver
;
3540 f
->font_driver_list
= list
;
3542 font_driver_list
= list
;
3548 free_font_driver_list (f
)
3551 struct font_driver_list
*list
, *next
;
3553 for (list
= f
->font_driver_list
; list
; list
= next
)
3558 f
->font_driver_list
= NULL
;
3562 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3563 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3564 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3566 A caller must free all realized faces if any in advance. The
3567 return value is a list of font backends actually made used on
3571 font_update_drivers (f
, new_drivers
)
3573 Lisp_Object new_drivers
;
3575 Lisp_Object active_drivers
= Qnil
;
3576 struct font_driver
*driver
;
3577 struct font_driver_list
*list
;
3579 /* At first, turn off non-requested drivers, and turn on requested
3581 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3583 driver
= list
->driver
;
3584 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3589 if (driver
->end_for_frame
)
3590 driver
->end_for_frame (f
);
3591 font_finish_cache (f
, driver
);
3596 if (! driver
->start_for_frame
3597 || driver
->start_for_frame (f
) == 0)
3599 font_prepare_cache (f
, driver
);
3606 if (NILP (new_drivers
))
3609 if (! EQ (new_drivers
, Qt
))
3611 /* Re-order the driver list according to new_drivers. */
3612 struct font_driver_list
**list_table
, **next
;
3616 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3617 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3619 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3620 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3623 list_table
[i
++] = list
;
3625 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3627 list_table
[i
++] = list
;
3628 list_table
[i
] = NULL
;
3630 next
= &f
->font_driver_list
;
3631 for (i
= 0; list_table
[i
]; i
++)
3633 *next
= list_table
[i
];
3634 next
= &(*next
)->next
;
3639 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3641 active_drivers
= nconc2 (active_drivers
,
3642 Fcons (list
->driver
->type
, Qnil
));
3643 return active_drivers
;
3647 font_put_frame_data (f
, driver
, data
)
3649 struct font_driver
*driver
;
3652 struct font_data_list
*list
, *prev
;
3654 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3655 prev
= list
, list
= list
->next
)
3656 if (list
->driver
== driver
)
3663 prev
->next
= list
->next
;
3665 f
->font_data_list
= list
->next
;
3673 list
= xmalloc (sizeof (struct font_data_list
));
3674 list
->driver
= driver
;
3675 list
->next
= f
->font_data_list
;
3676 f
->font_data_list
= list
;
3684 font_get_frame_data (f
, driver
)
3686 struct font_driver
*driver
;
3688 struct font_data_list
*list
;
3690 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3691 if (list
->driver
== driver
)
3699 /* Return the font used to draw character C by FACE at buffer position
3700 POS in window W. If STRING is non-nil, it is a string containing C
3701 at index POS. If C is negative, get C from the current buffer or
3705 font_at (c
, pos
, face
, w
, string
)
3714 Lisp_Object font_object
;
3716 multibyte
= (NILP (string
)
3717 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3718 : STRING_MULTIBYTE (string
));
3725 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3727 c
= FETCH_CHAR (pos_byte
);
3730 c
= FETCH_BYTE (pos
);
3736 multibyte
= STRING_MULTIBYTE (string
);
3739 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3741 str
= SDATA (string
) + pos_byte
;
3742 c
= STRING_CHAR (str
, 0);
3745 c
= SDATA (string
)[pos
];
3749 f
= XFRAME (w
->frame
);
3750 if (! FRAME_WINDOW_P (f
))
3757 if (STRINGP (string
))
3758 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3759 DEFAULT_FACE_ID
, 0);
3761 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3763 face
= FACE_FROM_ID (f
, face_id
);
3767 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3768 face
= FACE_FROM_ID (f
, face_id
);
3773 XSETFONT (font_object
, face
->font
);
3778 #ifdef HAVE_WINDOW_SYSTEM
3780 /* Check how many characters after POS (at most to *LIMIT) can be
3781 displayed by the same font on the window W. FACE, if non-NULL, is
3782 the face selected for the character at POS. If STRING is not nil,
3783 it is the string to check instead of the current buffer. In that
3784 case, FACE must be not NULL.
3786 The return value is the font-object for the character at POS.
3787 *LIMIT is set to the position where that font can't be used.
3789 It is assured that the current buffer (or STRING) is multibyte. */
3792 font_range (pos
, limit
, w
, face
, string
)
3793 EMACS_INT pos
, *limit
;
3798 EMACS_INT pos_byte
, ignore
, start
, start_byte
;
3800 Lisp_Object font_object
= Qnil
;
3804 pos_byte
= CHAR_TO_BYTE (pos
);
3809 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
, *limit
, 0);
3810 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3816 pos_byte
= string_char_to_byte (string
, pos
);
3819 start
= pos
, start_byte
= pos_byte
;
3820 while (pos
< *limit
)
3822 Lisp_Object category
;
3825 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3827 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3828 if (NILP (font_object
))
3830 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3831 if (NILP (font_object
))
3836 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3837 if (! EQ (category
, QCf
)
3838 && ! CHAR_VARIATION_SELECTOR_P (c
)
3839 && font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3841 Lisp_Object f
= font_for_char (face
, c
, pos
- 1, string
);
3842 EMACS_INT i
, i_byte
;
3850 i
= start
, i_byte
= start_byte
;
3855 FETCH_CHAR_ADVANCE_NO_CHECK (c
, i
, i_byte
);
3857 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, i
, i_byte
);
3858 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3859 if (! EQ (category
, QCf
)
3860 && ! CHAR_VARIATION_SELECTOR_P (c
)
3861 && font_encode_char (f
, c
) == FONT_INVALID_CODE
)
3877 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3878 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3879 Return nil otherwise.
3880 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3881 which kind of font it is. It must be one of `font-spec', `font-entity',
3883 (object
, extra_type
)
3884 Lisp_Object object
, extra_type
;
3886 if (NILP (extra_type
))
3887 return (FONTP (object
) ? Qt
: Qnil
);
3888 if (EQ (extra_type
, Qfont_spec
))
3889 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3890 if (EQ (extra_type
, Qfont_entity
))
3891 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3892 if (EQ (extra_type
, Qfont_object
))
3893 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3894 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3897 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3898 doc
: /* Return a newly created font-spec with arguments as properties.
3900 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3901 valid font property name listed below:
3903 `:family', `:weight', `:slant', `:width'
3905 They are the same as face attributes of the same name. See
3906 `set-face-attribute'.
3910 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3914 VALUE must be a string or a symbol specifying the additional
3915 typographic style information of a font, e.g. ``sans''.
3919 VALUE must be a string or a symbol specifying the charset registry and
3920 encoding of a font, e.g. ``iso8859-1''.
3924 VALUE must be a non-negative integer or a floating point number
3925 specifying the font size. It specifies the font size in pixels (if
3926 VALUE is an integer), or in points (if VALUE is a float).
3930 VALUE must be a string of XLFD-style or fontconfig-style font name.
3934 VALUE must be a symbol representing a script that the font must
3935 support. It may be a symbol representing a subgroup of a script
3936 listed in the variable `script-representative-chars'.
3940 VALUE must be a symbol of two-letter ISO-639 language names,
3945 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3946 required OpenType features.
3948 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3949 LANGSYS-TAG: OpenType language system tag symbol,
3950 or nil for the default language system.
3951 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3952 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3954 GSUB and GPOS may contain `nil' element. In such a case, the font
3955 must not have any of the remaining elements.
3957 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3958 be an OpenType font, and whose GPOS table of `thai' script's default
3959 language system must contain `mark' feature.
3961 usage: (font-spec ARGS...) */)
3966 Lisp_Object spec
= font_make_spec ();
3969 for (i
= 0; i
< nargs
; i
+= 2)
3971 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3973 if (EQ (key
, QCname
))
3976 font_parse_name ((char *) SDATA (val
), spec
);
3977 font_put_extra (spec
, key
, val
);
3981 int idx
= get_font_prop_index (key
);
3985 val
= font_prop_validate (idx
, Qnil
, val
);
3986 if (idx
< FONT_EXTRA_INDEX
)
3987 ASET (spec
, idx
, val
);
3989 font_put_extra (spec
, key
, val
);
3992 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3998 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3999 doc
: /* Return a copy of FONT as a font-spec. */)
4003 Lisp_Object new_spec
, tail
, prev
, extra
;
4007 new_spec
= font_make_spec ();
4008 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
4009 ASET (new_spec
, i
, AREF (font
, i
));
4010 extra
= Fcopy_sequence (AREF (font
, FONT_EXTRA_INDEX
));
4011 /* We must remove :font-entity property. */
4012 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
4013 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
4016 extra
= XCDR (extra
);
4018 XSETCDR (prev
, XCDR (tail
));
4021 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
4025 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
4026 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
4027 Every specified properties in FROM override the corresponding
4028 properties in TO. */)
4030 Lisp_Object from
, to
;
4032 Lisp_Object extra
, tail
;
4037 to
= Fcopy_font_spec (to
);
4038 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
4039 ASET (to
, i
, AREF (from
, i
));
4040 extra
= AREF (to
, FONT_EXTRA_INDEX
);
4041 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
4042 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
4044 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
4047 XSETCDR (slot
, XCDR (XCAR (tail
)));
4049 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
4051 ASET (to
, FONT_EXTRA_INDEX
, extra
);
4055 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
4056 doc
: /* Return the value of FONT's property KEY.
4057 FONT is a font-spec, a font-entity, or a font-object.
4058 KEY must be one of these symbols:
4059 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4060 :size, :name, :script
4061 See the documentation of `font-spec' for their meanings.
4062 If FONT is a font-entity or font-object, the value of :script may be
4063 a list of scripts that are supported by the font. */)
4065 Lisp_Object font
, key
;
4072 idx
= get_font_prop_index (key
);
4073 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4074 return font_style_symbolic (font
, idx
, 0);
4075 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4076 return AREF (font
, idx
);
4077 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
4080 #ifdef HAVE_WINDOW_SYSTEM
4082 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4083 doc
: /* Return a plist of face attributes generated by FONT.
4084 FONT is a font name, a font-spec, a font-entity, or a font-object.
4085 The return value is a list of the form
4087 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4089 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4090 compatible with `set-face-attribute'. Some of these key-attribute pairs
4091 may be omitted from the list if they are not specified by FONT.
4093 The optional argument FRAME specifies the frame that the face attributes
4094 are to be displayed on. If omitted, the selected frame is used. */)
4096 Lisp_Object font
, frame
;
4099 Lisp_Object plist
[10];
4104 frame
= selected_frame
;
4105 CHECK_LIVE_FRAME (frame
);
4110 int fontset
= fs_query_fontset (font
, 0);
4111 Lisp_Object name
= font
;
4113 font
= fontset_ascii (fontset
);
4114 font
= font_spec_from_name (name
);
4116 signal_error ("Invalid font name", name
);
4118 else if (! FONTP (font
))
4119 signal_error ("Invalid font object", font
);
4121 val
= AREF (font
, FONT_FAMILY_INDEX
);
4124 plist
[n
++] = QCfamily
;
4125 plist
[n
++] = SYMBOL_NAME (val
);
4128 val
= AREF (font
, FONT_SIZE_INDEX
);
4131 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4132 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4133 plist
[n
++] = QCheight
;
4134 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4136 else if (FLOATP (val
))
4138 plist
[n
++] = QCheight
;
4139 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4142 val
= FONT_WEIGHT_FOR_FACE (font
);
4145 plist
[n
++] = QCweight
;
4149 val
= FONT_SLANT_FOR_FACE (font
);
4152 plist
[n
++] = QCslant
;
4156 val
= FONT_WIDTH_FOR_FACE (font
);
4159 plist
[n
++] = QCwidth
;
4163 return Flist (n
, plist
);
4168 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4169 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
4170 (font_spec
, prop
, val
)
4171 Lisp_Object font_spec
, prop
, val
;
4175 CHECK_FONT_SPEC (font_spec
);
4176 idx
= get_font_prop_index (prop
);
4177 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4178 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
4180 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
4184 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4185 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4186 Optional 2nd argument FRAME specifies the target frame.
4187 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4188 Optional 4th argument PREFER, if non-nil, is a font-spec to
4189 control the order of the returned list. Fonts are sorted by
4190 how close they are to PREFER. */)
4191 (font_spec
, frame
, num
, prefer
)
4192 Lisp_Object font_spec
, frame
, num
, prefer
;
4194 Lisp_Object vec
, list
, tail
;
4198 frame
= selected_frame
;
4199 CHECK_LIVE_FRAME (frame
);
4200 CHECK_FONT_SPEC (font_spec
);
4208 if (! NILP (prefer
))
4209 CHECK_FONT_SPEC (prefer
);
4211 vec
= font_list_entities (frame
, font_spec
);
4216 return Fcons (AREF (vec
, 0), Qnil
);
4218 if (! NILP (prefer
))
4219 vec
= font_sort_entites (vec
, prefer
, frame
, 0);
4221 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
4222 if (n
== 0 || n
> len
)
4224 for (i
= 1; i
< n
; i
++)
4226 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
4228 XSETCDR (tail
, val
);
4234 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4235 doc
: /* List available font families on the current frame.
4236 Optional argument FRAME, if non-nil, specifies the target frame. */)
4241 struct font_driver_list
*driver_list
;
4245 frame
= selected_frame
;
4246 CHECK_LIVE_FRAME (frame
);
4249 for (driver_list
= f
->font_driver_list
; driver_list
;
4250 driver_list
= driver_list
->next
)
4251 if (driver_list
->driver
->list_family
)
4253 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4254 Lisp_Object tail
= list
;
4256 for (; CONSP (val
); val
= XCDR (val
))
4257 if (NILP (Fmemq (XCAR (val
), tail
))
4258 && SYMBOLP (XCAR (val
)))
4259 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4264 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4265 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4266 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4268 Lisp_Object font_spec
, frame
;
4270 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4277 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4278 doc
: /* Return XLFD name of FONT.
4279 FONT is a font-spec, font-entity, or font-object.
4280 If the name is too long for XLFD (maximum 255 chars), return nil.
4281 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4282 the consecutive wildcards are folded to one. */)
4283 (font
, fold_wildcards
)
4284 Lisp_Object font
, fold_wildcards
;
4291 if (FONT_OBJECT_P (font
))
4293 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4295 if (STRINGP (font_name
)
4296 && SDATA (font_name
)[0] == '-')
4298 if (NILP (fold_wildcards
))
4300 strcpy (name
, (char *) SDATA (font_name
));
4303 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4305 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4308 if (! NILP (fold_wildcards
))
4310 char *p0
= name
, *p1
;
4312 while ((p1
= strstr (p0
, "-*-*")))
4314 strcpy (p1
, p1
+ 2);
4319 return build_string (name
);
4322 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4323 doc
: /* Clear font cache. */)
4326 Lisp_Object list
, frame
;
4328 FOR_EACH_FRAME (list
, frame
)
4330 FRAME_PTR f
= XFRAME (frame
);
4331 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4333 for (; driver_list
; driver_list
= driver_list
->next
)
4334 if (driver_list
->on
)
4336 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4341 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4343 font_assert (! NILP (val
));
4344 val
= XCDR (XCAR (val
));
4345 if (XINT (XCAR (val
)) == 0)
4347 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4348 XSETCDR (cache
, XCDR (val
));
4358 font_fill_lglyph_metrics (glyph
, font_object
)
4359 Lisp_Object glyph
, font_object
;
4361 struct font
*font
= XFONT_OBJECT (font_object
);
4363 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4364 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4365 struct font_metrics metrics
;
4367 LGLYPH_SET_CODE (glyph
, ecode
);
4369 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4370 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4371 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4372 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4373 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4374 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4378 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4379 doc
: /* Shape the glyph-string GSTRING.
4380 Shaping means substituting glyphs and/or adjusting positions of glyphs
4381 to get the correct visual image of character sequences set in the
4382 header of the glyph-string.
4384 If the shaping was successful, the value is GSTRING itself or a newly
4385 created glyph-string. Otherwise, the value is nil. */)
4387 Lisp_Object gstring
;
4390 Lisp_Object font_object
, n
, glyph
;
4393 if (! composition_gstring_p (gstring
))
4394 signal_error ("Invalid glyph-string: ", gstring
);
4395 if (! NILP (LGSTRING_ID (gstring
)))
4397 font_object
= LGSTRING_FONT (gstring
);
4398 CHECK_FONT_OBJECT (font_object
);
4399 font
= XFONT_OBJECT (font_object
);
4400 if (! font
->driver
->shape
)
4403 /* Try at most three times with larger gstring each time. */
4404 for (i
= 0; i
< 3; i
++)
4406 n
= font
->driver
->shape (gstring
);
4409 gstring
= larger_vector (gstring
,
4410 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4413 if (i
== 3 || XINT (n
) == 0)
4416 glyph
= LGSTRING_GLYPH (gstring
, 0);
4417 from
= LGLYPH_FROM (glyph
);
4418 to
= LGLYPH_TO (glyph
);
4419 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4421 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4425 if (NILP (LGLYPH_ADJUSTMENT (this)))
4430 glyph
= LGSTRING_GLYPH (gstring
, j
);
4431 LGLYPH_SET_FROM (glyph
, from
);
4432 LGLYPH_SET_TO (glyph
, to
);
4434 from
= LGLYPH_FROM (this);
4435 to
= LGLYPH_TO (this);
4440 if (from
> LGLYPH_FROM (this))
4441 from
= LGLYPH_FROM (this);
4442 if (to
< LGLYPH_TO (this))
4443 to
= LGLYPH_TO (this);
4449 glyph
= LGSTRING_GLYPH (gstring
, j
);
4450 LGLYPH_SET_FROM (glyph
, from
);
4451 LGLYPH_SET_TO (glyph
, to
);
4453 return composition_gstring_put_cache (gstring
, XINT (n
));
4456 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4458 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4459 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4461 VARIATION-SELECTOR is a chracter code of variation selection
4462 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4463 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4464 (font_object
, character
)
4465 Lisp_Object font_object
, character
;
4467 unsigned variations
[256];
4472 CHECK_FONT_OBJECT (font_object
);
4473 CHECK_CHARACTER (character
);
4474 font
= XFONT_OBJECT (font_object
);
4475 if (! font
->driver
->get_variation_glyphs
)
4477 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4481 for (i
= 0; i
< 255; i
++)
4485 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4486 /* Stops GCC whining about limited range of data type. */
4487 EMACS_INT var
= variations
[i
];
4489 if (var
> MOST_POSITIVE_FIXNUM
)
4490 code
= Fcons (make_number ((variations
[i
]) >> 16),
4491 make_number ((variations
[i
]) & 0xFFFF));
4493 code
= make_number (variations
[i
]);
4494 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4501 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4502 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4503 OTF-FEATURES specifies which features to apply in this format:
4504 (SCRIPT LANGSYS GSUB GPOS)
4506 SCRIPT is a symbol specifying a script tag of OpenType,
4507 LANGSYS is a symbol specifying a langsys tag of OpenType,
4508 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4510 If LANGYS is nil, the default langsys is selected.
4512 The features are applied in the order they appear in the list. The
4513 symbol `*' means to apply all available features not present in this
4514 list, and the remaining features are ignored. For instance, (vatu
4515 pstf * haln) is to apply vatu and pstf in this order, then to apply
4516 all available features other than vatu, pstf, and haln.
4518 The features are applied to the glyphs in the range FROM and TO of
4519 the glyph-string GSTRING-IN.
4521 If some feature is actually applicable, the resulting glyphs are
4522 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4523 this case, the value is the number of produced glyphs.
4525 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4528 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4529 produced in GSTRING-OUT, and the value is nil.
4531 See the documentation of `font-make-gstring' for the format of
4533 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4534 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4536 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4541 check_otf_features (otf_features
);
4542 CHECK_FONT_OBJECT (font_object
);
4543 font
= XFONT_OBJECT (font_object
);
4544 if (! font
->driver
->otf_drive
)
4545 error ("Font backend %s can't drive OpenType GSUB table",
4546 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4547 CHECK_CONS (otf_features
);
4548 CHECK_SYMBOL (XCAR (otf_features
));
4549 val
= XCDR (otf_features
);
4550 CHECK_SYMBOL (XCAR (val
));
4551 val
= XCDR (otf_features
);
4554 len
= check_gstring (gstring_in
);
4555 CHECK_VECTOR (gstring_out
);
4556 CHECK_NATNUM (from
);
4558 CHECK_NATNUM (index
);
4560 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4561 args_out_of_range_3 (from
, to
, make_number (len
));
4562 if (XINT (index
) >= ASIZE (gstring_out
))
4563 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4564 num
= font
->driver
->otf_drive (font
, otf_features
,
4565 gstring_in
, XINT (from
), XINT (to
),
4566 gstring_out
, XINT (index
), 0);
4569 return make_number (num
);
4572 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4574 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4575 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4577 (SCRIPT LANGSYS FEATURE ...)
4578 See the documentation of `font-drive-otf' for more detail.
4580 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4581 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4582 character code corresponding to the glyph or nil if there's no
4583 corresponding character. */)
4584 (font_object
, character
, otf_features
)
4585 Lisp_Object font_object
, character
, otf_features
;
4588 Lisp_Object gstring_in
, gstring_out
, g
;
4589 Lisp_Object alternates
;
4592 CHECK_FONT_GET_OBJECT (font_object
, font
);
4593 if (! font
->driver
->otf_drive
)
4594 error ("Font backend %s can't drive OpenType GSUB table",
4595 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4596 CHECK_CHARACTER (character
);
4597 CHECK_CONS (otf_features
);
4599 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4600 g
= LGSTRING_GLYPH (gstring_in
, 0);
4601 LGLYPH_SET_CHAR (g
, XINT (character
));
4602 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4603 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4604 gstring_out
, 0, 1)) < 0)
4605 gstring_out
= Ffont_make_gstring (font_object
,
4606 make_number (ASIZE (gstring_out
) * 2));
4608 for (i
= 0; i
< num
; i
++)
4610 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4611 int c
= LGLYPH_CHAR (g
);
4612 unsigned code
= LGLYPH_CODE (g
);
4614 alternates
= Fcons (Fcons (make_number (code
),
4615 c
> 0 ? make_number (c
) : Qnil
),
4618 return Fnreverse (alternates
);
4624 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4625 doc
: /* Open FONT-ENTITY. */)
4626 (font_entity
, size
, frame
)
4627 Lisp_Object font_entity
;
4633 CHECK_FONT_ENTITY (font_entity
);
4635 frame
= selected_frame
;
4636 CHECK_LIVE_FRAME (frame
);
4639 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4642 CHECK_NUMBER_OR_FLOAT (size
);
4644 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4646 isize
= XINT (size
);
4650 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4653 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4654 doc
: /* Close FONT-OBJECT. */)
4655 (font_object
, frame
)
4656 Lisp_Object font_object
, frame
;
4658 CHECK_FONT_OBJECT (font_object
);
4660 frame
= selected_frame
;
4661 CHECK_LIVE_FRAME (frame
);
4662 font_close_object (XFRAME (frame
), font_object
);
4666 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4667 doc
: /* Return information about FONT-OBJECT.
4668 The value is a vector:
4669 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4672 NAME is a string of the font name (or nil if the font backend doesn't
4675 FILENAME is a string of the font file (or nil if the font backend
4676 doesn't provide a file name).
4678 PIXEL-SIZE is a pixel size by which the font is opened.
4680 SIZE is a maximum advance width of the font in pixels.
4682 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4685 CAPABILITY is a list whose first element is a symbol representing the
4686 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4687 remaining elements describe the details of the font capability.
4689 If the font is OpenType font, the form of the list is
4690 \(opentype GSUB GPOS)
4691 where GSUB shows which "GSUB" features the font supports, and GPOS
4692 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4693 lists of the format:
4694 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4696 If the font is not OpenType font, currently the length of the form is
4699 SCRIPT is a symbol representing OpenType script tag.
4701 LANGSYS is a symbol representing OpenType langsys tag, or nil
4702 representing the default langsys.
4704 FEATURE is a symbol representing OpenType feature tag.
4706 If the font is not OpenType font, CAPABILITY is nil. */)
4708 Lisp_Object font_object
;
4713 CHECK_FONT_GET_OBJECT (font_object
, font
);
4715 val
= Fmake_vector (make_number (9), Qnil
);
4716 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4717 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4718 ASET (val
, 2, make_number (font
->pixel_size
));
4719 ASET (val
, 3, make_number (font
->max_width
));
4720 ASET (val
, 4, make_number (font
->ascent
));
4721 ASET (val
, 5, make_number (font
->descent
));
4722 ASET (val
, 6, make_number (font
->space_width
));
4723 ASET (val
, 7, make_number (font
->average_width
));
4724 if (font
->driver
->otf_capability
)
4725 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4729 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4730 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4731 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4732 (font_object
, string
)
4733 Lisp_Object font_object
, string
;
4739 CHECK_FONT_GET_OBJECT (font_object
, font
);
4740 CHECK_STRING (string
);
4741 len
= SCHARS (string
);
4742 vec
= Fmake_vector (make_number (len
), Qnil
);
4743 for (i
= 0; i
< len
; i
++)
4745 Lisp_Object ch
= Faref (string
, make_number (i
));
4750 struct font_metrics metrics
;
4752 cod
= code
= font
->driver
->encode_char (font
, c
);
4753 if (code
== FONT_INVALID_CODE
)
4755 val
= Fmake_vector (make_number (6), Qnil
);
4756 if (cod
<= MOST_POSITIVE_FIXNUM
)
4757 ASET (val
, 0, make_number (code
));
4759 ASET (val
, 0, Fcons (make_number (code
>> 16),
4760 make_number (code
& 0xFFFF)));
4761 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4762 ASET (val
, 1, make_number (metrics
.lbearing
));
4763 ASET (val
, 2, make_number (metrics
.rbearing
));
4764 ASET (val
, 3, make_number (metrics
.width
));
4765 ASET (val
, 4, make_number (metrics
.ascent
));
4766 ASET (val
, 5, make_number (metrics
.descent
));
4772 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4773 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4774 FONT is a font-spec, font-entity, or font-object. */)
4776 Lisp_Object spec
, font
;
4778 CHECK_FONT_SPEC (spec
);
4781 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4784 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4785 doc
: /* Return a font-object for displaying a character at POSITION.
4786 Optional second arg WINDOW, if non-nil, is a window displaying
4787 the current buffer. It defaults to the currently selected window. */)
4788 (position
, window
, string
)
4789 Lisp_Object position
, window
, string
;
4796 CHECK_NUMBER_COERCE_MARKER (position
);
4797 pos
= XINT (position
);
4798 if (pos
< BEGV
|| pos
>= ZV
)
4799 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4803 CHECK_NUMBER (position
);
4804 CHECK_STRING (string
);
4805 pos
= XINT (position
);
4806 if (pos
< 0 || pos
>= SCHARS (string
))
4807 args_out_of_range (string
, position
);
4810 window
= selected_window
;
4811 CHECK_LIVE_WINDOW (window
);
4812 w
= XWINDOW (window
);
4814 return font_at (-1, pos
, NULL
, w
, string
);
4818 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4819 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4820 The value is a number of glyphs drawn.
4821 Type C-l to recover what previously shown. */)
4822 (font_object
, string
)
4823 Lisp_Object font_object
, string
;
4825 Lisp_Object frame
= selected_frame
;
4826 FRAME_PTR f
= XFRAME (frame
);
4832 CHECK_FONT_GET_OBJECT (font_object
, font
);
4833 CHECK_STRING (string
);
4834 len
= SCHARS (string
);
4835 code
= alloca (sizeof (unsigned) * len
);
4836 for (i
= 0; i
< len
; i
++)
4838 Lisp_Object ch
= Faref (string
, make_number (i
));
4842 code
[i
] = font
->driver
->encode_char (font
, c
);
4843 if (code
[i
] == FONT_INVALID_CODE
)
4846 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4848 if (font
->driver
->prepare_face
)
4849 font
->driver
->prepare_face (f
, face
);
4850 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4851 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4852 if (font
->driver
->done_face
)
4853 font
->driver
->done_face (f
, face
);
4855 return make_number (len
);
4859 #endif /* FONT_DEBUG */
4861 #ifdef HAVE_WINDOW_SYSTEM
4863 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4864 doc
: /* Return information about a font named NAME on frame FRAME.
4865 If FRAME is omitted or nil, use the selected frame.
4866 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4867 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4869 OPENED-NAME is the name used for opening the font,
4870 FULL-NAME is the full name of the font,
4871 SIZE is the maximum bound width of the font,
4872 HEIGHT is the height of the font,
4873 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4874 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4875 how to compose characters.
4876 If the named font is not yet loaded, return nil. */)
4878 Lisp_Object name
, frame
;
4883 Lisp_Object font_object
;
4885 (*check_window_system_func
) ();
4888 CHECK_STRING (name
);
4890 frame
= selected_frame
;
4891 CHECK_LIVE_FRAME (frame
);
4896 int fontset
= fs_query_fontset (name
, 0);
4899 name
= fontset_ascii (fontset
);
4900 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4902 else if (FONT_OBJECT_P (name
))
4904 else if (FONT_ENTITY_P (name
))
4905 font_object
= font_open_entity (f
, name
, 0);
4908 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4909 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4911 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4913 if (NILP (font_object
))
4915 font
= XFONT_OBJECT (font_object
);
4917 info
= Fmake_vector (make_number (7), Qnil
);
4918 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4919 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4920 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4921 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4922 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4923 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4924 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4927 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4928 close it now. Perhaps, we should manage font-objects
4929 by `reference-count'. */
4930 font_close_object (f
, font_object
);
4937 #define BUILD_STYLE_TABLE(TBL) \
4938 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4941 build_style_table (entry
, nelement
)
4942 struct table_entry
*entry
;
4946 Lisp_Object table
, elt
;
4948 table
= Fmake_vector (make_number (nelement
), Qnil
);
4949 for (i
= 0; i
< nelement
; i
++)
4951 for (j
= 0; entry
[i
].names
[j
]; j
++);
4952 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4953 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4954 for (j
= 0; entry
[i
].names
[j
]; j
++)
4955 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4956 ASET (table
, i
, elt
);
4961 static Lisp_Object Vfont_log
;
4962 static int font_log_env_checked
;
4964 /* The deferred font-log data of the form [ACTION ARG RESULT].
4965 If ACTION is not nil, that is added to the log when font_add_log is
4966 called next time. At that time, ACTION is set back to nil. */
4967 static Lisp_Object Vfont_log_deferred
;
4969 /* Prepend the font-related logging data in Vfont_log if it is not
4970 `t'. ACTION describes a kind of font-related action (e.g. listing,
4971 opening), ARG is the argument for the action, and RESULT is the
4972 result of the action. */
4974 font_add_log (action
, arg
, result
)
4976 Lisp_Object arg
, result
;
4978 Lisp_Object tail
, val
;
4981 if (! font_log_env_checked
)
4983 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
4984 font_log_env_checked
= 1;
4986 if (EQ (Vfont_log
, Qt
))
4988 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4990 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
4992 ASET (Vfont_log_deferred
, 0, Qnil
);
4993 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4994 AREF (Vfont_log_deferred
, 2));
4999 Lisp_Object tail
, elt
;
5000 Lisp_Object equalstr
= build_string ("=");
5002 val
= Ffont_xlfd_name (arg
, Qt
);
5003 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5007 if (EQ (XCAR (elt
), QCscript
)
5008 && SYMBOLP (XCDR (elt
)))
5009 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5010 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5011 else if (EQ (XCAR (elt
), QClang
)
5012 && SYMBOLP (XCDR (elt
)))
5013 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5014 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5015 else if (EQ (XCAR (elt
), QCotf
)
5016 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5017 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5019 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5025 val
= Ffont_xlfd_name (result
, Qt
);
5026 if (! FONT_SPEC_P (result
))
5027 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5028 build_string (":"), val
);
5031 else if (CONSP (result
))
5033 result
= Fcopy_sequence (result
);
5034 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5038 val
= Ffont_xlfd_name (val
, Qt
);
5039 XSETCAR (tail
, val
);
5042 else if (VECTORP (result
))
5044 result
= Fcopy_sequence (result
);
5045 for (i
= 0; i
< ASIZE (result
); i
++)
5047 val
= AREF (result
, i
);
5049 val
= Ffont_xlfd_name (val
, Qt
);
5050 ASET (result
, i
, val
);
5053 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5056 /* Record a font-related logging data to be added to Vfont_log when
5057 font_add_log is called next time. ACTION, ARG, RESULT are the same
5061 font_deferred_log (action
, arg
, result
)
5063 Lisp_Object arg
, result
;
5065 ASET (Vfont_log_deferred
, 0, build_string (action
));
5066 ASET (Vfont_log_deferred
, 1, arg
);
5067 ASET (Vfont_log_deferred
, 2, result
);
5070 extern void syms_of_ftfont
P_ (());
5071 extern void syms_of_xfont
P_ (());
5072 extern void syms_of_xftfont
P_ (());
5073 extern void syms_of_ftxfont
P_ (());
5074 extern void syms_of_bdffont
P_ (());
5075 extern void syms_of_w32font
P_ (());
5076 extern void syms_of_atmfont
P_ (());
5077 extern void syms_of_nsfont
P_ (());
5082 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5083 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5084 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5085 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5086 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5087 /* Note that the other elements in sort_shift_bits are not used. */
5089 staticpro (&font_charset_alist
);
5090 font_charset_alist
= Qnil
;
5092 DEFSYM (Qopentype
, "opentype");
5094 DEFSYM (Qascii_0
, "ascii-0");
5095 DEFSYM (Qiso8859_1
, "iso8859-1");
5096 DEFSYM (Qiso10646_1
, "iso10646-1");
5097 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5098 DEFSYM (Qunicode_sip
, "unicode-sip");
5102 DEFSYM (QCotf
, ":otf");
5103 DEFSYM (QClang
, ":lang");
5104 DEFSYM (QCscript
, ":script");
5105 DEFSYM (QCantialias
, ":antialias");
5107 DEFSYM (QCfoundry
, ":foundry");
5108 DEFSYM (QCadstyle
, ":adstyle");
5109 DEFSYM (QCregistry
, ":registry");
5110 DEFSYM (QCspacing
, ":spacing");
5111 DEFSYM (QCdpi
, ":dpi");
5112 DEFSYM (QCscalable
, ":scalable");
5113 DEFSYM (QCavgwidth
, ":avgwidth");
5114 DEFSYM (QCfont_entity
, ":font-entity");
5115 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5122 staticpro (&null_vector
);
5123 null_vector
= Fmake_vector (make_number (0), Qnil
);
5125 staticpro (&scratch_font_spec
);
5126 scratch_font_spec
= Ffont_spec (0, NULL
);
5127 staticpro (&scratch_font_prefer
);
5128 scratch_font_prefer
= Ffont_spec (0, NULL
);
5130 staticpro (&Vfont_log_deferred
);
5131 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5135 staticpro (&otf_list
);
5137 #endif /* HAVE_LIBOTF */
5141 defsubr (&Sfont_spec
);
5142 defsubr (&Sfont_get
);
5143 #ifdef HAVE_WINDOW_SYSTEM
5144 defsubr (&Sfont_face_attributes
);
5146 defsubr (&Sfont_put
);
5147 defsubr (&Slist_fonts
);
5148 defsubr (&Sfont_family_list
);
5149 defsubr (&Sfind_font
);
5150 defsubr (&Sfont_xlfd_name
);
5151 defsubr (&Sclear_font_cache
);
5152 defsubr (&Sfont_shape_gstring
);
5153 defsubr (&Sfont_variation_glyphs
);
5155 defsubr (&Sfont_drive_otf
);
5156 defsubr (&Sfont_otf_alternates
);
5160 defsubr (&Sopen_font
);
5161 defsubr (&Sclose_font
);
5162 defsubr (&Squery_font
);
5163 defsubr (&Sget_font_glyphs
);
5164 defsubr (&Sfont_match_p
);
5165 defsubr (&Sfont_at
);
5167 defsubr (&Sdraw_string
);
5169 #endif /* FONT_DEBUG */
5170 #ifdef HAVE_WINDOW_SYSTEM
5171 defsubr (&Sfont_info
);
5174 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5176 Alist of fontname patterns vs the corresponding encoding and repertory info.
5177 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5178 where ENCODING is a charset or a char-table,
5179 and REPERTORY is a charset, a char-table, or nil.
5181 If ENCODING and REPERTORY are the same, the element can have the form
5182 \(REGEXP . ENCODING).
5184 ENCODING is for converting a character to a glyph code of the font.
5185 If ENCODING is a charset, encoding a character by the charset gives
5186 the corresponding glyph code. If ENCODING is a char-table, looking up
5187 the table by a character gives the corresponding glyph code.
5189 REPERTORY specifies a repertory of characters supported by the font.
5190 If REPERTORY is a charset, all characters beloging to the charset are
5191 supported. If REPERTORY is a char-table, all characters who have a
5192 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5193 gets the repertory information by an opened font and ENCODING. */);
5194 Vfont_encoding_alist
= Qnil
;
5196 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5197 doc
: /* Vector of valid font weight values.
5198 Each element has the form:
5199 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5200 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5201 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5203 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5204 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5205 See `font-weight-table' for the format of the vector. */);
5206 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5208 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5209 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5210 See `font-weight-table' for the format of the vector. */);
5211 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5213 staticpro (&font_style_table
);
5214 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5215 ASET (font_style_table
, 0, Vfont_weight_table
);
5216 ASET (font_style_table
, 1, Vfont_slant_table
);
5217 ASET (font_style_table
, 2, Vfont_width_table
);
5219 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5220 *Logging list of font related actions and results.
5221 The value t means to suppress the logging.
5222 The initial value is set to nil if the environment variable
5223 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5226 #ifdef HAVE_WINDOW_SYSTEM
5227 #ifdef HAVE_FREETYPE
5229 #ifdef HAVE_X_WINDOWS
5234 #endif /* HAVE_XFT */
5235 #endif /* HAVE_X_WINDOWS */
5236 #else /* not HAVE_FREETYPE */
5237 #ifdef HAVE_X_WINDOWS
5239 #endif /* HAVE_X_WINDOWS */
5240 #endif /* not HAVE_FREETYPE */
5243 #endif /* HAVE_BDFFONT */
5246 #endif /* WINDOWSNT */
5249 #endif /* HAVE_NS */
5250 #endif /* HAVE_WINDOW_SYSTEM */
5253 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5254 (do not change this comment) */