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
;
146 /* Special ADSTYLE properties to avoid fonts used for Latin
147 characters; used in xfont.c and ftfont.c. */
148 Lisp_Object Qja
, Qko
;
150 Lisp_Object Vfont_encoding_alist
;
152 /* Alist of font registry symbol and the corresponding charsets
153 information. The information is retrieved from
154 Vfont_encoding_alist on demand.
156 Eash element has the form:
157 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
161 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
162 encodes a character code to a glyph code of a font, and
163 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
164 character is supported by a font.
166 The latter form means that the information for REGISTRY couldn't be
168 static Lisp_Object font_charset_alist
;
170 /* List of all font drivers. Each font-backend (XXXfont.c) calls
171 register_font_driver in syms_of_XXXfont to register its font-driver
173 static struct font_driver_list
*font_driver_list
;
177 /* Creaters of font-related Lisp object. */
182 Lisp_Object font_spec
;
183 struct font_spec
*spec
184 = ((struct font_spec
*)
185 allocate_pseudovector (VECSIZE (struct font_spec
),
186 FONT_SPEC_MAX
, PVEC_FONT
));
187 XSETFONT (font_spec
, spec
);
194 Lisp_Object font_entity
;
195 struct font_entity
*entity
196 = ((struct font_entity
*)
197 allocate_pseudovector (VECSIZE (struct font_entity
),
198 FONT_ENTITY_MAX
, PVEC_FONT
));
199 XSETFONT (font_entity
, entity
);
203 /* Create a font-object whose structure size is SIZE. If ENTITY is
204 not nil, copy properties from ENTITY to the font-object. If
205 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
207 font_make_object (size
, entity
, pixelsize
)
212 Lisp_Object font_object
;
214 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
217 XSETFONT (font_object
, font
);
221 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
222 font
->props
[i
] = AREF (entity
, i
);
223 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
224 font
->props
[FONT_EXTRA_INDEX
]
225 = Fcopy_sequence (AREF (entity
, FONT_EXTRA_INDEX
));
228 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
234 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
235 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
236 static Lisp_Object font_matching_entity
P_ ((FRAME_PTR
, Lisp_Object
*,
239 /* Number of registered font drivers. */
240 static int num_font_drivers
;
243 /* Return a Lispy value of a font property value at STR and LEN bytes.
244 If STR is "*", it returns nil.
245 If FORCE_SYMBOL is zero and all characters in STR are digits, it
246 returns an integer. Otherwise, it returns a symbol interned from
250 font_intern_prop (str
, len
, force_symbol
)
260 if (len
== 1 && *str
== '*')
262 if (!force_symbol
&& len
>=1 && isdigit (*str
))
264 for (i
= 1; i
< len
; i
++)
265 if (! isdigit (str
[i
]))
268 return make_number (atoi (str
));
271 /* The following code is copied from the function intern (in
272 lread.c), and modified to suite our purpose. */
274 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
275 obarray
= check_obarray (obarray
);
276 parse_str_as_multibyte (str
, len
, &nchars
, &nbytes
);
277 if (len
== nchars
|| len
!= nbytes
)
278 /* CONTENTS contains no multibyte sequences or contains an invalid
279 multibyte sequence. We'll make a unibyte string. */
280 tem
= oblookup (obarray
, str
, len
, len
);
282 tem
= oblookup (obarray
, str
, nchars
, len
);
285 if (len
== nchars
|| len
!= nbytes
)
286 tem
= make_unibyte_string (str
, len
);
288 tem
= make_multibyte_string (str
, nchars
, len
);
289 return Fintern (tem
, obarray
);
292 /* Return a pixel size of font-spec SPEC on frame F. */
295 font_pixel_size (f
, spec
)
299 #ifdef HAVE_WINDOW_SYSTEM
300 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
309 font_assert (FLOATP (size
));
310 point_size
= XFLOAT_DATA (size
);
311 val
= AREF (spec
, FONT_DPI_INDEX
);
316 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
324 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
325 font vector. If VAL is not valid (i.e. not registered in
326 font_style_table), return -1 if NOERROR is zero, and return a
327 proper index if NOERROR is nonzero. In that case, register VAL in
328 font_style_table if VAL is a symbol, and return a closest index if
329 VAL is an integer. */
332 font_style_to_value (prop
, val
, noerror
)
333 enum font_property_index prop
;
337 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
338 int len
= ASIZE (table
);
344 Lisp_Object args
[2], elt
;
346 /* At first try exact match. */
347 for (i
= 0; i
< len
; i
++)
348 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
349 if (EQ (val
, AREF (AREF (table
, i
), j
)))
350 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
351 | (i
<< 4) | (j
- 1));
352 /* Try also with case-folding match. */
353 s
= SDATA (SYMBOL_NAME (val
));
354 for (i
= 0; i
< len
; i
++)
355 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
357 elt
= AREF (AREF (table
, i
), j
);
358 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
359 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
360 | (i
<< 4) | (j
- 1));
366 elt
= Fmake_vector (make_number (2), make_number (100));
369 args
[1] = Fmake_vector (make_number (1), elt
);
370 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
371 return (100 << 8) | (i
<< 4);
376 int numeric
= XINT (val
);
378 for (i
= 0, last_n
= -1; i
< len
; i
++)
380 int n
= XINT (AREF (AREF (table
, i
), 0));
383 return (n
<< 8) | (i
<< 4);
388 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
389 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
395 return ((last_n
<< 8) | ((i
- 1) << 4));
400 font_style_symbolic (font
, prop
, for_face
)
402 enum font_property_index prop
;
405 Lisp_Object val
= AREF (font
, prop
);
406 Lisp_Object table
, elt
;
411 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
412 i
= XINT (val
) & 0xFF;
413 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
414 elt
= AREF (table
, ((i
>> 4) & 0xF));
415 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
416 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
419 extern Lisp_Object Vface_alternative_font_family_alist
;
421 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
424 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
425 FONTNAME. ENCODING is a charset symbol that specifies the encoding
426 of the font. REPERTORY is a charset symbol or nil. */
429 find_font_encoding (fontname
)
430 Lisp_Object fontname
;
432 Lisp_Object tail
, elt
;
434 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
438 && STRINGP (XCAR (elt
))
439 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
440 && (SYMBOLP (XCDR (elt
))
441 ? CHARSETP (XCDR (elt
))
442 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
448 /* Return encoding charset and repertory charset for REGISTRY in
449 ENCODING and REPERTORY correspondingly. If correct information for
450 REGISTRY is available, return 0. Otherwise return -1. */
453 font_registry_charsets (registry
, encoding
, repertory
)
454 Lisp_Object registry
;
455 struct charset
**encoding
, **repertory
;
458 int encoding_id
, repertory_id
;
460 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
466 encoding_id
= XINT (XCAR (val
));
467 repertory_id
= XINT (XCDR (val
));
471 val
= find_font_encoding (SYMBOL_NAME (registry
));
472 if (SYMBOLP (val
) && CHARSETP (val
))
474 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
476 else if (CONSP (val
))
478 if (! CHARSETP (XCAR (val
)))
480 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
481 if (NILP (XCDR (val
)))
485 if (! CHARSETP (XCDR (val
)))
487 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
492 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
494 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
498 *encoding
= CHARSET_FROM_ID (encoding_id
);
500 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
505 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
510 /* Font property value validaters. See the comment of
511 font_property_table for the meaning of the arguments. */
513 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
514 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
515 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
516 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
517 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
518 static int get_font_prop_index
P_ ((Lisp_Object
));
521 font_prop_validate_symbol (prop
, val
)
522 Lisp_Object prop
, val
;
525 val
= Fintern (val
, Qnil
);
528 else if (EQ (prop
, QCregistry
))
529 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
535 font_prop_validate_style (style
, val
)
536 Lisp_Object style
, val
;
538 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
539 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
546 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
550 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
552 if ((n
& 0xF) + 1 >= ASIZE (elt
))
554 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
558 else if (SYMBOLP (val
))
560 int n
= font_style_to_value (prop
, val
, 0);
562 val
= n
>= 0 ? make_number (n
) : Qerror
;
570 font_prop_validate_non_neg (prop
, val
)
571 Lisp_Object prop
, val
;
573 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
578 font_prop_validate_spacing (prop
, val
)
579 Lisp_Object prop
, val
;
581 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
583 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
585 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
587 if (spacing
== 'c' || spacing
== 'C')
588 return make_number (FONT_SPACING_CHARCELL
);
589 if (spacing
== 'm' || spacing
== 'M')
590 return make_number (FONT_SPACING_MONO
);
591 if (spacing
== 'p' || spacing
== 'P')
592 return make_number (FONT_SPACING_PROPORTIONAL
);
593 if (spacing
== 'd' || spacing
== 'D')
594 return make_number (FONT_SPACING_DUAL
);
600 font_prop_validate_otf (prop
, val
)
601 Lisp_Object prop
, val
;
603 Lisp_Object tail
, tmp
;
606 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
607 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
608 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
611 if (! SYMBOLP (XCAR (val
)))
616 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
618 for (i
= 0; i
< 2; i
++)
625 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
626 if (! SYMBOLP (XCAR (tmp
)))
634 /* Structure of known font property keys and validater of the
638 /* Pointer to the key symbol. */
640 /* Function to validate PROP's value VAL, or NULL if any value is
641 ok. The value is VAL or its regularized value if VAL is valid,
642 and Qerror if not. */
643 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
644 } font_property_table
[] =
645 { { &QCtype
, font_prop_validate_symbol
},
646 { &QCfoundry
, font_prop_validate_symbol
},
647 { &QCfamily
, font_prop_validate_symbol
},
648 { &QCadstyle
, font_prop_validate_symbol
},
649 { &QCregistry
, font_prop_validate_symbol
},
650 { &QCweight
, font_prop_validate_style
},
651 { &QCslant
, font_prop_validate_style
},
652 { &QCwidth
, font_prop_validate_style
},
653 { &QCsize
, font_prop_validate_non_neg
},
654 { &QCdpi
, font_prop_validate_non_neg
},
655 { &QCspacing
, font_prop_validate_spacing
},
656 { &QCavgwidth
, font_prop_validate_non_neg
},
657 /* The order of the above entries must match with enum
658 font_property_index. */
659 { &QClang
, font_prop_validate_symbol
},
660 { &QCscript
, font_prop_validate_symbol
},
661 { &QCotf
, font_prop_validate_otf
}
664 /* Size (number of elements) of the above table. */
665 #define FONT_PROPERTY_TABLE_SIZE \
666 ((sizeof font_property_table) / (sizeof *font_property_table))
668 /* Return an index number of font property KEY or -1 if KEY is not an
669 already known property. */
672 get_font_prop_index (key
)
677 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
678 if (EQ (key
, *font_property_table
[i
].key
))
683 /* Validate the font property. The property key is specified by the
684 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
685 signal an error. The value is VAL or the regularized one. */
688 font_prop_validate (idx
, prop
, val
)
690 Lisp_Object prop
, val
;
692 Lisp_Object validated
;
697 prop
= *font_property_table
[idx
].key
;
700 idx
= get_font_prop_index (prop
);
704 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
705 if (EQ (validated
, Qerror
))
706 signal_error ("invalid font property", Fcons (prop
, val
));
711 /* Store VAL as a value of extra font property PROP in FONT while
712 keeping the sorting order. Don't check the validity of VAL. */
715 font_put_extra (font
, prop
, val
)
716 Lisp_Object font
, prop
, val
;
718 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
719 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
723 Lisp_Object prev
= Qnil
;
728 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
729 prev
= extra
, extra
= XCDR (extra
);
731 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
733 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
738 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
743 /* Font name parser and unparser */
745 static int parse_matrix
P_ ((char *));
746 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
747 static int font_parse_name
P_ ((char *, Lisp_Object
));
749 /* An enumerator for each field of an XLFD font name. */
750 enum xlfd_field_index
769 /* An enumerator for mask bit corresponding to each XLFD field. */
772 XLFD_FOUNDRY_MASK
= 0x0001,
773 XLFD_FAMILY_MASK
= 0x0002,
774 XLFD_WEIGHT_MASK
= 0x0004,
775 XLFD_SLANT_MASK
= 0x0008,
776 XLFD_SWIDTH_MASK
= 0x0010,
777 XLFD_ADSTYLE_MASK
= 0x0020,
778 XLFD_PIXEL_MASK
= 0x0040,
779 XLFD_POINT_MASK
= 0x0080,
780 XLFD_RESX_MASK
= 0x0100,
781 XLFD_RESY_MASK
= 0x0200,
782 XLFD_SPACING_MASK
= 0x0400,
783 XLFD_AVGWIDTH_MASK
= 0x0800,
784 XLFD_REGISTRY_MASK
= 0x1000,
785 XLFD_ENCODING_MASK
= 0x2000
789 /* Parse P pointing the pixel/point size field of the form
790 `[A B C D]' which specifies a transformation matrix:
796 by which all glyphs of the font are transformed. The spec says
797 that scalar value N for the pixel/point size is equivalent to:
798 A = N * resx/resy, B = C = 0, D = N.
800 Return the scalar value N if the form is valid. Otherwise return
811 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
814 matrix
[i
] = - strtod (p
+ 1, &end
);
816 matrix
[i
] = strtod (p
, &end
);
819 return (i
== 4 ? (int) matrix
[3] : -1);
822 /* Expand a wildcard field in FIELD (the first N fields are filled) to
823 multiple fields to fill in all 14 XLFD fields while restring a
824 field position by its contents. */
827 font_expand_wildcards (field
, n
)
828 Lisp_Object field
[XLFD_LAST_INDEX
];
832 Lisp_Object tmp
[XLFD_LAST_INDEX
];
833 /* Array of information about where this element can go. Nth
834 element is for Nth element of FIELD. */
836 /* Minimum possible field. */
838 /* Maxinum possible field. */
840 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
842 } range
[XLFD_LAST_INDEX
];
844 int range_from
, range_to
;
847 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
848 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
849 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
850 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
851 | XLFD_AVGWIDTH_MASK)
852 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
854 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
855 field. The value is shifted to left one bit by one in the
857 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
858 range_mask
= (range_mask
<< 1) | 1;
860 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
861 position-based retriction for FIELD[I]. */
862 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
863 i
++, range_from
++, range_to
++, range_mask
<<= 1)
865 Lisp_Object val
= field
[i
];
871 range
[i
].from
= range_from
;
872 range
[i
].to
= range_to
;
873 range
[i
].mask
= range_mask
;
877 /* The triplet FROM, TO, and MASK is a value-based
878 retriction for FIELD[I]. */
884 int numeric
= XINT (val
);
887 from
= to
= XLFD_ENCODING_INDEX
,
888 mask
= XLFD_ENCODING_MASK
;
889 else if (numeric
== 0)
890 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
891 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
892 else if (numeric
<= 48)
893 from
= to
= XLFD_PIXEL_INDEX
,
894 mask
= XLFD_PIXEL_MASK
;
896 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
897 mask
= XLFD_LARGENUM_MASK
;
899 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
900 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
901 mask
= XLFD_NULL_MASK
;
903 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
906 Lisp_Object name
= SYMBOL_NAME (val
);
908 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
909 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
910 mask
= XLFD_REGENC_MASK
;
912 from
= to
= XLFD_ENCODING_INDEX
,
913 mask
= XLFD_ENCODING_MASK
;
915 else if (range_from
<= XLFD_WEIGHT_INDEX
916 && range_to
>= XLFD_WEIGHT_INDEX
917 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
918 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
919 else if (range_from
<= XLFD_SLANT_INDEX
920 && range_to
>= XLFD_SLANT_INDEX
921 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
922 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
923 else if (range_from
<= XLFD_SWIDTH_INDEX
924 && range_to
>= XLFD_SWIDTH_INDEX
925 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
926 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
929 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
930 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
932 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
933 mask
= XLFD_SYMBOL_MASK
;
936 /* Merge position-based and value-based restrictions. */
938 while (from
< range_from
)
939 mask
&= ~(1 << from
++);
940 while (from
< 14 && ! (mask
& (1 << from
)))
942 while (to
> range_to
)
943 mask
&= ~(1 << to
--);
944 while (to
>= 0 && ! (mask
& (1 << to
)))
948 range
[i
].from
= from
;
950 range
[i
].mask
= mask
;
952 if (from
> range_from
|| to
< range_to
)
954 /* The range is narrowed by value-based restrictions.
955 Reflect it to the other fields. */
957 /* Following fields should be after FROM. */
959 /* Preceding fields should be before TO. */
960 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
962 /* Check FROM for non-wildcard field. */
963 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
965 while (range
[j
].from
< from
)
966 range
[j
].mask
&= ~(1 << range
[j
].from
++);
967 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
969 range
[j
].from
= from
;
972 from
= range
[j
].from
;
973 if (range
[j
].to
> to
)
975 while (range
[j
].to
> to
)
976 range
[j
].mask
&= ~(1 << range
[j
].to
--);
977 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
990 /* Decide all fileds from restrictions in RANGE. */
991 for (i
= j
= 0; i
< n
; i
++)
993 if (j
< range
[i
].from
)
995 if (i
== 0 || ! NILP (tmp
[i
- 1]))
996 /* None of TMP[X] corresponds to Jth field. */
998 for (; j
< range
[i
].from
; j
++)
1001 field
[j
++] = tmp
[i
];
1003 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
1005 for (; j
< XLFD_LAST_INDEX
; j
++)
1007 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
1008 field
[XLFD_ENCODING_INDEX
]
1009 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1014 #ifdef ENABLE_CHECKING
1015 /* Match a 14-field XLFD pattern against a full XLFD font name. */
1017 font_match_xlfd (char *pattern
, char *name
)
1019 while (*pattern
&& *name
)
1021 if (*pattern
== *name
)
1023 else if (*pattern
== '*')
1024 if (*name
== pattern
[1])
1035 /* Make sure the font object matches the XLFD font name. */
1037 font_check_xlfd_parse (Lisp_Object font
, char *name
)
1039 char name_check
[256];
1040 font_unparse_xlfd (font
, 0, name_check
, 255);
1041 return font_match_xlfd (name_check
, name
);
1047 /* Parse NAME (null terminated) as XLFD and store information in FONT
1048 (font-spec or font-entity). Size property of FONT is set as
1050 specified XLFD fields FONT property
1051 --------------------- -------------
1052 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1053 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1054 POINT_SIZE POINT_SIZE/10 (Lisp float)
1056 If NAME is successfully parsed, return 0. Otherwise return -1.
1058 FONT is usually a font-spec, but when this function is called from
1059 X font backend driver, it is a font-entity. In that case, NAME is
1060 a fully specified XLFD. */
1063 font_parse_xlfd (name
, font
)
1067 int len
= strlen (name
);
1069 char *f
[XLFD_LAST_INDEX
+ 1];
1073 if (len
> 255 || !len
)
1074 /* Maximum XLFD name length is 255. */
1076 /* Accept "*-.." as a fully specified XLFD. */
1077 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1078 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1081 for (p
= name
+ i
; *p
; p
++)
1085 if (i
== XLFD_LAST_INDEX
)
1090 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1091 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1093 if (i
== XLFD_LAST_INDEX
)
1095 /* Fully specified XLFD. */
1098 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1099 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1100 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1101 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1103 val
= INTERN_FIELD_SYM (i
);
1106 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1108 ASET (font
, j
, make_number (n
));
1111 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1112 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1113 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1115 ASET (font
, FONT_REGISTRY_INDEX
,
1116 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1117 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1119 p
= f
[XLFD_PIXEL_INDEX
];
1120 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1121 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1124 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1126 ASET (font
, FONT_SIZE_INDEX
, val
);
1129 double point_size
= -1;
1131 font_assert (FONT_SPEC_P (font
));
1132 p
= f
[XLFD_POINT_INDEX
];
1134 point_size
= parse_matrix (p
);
1135 else if (isdigit (*p
))
1136 point_size
= atoi (p
), point_size
/= 10;
1137 if (point_size
>= 0)
1138 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1142 ASET (font
, FONT_DPI_INDEX
, INTERN_FIELD (XLFD_RESY_INDEX
));
1143 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1146 val
= font_prop_validate_spacing (QCspacing
, val
);
1147 if (! INTEGERP (val
))
1149 ASET (font
, FONT_SPACING_INDEX
, val
);
1151 p
= f
[XLFD_AVGWIDTH_INDEX
];
1154 ASET (font
, FONT_AVGWIDTH_INDEX
,
1155 font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0));
1159 int wild_card_found
= 0;
1160 Lisp_Object prop
[XLFD_LAST_INDEX
];
1162 if (FONT_ENTITY_P (font
))
1164 for (j
= 0; j
< i
; j
++)
1168 if (f
[j
][1] && f
[j
][1] != '-')
1171 wild_card_found
= 1;
1174 prop
[j
] = INTERN_FIELD (j
);
1176 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1178 if (! wild_card_found
)
1180 if (font_expand_wildcards (prop
, i
) < 0)
1183 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1184 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1185 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1186 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1187 if (! NILP (prop
[i
]))
1189 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1191 ASET (font
, j
, make_number (n
));
1193 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1194 val
= prop
[XLFD_REGISTRY_INDEX
];
1197 val
= prop
[XLFD_ENCODING_INDEX
];
1199 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1201 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1202 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1204 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1205 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1207 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1209 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1210 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1211 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1213 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1215 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1218 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1219 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1220 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1222 val
= font_prop_validate_spacing (QCspacing
,
1223 prop
[XLFD_SPACING_INDEX
]);
1224 if (! INTEGERP (val
))
1226 ASET (font
, FONT_SPACING_INDEX
, val
);
1228 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1229 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1235 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1236 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1237 0, use PIXEL_SIZE instead. */
1240 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1246 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1250 font_assert (FONTP (font
));
1252 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1255 if (i
== FONT_ADSTYLE_INDEX
)
1256 j
= XLFD_ADSTYLE_INDEX
;
1257 else if (i
== FONT_REGISTRY_INDEX
)
1258 j
= XLFD_REGISTRY_INDEX
;
1259 val
= AREF (font
, i
);
1262 if (j
== XLFD_REGISTRY_INDEX
)
1263 f
[j
] = "*-*", len
+= 4;
1265 f
[j
] = "*", len
+= 2;
1270 val
= SYMBOL_NAME (val
);
1271 if (j
== XLFD_REGISTRY_INDEX
1272 && ! strchr ((char *) SDATA (val
), '-'))
1274 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1275 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1277 f
[j
] = alloca (SBYTES (val
) + 3);
1278 sprintf (f
[j
], "%s-*", SDATA (val
));
1279 len
+= SBYTES (val
) + 3;
1283 f
[j
] = alloca (SBYTES (val
) + 4);
1284 sprintf (f
[j
], "%s*-*", SDATA (val
));
1285 len
+= SBYTES (val
) + 4;
1289 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1293 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1296 val
= font_style_symbolic (font
, i
, 0);
1298 f
[j
] = "*", len
+= 2;
1301 val
= SYMBOL_NAME (val
);
1302 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1306 val
= AREF (font
, FONT_SIZE_INDEX
);
1307 font_assert (NUMBERP (val
) || NILP (val
));
1315 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1316 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1319 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1321 else if (FLOATP (val
))
1323 i
= XFLOAT_DATA (val
) * 10;
1324 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1325 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1328 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1330 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1332 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1333 f
[XLFD_RESX_INDEX
] = alloca (22);
1334 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1338 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1339 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1341 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1343 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1344 : spacing
<= FONT_SPACING_DUAL
? "d"
1345 : spacing
<= FONT_SPACING_MONO
? "m"
1350 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1351 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1353 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1354 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
],
1355 "%d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1358 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1359 len
++; /* for terminating '\0'. */
1362 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1363 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1364 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1365 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1366 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1367 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1368 f
[XLFD_REGISTRY_INDEX
]);
1371 /* Parse NAME (null terminated) and store information in FONT
1372 (font-spec or font-entity). NAME is supplied in either the
1373 Fontconfig or GTK font name format. If NAME is successfully
1374 parsed, return 0. Otherwise return -1.
1376 The fontconfig format is
1378 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1382 FAMILY [PROPS...] [SIZE]
1384 This function tries to guess which format it is. */
1387 font_parse_fcname (name
, font
)
1392 char *size_beg
= NULL
, *size_end
= NULL
;
1393 char *props_beg
= NULL
, *family_end
= NULL
;
1394 int len
= strlen (name
);
1399 for (p
= name
; *p
; p
++)
1401 if (*p
== '\\' && p
[1])
1405 props_beg
= family_end
= p
;
1410 int decimal
= 0, size_found
= 1;
1411 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1414 if (*q
!= '.' || decimal
)
1433 /* A fontconfig name with size and/or property data. */
1434 if (family_end
> name
)
1437 family
= font_intern_prop (name
, family_end
- name
, 1);
1438 ASET (font
, FONT_FAMILY_INDEX
, family
);
1442 double point_size
= strtod (size_beg
, &size_end
);
1443 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1444 if (*size_end
== ':' && size_end
[1])
1445 props_beg
= size_end
;
1449 /* Now parse ":KEY=VAL" patterns. */
1452 for (p
= props_beg
; *p
; p
= q
)
1454 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1457 /* Must be an enumerated value. */
1461 val
= font_intern_prop (p
, q
- p
, 1);
1463 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1465 if (PROP_MATCH ("light", 5)
1466 || PROP_MATCH ("medium", 6)
1467 || PROP_MATCH ("demibold", 8)
1468 || PROP_MATCH ("bold", 4)
1469 || PROP_MATCH ("black", 5))
1470 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1471 else if (PROP_MATCH ("roman", 5)
1472 || PROP_MATCH ("italic", 6)
1473 || PROP_MATCH ("oblique", 7))
1474 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1475 else if (PROP_MATCH ("charcell", 8))
1476 ASET (font
, FONT_SPACING_INDEX
,
1477 make_number (FONT_SPACING_CHARCELL
));
1478 else if (PROP_MATCH ("mono", 4))
1479 ASET (font
, FONT_SPACING_INDEX
,
1480 make_number (FONT_SPACING_MONO
));
1481 else if (PROP_MATCH ("proportional", 12))
1482 ASET (font
, FONT_SPACING_INDEX
,
1483 make_number (FONT_SPACING_PROPORTIONAL
));
1492 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1493 prop
= FONT_SIZE_INDEX
;
1496 key
= font_intern_prop (p
, q
- p
, 1);
1497 prop
= get_font_prop_index (key
);
1501 for (q
= p
; *q
&& *q
!= ':'; q
++);
1502 val
= font_intern_prop (p
, q
- p
, 0);
1504 if (prop
>= FONT_FOUNDRY_INDEX
1505 && prop
< FONT_EXTRA_INDEX
)
1506 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1508 Ffont_put (font
, key
, val
);
1516 /* Either a fontconfig-style name with no size and property
1517 data, or a GTK-style name. */
1519 int word_len
, prop_found
= 0;
1521 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1527 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1535 double point_size
= strtod (p
, &q
);
1536 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1541 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1542 if (*q
== '\\' && q
[1])
1546 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1548 if (PROP_MATCH ("Ultra-Light", 11))
1551 prop
= font_intern_prop ("ultra-light", 11, 1);
1552 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1554 else if (PROP_MATCH ("Light", 5))
1557 prop
= font_intern_prop ("light", 5, 1);
1558 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1560 else if (PROP_MATCH ("Semi-Bold", 9))
1563 prop
= font_intern_prop ("semi-bold", 9, 1);
1564 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1566 else if (PROP_MATCH ("Bold", 4))
1569 prop
= font_intern_prop ("bold", 4, 1);
1570 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1572 else if (PROP_MATCH ("Italic", 6))
1575 prop
= font_intern_prop ("italic", 4, 1);
1576 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1578 else if (PROP_MATCH ("Oblique", 7))
1581 prop
= font_intern_prop ("oblique", 7, 1);
1582 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1586 return -1; /* Unknown property in GTK-style font name. */
1595 family
= font_intern_prop (name
, family_end
- name
, 1);
1596 ASET (font
, FONT_FAMILY_INDEX
, family
);
1603 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1604 NAME (NBYTES length), and return the name length. If
1605 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1608 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1614 Lisp_Object family
, foundry
;
1615 Lisp_Object tail
, val
;
1619 Lisp_Object styles
[3];
1620 char *style_names
[3] = { "weight", "slant", "width" };
1623 family
= AREF (font
, FONT_FAMILY_INDEX
);
1624 if (! NILP (family
))
1626 if (SYMBOLP (family
))
1628 family
= SYMBOL_NAME (family
);
1629 len
+= SBYTES (family
);
1635 val
= AREF (font
, FONT_SIZE_INDEX
);
1638 if (XINT (val
) != 0)
1639 pixel_size
= XINT (val
);
1641 len
+= 21; /* for ":pixelsize=NUM" */
1643 else if (FLOATP (val
))
1646 point_size
= (int) XFLOAT_DATA (val
);
1647 len
+= 11; /* for "-NUM" */
1650 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1651 if (! NILP (foundry
))
1653 if (SYMBOLP (foundry
))
1655 foundry
= SYMBOL_NAME (foundry
);
1656 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1662 for (i
= 0; i
< 3; i
++)
1664 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1665 if (! NILP (styles
[i
]))
1666 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1667 SDATA (SYMBOL_NAME (styles
[i
])));
1670 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1671 len
+= sprintf (work
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1672 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1673 len
+= strlen (":spacing=100");
1674 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1675 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1676 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1678 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1680 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1682 len
+= SBYTES (val
);
1683 else if (INTEGERP (val
))
1684 len
+= sprintf (work
, "%d", XINT (val
));
1685 else if (SYMBOLP (val
))
1686 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1692 if (! NILP (family
))
1693 p
+= sprintf (p
, "%s", SDATA (family
));
1697 p
+= sprintf (p
, "%d", point_size
);
1699 p
+= sprintf (p
, "-%d", point_size
);
1701 else if (pixel_size
> 0)
1702 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1703 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1704 p
+= sprintf (p
, ":foundry=%s",
1705 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1706 for (i
= 0; i
< 3; i
++)
1707 if (! NILP (styles
[i
]))
1708 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1709 SDATA (SYMBOL_NAME (styles
[i
])));
1710 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1711 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1712 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1713 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1714 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1716 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1717 p
+= sprintf (p
, ":scalable=true");
1719 p
+= sprintf (p
, ":scalable=false");
1724 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1725 NAME (NBYTES length), and return the name length. F is the frame
1726 on which the font is displayed; it is used to calculate the point
1730 font_unparse_gtkname (font
, f
, name
, nbytes
)
1738 Lisp_Object family
, weight
, slant
, size
;
1739 int point_size
= -1;
1741 family
= AREF (font
, FONT_FAMILY_INDEX
);
1742 if (! NILP (family
))
1744 if (! SYMBOLP (family
))
1746 family
= SYMBOL_NAME (family
);
1747 len
+= SBYTES (family
);
1750 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1751 if (EQ (weight
, Qnormal
))
1753 else if (! NILP (weight
))
1755 weight
= SYMBOL_NAME (weight
);
1756 len
+= SBYTES (weight
);
1759 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1760 if (EQ (slant
, Qnormal
))
1762 else if (! NILP (slant
))
1764 slant
= SYMBOL_NAME (slant
);
1765 len
+= SBYTES (slant
);
1768 size
= AREF (font
, FONT_SIZE_INDEX
);
1769 /* Convert pixel size to point size. */
1770 if (INTEGERP (size
))
1772 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1774 if (INTEGERP (font_dpi
))
1775 dpi
= XINT (font_dpi
);
1778 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1781 else if (FLOATP (size
))
1783 point_size
= (int) XFLOAT_DATA (size
);
1790 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1792 if (! NILP (weight
))
1795 p
+= sprintf (p
, " %s", SDATA (weight
));
1796 q
[1] = toupper (q
[1]);
1802 p
+= sprintf (p
, " %s", SDATA (slant
));
1803 q
[1] = toupper (q
[1]);
1807 p
+= sprintf (p
, " %d", point_size
);
1812 /* Parse NAME (null terminated) and store information in FONT
1813 (font-spec or font-entity). If NAME is successfully parsed, return
1814 0. Otherwise return -1. */
1817 font_parse_name (name
, font
)
1821 if (name
[0] == '-' || index (name
, '*') || index (name
, '?'))
1822 return font_parse_xlfd (name
, font
);
1823 return font_parse_fcname (name
, font
);
1827 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1828 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1832 font_parse_family_registry (family
, registry
, font_spec
)
1833 Lisp_Object family
, registry
, font_spec
;
1839 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1841 CHECK_STRING (family
);
1842 len
= SBYTES (family
);
1843 p0
= (char *) SDATA (family
);
1844 p1
= index (p0
, '-');
1847 if ((*p0
!= '*' || p1
- p0
> 1)
1848 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1849 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1852 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1855 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1857 if (! NILP (registry
))
1859 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1860 CHECK_STRING (registry
);
1861 len
= SBYTES (registry
);
1862 p0
= (char *) SDATA (registry
);
1863 p1
= index (p0
, '-');
1866 if (SDATA (registry
)[len
- 1] == '*')
1867 registry
= concat2 (registry
, build_string ("-*"));
1869 registry
= concat2 (registry
, build_string ("*-*"));
1871 registry
= Fdowncase (registry
);
1872 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1877 /* This part (through the next ^L) is still experimental and not
1878 tested much. We may drastically change codes. */
1884 #define LGSTRING_HEADER_SIZE 6
1885 #define LGSTRING_GLYPH_SIZE 8
1888 check_gstring (gstring
)
1889 Lisp_Object gstring
;
1894 CHECK_VECTOR (gstring
);
1895 val
= AREF (gstring
, 0);
1897 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1899 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1900 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1901 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1902 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1903 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1904 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1905 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1906 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1907 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1908 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1909 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1911 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1913 val
= LGSTRING_GLYPH (gstring
, i
);
1915 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1917 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1919 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1920 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1921 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1922 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1923 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1924 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1925 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1926 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1928 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1930 if (ASIZE (val
) < 3)
1932 for (j
= 0; j
< 3; j
++)
1933 CHECK_NUMBER (AREF (val
, j
));
1938 error ("Invalid glyph-string format");
1943 check_otf_features (otf_features
)
1944 Lisp_Object otf_features
;
1948 CHECK_CONS (otf_features
);
1949 CHECK_SYMBOL (XCAR (otf_features
));
1950 otf_features
= XCDR (otf_features
);
1951 CHECK_CONS (otf_features
);
1952 CHECK_SYMBOL (XCAR (otf_features
));
1953 otf_features
= XCDR (otf_features
);
1954 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1956 CHECK_SYMBOL (Fcar (val
));
1957 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1958 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1960 otf_features
= XCDR (otf_features
);
1961 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1963 CHECK_SYMBOL (Fcar (val
));
1964 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1965 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1972 Lisp_Object otf_list
;
1975 otf_tag_symbol (tag
)
1980 OTF_tag_name (tag
, name
);
1981 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1988 Lisp_Object val
= Fassoc (file
, otf_list
);
1992 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1995 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1996 val
= make_save_value (otf
, 0);
1997 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
2003 /* Return a list describing which scripts/languages FONT supports by
2004 which GSUB/GPOS features of OpenType tables. See the comment of
2005 (struct font_driver).otf_capability. */
2008 font_otf_capability (font
)
2012 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
2015 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
2018 for (i
= 0; i
< 2; i
++)
2020 OTF_GSUB_GPOS
*gsub_gpos
;
2021 Lisp_Object script_list
= Qnil
;
2024 if (OTF_get_features (otf
, i
== 0) < 0)
2026 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2027 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2029 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2030 Lisp_Object langsys_list
= Qnil
;
2031 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2034 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2036 OTF_LangSys
*langsys
;
2037 Lisp_Object feature_list
= Qnil
;
2038 Lisp_Object langsys_tag
;
2041 if (k
== script
->LangSysCount
)
2043 langsys
= &script
->DefaultLangSys
;
2048 langsys
= script
->LangSys
+ k
;
2050 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2052 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2054 OTF_Feature
*feature
2055 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2056 Lisp_Object feature_tag
2057 = otf_tag_symbol (feature
->FeatureTag
);
2059 feature_list
= Fcons (feature_tag
, feature_list
);
2061 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2064 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2069 XSETCAR (capability
, script_list
);
2071 XSETCDR (capability
, script_list
);
2077 /* Parse OTF features in SPEC and write a proper features spec string
2078 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2079 assured that the sufficient memory has already allocated for
2083 generate_otf_features (spec
, features
)
2093 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2099 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2104 else if (! asterisk
)
2106 val
= SYMBOL_NAME (val
);
2107 p
+= sprintf (p
, "%s", SDATA (val
));
2111 val
= SYMBOL_NAME (val
);
2112 p
+= sprintf (p
, "~%s", SDATA (val
));
2116 error ("OTF spec too long");
2120 font_otf_DeviceTable (device_table
)
2121 OTF_DeviceTable
*device_table
;
2123 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2125 return Fcons (make_number (len
),
2126 make_unibyte_string (device_table
->DeltaValue
, len
));
2130 font_otf_ValueRecord (value_format
, value_record
)
2132 OTF_ValueRecord
*value_record
;
2134 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2136 if (value_format
& OTF_XPlacement
)
2137 ASET (val
, 0, make_number (value_record
->XPlacement
));
2138 if (value_format
& OTF_YPlacement
)
2139 ASET (val
, 1, make_number (value_record
->YPlacement
));
2140 if (value_format
& OTF_XAdvance
)
2141 ASET (val
, 2, make_number (value_record
->XAdvance
));
2142 if (value_format
& OTF_YAdvance
)
2143 ASET (val
, 3, make_number (value_record
->YAdvance
));
2144 if (value_format
& OTF_XPlaDevice
)
2145 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2146 if (value_format
& OTF_YPlaDevice
)
2147 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2148 if (value_format
& OTF_XAdvDevice
)
2149 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2150 if (value_format
& OTF_YAdvDevice
)
2151 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2156 font_otf_Anchor (anchor
)
2161 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2162 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2163 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2164 if (anchor
->AnchorFormat
== 2)
2165 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2168 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2169 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2173 #endif /* HAVE_LIBOTF */
2179 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2180 static int font_compare
P_ ((const void *, const void *));
2181 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
2184 /* Return a rescaling ratio of FONT_ENTITY. */
2185 extern Lisp_Object Vface_font_rescale_alist
;
2188 font_rescale_ratio (font_entity
)
2189 Lisp_Object font_entity
;
2191 Lisp_Object tail
, elt
;
2192 Lisp_Object name
= Qnil
;
2194 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2197 if (FLOATP (XCDR (elt
)))
2199 if (STRINGP (XCAR (elt
)))
2202 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2203 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2204 return XFLOAT_DATA (XCDR (elt
));
2206 else if (FONT_SPEC_P (XCAR (elt
)))
2208 if (font_match_p (XCAR (elt
), font_entity
))
2209 return XFLOAT_DATA (XCDR (elt
));
2216 /* We sort fonts by scoring each of them against a specified
2217 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2218 the value is, the closer the font is to the font-spec.
2220 The lowest 2 bits of the score is used for driver type. The font
2221 available by the most preferred font driver is 0.
2223 Each 7-bit in the higher 28 bits are used for numeric properties
2224 WEIGHT, SLANT, WIDTH, and SIZE. */
2226 /* How many bits to shift to store the difference value of each font
2227 property in a score. Note that flots for FONT_TYPE_INDEX and
2228 FONT_REGISTRY_INDEX are not used. */
2229 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2231 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2232 The return value indicates how different ENTITY is compared with
2236 font_score (entity
, spec_prop
)
2237 Lisp_Object entity
, *spec_prop
;
2242 /* Score three style numeric fields. Maximum difference is 127. */
2243 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2244 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2246 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2251 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2254 /* Score the size. Maximum difference is 127. */
2255 i
= FONT_SIZE_INDEX
;
2256 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2257 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2259 /* We use the higher 6-bit for the actual size difference. The
2260 lowest bit is set if the DPI is different. */
2262 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2264 if (CONSP (Vface_font_rescale_alist
))
2265 pixel_size
*= font_rescale_ratio (entity
);
2266 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2270 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2271 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2273 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2280 /* The comparison function for qsort. */
2283 font_compare (d1
, d2
)
2284 const void *d1
, *d2
;
2286 return (*(unsigned *) d1
- *(unsigned *) d2
);
2290 /* The structure for elements being sorted by qsort. */
2291 struct font_sort_data
2298 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2299 If PREFER specifies a point-size, calculate the corresponding
2300 pixel-size from QCdpi property of PREFER or from the Y-resolution
2301 of FRAME before sorting.
2303 If BEST-ONLY is nonzero, return the best matching entity (that
2304 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2305 if BEST-ONLY is negative). Otherwise, return the sorted VEC.
2307 This function does no optimization for the case that the length of
2308 VEC is 1. The caller should avoid calling this in such a case. */
2311 font_sort_entites (vec
, prefer
, frame
, best_only
)
2312 Lisp_Object vec
, prefer
, frame
;
2315 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2317 struct font_sort_data
*data
;
2318 unsigned best_score
;
2319 Lisp_Object best_entity
, driver_type
;
2321 struct frame
*f
= XFRAME (frame
);
2322 struct font_driver_list
*list
;
2326 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_DPI_INDEX
; i
++)
2327 prefer_prop
[i
] = AREF (prefer
, i
);
2328 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2329 prefer_prop
[FONT_SIZE_INDEX
]
2330 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2332 /* Scoring and sorting. */
2333 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2334 /* We are sure that the length of VEC > 1. */
2335 driver_type
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2336 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2337 driver_order
++, list
= list
->next
)
2338 if (EQ (driver_type
, list
->driver
->type
))
2340 best_score
= 0xFFFFFFFF;
2342 for (i
= 0; i
< len
; i
++)
2344 if (!EQ (driver_type
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2345 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2346 driver_order
++, list
= list
->next
)
2347 if (EQ (driver_type
, list
->driver
->type
))
2349 data
[i
].entity
= AREF (vec
, i
);
2351 = (best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
) > 0
2352 ? font_score (data
[i
].entity
, prefer_prop
) | driver_order
2354 if (best_only
&& best_score
> data
[i
].score
)
2356 best_score
= data
[i
].score
;
2357 best_entity
= data
[i
].entity
;
2358 if (best_score
== 0)
2364 qsort (data
, len
, sizeof *data
, font_compare
);
2365 for (i
= 0; i
< len
; i
++)
2366 ASET (vec
, i
, data
[i
].entity
);
2372 font_add_log ("sort-by", prefer
, vec
);
2377 /* API of Font Service Layer. */
2379 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2380 sort_shift_bits. Finternal_set_font_selection_order calls this
2381 function with font_sort_order after setting up it. */
2384 font_update_sort_order (order
)
2389 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2391 int xlfd_idx
= order
[i
];
2393 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2394 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2395 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2396 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2397 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2398 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2400 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2405 font_check_otf_features (script
, langsys
, features
, table
)
2406 Lisp_Object script
, langsys
, features
, table
;
2411 table
= assq_no_quit (script
, table
);
2414 table
= XCDR (table
);
2415 if (! NILP (langsys
))
2417 table
= assq_no_quit (langsys
, table
);
2423 val
= assq_no_quit (Qnil
, table
);
2425 table
= XCAR (table
);
2429 table
= XCDR (table
);
2430 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2432 if (NILP (XCAR (features
)))
2437 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2443 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2446 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2448 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2450 script
= XCAR (spec
);
2454 langsys
= XCAR (spec
);
2465 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2466 XCAR (otf_capability
)))
2468 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2469 XCDR (otf_capability
)))
2476 /* Check if FONT (font-entity or font-object) matches with the font
2477 specification SPEC. */
2480 font_match_p (spec
, font
)
2481 Lisp_Object spec
, font
;
2483 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2484 Lisp_Object extra
, font_extra
;
2487 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2488 if (! NILP (AREF (spec
, i
))
2489 && ! NILP (AREF (font
, i
))
2490 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2492 props
= XFONT_SPEC (spec
)->props
;
2493 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2495 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2496 prop
[i
] = AREF (spec
, i
);
2497 prop
[FONT_SIZE_INDEX
]
2498 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2502 if (font_score (font
, props
) > 0)
2504 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2505 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2506 for (; CONSP (extra
); extra
= XCDR (extra
))
2508 Lisp_Object key
= XCAR (XCAR (extra
));
2509 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2511 if (EQ (key
, QClang
))
2513 val2
= assq_no_quit (key
, font_extra
);
2522 if (NILP (Fmemq (val
, val2
)))
2527 ? NILP (Fmemq (val
, XCDR (val2
)))
2531 else if (EQ (key
, QCscript
))
2533 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2539 /* All characters in the list must be supported. */
2540 for (; CONSP (val2
); val2
= XCDR (val2
))
2542 if (! NATNUMP (XCAR (val2
)))
2544 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2545 == FONT_INVALID_CODE
)
2549 else if (VECTORP (val2
))
2551 /* At most one character in the vector must be supported. */
2552 for (i
= 0; i
< ASIZE (val2
); i
++)
2554 if (! NATNUMP (AREF (val2
, i
)))
2556 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2557 != FONT_INVALID_CODE
)
2560 if (i
== ASIZE (val2
))
2565 else if (EQ (key
, QCotf
))
2569 if (! FONT_OBJECT_P (font
))
2571 fontp
= XFONT_OBJECT (font
);
2572 if (! fontp
->driver
->otf_capability
)
2574 val2
= fontp
->driver
->otf_capability (fontp
);
2575 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2586 Each font backend has the callback function get_cache, and it
2587 returns a cons cell of which cdr part can be freely used for
2588 caching fonts. The cons cell may be shared by multiple frames
2589 and/or multiple font drivers. So, we arrange the cdr part as this:
2591 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2593 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2594 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2595 cons (FONT-SPEC FONT-ENTITY ...). */
2597 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2598 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2599 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2600 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2601 struct font_driver
*));
2604 font_prepare_cache (f
, driver
)
2606 struct font_driver
*driver
;
2608 Lisp_Object cache
, val
;
2610 cache
= driver
->get_cache (f
);
2612 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2616 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2617 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2621 val
= XCDR (XCAR (val
));
2622 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2628 font_finish_cache (f
, driver
)
2630 struct font_driver
*driver
;
2632 Lisp_Object cache
, val
, tmp
;
2635 cache
= driver
->get_cache (f
);
2637 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2638 cache
= val
, val
= XCDR (val
);
2639 font_assert (! NILP (val
));
2640 tmp
= XCDR (XCAR (val
));
2641 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2642 if (XINT (XCAR (tmp
)) == 0)
2644 font_clear_cache (f
, XCAR (val
), driver
);
2645 XSETCDR (cache
, XCDR (val
));
2651 font_get_cache (f
, driver
)
2653 struct font_driver
*driver
;
2655 Lisp_Object val
= driver
->get_cache (f
);
2656 Lisp_Object type
= driver
->type
;
2658 font_assert (CONSP (val
));
2659 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2660 font_assert (CONSP (val
));
2661 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2662 val
= XCDR (XCAR (val
));
2666 static int num_fonts
;
2669 font_clear_cache (f
, cache
, driver
)
2672 struct font_driver
*driver
;
2674 Lisp_Object tail
, elt
;
2675 Lisp_Object tail2
, entity
;
2677 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2678 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2681 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2682 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2684 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2686 entity
= XCAR (tail2
);
2688 if (FONT_ENTITY_P (entity
)
2689 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2691 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2693 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2695 Lisp_Object val
= XCAR (objlist
);
2696 struct font
*font
= XFONT_OBJECT (val
);
2698 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2700 font_assert (font
&& driver
== font
->driver
);
2701 driver
->close (f
, font
);
2705 if (driver
->free_entity
)
2706 driver
->free_entity (entity
);
2711 XSETCDR (cache
, Qnil
);
2715 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2718 font_delete_unmatched (list
, spec
, size
)
2719 Lisp_Object list
, spec
;
2722 Lisp_Object entity
, val
;
2723 enum font_property_index prop
;
2725 for (val
= Qnil
; CONSP (list
); list
= XCDR (list
))
2727 entity
= XCAR (list
);
2728 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2729 if (INTEGERP (AREF (spec
, prop
))
2730 && ((XINT (AREF (spec
, prop
)) >> 8)
2731 != (XINT (AREF (entity
, prop
)) >> 8)))
2732 prop
= FONT_SPEC_MAX
;
2733 if (prop
< FONT_SPEC_MAX
2735 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2737 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2740 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2741 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2742 prop
= FONT_SPEC_MAX
;
2744 if (prop
< FONT_SPEC_MAX
2745 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2746 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2747 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2748 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2749 prop
= FONT_SPEC_MAX
;
2750 if (prop
< FONT_SPEC_MAX
2751 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2752 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2753 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2754 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2755 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2756 prop
= FONT_SPEC_MAX
;
2757 if (prop
< FONT_SPEC_MAX
)
2758 val
= Fcons (entity
, val
);
2760 return Fnreverse (val
);
2764 /* Return a vector of font-entities matching with SPEC on FRAME. */
2767 font_list_entities (frame
, spec
)
2768 Lisp_Object frame
, spec
;
2770 FRAME_PTR f
= XFRAME (frame
);
2771 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2772 Lisp_Object ftype
, val
;
2775 int need_filtering
= 0;
2778 font_assert (FONT_SPEC_P (spec
));
2780 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2781 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2782 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2783 size
= font_pixel_size (f
, spec
);
2787 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2788 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2789 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2790 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2792 ASET (scratch_font_spec
, i
, Qnil
);
2793 if (! NILP (AREF (spec
, i
)))
2795 if (i
== FONT_DPI_INDEX
)
2796 /* Skip FONT_SPACING_INDEX */
2799 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2800 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2802 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2806 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2808 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2810 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2812 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2813 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2820 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2821 copy
= Fcopy_font_spec (scratch_font_spec
);
2822 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2823 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2825 if (! NILP (val
) && need_filtering
)
2826 val
= font_delete_unmatched (val
, spec
, size
);
2831 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2832 font_add_log ("list", spec
, val
);
2837 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2838 nil, is an array of face's attributes, which specifies preferred
2839 font-related attributes. */
2842 font_matching_entity (f
, attrs
, spec
)
2844 Lisp_Object
*attrs
, spec
;
2846 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2847 Lisp_Object ftype
, size
, entity
;
2849 Lisp_Object work
= Fcopy_font_spec (spec
);
2851 XSETFRAME (frame
, f
);
2852 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2853 size
= AREF (spec
, FONT_SIZE_INDEX
);
2856 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2857 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2858 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2859 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2862 for (; driver_list
; driver_list
= driver_list
->next
)
2864 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2866 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2869 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2870 entity
= assoc_no_quit (work
, XCDR (cache
));
2872 entity
= XCDR (entity
);
2875 entity
= driver_list
->driver
->match (frame
, work
);
2876 copy
= Fcopy_font_spec (work
);
2877 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2878 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2880 if (! NILP (entity
))
2883 font_add_log ("match", work
, entity
);
2888 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2889 opened font object. */
2892 font_open_entity (f
, entity
, pixel_size
)
2897 struct font_driver_list
*driver_list
;
2898 Lisp_Object objlist
, size
, val
, font_object
;
2900 int min_width
, height
;
2901 int scaled_pixel_size
;
2903 font_assert (FONT_ENTITY_P (entity
));
2904 size
= AREF (entity
, FONT_SIZE_INDEX
);
2905 if (XINT (size
) != 0)
2906 scaled_pixel_size
= pixel_size
= XINT (size
);
2907 else if (CONSP (Vface_font_rescale_alist
))
2908 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2910 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2911 objlist
= XCDR (objlist
))
2912 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2913 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2914 return XCAR (objlist
);
2916 val
= AREF (entity
, FONT_TYPE_INDEX
);
2917 for (driver_list
= f
->font_driver_list
;
2918 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2919 driver_list
= driver_list
->next
);
2923 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2924 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2925 font_add_log ("open", entity
, font_object
);
2926 if (NILP (font_object
))
2928 ASET (entity
, FONT_OBJLIST_INDEX
,
2929 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2930 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
2933 font
= XFONT_OBJECT (font_object
);
2934 min_width
= (font
->min_width
? font
->min_width
2935 : font
->average_width
? font
->average_width
2936 : font
->space_width
? font
->space_width
2938 height
= (font
->height
? font
->height
: 1);
2939 #ifdef HAVE_WINDOW_SYSTEM
2940 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2941 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2943 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2944 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2945 fonts_changed_p
= 1;
2949 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2950 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2951 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2952 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2960 /* Close FONT_OBJECT that is opened on frame F. */
2963 font_close_object (f
, font_object
)
2965 Lisp_Object font_object
;
2967 struct font
*font
= XFONT_OBJECT (font_object
);
2969 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2970 /* Already closed. */
2972 font_add_log ("close", font_object
, Qnil
);
2973 font
->driver
->close (f
, font
);
2974 #ifdef HAVE_WINDOW_SYSTEM
2975 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2976 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2982 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2983 FONT is a font-entity and it must be opened to check. */
2986 font_has_char (f
, font
, c
)
2993 if (FONT_ENTITY_P (font
))
2995 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2996 struct font_driver_list
*driver_list
;
2998 for (driver_list
= f
->font_driver_list
;
2999 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
3000 driver_list
= driver_list
->next
);
3003 if (! driver_list
->driver
->has_char
)
3005 return driver_list
->driver
->has_char (font
, c
);
3008 font_assert (FONT_OBJECT_P (font
));
3009 fontp
= XFONT_OBJECT (font
);
3010 if (fontp
->driver
->has_char
)
3012 int result
= fontp
->driver
->has_char (font
, c
);
3017 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
3021 /* Return the glyph ID of FONT_OBJECT for character C. */
3024 font_encode_char (font_object
, c
)
3025 Lisp_Object font_object
;
3030 font_assert (FONT_OBJECT_P (font_object
));
3031 font
= XFONT_OBJECT (font_object
);
3032 return font
->driver
->encode_char (font
, c
);
3036 /* Return the name of FONT_OBJECT. */
3039 font_get_name (font_object
)
3040 Lisp_Object font_object
;
3042 font_assert (FONT_OBJECT_P (font_object
));
3043 return AREF (font_object
, FONT_NAME_INDEX
);
3047 /* Return the specification of FONT_OBJECT. */
3050 font_get_spec (font_object
)
3051 Lisp_Object font_object
;
3053 Lisp_Object spec
= font_make_spec ();
3056 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
3057 ASET (spec
, i
, AREF (font_object
, i
));
3058 ASET (spec
, FONT_SIZE_INDEX
,
3059 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
3064 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3065 could not be parsed by font_parse_name, return Qnil. */
3068 font_spec_from_name (font_name
)
3069 Lisp_Object font_name
;
3071 Lisp_Object spec
= Ffont_spec (0, NULL
);
3073 CHECK_STRING (font_name
);
3074 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3076 font_put_extra (spec
, QCname
, font_name
);
3082 font_clear_prop (attrs
, prop
)
3084 enum font_property_index prop
;
3086 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3090 if (! NILP (Ffont_get (font
, QCname
)))
3092 font
= Fcopy_font_spec (font
);
3093 font_put_extra (font
, QCname
, Qnil
);
3096 if (NILP (AREF (font
, prop
))
3097 && prop
!= FONT_FAMILY_INDEX
3098 && prop
!= FONT_FOUNDRY_INDEX
3099 && prop
!= FONT_WIDTH_INDEX
3100 && prop
!= FONT_SIZE_INDEX
)
3102 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3103 font
= Fcopy_font_spec (font
);
3104 ASET (font
, prop
, Qnil
);
3105 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3107 if (prop
== FONT_FAMILY_INDEX
)
3109 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3110 /* If we are setting the font family, we must also clear
3111 FONT_WIDTH_INDEX to avoid rejecting families that lack
3112 support for some widths. */
3113 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3115 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3116 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3117 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3118 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3119 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3120 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3122 else if (prop
== FONT_SIZE_INDEX
)
3124 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3125 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3126 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3128 else if (prop
== FONT_WIDTH_INDEX
)
3129 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3130 attrs
[LFACE_FONT_INDEX
] = font
;
3134 font_update_lface (f
, attrs
)
3140 spec
= attrs
[LFACE_FONT_INDEX
];
3141 if (! FONT_SPEC_P (spec
))
3144 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3145 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3146 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3147 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3148 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3149 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3150 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3151 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);
3152 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3153 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3154 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3158 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3163 val
= Ffont_get (spec
, QCdpi
);
3166 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3168 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3170 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3172 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3173 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3179 /* Selecte a font from ENTITIES that supports C and matches best with
3180 ATTRS and PIXEL_SIZE. */
3183 font_select_entity (frame
, entities
, attrs
, pixel_size
, c
)
3184 Lisp_Object frame
, entities
, *attrs
;
3187 Lisp_Object font_entity
;
3189 Lisp_Object props
[FONT_REGISTRY_INDEX
+ 1] ;
3191 FRAME_PTR f
= XFRAME (frame
);
3193 if (ASIZE (entities
) == 1)
3195 font_entity
= AREF (entities
, 0);
3197 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3202 /* Sort fonts by properties specified in ATTRS. */
3203 prefer
= scratch_font_prefer
;
3205 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3206 ASET (prefer
, i
, Qnil
);
3207 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3209 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3211 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3212 ASET (prefer
, i
, AREF (face_font
, i
));
3214 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3215 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3216 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3217 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3218 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3219 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3220 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3222 return font_sort_entites (entities
, prefer
, frame
, c
);
3225 /* Return a font-entity satisfying SPEC and best matching with face's
3226 font related attributes in ATTRS. C, if not negative, is a
3227 character that the entity must support. */
3230 font_find_for_lface (f
, attrs
, spec
, c
)
3237 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
3238 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3240 int i
, j
, k
, l
, result
;
3242 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3243 if (NILP (registry
[0]))
3245 registry
[0] = DEFAULT_ENCODING
;
3246 registry
[1] = Qascii_0
;
3247 registry
[2] = null_vector
;
3250 registry
[1] = null_vector
;
3252 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3254 struct charset
*encoding
, *repertory
;
3256 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3257 &encoding
, &repertory
) < 0)
3261 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3263 /* Any font of this registry support C. So, let's
3264 suppress the further checking. */
3267 else if (c
> encoding
->max_char
)
3271 work
= Fcopy_font_spec (spec
);
3272 XSETFRAME (frame
, f
);
3273 size
= AREF (spec
, FONT_SIZE_INDEX
);
3274 pixel_size
= font_pixel_size (f
, spec
);
3275 if (pixel_size
== 0)
3277 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3279 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3281 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3282 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3283 if (! NILP (foundry
[0]))
3284 foundry
[1] = null_vector
;
3285 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3287 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3288 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3290 foundry
[2] = null_vector
;
3293 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3295 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3296 if (! NILP (adstyle
[0]))
3297 adstyle
[1] = null_vector
;
3298 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3300 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3302 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3304 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3306 adstyle
[2] = null_vector
;
3309 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3312 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3315 val
= AREF (work
, FONT_FAMILY_INDEX
);
3316 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3318 val
= attrs
[LFACE_FAMILY_INDEX
];
3319 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3323 family
= alloca ((sizeof family
[0]) * 2);
3325 family
[1] = null_vector
; /* terminator. */
3330 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3338 if (! NILP (alters
))
3340 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3341 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3342 family
[i
] = XCAR (alters
);
3343 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3345 family
[i
] = null_vector
;
3349 family
= alloca ((sizeof family
[0]) * 3);
3352 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3354 family
[i
] = null_vector
;
3358 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3360 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3361 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3363 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3364 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3366 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3367 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3369 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3370 entities
= font_list_entities (frame
, work
);
3371 if (ASIZE (entities
) > 0)
3373 val
= font_select_entity (frame
, entities
,
3374 attrs
, pixel_size
, c
);
3387 font_open_for_lface (f
, entity
, attrs
, spec
)
3395 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3396 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3397 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3398 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3399 size
= font_pixel_size (f
, spec
);
3403 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3404 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3407 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3408 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3409 if (INTEGERP (height
))
3412 abort(); /* We should never end up here. */
3416 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3420 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3421 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3425 return font_open_entity (f
, entity
, size
);
3429 /* Find a font satisfying SPEC and best matching with face's
3430 attributes in ATTRS on FRAME, and return the opened
3434 font_load_for_lface (f
, attrs
, spec
)
3436 Lisp_Object
*attrs
, spec
;
3440 /* We assume that a font that supports 'A' supports ASCII chars. */
3441 entity
= font_find_for_lface (f
, attrs
, spec
, 'A');
3444 /* No font is listed for SPEC, but each font-backend may have
3445 the different criteria about "font matching". So, try
3447 entity
= font_matching_entity (f
, attrs
, spec
);
3451 return font_open_for_lface (f
, entity
, attrs
, spec
);
3455 /* Make FACE on frame F ready to use the font opened for FACE. */
3458 font_prepare_for_face (f
, face
)
3462 if (face
->font
->driver
->prepare_face
)
3463 face
->font
->driver
->prepare_face (f
, face
);
3467 /* Make FACE on frame F stop using the font opened for FACE. */
3470 font_done_for_face (f
, face
)
3474 if (face
->font
->driver
->done_face
)
3475 face
->font
->driver
->done_face (f
, face
);
3480 /* Open a font matching with font-spec SPEC on frame F. If no proper
3481 font is found, return Qnil. */
3484 font_open_by_spec (f
, spec
)
3488 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3490 /* We set up the default font-related attributes of a face to prefer
3492 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3493 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3494 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3496 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3498 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3500 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3502 return font_load_for_lface (f
, attrs
, spec
);
3506 /* Open a font matching with NAME on frame F. If no proper font is
3507 found, return Qnil. */
3510 font_open_by_name (f
, name
)
3514 Lisp_Object args
[2];
3518 args
[1] = make_unibyte_string (name
, strlen (name
));
3519 spec
= Ffont_spec (2, args
);
3520 return font_open_by_spec (f
, spec
);
3524 /* Register font-driver DRIVER. This function is used in two ways.
3526 The first is with frame F non-NULL. In this case, make DRIVER
3527 available (but not yet activated) on F. All frame creaters
3528 (e.g. Fx_create_frame) must call this function at least once with
3529 an available font-driver.
3531 The second is with frame F NULL. In this case, DRIVER is globally
3532 registered in the variable `font_driver_list'. All font-driver
3533 implementations must call this function in its syms_of_XXXX
3534 (e.g. syms_of_xfont). */
3537 register_font_driver (driver
, f
)
3538 struct font_driver
*driver
;
3541 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3542 struct font_driver_list
*prev
, *list
;
3544 if (f
&& ! driver
->draw
)
3545 error ("Unusable font driver for a frame: %s",
3546 SDATA (SYMBOL_NAME (driver
->type
)));
3548 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3549 if (EQ (list
->driver
->type
, driver
->type
))
3550 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3552 list
= xmalloc (sizeof (struct font_driver_list
));
3554 list
->driver
= driver
;
3559 f
->font_driver_list
= list
;
3561 font_driver_list
= list
;
3567 free_font_driver_list (f
)
3570 struct font_driver_list
*list
, *next
;
3572 for (list
= f
->font_driver_list
; list
; list
= next
)
3577 f
->font_driver_list
= NULL
;
3581 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3582 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3583 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3585 A caller must free all realized faces if any in advance. The
3586 return value is a list of font backends actually made used on
3590 font_update_drivers (f
, new_drivers
)
3592 Lisp_Object new_drivers
;
3594 Lisp_Object active_drivers
= Qnil
;
3595 struct font_driver
*driver
;
3596 struct font_driver_list
*list
;
3598 /* At first, turn off non-requested drivers, and turn on requested
3600 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3602 driver
= list
->driver
;
3603 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3608 if (driver
->end_for_frame
)
3609 driver
->end_for_frame (f
);
3610 font_finish_cache (f
, driver
);
3615 if (! driver
->start_for_frame
3616 || driver
->start_for_frame (f
) == 0)
3618 font_prepare_cache (f
, driver
);
3625 if (NILP (new_drivers
))
3628 if (! EQ (new_drivers
, Qt
))
3630 /* Re-order the driver list according to new_drivers. */
3631 struct font_driver_list
**list_table
, **next
;
3635 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3636 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3638 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3639 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3642 list_table
[i
++] = list
;
3644 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3646 list_table
[i
++] = list
;
3647 list_table
[i
] = NULL
;
3649 next
= &f
->font_driver_list
;
3650 for (i
= 0; list_table
[i
]; i
++)
3652 *next
= list_table
[i
];
3653 next
= &(*next
)->next
;
3658 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3660 active_drivers
= nconc2 (active_drivers
,
3661 Fcons (list
->driver
->type
, Qnil
));
3662 return active_drivers
;
3666 font_put_frame_data (f
, driver
, data
)
3668 struct font_driver
*driver
;
3671 struct font_data_list
*list
, *prev
;
3673 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3674 prev
= list
, list
= list
->next
)
3675 if (list
->driver
== driver
)
3682 prev
->next
= list
->next
;
3684 f
->font_data_list
= list
->next
;
3692 list
= xmalloc (sizeof (struct font_data_list
));
3693 list
->driver
= driver
;
3694 list
->next
= f
->font_data_list
;
3695 f
->font_data_list
= list
;
3703 font_get_frame_data (f
, driver
)
3705 struct font_driver
*driver
;
3707 struct font_data_list
*list
;
3709 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3710 if (list
->driver
== driver
)
3718 /* Return the font used to draw character C by FACE at buffer position
3719 POS in window W. If STRING is non-nil, it is a string containing C
3720 at index POS. If C is negative, get C from the current buffer or
3724 font_at (c
, pos
, face
, w
, string
)
3733 Lisp_Object font_object
;
3735 multibyte
= (NILP (string
)
3736 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3737 : STRING_MULTIBYTE (string
));
3744 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3746 c
= FETCH_CHAR (pos_byte
);
3749 c
= FETCH_BYTE (pos
);
3755 multibyte
= STRING_MULTIBYTE (string
);
3758 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3760 str
= SDATA (string
) + pos_byte
;
3761 c
= STRING_CHAR (str
, 0);
3764 c
= SDATA (string
)[pos
];
3768 f
= XFRAME (w
->frame
);
3769 if (! FRAME_WINDOW_P (f
))
3776 if (STRINGP (string
))
3777 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3778 DEFAULT_FACE_ID
, 0);
3780 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3782 face
= FACE_FROM_ID (f
, face_id
);
3786 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3787 face
= FACE_FROM_ID (f
, face_id
);
3792 XSETFONT (font_object
, face
->font
);
3797 #ifdef HAVE_WINDOW_SYSTEM
3799 /* Check how many characters after POS (at most to *LIMIT) can be
3800 displayed by the same font on the window W. FACE, if non-NULL, is
3801 the face selected for the character at POS. If STRING is not nil,
3802 it is the string to check instead of the current buffer. In that
3803 case, FACE must be not NULL.
3805 The return value is the font-object for the character at POS.
3806 *LIMIT is set to the position where that font can't be used.
3808 It is assured that the current buffer (or STRING) is multibyte. */
3811 font_range (pos
, limit
, w
, face
, string
)
3812 EMACS_INT pos
, *limit
;
3817 EMACS_INT pos_byte
, ignore
, start
, start_byte
;
3819 Lisp_Object font_object
= Qnil
;
3823 pos_byte
= CHAR_TO_BYTE (pos
);
3828 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
, *limit
, 0);
3829 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3835 pos_byte
= string_char_to_byte (string
, pos
);
3838 start
= pos
, start_byte
= pos_byte
;
3839 while (pos
< *limit
)
3841 Lisp_Object category
;
3844 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3846 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3847 if (NILP (font_object
))
3849 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3850 if (NILP (font_object
))
3855 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3856 if (! EQ (category
, QCf
)
3857 && ! CHAR_VARIATION_SELECTOR_P (c
)
3858 && font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3860 Lisp_Object f
= font_for_char (face
, c
, pos
- 1, string
);
3861 EMACS_INT i
, i_byte
;
3869 i
= start
, i_byte
= start_byte
;
3874 FETCH_CHAR_ADVANCE_NO_CHECK (c
, i
, i_byte
);
3876 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, i
, i_byte
);
3877 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3878 if (! EQ (category
, QCf
)
3879 && ! CHAR_VARIATION_SELECTOR_P (c
)
3880 && font_encode_char (f
, c
) == FONT_INVALID_CODE
)
3896 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3897 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3898 Return nil otherwise.
3899 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3900 which kind of font it is. It must be one of `font-spec', `font-entity',
3902 (object
, extra_type
)
3903 Lisp_Object object
, extra_type
;
3905 if (NILP (extra_type
))
3906 return (FONTP (object
) ? Qt
: Qnil
);
3907 if (EQ (extra_type
, Qfont_spec
))
3908 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3909 if (EQ (extra_type
, Qfont_entity
))
3910 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3911 if (EQ (extra_type
, Qfont_object
))
3912 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3913 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3916 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3917 doc
: /* Return a newly created font-spec with arguments as properties.
3919 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3920 valid font property name listed below:
3922 `:family', `:weight', `:slant', `:width'
3924 They are the same as face attributes of the same name. See
3925 `set-face-attribute'.
3929 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3933 VALUE must be a string or a symbol specifying the additional
3934 typographic style information of a font, e.g. ``sans''.
3938 VALUE must be a string or a symbol specifying the charset registry and
3939 encoding of a font, e.g. ``iso8859-1''.
3943 VALUE must be a non-negative integer or a floating point number
3944 specifying the font size. It specifies the font size in pixels (if
3945 VALUE is an integer), or in points (if VALUE is a float).
3949 VALUE must be a string of XLFD-style or fontconfig-style font name.
3953 VALUE must be a symbol representing a script that the font must
3954 support. It may be a symbol representing a subgroup of a script
3955 listed in the variable `script-representative-chars'.
3959 VALUE must be a symbol of two-letter ISO-639 language names,
3964 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3965 required OpenType features.
3967 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3968 LANGSYS-TAG: OpenType language system tag symbol,
3969 or nil for the default language system.
3970 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3971 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3973 GSUB and GPOS may contain `nil' element. In such a case, the font
3974 must not have any of the remaining elements.
3976 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3977 be an OpenType font, and whose GPOS table of `thai' script's default
3978 language system must contain `mark' feature.
3980 usage: (font-spec ARGS...) */)
3985 Lisp_Object spec
= font_make_spec ();
3988 for (i
= 0; i
< nargs
; i
+= 2)
3990 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3992 if (EQ (key
, QCname
))
3995 font_parse_name ((char *) SDATA (val
), spec
);
3996 font_put_extra (spec
, key
, val
);
4000 int idx
= get_font_prop_index (key
);
4004 val
= font_prop_validate (idx
, Qnil
, val
);
4005 if (idx
< FONT_EXTRA_INDEX
)
4006 ASET (spec
, idx
, val
);
4008 font_put_extra (spec
, key
, val
);
4011 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
4017 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
4018 doc
: /* Return a copy of FONT as a font-spec. */)
4022 Lisp_Object new_spec
, tail
, prev
, extra
;
4026 new_spec
= font_make_spec ();
4027 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
4028 ASET (new_spec
, i
, AREF (font
, i
));
4029 extra
= Fcopy_sequence (AREF (font
, FONT_EXTRA_INDEX
));
4030 /* We must remove :font-entity property. */
4031 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
4032 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
4035 extra
= XCDR (extra
);
4037 XSETCDR (prev
, XCDR (tail
));
4040 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
4044 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
4045 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
4046 Every specified properties in FROM override the corresponding
4047 properties in TO. */)
4049 Lisp_Object from
, to
;
4051 Lisp_Object extra
, tail
;
4056 to
= Fcopy_font_spec (to
);
4057 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
4058 ASET (to
, i
, AREF (from
, i
));
4059 extra
= AREF (to
, FONT_EXTRA_INDEX
);
4060 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
4061 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
4063 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
4066 XSETCDR (slot
, XCDR (XCAR (tail
)));
4068 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
4070 ASET (to
, FONT_EXTRA_INDEX
, extra
);
4074 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
4075 doc
: /* Return the value of FONT's property KEY.
4076 FONT is a font-spec, a font-entity, or a font-object.
4077 KEY must be one of these symbols:
4078 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4079 :size, :name, :script
4080 See the documentation of `font-spec' for their meanings.
4081 If FONT is a font-entity or font-object, the value of :script may be
4082 a list of scripts that are supported by the font. */)
4084 Lisp_Object font
, key
;
4091 idx
= get_font_prop_index (key
);
4092 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4093 return font_style_symbolic (font
, idx
, 0);
4094 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4095 return AREF (font
, idx
);
4096 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
4099 #ifdef HAVE_WINDOW_SYSTEM
4101 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4102 doc
: /* Return a plist of face attributes generated by FONT.
4103 FONT is a font name, a font-spec, a font-entity, or a font-object.
4104 The return value is a list of the form
4106 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4108 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4109 compatible with `set-face-attribute'. Some of these key-attribute pairs
4110 may be omitted from the list if they are not specified by FONT.
4112 The optional argument FRAME specifies the frame that the face attributes
4113 are to be displayed on. If omitted, the selected frame is used. */)
4115 Lisp_Object font
, frame
;
4118 Lisp_Object plist
[10];
4123 frame
= selected_frame
;
4124 CHECK_LIVE_FRAME (frame
);
4129 int fontset
= fs_query_fontset (font
, 0);
4130 Lisp_Object name
= font
;
4132 font
= fontset_ascii (fontset
);
4133 font
= font_spec_from_name (name
);
4135 signal_error ("Invalid font name", name
);
4137 else if (! FONTP (font
))
4138 signal_error ("Invalid font object", font
);
4140 val
= AREF (font
, FONT_FAMILY_INDEX
);
4143 plist
[n
++] = QCfamily
;
4144 plist
[n
++] = SYMBOL_NAME (val
);
4147 val
= AREF (font
, FONT_SIZE_INDEX
);
4150 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4151 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4152 plist
[n
++] = QCheight
;
4153 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4155 else if (FLOATP (val
))
4157 plist
[n
++] = QCheight
;
4158 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4161 val
= FONT_WEIGHT_FOR_FACE (font
);
4164 plist
[n
++] = QCweight
;
4168 val
= FONT_SLANT_FOR_FACE (font
);
4171 plist
[n
++] = QCslant
;
4175 val
= FONT_WIDTH_FOR_FACE (font
);
4178 plist
[n
++] = QCwidth
;
4182 return Flist (n
, plist
);
4187 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4188 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
4189 (font_spec
, prop
, val
)
4190 Lisp_Object font_spec
, prop
, val
;
4194 CHECK_FONT_SPEC (font_spec
);
4195 idx
= get_font_prop_index (prop
);
4196 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4197 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
4199 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
4203 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4204 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4205 Optional 2nd argument FRAME specifies the target frame.
4206 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4207 Optional 4th argument PREFER, if non-nil, is a font-spec to
4208 control the order of the returned list. Fonts are sorted by
4209 how close they are to PREFER. */)
4210 (font_spec
, frame
, num
, prefer
)
4211 Lisp_Object font_spec
, frame
, num
, prefer
;
4213 Lisp_Object vec
, list
, tail
;
4217 frame
= selected_frame
;
4218 CHECK_LIVE_FRAME (frame
);
4219 CHECK_FONT_SPEC (font_spec
);
4227 if (! NILP (prefer
))
4228 CHECK_FONT_SPEC (prefer
);
4230 vec
= font_list_entities (frame
, font_spec
);
4235 return Fcons (AREF (vec
, 0), Qnil
);
4237 if (! NILP (prefer
))
4238 vec
= font_sort_entites (vec
, prefer
, frame
, 0);
4240 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
4241 if (n
== 0 || n
> len
)
4243 for (i
= 1; i
< n
; i
++)
4245 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
4247 XSETCDR (tail
, val
);
4253 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4254 doc
: /* List available font families on the current frame.
4255 Optional argument FRAME, if non-nil, specifies the target frame. */)
4260 struct font_driver_list
*driver_list
;
4264 frame
= selected_frame
;
4265 CHECK_LIVE_FRAME (frame
);
4268 for (driver_list
= f
->font_driver_list
; driver_list
;
4269 driver_list
= driver_list
->next
)
4270 if (driver_list
->driver
->list_family
)
4272 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4273 Lisp_Object tail
= list
;
4275 for (; CONSP (val
); val
= XCDR (val
))
4276 if (NILP (Fmemq (XCAR (val
), tail
))
4277 && SYMBOLP (XCAR (val
)))
4278 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4283 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4284 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4285 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4287 Lisp_Object font_spec
, frame
;
4289 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4296 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4297 doc
: /* Return XLFD name of FONT.
4298 FONT is a font-spec, font-entity, or font-object.
4299 If the name is too long for XLFD (maximum 255 chars), return nil.
4300 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4301 the consecutive wildcards are folded to one. */)
4302 (font
, fold_wildcards
)
4303 Lisp_Object font
, fold_wildcards
;
4310 if (FONT_OBJECT_P (font
))
4312 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4314 if (STRINGP (font_name
)
4315 && SDATA (font_name
)[0] == '-')
4317 if (NILP (fold_wildcards
))
4319 strcpy (name
, (char *) SDATA (font_name
));
4322 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4324 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4327 if (! NILP (fold_wildcards
))
4329 char *p0
= name
, *p1
;
4331 while ((p1
= strstr (p0
, "-*-*")))
4333 strcpy (p1
, p1
+ 2);
4338 return build_string (name
);
4341 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4342 doc
: /* Clear font cache. */)
4345 Lisp_Object list
, frame
;
4347 FOR_EACH_FRAME (list
, frame
)
4349 FRAME_PTR f
= XFRAME (frame
);
4350 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4352 for (; driver_list
; driver_list
= driver_list
->next
)
4353 if (driver_list
->on
)
4355 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4360 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4362 font_assert (! NILP (val
));
4363 val
= XCDR (XCAR (val
));
4364 if (XINT (XCAR (val
)) == 0)
4366 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4367 XSETCDR (cache
, XCDR (val
));
4377 font_fill_lglyph_metrics (glyph
, font_object
)
4378 Lisp_Object glyph
, font_object
;
4380 struct font
*font
= XFONT_OBJECT (font_object
);
4382 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4383 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4384 struct font_metrics metrics
;
4386 LGLYPH_SET_CODE (glyph
, ecode
);
4388 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4389 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4390 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4391 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4392 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4393 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4397 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4398 doc
: /* Shape the glyph-string GSTRING.
4399 Shaping means substituting glyphs and/or adjusting positions of glyphs
4400 to get the correct visual image of character sequences set in the
4401 header of the glyph-string.
4403 If the shaping was successful, the value is GSTRING itself or a newly
4404 created glyph-string. Otherwise, the value is nil. */)
4406 Lisp_Object gstring
;
4409 Lisp_Object font_object
, n
, glyph
;
4412 if (! composition_gstring_p (gstring
))
4413 signal_error ("Invalid glyph-string: ", gstring
);
4414 if (! NILP (LGSTRING_ID (gstring
)))
4416 font_object
= LGSTRING_FONT (gstring
);
4417 CHECK_FONT_OBJECT (font_object
);
4418 font
= XFONT_OBJECT (font_object
);
4419 if (! font
->driver
->shape
)
4422 /* Try at most three times with larger gstring each time. */
4423 for (i
= 0; i
< 3; i
++)
4425 n
= font
->driver
->shape (gstring
);
4428 gstring
= larger_vector (gstring
,
4429 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4432 if (i
== 3 || XINT (n
) == 0)
4435 glyph
= LGSTRING_GLYPH (gstring
, 0);
4436 from
= LGLYPH_FROM (glyph
);
4437 to
= LGLYPH_TO (glyph
);
4438 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4440 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4444 if (NILP (LGLYPH_ADJUSTMENT (this)))
4449 glyph
= LGSTRING_GLYPH (gstring
, j
);
4450 LGLYPH_SET_FROM (glyph
, from
);
4451 LGLYPH_SET_TO (glyph
, to
);
4453 from
= LGLYPH_FROM (this);
4454 to
= LGLYPH_TO (this);
4459 if (from
> LGLYPH_FROM (this))
4460 from
= LGLYPH_FROM (this);
4461 if (to
< LGLYPH_TO (this))
4462 to
= LGLYPH_TO (this);
4468 glyph
= LGSTRING_GLYPH (gstring
, j
);
4469 LGLYPH_SET_FROM (glyph
, from
);
4470 LGLYPH_SET_TO (glyph
, to
);
4472 return composition_gstring_put_cache (gstring
, XINT (n
));
4475 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4477 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4478 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4480 VARIATION-SELECTOR is a chracter code of variation selection
4481 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4482 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4483 (font_object
, character
)
4484 Lisp_Object font_object
, character
;
4486 unsigned variations
[256];
4491 CHECK_FONT_OBJECT (font_object
);
4492 CHECK_CHARACTER (character
);
4493 font
= XFONT_OBJECT (font_object
);
4494 if (! font
->driver
->get_variation_glyphs
)
4496 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4500 for (i
= 0; i
< 255; i
++)
4504 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4505 /* Stops GCC whining about limited range of data type. */
4506 EMACS_INT var
= variations
[i
];
4508 if (var
> MOST_POSITIVE_FIXNUM
)
4509 code
= Fcons (make_number ((variations
[i
]) >> 16),
4510 make_number ((variations
[i
]) & 0xFFFF));
4512 code
= make_number (variations
[i
]);
4513 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4520 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4521 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4522 OTF-FEATURES specifies which features to apply in this format:
4523 (SCRIPT LANGSYS GSUB GPOS)
4525 SCRIPT is a symbol specifying a script tag of OpenType,
4526 LANGSYS is a symbol specifying a langsys tag of OpenType,
4527 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4529 If LANGYS is nil, the default langsys is selected.
4531 The features are applied in the order they appear in the list. The
4532 symbol `*' means to apply all available features not present in this
4533 list, and the remaining features are ignored. For instance, (vatu
4534 pstf * haln) is to apply vatu and pstf in this order, then to apply
4535 all available features other than vatu, pstf, and haln.
4537 The features are applied to the glyphs in the range FROM and TO of
4538 the glyph-string GSTRING-IN.
4540 If some feature is actually applicable, the resulting glyphs are
4541 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4542 this case, the value is the number of produced glyphs.
4544 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4547 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4548 produced in GSTRING-OUT, and the value is nil.
4550 See the documentation of `font-make-gstring' for the format of
4552 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4553 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4555 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4560 check_otf_features (otf_features
);
4561 CHECK_FONT_OBJECT (font_object
);
4562 font
= XFONT_OBJECT (font_object
);
4563 if (! font
->driver
->otf_drive
)
4564 error ("Font backend %s can't drive OpenType GSUB table",
4565 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4566 CHECK_CONS (otf_features
);
4567 CHECK_SYMBOL (XCAR (otf_features
));
4568 val
= XCDR (otf_features
);
4569 CHECK_SYMBOL (XCAR (val
));
4570 val
= XCDR (otf_features
);
4573 len
= check_gstring (gstring_in
);
4574 CHECK_VECTOR (gstring_out
);
4575 CHECK_NATNUM (from
);
4577 CHECK_NATNUM (index
);
4579 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4580 args_out_of_range_3 (from
, to
, make_number (len
));
4581 if (XINT (index
) >= ASIZE (gstring_out
))
4582 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4583 num
= font
->driver
->otf_drive (font
, otf_features
,
4584 gstring_in
, XINT (from
), XINT (to
),
4585 gstring_out
, XINT (index
), 0);
4588 return make_number (num
);
4591 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4593 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4594 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4596 (SCRIPT LANGSYS FEATURE ...)
4597 See the documentation of `font-drive-otf' for more detail.
4599 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4600 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4601 character code corresponding to the glyph or nil if there's no
4602 corresponding character. */)
4603 (font_object
, character
, otf_features
)
4604 Lisp_Object font_object
, character
, otf_features
;
4607 Lisp_Object gstring_in
, gstring_out
, g
;
4608 Lisp_Object alternates
;
4611 CHECK_FONT_GET_OBJECT (font_object
, font
);
4612 if (! font
->driver
->otf_drive
)
4613 error ("Font backend %s can't drive OpenType GSUB table",
4614 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4615 CHECK_CHARACTER (character
);
4616 CHECK_CONS (otf_features
);
4618 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4619 g
= LGSTRING_GLYPH (gstring_in
, 0);
4620 LGLYPH_SET_CHAR (g
, XINT (character
));
4621 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4622 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4623 gstring_out
, 0, 1)) < 0)
4624 gstring_out
= Ffont_make_gstring (font_object
,
4625 make_number (ASIZE (gstring_out
) * 2));
4627 for (i
= 0; i
< num
; i
++)
4629 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4630 int c
= LGLYPH_CHAR (g
);
4631 unsigned code
= LGLYPH_CODE (g
);
4633 alternates
= Fcons (Fcons (make_number (code
),
4634 c
> 0 ? make_number (c
) : Qnil
),
4637 return Fnreverse (alternates
);
4643 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4644 doc
: /* Open FONT-ENTITY. */)
4645 (font_entity
, size
, frame
)
4646 Lisp_Object font_entity
;
4652 CHECK_FONT_ENTITY (font_entity
);
4654 frame
= selected_frame
;
4655 CHECK_LIVE_FRAME (frame
);
4658 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4661 CHECK_NUMBER_OR_FLOAT (size
);
4663 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4665 isize
= XINT (size
);
4669 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4672 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4673 doc
: /* Close FONT-OBJECT. */)
4674 (font_object
, frame
)
4675 Lisp_Object font_object
, frame
;
4677 CHECK_FONT_OBJECT (font_object
);
4679 frame
= selected_frame
;
4680 CHECK_LIVE_FRAME (frame
);
4681 font_close_object (XFRAME (frame
), font_object
);
4685 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4686 doc
: /* Return information about FONT-OBJECT.
4687 The value is a vector:
4688 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4691 NAME is a string of the font name (or nil if the font backend doesn't
4694 FILENAME is a string of the font file (or nil if the font backend
4695 doesn't provide a file name).
4697 PIXEL-SIZE is a pixel size by which the font is opened.
4699 SIZE is a maximum advance width of the font in pixels.
4701 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4704 CAPABILITY is a list whose first element is a symbol representing the
4705 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4706 remaining elements describe the details of the font capability.
4708 If the font is OpenType font, the form of the list is
4709 \(opentype GSUB GPOS)
4710 where GSUB shows which "GSUB" features the font supports, and GPOS
4711 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4712 lists of the format:
4713 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4715 If the font is not OpenType font, currently the length of the form is
4718 SCRIPT is a symbol representing OpenType script tag.
4720 LANGSYS is a symbol representing OpenType langsys tag, or nil
4721 representing the default langsys.
4723 FEATURE is a symbol representing OpenType feature tag.
4725 If the font is not OpenType font, CAPABILITY is nil. */)
4727 Lisp_Object font_object
;
4732 CHECK_FONT_GET_OBJECT (font_object
, font
);
4734 val
= Fmake_vector (make_number (9), Qnil
);
4735 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4736 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4737 ASET (val
, 2, make_number (font
->pixel_size
));
4738 ASET (val
, 3, make_number (font
->max_width
));
4739 ASET (val
, 4, make_number (font
->ascent
));
4740 ASET (val
, 5, make_number (font
->descent
));
4741 ASET (val
, 6, make_number (font
->space_width
));
4742 ASET (val
, 7, make_number (font
->average_width
));
4743 if (font
->driver
->otf_capability
)
4744 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4748 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4749 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4750 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4751 (font_object
, string
)
4752 Lisp_Object font_object
, string
;
4758 CHECK_FONT_GET_OBJECT (font_object
, font
);
4759 CHECK_STRING (string
);
4760 len
= SCHARS (string
);
4761 vec
= Fmake_vector (make_number (len
), Qnil
);
4762 for (i
= 0; i
< len
; i
++)
4764 Lisp_Object ch
= Faref (string
, make_number (i
));
4769 struct font_metrics metrics
;
4771 cod
= code
= font
->driver
->encode_char (font
, c
);
4772 if (code
== FONT_INVALID_CODE
)
4774 val
= Fmake_vector (make_number (6), Qnil
);
4775 if (cod
<= MOST_POSITIVE_FIXNUM
)
4776 ASET (val
, 0, make_number (code
));
4778 ASET (val
, 0, Fcons (make_number (code
>> 16),
4779 make_number (code
& 0xFFFF)));
4780 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4781 ASET (val
, 1, make_number (metrics
.lbearing
));
4782 ASET (val
, 2, make_number (metrics
.rbearing
));
4783 ASET (val
, 3, make_number (metrics
.width
));
4784 ASET (val
, 4, make_number (metrics
.ascent
));
4785 ASET (val
, 5, make_number (metrics
.descent
));
4791 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4792 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4793 FONT is a font-spec, font-entity, or font-object. */)
4795 Lisp_Object spec
, font
;
4797 CHECK_FONT_SPEC (spec
);
4800 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4803 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4804 doc
: /* Return a font-object for displaying a character at POSITION.
4805 Optional second arg WINDOW, if non-nil, is a window displaying
4806 the current buffer. It defaults to the currently selected window. */)
4807 (position
, window
, string
)
4808 Lisp_Object position
, window
, string
;
4815 CHECK_NUMBER_COERCE_MARKER (position
);
4816 pos
= XINT (position
);
4817 if (pos
< BEGV
|| pos
>= ZV
)
4818 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4822 CHECK_NUMBER (position
);
4823 CHECK_STRING (string
);
4824 pos
= XINT (position
);
4825 if (pos
< 0 || pos
>= SCHARS (string
))
4826 args_out_of_range (string
, position
);
4829 window
= selected_window
;
4830 CHECK_LIVE_WINDOW (window
);
4831 w
= XWINDOW (window
);
4833 return font_at (-1, pos
, NULL
, w
, string
);
4837 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4838 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4839 The value is a number of glyphs drawn.
4840 Type C-l to recover what previously shown. */)
4841 (font_object
, string
)
4842 Lisp_Object font_object
, string
;
4844 Lisp_Object frame
= selected_frame
;
4845 FRAME_PTR f
= XFRAME (frame
);
4851 CHECK_FONT_GET_OBJECT (font_object
, font
);
4852 CHECK_STRING (string
);
4853 len
= SCHARS (string
);
4854 code
= alloca (sizeof (unsigned) * len
);
4855 for (i
= 0; i
< len
; i
++)
4857 Lisp_Object ch
= Faref (string
, make_number (i
));
4861 code
[i
] = font
->driver
->encode_char (font
, c
);
4862 if (code
[i
] == FONT_INVALID_CODE
)
4865 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4867 if (font
->driver
->prepare_face
)
4868 font
->driver
->prepare_face (f
, face
);
4869 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4870 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4871 if (font
->driver
->done_face
)
4872 font
->driver
->done_face (f
, face
);
4874 return make_number (len
);
4878 #endif /* FONT_DEBUG */
4880 #ifdef HAVE_WINDOW_SYSTEM
4882 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4883 doc
: /* Return information about a font named NAME on frame FRAME.
4884 If FRAME is omitted or nil, use the selected frame.
4885 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4886 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4888 OPENED-NAME is the name used for opening the font,
4889 FULL-NAME is the full name of the font,
4890 SIZE is the pixelsize of the font,
4891 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4892 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4893 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4894 how to compose characters.
4895 If the named font is not yet loaded, return nil. */)
4897 Lisp_Object name
, frame
;
4902 Lisp_Object font_object
;
4904 (*check_window_system_func
) ();
4907 CHECK_STRING (name
);
4909 frame
= selected_frame
;
4910 CHECK_LIVE_FRAME (frame
);
4915 int fontset
= fs_query_fontset (name
, 0);
4918 name
= fontset_ascii (fontset
);
4919 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4921 else if (FONT_OBJECT_P (name
))
4923 else if (FONT_ENTITY_P (name
))
4924 font_object
= font_open_entity (f
, name
, 0);
4927 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4928 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4930 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4932 if (NILP (font_object
))
4934 font
= XFONT_OBJECT (font_object
);
4936 info
= Fmake_vector (make_number (7), Qnil
);
4937 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4938 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
4939 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4940 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4941 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4942 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4943 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4946 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4947 close it now. Perhaps, we should manage font-objects
4948 by `reference-count'. */
4949 font_close_object (f
, font_object
);
4956 #define BUILD_STYLE_TABLE(TBL) \
4957 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4960 build_style_table (entry
, nelement
)
4961 struct table_entry
*entry
;
4965 Lisp_Object table
, elt
;
4967 table
= Fmake_vector (make_number (nelement
), Qnil
);
4968 for (i
= 0; i
< nelement
; i
++)
4970 for (j
= 0; entry
[i
].names
[j
]; j
++);
4971 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4972 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4973 for (j
= 0; entry
[i
].names
[j
]; j
++)
4974 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4975 ASET (table
, i
, elt
);
4980 static Lisp_Object Vfont_log
;
4981 static int font_log_env_checked
;
4983 /* The deferred font-log data of the form [ACTION ARG RESULT].
4984 If ACTION is not nil, that is added to the log when font_add_log is
4985 called next time. At that time, ACTION is set back to nil. */
4986 static Lisp_Object Vfont_log_deferred
;
4988 /* Prepend the font-related logging data in Vfont_log if it is not
4989 `t'. ACTION describes a kind of font-related action (e.g. listing,
4990 opening), ARG is the argument for the action, and RESULT is the
4991 result of the action. */
4993 font_add_log (action
, arg
, result
)
4995 Lisp_Object arg
, result
;
4997 Lisp_Object tail
, val
;
5000 if (! font_log_env_checked
)
5002 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
5003 font_log_env_checked
= 1;
5005 if (EQ (Vfont_log
, Qt
))
5007 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5009 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
5011 ASET (Vfont_log_deferred
, 0, Qnil
);
5012 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5013 AREF (Vfont_log_deferred
, 2));
5018 Lisp_Object tail
, elt
;
5019 Lisp_Object equalstr
= build_string ("=");
5021 val
= Ffont_xlfd_name (arg
, Qt
);
5022 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5026 if (EQ (XCAR (elt
), QCscript
)
5027 && SYMBOLP (XCDR (elt
)))
5028 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5029 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5030 else if (EQ (XCAR (elt
), QClang
)
5031 && SYMBOLP (XCDR (elt
)))
5032 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5033 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5034 else if (EQ (XCAR (elt
), QCotf
)
5035 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5036 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5038 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5044 val
= Ffont_xlfd_name (result
, Qt
);
5045 if (! FONT_SPEC_P (result
))
5046 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5047 build_string (":"), val
);
5050 else if (CONSP (result
))
5052 result
= Fcopy_sequence (result
);
5053 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5057 val
= Ffont_xlfd_name (val
, Qt
);
5058 XSETCAR (tail
, val
);
5061 else if (VECTORP (result
))
5063 result
= Fcopy_sequence (result
);
5064 for (i
= 0; i
< ASIZE (result
); i
++)
5066 val
= AREF (result
, i
);
5068 val
= Ffont_xlfd_name (val
, Qt
);
5069 ASET (result
, i
, val
);
5072 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5075 /* Record a font-related logging data to be added to Vfont_log when
5076 font_add_log is called next time. ACTION, ARG, RESULT are the same
5080 font_deferred_log (action
, arg
, result
)
5082 Lisp_Object arg
, result
;
5084 ASET (Vfont_log_deferred
, 0, build_string (action
));
5085 ASET (Vfont_log_deferred
, 1, arg
);
5086 ASET (Vfont_log_deferred
, 2, result
);
5089 extern void syms_of_ftfont
P_ (());
5090 extern void syms_of_xfont
P_ (());
5091 extern void syms_of_xftfont
P_ (());
5092 extern void syms_of_ftxfont
P_ (());
5093 extern void syms_of_bdffont
P_ (());
5094 extern void syms_of_w32font
P_ (());
5095 extern void syms_of_atmfont
P_ (());
5096 extern void syms_of_nsfont
P_ (());
5101 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5102 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5103 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5104 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5105 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5106 /* Note that the other elements in sort_shift_bits are not used. */
5108 staticpro (&font_charset_alist
);
5109 font_charset_alist
= Qnil
;
5111 DEFSYM (Qopentype
, "opentype");
5113 DEFSYM (Qascii_0
, "ascii-0");
5114 DEFSYM (Qiso8859_1
, "iso8859-1");
5115 DEFSYM (Qiso10646_1
, "iso10646-1");
5116 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5117 DEFSYM (Qunicode_sip
, "unicode-sip");
5121 DEFSYM (QCotf
, ":otf");
5122 DEFSYM (QClang
, ":lang");
5123 DEFSYM (QCscript
, ":script");
5124 DEFSYM (QCantialias
, ":antialias");
5126 DEFSYM (QCfoundry
, ":foundry");
5127 DEFSYM (QCadstyle
, ":adstyle");
5128 DEFSYM (QCregistry
, ":registry");
5129 DEFSYM (QCspacing
, ":spacing");
5130 DEFSYM (QCdpi
, ":dpi");
5131 DEFSYM (QCscalable
, ":scalable");
5132 DEFSYM (QCavgwidth
, ":avgwidth");
5133 DEFSYM (QCfont_entity
, ":font-entity");
5134 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5144 staticpro (&null_vector
);
5145 null_vector
= Fmake_vector (make_number (0), Qnil
);
5147 staticpro (&scratch_font_spec
);
5148 scratch_font_spec
= Ffont_spec (0, NULL
);
5149 staticpro (&scratch_font_prefer
);
5150 scratch_font_prefer
= Ffont_spec (0, NULL
);
5152 staticpro (&Vfont_log_deferred
);
5153 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5157 staticpro (&otf_list
);
5159 #endif /* HAVE_LIBOTF */
5163 defsubr (&Sfont_spec
);
5164 defsubr (&Sfont_get
);
5165 #ifdef HAVE_WINDOW_SYSTEM
5166 defsubr (&Sfont_face_attributes
);
5168 defsubr (&Sfont_put
);
5169 defsubr (&Slist_fonts
);
5170 defsubr (&Sfont_family_list
);
5171 defsubr (&Sfind_font
);
5172 defsubr (&Sfont_xlfd_name
);
5173 defsubr (&Sclear_font_cache
);
5174 defsubr (&Sfont_shape_gstring
);
5175 defsubr (&Sfont_variation_glyphs
);
5177 defsubr (&Sfont_drive_otf
);
5178 defsubr (&Sfont_otf_alternates
);
5182 defsubr (&Sopen_font
);
5183 defsubr (&Sclose_font
);
5184 defsubr (&Squery_font
);
5185 defsubr (&Sget_font_glyphs
);
5186 defsubr (&Sfont_match_p
);
5187 defsubr (&Sfont_at
);
5189 defsubr (&Sdraw_string
);
5191 #endif /* FONT_DEBUG */
5192 #ifdef HAVE_WINDOW_SYSTEM
5193 defsubr (&Sfont_info
);
5196 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5198 Alist of fontname patterns vs the corresponding encoding and repertory info.
5199 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5200 where ENCODING is a charset or a char-table,
5201 and REPERTORY is a charset, a char-table, or nil.
5203 If ENCODING and REPERTORY are the same, the element can have the form
5204 \(REGEXP . ENCODING).
5206 ENCODING is for converting a character to a glyph code of the font.
5207 If ENCODING is a charset, encoding a character by the charset gives
5208 the corresponding glyph code. If ENCODING is a char-table, looking up
5209 the table by a character gives the corresponding glyph code.
5211 REPERTORY specifies a repertory of characters supported by the font.
5212 If REPERTORY is a charset, all characters beloging to the charset are
5213 supported. If REPERTORY is a char-table, all characters who have a
5214 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5215 gets the repertory information by an opened font and ENCODING. */);
5216 Vfont_encoding_alist
= Qnil
;
5218 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5219 doc
: /* Vector of valid font weight values.
5220 Each element has the form:
5221 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5222 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5223 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5225 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5226 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5227 See `font-weight-table' for the format of the vector. */);
5228 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5230 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5231 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5232 See `font-weight-table' for the format of the vector. */);
5233 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5235 staticpro (&font_style_table
);
5236 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5237 ASET (font_style_table
, 0, Vfont_weight_table
);
5238 ASET (font_style_table
, 1, Vfont_slant_table
);
5239 ASET (font_style_table
, 2, Vfont_width_table
);
5241 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5242 *Logging list of font related actions and results.
5243 The value t means to suppress the logging.
5244 The initial value is set to nil if the environment variable
5245 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5248 #ifdef HAVE_WINDOW_SYSTEM
5249 #ifdef HAVE_FREETYPE
5251 #ifdef HAVE_X_WINDOWS
5256 #endif /* HAVE_XFT */
5257 #endif /* HAVE_X_WINDOWS */
5258 #else /* not HAVE_FREETYPE */
5259 #ifdef HAVE_X_WINDOWS
5261 #endif /* HAVE_X_WINDOWS */
5262 #endif /* not HAVE_FREETYPE */
5265 #endif /* HAVE_BDFFONT */
5268 #endif /* WINDOWSNT */
5271 #endif /* HAVE_NS */
5272 #endif /* HAVE_WINDOW_SYSTEM */
5275 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5276 (do not change this comment) */