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 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2274 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2276 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2283 /* The comparison function for qsort. */
2286 font_compare (d1
, d2
)
2287 const void *d1
, *d2
;
2289 return (*(unsigned *) d1
- *(unsigned *) d2
);
2293 /* The structure for elements being sorted by qsort. */
2294 struct font_sort_data
2301 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2302 If PREFER specifies a point-size, calculate the corresponding
2303 pixel-size from QCdpi property of PREFER or from the Y-resolution
2304 of FRAME before sorting.
2306 If BEST-ONLY is nonzero, return the best matching entity (that
2307 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2308 if BEST-ONLY is negative). Otherwise, return the sorted VEC.
2310 This function does no optimization for the case that the length of
2311 VEC is 1. The caller should avoid calling this in such a case. */
2314 font_sort_entites (vec
, prefer
, frame
, best_only
)
2315 Lisp_Object vec
, prefer
, frame
;
2318 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2320 struct font_sort_data
*data
;
2321 unsigned best_score
;
2322 Lisp_Object best_entity
, driver_type
;
2324 struct frame
*f
= XFRAME (frame
);
2325 struct font_driver_list
*list
;
2329 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_DPI_INDEX
; i
++)
2330 prefer_prop
[i
] = AREF (prefer
, i
);
2331 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2332 prefer_prop
[FONT_SIZE_INDEX
]
2333 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2335 /* Scoring and sorting. */
2336 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2337 /* We are sure that the length of VEC > 1. */
2338 driver_type
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2339 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2340 driver_order
++, list
= list
->next
)
2341 if (EQ (driver_type
, list
->driver
->type
))
2343 best_score
= 0xFFFFFFFF;
2345 for (i
= 0; i
< len
; i
++)
2347 if (!EQ (driver_type
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2348 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2349 driver_order
++, list
= list
->next
)
2350 if (EQ (driver_type
, list
->driver
->type
))
2352 data
[i
].entity
= AREF (vec
, i
);
2354 = (best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
) > 0
2355 ? font_score (data
[i
].entity
, prefer_prop
) | driver_order
2357 if (best_only
&& best_score
> data
[i
].score
)
2359 best_score
= data
[i
].score
;
2360 best_entity
= data
[i
].entity
;
2361 if (best_score
== 0)
2367 qsort (data
, len
, sizeof *data
, font_compare
);
2368 for (i
= 0; i
< len
; i
++)
2369 ASET (vec
, i
, data
[i
].entity
);
2375 font_add_log ("sort-by", prefer
, vec
);
2380 /* API of Font Service Layer. */
2382 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2383 sort_shift_bits. Finternal_set_font_selection_order calls this
2384 function with font_sort_order after setting up it. */
2387 font_update_sort_order (order
)
2392 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2394 int xlfd_idx
= order
[i
];
2396 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2397 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2398 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2399 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2400 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2401 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2403 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2408 font_check_otf_features (script
, langsys
, features
, table
)
2409 Lisp_Object script
, langsys
, features
, table
;
2414 table
= assq_no_quit (script
, table
);
2417 table
= XCDR (table
);
2418 if (! NILP (langsys
))
2420 table
= assq_no_quit (langsys
, table
);
2426 val
= assq_no_quit (Qnil
, table
);
2428 table
= XCAR (table
);
2432 table
= XCDR (table
);
2433 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2435 if (NILP (XCAR (features
)))
2440 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2446 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2449 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2451 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2453 script
= XCAR (spec
);
2457 langsys
= XCAR (spec
);
2468 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2469 XCAR (otf_capability
)))
2471 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2472 XCDR (otf_capability
)))
2479 /* Check if FONT (font-entity or font-object) matches with the font
2480 specification SPEC. */
2483 font_match_p (spec
, font
)
2484 Lisp_Object spec
, font
;
2486 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2487 Lisp_Object extra
, font_extra
;
2490 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2491 if (! NILP (AREF (spec
, i
))
2492 && ! NILP (AREF (font
, i
))
2493 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2495 props
= XFONT_SPEC (spec
)->props
;
2496 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2498 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2499 prop
[i
] = AREF (spec
, i
);
2500 prop
[FONT_SIZE_INDEX
]
2501 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2505 if (font_score (font
, props
) > 0)
2507 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2508 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2509 for (; CONSP (extra
); extra
= XCDR (extra
))
2511 Lisp_Object key
= XCAR (XCAR (extra
));
2512 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2514 if (EQ (key
, QClang
))
2516 val2
= assq_no_quit (key
, font_extra
);
2525 if (NILP (Fmemq (val
, val2
)))
2530 ? NILP (Fmemq (val
, XCDR (val2
)))
2534 else if (EQ (key
, QCscript
))
2536 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2542 /* All characters in the list must be supported. */
2543 for (; CONSP (val2
); val2
= XCDR (val2
))
2545 if (! NATNUMP (XCAR (val2
)))
2547 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2548 == FONT_INVALID_CODE
)
2552 else if (VECTORP (val2
))
2554 /* At most one character in the vector must be supported. */
2555 for (i
= 0; i
< ASIZE (val2
); i
++)
2557 if (! NATNUMP (AREF (val2
, i
)))
2559 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2560 != FONT_INVALID_CODE
)
2563 if (i
== ASIZE (val2
))
2568 else if (EQ (key
, QCotf
))
2572 if (! FONT_OBJECT_P (font
))
2574 fontp
= XFONT_OBJECT (font
);
2575 if (! fontp
->driver
->otf_capability
)
2577 val2
= fontp
->driver
->otf_capability (fontp
);
2578 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2589 Each font backend has the callback function get_cache, and it
2590 returns a cons cell of which cdr part can be freely used for
2591 caching fonts. The cons cell may be shared by multiple frames
2592 and/or multiple font drivers. So, we arrange the cdr part as this:
2594 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2596 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2597 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2598 cons (FONT-SPEC FONT-ENTITY ...). */
2600 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2601 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2602 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2603 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2604 struct font_driver
*));
2607 font_prepare_cache (f
, driver
)
2609 struct font_driver
*driver
;
2611 Lisp_Object cache
, val
;
2613 cache
= driver
->get_cache (f
);
2615 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2619 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2620 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2624 val
= XCDR (XCAR (val
));
2625 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2631 font_finish_cache (f
, driver
)
2633 struct font_driver
*driver
;
2635 Lisp_Object cache
, val
, tmp
;
2638 cache
= driver
->get_cache (f
);
2640 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2641 cache
= val
, val
= XCDR (val
);
2642 font_assert (! NILP (val
));
2643 tmp
= XCDR (XCAR (val
));
2644 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2645 if (XINT (XCAR (tmp
)) == 0)
2647 font_clear_cache (f
, XCAR (val
), driver
);
2648 XSETCDR (cache
, XCDR (val
));
2654 font_get_cache (f
, driver
)
2656 struct font_driver
*driver
;
2658 Lisp_Object val
= driver
->get_cache (f
);
2659 Lisp_Object type
= driver
->type
;
2661 font_assert (CONSP (val
));
2662 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2663 font_assert (CONSP (val
));
2664 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2665 val
= XCDR (XCAR (val
));
2669 static int num_fonts
;
2672 font_clear_cache (f
, cache
, driver
)
2675 struct font_driver
*driver
;
2677 Lisp_Object tail
, elt
;
2678 Lisp_Object tail2
, entity
;
2680 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2681 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2684 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2685 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2687 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2689 entity
= XCAR (tail2
);
2691 if (FONT_ENTITY_P (entity
)
2692 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2694 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2696 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2698 Lisp_Object val
= XCAR (objlist
);
2699 struct font
*font
= XFONT_OBJECT (val
);
2701 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2703 font_assert (font
&& driver
== font
->driver
);
2704 driver
->close (f
, font
);
2708 if (driver
->free_entity
)
2709 driver
->free_entity (entity
);
2714 XSETCDR (cache
, Qnil
);
2718 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2721 font_delete_unmatched (list
, spec
, size
)
2722 Lisp_Object list
, spec
;
2725 Lisp_Object entity
, val
;
2726 enum font_property_index prop
;
2728 for (val
= Qnil
; CONSP (list
); list
= XCDR (list
))
2730 entity
= XCAR (list
);
2731 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2732 if (INTEGERP (AREF (spec
, prop
))
2733 && ((XINT (AREF (spec
, prop
)) >> 8)
2734 != (XINT (AREF (entity
, prop
)) >> 8)))
2735 prop
= FONT_SPEC_MAX
;
2736 if (prop
< FONT_SPEC_MAX
2738 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2740 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2743 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2744 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2745 prop
= FONT_SPEC_MAX
;
2747 if (prop
< FONT_SPEC_MAX
2748 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2749 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2750 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2751 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2752 prop
= FONT_SPEC_MAX
;
2753 if (prop
< FONT_SPEC_MAX
2754 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2755 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2756 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2757 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2758 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2759 prop
= FONT_SPEC_MAX
;
2760 if (prop
< FONT_SPEC_MAX
)
2761 val
= Fcons (entity
, val
);
2763 return Fnreverse (val
);
2767 /* Return a vector of font-entities matching with SPEC on FRAME. */
2770 font_list_entities (frame
, spec
)
2771 Lisp_Object frame
, spec
;
2773 FRAME_PTR f
= XFRAME (frame
);
2774 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2775 Lisp_Object ftype
, val
;
2778 int need_filtering
= 0;
2781 font_assert (FONT_SPEC_P (spec
));
2783 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2784 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2785 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2786 size
= font_pixel_size (f
, spec
);
2790 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2791 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2792 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2793 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2795 ASET (scratch_font_spec
, i
, Qnil
);
2796 if (! NILP (AREF (spec
, i
)))
2798 if (i
== FONT_DPI_INDEX
)
2799 /* Skip FONT_SPACING_INDEX */
2802 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2803 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2805 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2809 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2811 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2813 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2815 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2816 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2823 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2824 copy
= Fcopy_font_spec (scratch_font_spec
);
2825 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2826 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2828 if (! NILP (val
) && need_filtering
)
2829 val
= font_delete_unmatched (val
, spec
, size
);
2834 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2835 font_add_log ("list", spec
, val
);
2840 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2841 nil, is an array of face's attributes, which specifies preferred
2842 font-related attributes. */
2845 font_matching_entity (f
, attrs
, spec
)
2847 Lisp_Object
*attrs
, spec
;
2849 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2850 Lisp_Object ftype
, size
, entity
;
2852 Lisp_Object work
= Fcopy_font_spec (spec
);
2854 XSETFRAME (frame
, f
);
2855 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2856 size
= AREF (spec
, FONT_SIZE_INDEX
);
2859 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2860 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2861 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2862 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2865 for (; driver_list
; driver_list
= driver_list
->next
)
2867 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2869 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2872 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2873 entity
= assoc_no_quit (work
, XCDR (cache
));
2875 entity
= XCDR (entity
);
2878 entity
= driver_list
->driver
->match (frame
, work
);
2879 copy
= Fcopy_font_spec (work
);
2880 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2881 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2883 if (! NILP (entity
))
2886 font_add_log ("match", work
, entity
);
2891 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2892 opened font object. */
2895 font_open_entity (f
, entity
, pixel_size
)
2900 struct font_driver_list
*driver_list
;
2901 Lisp_Object objlist
, size
, val
, font_object
;
2903 int min_width
, height
;
2904 int scaled_pixel_size
;
2906 font_assert (FONT_ENTITY_P (entity
));
2907 size
= AREF (entity
, FONT_SIZE_INDEX
);
2908 if (XINT (size
) != 0)
2909 scaled_pixel_size
= pixel_size
= XINT (size
);
2910 else if (CONSP (Vface_font_rescale_alist
))
2911 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2913 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2914 objlist
= XCDR (objlist
))
2915 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2916 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2917 return XCAR (objlist
);
2919 val
= AREF (entity
, FONT_TYPE_INDEX
);
2920 for (driver_list
= f
->font_driver_list
;
2921 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2922 driver_list
= driver_list
->next
);
2926 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2927 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2928 font_add_log ("open", entity
, font_object
);
2929 if (NILP (font_object
))
2931 ASET (entity
, FONT_OBJLIST_INDEX
,
2932 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2933 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
2936 font
= XFONT_OBJECT (font_object
);
2937 min_width
= (font
->min_width
? font
->min_width
2938 : font
->average_width
? font
->average_width
2939 : font
->space_width
? font
->space_width
2941 height
= (font
->height
? font
->height
: 1);
2942 #ifdef HAVE_WINDOW_SYSTEM
2943 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2944 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2946 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2947 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2948 fonts_changed_p
= 1;
2952 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2953 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2954 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2955 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2963 /* Close FONT_OBJECT that is opened on frame F. */
2966 font_close_object (f
, font_object
)
2968 Lisp_Object font_object
;
2970 struct font
*font
= XFONT_OBJECT (font_object
);
2972 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2973 /* Already closed. */
2975 font_add_log ("close", font_object
, Qnil
);
2976 font
->driver
->close (f
, font
);
2977 #ifdef HAVE_WINDOW_SYSTEM
2978 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2979 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2985 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2986 FONT is a font-entity and it must be opened to check. */
2989 font_has_char (f
, font
, c
)
2996 if (FONT_ENTITY_P (font
))
2998 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2999 struct font_driver_list
*driver_list
;
3001 for (driver_list
= f
->font_driver_list
;
3002 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
3003 driver_list
= driver_list
->next
);
3006 if (! driver_list
->driver
->has_char
)
3008 return driver_list
->driver
->has_char (font
, c
);
3011 font_assert (FONT_OBJECT_P (font
));
3012 fontp
= XFONT_OBJECT (font
);
3013 if (fontp
->driver
->has_char
)
3015 int result
= fontp
->driver
->has_char (font
, c
);
3020 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
3024 /* Return the glyph ID of FONT_OBJECT for character C. */
3027 font_encode_char (font_object
, c
)
3028 Lisp_Object font_object
;
3033 font_assert (FONT_OBJECT_P (font_object
));
3034 font
= XFONT_OBJECT (font_object
);
3035 return font
->driver
->encode_char (font
, c
);
3039 /* Return the name of FONT_OBJECT. */
3042 font_get_name (font_object
)
3043 Lisp_Object font_object
;
3045 font_assert (FONT_OBJECT_P (font_object
));
3046 return AREF (font_object
, FONT_NAME_INDEX
);
3050 /* Return the specification of FONT_OBJECT. */
3053 font_get_spec (font_object
)
3054 Lisp_Object font_object
;
3056 Lisp_Object spec
= font_make_spec ();
3059 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
3060 ASET (spec
, i
, AREF (font_object
, i
));
3061 ASET (spec
, FONT_SIZE_INDEX
,
3062 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
3067 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3068 could not be parsed by font_parse_name, return Qnil. */
3071 font_spec_from_name (font_name
)
3072 Lisp_Object font_name
;
3074 Lisp_Object spec
= Ffont_spec (0, NULL
);
3076 CHECK_STRING (font_name
);
3077 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3079 font_put_extra (spec
, QCname
, font_name
);
3085 font_clear_prop (attrs
, prop
)
3087 enum font_property_index prop
;
3089 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3093 if (! NILP (Ffont_get (font
, QCname
)))
3095 font
= Fcopy_font_spec (font
);
3096 font_put_extra (font
, QCname
, Qnil
);
3099 if (NILP (AREF (font
, prop
))
3100 && prop
!= FONT_FAMILY_INDEX
3101 && prop
!= FONT_FOUNDRY_INDEX
3102 && prop
!= FONT_WIDTH_INDEX
3103 && prop
!= FONT_SIZE_INDEX
)
3105 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3106 font
= Fcopy_font_spec (font
);
3107 ASET (font
, prop
, Qnil
);
3108 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3110 if (prop
== FONT_FAMILY_INDEX
)
3112 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3113 /* If we are setting the font family, we must also clear
3114 FONT_WIDTH_INDEX to avoid rejecting families that lack
3115 support for some widths. */
3116 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3118 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3119 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3120 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3121 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3122 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3123 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3125 else if (prop
== FONT_SIZE_INDEX
)
3127 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3128 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3129 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3131 else if (prop
== FONT_WIDTH_INDEX
)
3132 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3133 attrs
[LFACE_FONT_INDEX
] = font
;
3137 font_update_lface (f
, attrs
)
3143 spec
= attrs
[LFACE_FONT_INDEX
];
3144 if (! FONT_SPEC_P (spec
))
3147 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3148 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3149 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3150 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3151 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3152 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3153 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3154 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);
3155 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3156 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3157 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3161 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3166 val
= Ffont_get (spec
, QCdpi
);
3169 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3171 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3173 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3175 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3176 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3182 /* Selecte a font from ENTITIES that supports C and matches best with
3183 ATTRS and PIXEL_SIZE. */
3186 font_select_entity (frame
, entities
, attrs
, pixel_size
, c
)
3187 Lisp_Object frame
, entities
, *attrs
;
3190 Lisp_Object font_entity
;
3192 Lisp_Object props
[FONT_REGISTRY_INDEX
+ 1] ;
3194 FRAME_PTR f
= XFRAME (frame
);
3196 if (ASIZE (entities
) == 1)
3198 font_entity
= AREF (entities
, 0);
3200 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3205 /* Sort fonts by properties specified in ATTRS. */
3206 prefer
= scratch_font_prefer
;
3208 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3209 ASET (prefer
, i
, Qnil
);
3210 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3212 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3214 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3215 ASET (prefer
, i
, AREF (face_font
, i
));
3217 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3218 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3219 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3220 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3221 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3222 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3223 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3225 return font_sort_entites (entities
, prefer
, frame
, c
);
3228 /* Return a font-entity satisfying SPEC and best matching with face's
3229 font related attributes in ATTRS. C, if not negative, is a
3230 character that the entity must support. */
3233 font_find_for_lface (f
, attrs
, spec
, c
)
3240 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
3241 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3243 int i
, j
, k
, l
, result
;
3245 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3246 if (NILP (registry
[0]))
3248 registry
[0] = DEFAULT_ENCODING
;
3249 registry
[1] = Qascii_0
;
3250 registry
[2] = null_vector
;
3253 registry
[1] = null_vector
;
3255 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3257 struct charset
*encoding
, *repertory
;
3259 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3260 &encoding
, &repertory
) < 0)
3264 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3266 /* Any font of this registry support C. So, let's
3267 suppress the further checking. */
3270 else if (c
> encoding
->max_char
)
3274 work
= Fcopy_font_spec (spec
);
3275 XSETFRAME (frame
, f
);
3276 size
= AREF (spec
, FONT_SIZE_INDEX
);
3277 pixel_size
= font_pixel_size (f
, spec
);
3278 if (pixel_size
== 0)
3280 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3282 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3284 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3285 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3286 if (! NILP (foundry
[0]))
3287 foundry
[1] = null_vector
;
3288 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3290 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3291 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3293 foundry
[2] = null_vector
;
3296 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3298 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3299 if (! NILP (adstyle
[0]))
3300 adstyle
[1] = null_vector
;
3301 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3303 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3305 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3307 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3309 adstyle
[2] = null_vector
;
3312 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3315 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3318 val
= AREF (work
, FONT_FAMILY_INDEX
);
3319 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3321 val
= attrs
[LFACE_FAMILY_INDEX
];
3322 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3326 family
= alloca ((sizeof family
[0]) * 2);
3328 family
[1] = null_vector
; /* terminator. */
3333 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3341 if (! NILP (alters
))
3343 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3344 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3345 family
[i
] = XCAR (alters
);
3346 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3348 family
[i
] = null_vector
;
3352 family
= alloca ((sizeof family
[0]) * 3);
3355 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3357 family
[i
] = null_vector
;
3361 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3363 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3364 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3366 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3367 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3369 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3370 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3372 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3373 entities
= font_list_entities (frame
, work
);
3374 if (ASIZE (entities
) > 0)
3376 val
= font_select_entity (frame
, entities
,
3377 attrs
, pixel_size
, c
);
3390 font_open_for_lface (f
, entity
, attrs
, spec
)
3398 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3399 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3400 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3401 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3402 size
= font_pixel_size (f
, spec
);
3406 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3407 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3410 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3411 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3412 if (INTEGERP (height
))
3415 abort(); /* We should never end up here. */
3419 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3423 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3424 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3428 return font_open_entity (f
, entity
, size
);
3432 /* Find a font satisfying SPEC and best matching with face's
3433 attributes in ATTRS on FRAME, and return the opened
3437 font_load_for_lface (f
, attrs
, spec
)
3439 Lisp_Object
*attrs
, spec
;
3443 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3446 /* No font is listed for SPEC, but each font-backend may have
3447 the different criteria about "font matching". So, try
3449 entity
= font_matching_entity (f
, attrs
, spec
);
3453 return font_open_for_lface (f
, entity
, attrs
, spec
);
3457 /* Make FACE on frame F ready to use the font opened for FACE. */
3460 font_prepare_for_face (f
, face
)
3464 if (face
->font
->driver
->prepare_face
)
3465 face
->font
->driver
->prepare_face (f
, face
);
3469 /* Make FACE on frame F stop using the font opened for FACE. */
3472 font_done_for_face (f
, face
)
3476 if (face
->font
->driver
->done_face
)
3477 face
->font
->driver
->done_face (f
, face
);
3482 /* Open a font matching with font-spec SPEC on frame F. If no proper
3483 font is found, return Qnil. */
3486 font_open_by_spec (f
, spec
)
3490 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3492 /* We set up the default font-related attributes of a face to prefer
3494 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3495 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3496 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3498 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3500 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3502 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3504 return font_load_for_lface (f
, attrs
, spec
);
3508 /* Open a font matching with NAME on frame F. If no proper font is
3509 found, return Qnil. */
3512 font_open_by_name (f
, name
)
3516 Lisp_Object args
[2];
3520 args
[1] = make_unibyte_string (name
, strlen (name
));
3521 spec
= Ffont_spec (2, args
);
3522 return font_open_by_spec (f
, spec
);
3526 /* Register font-driver DRIVER. This function is used in two ways.
3528 The first is with frame F non-NULL. In this case, make DRIVER
3529 available (but not yet activated) on F. All frame creaters
3530 (e.g. Fx_create_frame) must call this function at least once with
3531 an available font-driver.
3533 The second is with frame F NULL. In this case, DRIVER is globally
3534 registered in the variable `font_driver_list'. All font-driver
3535 implementations must call this function in its syms_of_XXXX
3536 (e.g. syms_of_xfont). */
3539 register_font_driver (driver
, f
)
3540 struct font_driver
*driver
;
3543 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3544 struct font_driver_list
*prev
, *list
;
3546 if (f
&& ! driver
->draw
)
3547 error ("Unusable font driver for a frame: %s",
3548 SDATA (SYMBOL_NAME (driver
->type
)));
3550 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3551 if (EQ (list
->driver
->type
, driver
->type
))
3552 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3554 list
= xmalloc (sizeof (struct font_driver_list
));
3556 list
->driver
= driver
;
3561 f
->font_driver_list
= list
;
3563 font_driver_list
= list
;
3569 free_font_driver_list (f
)
3572 struct font_driver_list
*list
, *next
;
3574 for (list
= f
->font_driver_list
; list
; list
= next
)
3579 f
->font_driver_list
= NULL
;
3583 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3584 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3585 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3587 A caller must free all realized faces if any in advance. The
3588 return value is a list of font backends actually made used on
3592 font_update_drivers (f
, new_drivers
)
3594 Lisp_Object new_drivers
;
3596 Lisp_Object active_drivers
= Qnil
;
3597 struct font_driver
*driver
;
3598 struct font_driver_list
*list
;
3600 /* At first, turn off non-requested drivers, and turn on requested
3602 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3604 driver
= list
->driver
;
3605 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3610 if (driver
->end_for_frame
)
3611 driver
->end_for_frame (f
);
3612 font_finish_cache (f
, driver
);
3617 if (! driver
->start_for_frame
3618 || driver
->start_for_frame (f
) == 0)
3620 font_prepare_cache (f
, driver
);
3627 if (NILP (new_drivers
))
3630 if (! EQ (new_drivers
, Qt
))
3632 /* Re-order the driver list according to new_drivers. */
3633 struct font_driver_list
**list_table
, **next
;
3637 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3638 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3640 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3641 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3644 list_table
[i
++] = list
;
3646 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3648 list_table
[i
++] = list
;
3649 list_table
[i
] = NULL
;
3651 next
= &f
->font_driver_list
;
3652 for (i
= 0; list_table
[i
]; i
++)
3654 *next
= list_table
[i
];
3655 next
= &(*next
)->next
;
3660 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3662 active_drivers
= nconc2 (active_drivers
,
3663 Fcons (list
->driver
->type
, Qnil
));
3664 return active_drivers
;
3668 font_put_frame_data (f
, driver
, data
)
3670 struct font_driver
*driver
;
3673 struct font_data_list
*list
, *prev
;
3675 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3676 prev
= list
, list
= list
->next
)
3677 if (list
->driver
== driver
)
3684 prev
->next
= list
->next
;
3686 f
->font_data_list
= list
->next
;
3694 list
= xmalloc (sizeof (struct font_data_list
));
3695 list
->driver
= driver
;
3696 list
->next
= f
->font_data_list
;
3697 f
->font_data_list
= list
;
3705 font_get_frame_data (f
, driver
)
3707 struct font_driver
*driver
;
3709 struct font_data_list
*list
;
3711 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3712 if (list
->driver
== driver
)
3720 /* Return the font used to draw character C by FACE at buffer position
3721 POS in window W. If STRING is non-nil, it is a string containing C
3722 at index POS. If C is negative, get C from the current buffer or
3726 font_at (c
, pos
, face
, w
, string
)
3735 Lisp_Object font_object
;
3737 multibyte
= (NILP (string
)
3738 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3739 : STRING_MULTIBYTE (string
));
3746 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3748 c
= FETCH_CHAR (pos_byte
);
3751 c
= FETCH_BYTE (pos
);
3757 multibyte
= STRING_MULTIBYTE (string
);
3760 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3762 str
= SDATA (string
) + pos_byte
;
3763 c
= STRING_CHAR (str
, 0);
3766 c
= SDATA (string
)[pos
];
3770 f
= XFRAME (w
->frame
);
3771 if (! FRAME_WINDOW_P (f
))
3778 if (STRINGP (string
))
3779 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3780 DEFAULT_FACE_ID
, 0);
3782 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3784 face
= FACE_FROM_ID (f
, face_id
);
3788 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3789 face
= FACE_FROM_ID (f
, face_id
);
3794 XSETFONT (font_object
, face
->font
);
3799 #ifdef HAVE_WINDOW_SYSTEM
3801 /* Check how many characters after POS (at most to *LIMIT) can be
3802 displayed by the same font on the window W. FACE, if non-NULL, is
3803 the face selected for the character at POS. If STRING is not nil,
3804 it is the string to check instead of the current buffer. In that
3805 case, FACE must be not NULL.
3807 The return value is the font-object for the character at POS.
3808 *LIMIT is set to the position where that font can't be used.
3810 It is assured that the current buffer (or STRING) is multibyte. */
3813 font_range (pos
, limit
, w
, face
, string
)
3814 EMACS_INT pos
, *limit
;
3819 EMACS_INT pos_byte
, ignore
, start
, start_byte
;
3821 Lisp_Object font_object
= Qnil
;
3825 pos_byte
= CHAR_TO_BYTE (pos
);
3830 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3832 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3838 pos_byte
= string_char_to_byte (string
, pos
);
3841 start
= pos
, start_byte
= pos_byte
;
3842 while (pos
< *limit
)
3844 Lisp_Object category
;
3847 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3849 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3850 if (NILP (font_object
))
3852 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3853 if (NILP (font_object
))
3858 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3859 if (! EQ (category
, QCf
)
3860 && ! CHAR_VARIATION_SELECTOR_P (c
)
3861 && font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3863 Lisp_Object f
= font_for_char (face
, c
, pos
- 1, string
);
3864 EMACS_INT i
, i_byte
;
3872 i
= start
, i_byte
= start_byte
;
3877 FETCH_CHAR_ADVANCE_NO_CHECK (c
, i
, i_byte
);
3879 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, i
, i_byte
);
3880 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3881 if (! EQ (category
, QCf
)
3882 && ! CHAR_VARIATION_SELECTOR_P (c
)
3883 && font_encode_char (f
, c
) == FONT_INVALID_CODE
)
3899 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3900 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3901 Return nil otherwise.
3902 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3903 which kind of font it is. It must be one of `font-spec', `font-entity',
3905 (object
, extra_type
)
3906 Lisp_Object object
, extra_type
;
3908 if (NILP (extra_type
))
3909 return (FONTP (object
) ? Qt
: Qnil
);
3910 if (EQ (extra_type
, Qfont_spec
))
3911 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3912 if (EQ (extra_type
, Qfont_entity
))
3913 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3914 if (EQ (extra_type
, Qfont_object
))
3915 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3916 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3919 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3920 doc
: /* Return a newly created font-spec with arguments as properties.
3922 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3923 valid font property name listed below:
3925 `:family', `:weight', `:slant', `:width'
3927 They are the same as face attributes of the same name. See
3928 `set-face-attribute'.
3932 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3936 VALUE must be a string or a symbol specifying the additional
3937 typographic style information of a font, e.g. ``sans''.
3941 VALUE must be a string or a symbol specifying the charset registry and
3942 encoding of a font, e.g. ``iso8859-1''.
3946 VALUE must be a non-negative integer or a floating point number
3947 specifying the font size. It specifies the font size in pixels (if
3948 VALUE is an integer), or in points (if VALUE is a float).
3952 VALUE must be a string of XLFD-style or fontconfig-style font name.
3956 VALUE must be a symbol representing a script that the font must
3957 support. It may be a symbol representing a subgroup of a script
3958 listed in the variable `script-representative-chars'.
3962 VALUE must be a symbol of two-letter ISO-639 language names,
3967 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3968 required OpenType features.
3970 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3971 LANGSYS-TAG: OpenType language system tag symbol,
3972 or nil for the default language system.
3973 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3974 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3976 GSUB and GPOS may contain `nil' element. In such a case, the font
3977 must not have any of the remaining elements.
3979 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3980 be an OpenType font, and whose GPOS table of `thai' script's default
3981 language system must contain `mark' feature.
3983 usage: (font-spec ARGS...) */)
3988 Lisp_Object spec
= font_make_spec ();
3991 for (i
= 0; i
< nargs
; i
+= 2)
3993 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3995 if (EQ (key
, QCname
))
3998 font_parse_name ((char *) SDATA (val
), spec
);
3999 font_put_extra (spec
, key
, val
);
4003 int idx
= get_font_prop_index (key
);
4007 val
= font_prop_validate (idx
, Qnil
, val
);
4008 if (idx
< FONT_EXTRA_INDEX
)
4009 ASET (spec
, idx
, val
);
4011 font_put_extra (spec
, key
, val
);
4014 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
4020 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
4021 doc
: /* Return a copy of FONT as a font-spec. */)
4025 Lisp_Object new_spec
, tail
, prev
, extra
;
4029 new_spec
= font_make_spec ();
4030 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
4031 ASET (new_spec
, i
, AREF (font
, i
));
4032 extra
= Fcopy_sequence (AREF (font
, FONT_EXTRA_INDEX
));
4033 /* We must remove :font-entity property. */
4034 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
4035 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
4038 extra
= XCDR (extra
);
4040 XSETCDR (prev
, XCDR (tail
));
4043 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
4047 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
4048 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
4049 Every specified properties in FROM override the corresponding
4050 properties in TO. */)
4052 Lisp_Object from
, to
;
4054 Lisp_Object extra
, tail
;
4059 to
= Fcopy_font_spec (to
);
4060 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
4061 ASET (to
, i
, AREF (from
, i
));
4062 extra
= AREF (to
, FONT_EXTRA_INDEX
);
4063 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
4064 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
4066 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
4069 XSETCDR (slot
, XCDR (XCAR (tail
)));
4071 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
4073 ASET (to
, FONT_EXTRA_INDEX
, extra
);
4077 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
4078 doc
: /* Return the value of FONT's property KEY.
4079 FONT is a font-spec, a font-entity, or a font-object.
4080 KEY must be one of these symbols:
4081 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4082 :size, :name, :script
4083 See the documentation of `font-spec' for their meanings.
4084 If FONT is a font-entity or font-object, the value of :script may be
4085 a list of scripts that are supported by the font. */)
4087 Lisp_Object font
, key
;
4094 idx
= get_font_prop_index (key
);
4095 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4096 return font_style_symbolic (font
, idx
, 0);
4097 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4098 return AREF (font
, idx
);
4099 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
4102 #ifdef HAVE_WINDOW_SYSTEM
4104 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4105 doc
: /* Return a plist of face attributes generated by FONT.
4106 FONT is a font name, a font-spec, a font-entity, or a font-object.
4107 The return value is a list of the form
4109 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4111 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4112 compatible with `set-face-attribute'. Some of these key-attribute pairs
4113 may be omitted from the list if they are not specified by FONT.
4115 The optional argument FRAME specifies the frame that the face attributes
4116 are to be displayed on. If omitted, the selected frame is used. */)
4118 Lisp_Object font
, frame
;
4121 Lisp_Object plist
[10];
4126 frame
= selected_frame
;
4127 CHECK_LIVE_FRAME (frame
);
4132 int fontset
= fs_query_fontset (font
, 0);
4133 Lisp_Object name
= font
;
4135 font
= fontset_ascii (fontset
);
4136 font
= font_spec_from_name (name
);
4138 signal_error ("Invalid font name", name
);
4140 else if (! FONTP (font
))
4141 signal_error ("Invalid font object", font
);
4143 val
= AREF (font
, FONT_FAMILY_INDEX
);
4146 plist
[n
++] = QCfamily
;
4147 plist
[n
++] = SYMBOL_NAME (val
);
4150 val
= AREF (font
, FONT_SIZE_INDEX
);
4153 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4154 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4155 plist
[n
++] = QCheight
;
4156 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4158 else if (FLOATP (val
))
4160 plist
[n
++] = QCheight
;
4161 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4164 val
= FONT_WEIGHT_FOR_FACE (font
);
4167 plist
[n
++] = QCweight
;
4171 val
= FONT_SLANT_FOR_FACE (font
);
4174 plist
[n
++] = QCslant
;
4178 val
= FONT_WIDTH_FOR_FACE (font
);
4181 plist
[n
++] = QCwidth
;
4185 return Flist (n
, plist
);
4190 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4191 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
4192 (font_spec
, prop
, val
)
4193 Lisp_Object font_spec
, prop
, val
;
4197 CHECK_FONT_SPEC (font_spec
);
4198 idx
= get_font_prop_index (prop
);
4199 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4200 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
4202 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
4206 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4207 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4208 Optional 2nd argument FRAME specifies the target frame.
4209 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4210 Optional 4th argument PREFER, if non-nil, is a font-spec to
4211 control the order of the returned list. Fonts are sorted by
4212 how close they are to PREFER. */)
4213 (font_spec
, frame
, num
, prefer
)
4214 Lisp_Object font_spec
, frame
, num
, prefer
;
4216 Lisp_Object vec
, list
, tail
;
4220 frame
= selected_frame
;
4221 CHECK_LIVE_FRAME (frame
);
4222 CHECK_FONT_SPEC (font_spec
);
4230 if (! NILP (prefer
))
4231 CHECK_FONT_SPEC (prefer
);
4233 vec
= font_list_entities (frame
, font_spec
);
4238 return Fcons (AREF (vec
, 0), Qnil
);
4240 if (! NILP (prefer
))
4241 vec
= font_sort_entites (vec
, prefer
, frame
, 0);
4243 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
4244 if (n
== 0 || n
> len
)
4246 for (i
= 1; i
< n
; i
++)
4248 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
4250 XSETCDR (tail
, val
);
4256 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4257 doc
: /* List available font families on the current frame.
4258 Optional argument FRAME, if non-nil, specifies the target frame. */)
4263 struct font_driver_list
*driver_list
;
4267 frame
= selected_frame
;
4268 CHECK_LIVE_FRAME (frame
);
4271 for (driver_list
= f
->font_driver_list
; driver_list
;
4272 driver_list
= driver_list
->next
)
4273 if (driver_list
->driver
->list_family
)
4275 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4276 Lisp_Object tail
= list
;
4278 for (; CONSP (val
); val
= XCDR (val
))
4279 if (NILP (Fmemq (XCAR (val
), tail
))
4280 && SYMBOLP (XCAR (val
)))
4281 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4286 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4287 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4288 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4290 Lisp_Object font_spec
, frame
;
4292 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4299 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4300 doc
: /* Return XLFD name of FONT.
4301 FONT is a font-spec, font-entity, or font-object.
4302 If the name is too long for XLFD (maximum 255 chars), return nil.
4303 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4304 the consecutive wildcards are folded to one. */)
4305 (font
, fold_wildcards
)
4306 Lisp_Object font
, fold_wildcards
;
4313 if (FONT_OBJECT_P (font
))
4315 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4317 if (STRINGP (font_name
)
4318 && SDATA (font_name
)[0] == '-')
4320 if (NILP (fold_wildcards
))
4322 strcpy (name
, (char *) SDATA (font_name
));
4325 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4327 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4330 if (! NILP (fold_wildcards
))
4332 char *p0
= name
, *p1
;
4334 while ((p1
= strstr (p0
, "-*-*")))
4336 strcpy (p1
, p1
+ 2);
4341 return build_string (name
);
4344 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4345 doc
: /* Clear font cache. */)
4348 Lisp_Object list
, frame
;
4350 FOR_EACH_FRAME (list
, frame
)
4352 FRAME_PTR f
= XFRAME (frame
);
4353 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4355 for (; driver_list
; driver_list
= driver_list
->next
)
4356 if (driver_list
->on
)
4358 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4363 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4365 font_assert (! NILP (val
));
4366 val
= XCDR (XCAR (val
));
4367 if (XINT (XCAR (val
)) == 0)
4369 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4370 XSETCDR (cache
, XCDR (val
));
4380 font_fill_lglyph_metrics (glyph
, font_object
)
4381 Lisp_Object glyph
, font_object
;
4383 struct font
*font
= XFONT_OBJECT (font_object
);
4385 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4386 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4387 struct font_metrics metrics
;
4389 LGLYPH_SET_CODE (glyph
, ecode
);
4391 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4392 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4393 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4394 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4395 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4396 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4400 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4401 doc
: /* Shape the glyph-string GSTRING.
4402 Shaping means substituting glyphs and/or adjusting positions of glyphs
4403 to get the correct visual image of character sequences set in the
4404 header of the glyph-string.
4406 If the shaping was successful, the value is GSTRING itself or a newly
4407 created glyph-string. Otherwise, the value is nil. */)
4409 Lisp_Object gstring
;
4412 Lisp_Object font_object
, n
, glyph
;
4415 if (! composition_gstring_p (gstring
))
4416 signal_error ("Invalid glyph-string: ", gstring
);
4417 if (! NILP (LGSTRING_ID (gstring
)))
4419 font_object
= LGSTRING_FONT (gstring
);
4420 CHECK_FONT_OBJECT (font_object
);
4421 font
= XFONT_OBJECT (font_object
);
4422 if (! font
->driver
->shape
)
4425 /* Try at most three times with larger gstring each time. */
4426 for (i
= 0; i
< 3; i
++)
4428 n
= font
->driver
->shape (gstring
);
4431 gstring
= larger_vector (gstring
,
4432 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4435 if (i
== 3 || XINT (n
) == 0)
4438 glyph
= LGSTRING_GLYPH (gstring
, 0);
4439 from
= LGLYPH_FROM (glyph
);
4440 to
= LGLYPH_TO (glyph
);
4441 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4443 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4447 if (NILP (LGLYPH_ADJUSTMENT (this)))
4452 glyph
= LGSTRING_GLYPH (gstring
, j
);
4453 LGLYPH_SET_FROM (glyph
, from
);
4454 LGLYPH_SET_TO (glyph
, to
);
4456 from
= LGLYPH_FROM (this);
4457 to
= LGLYPH_TO (this);
4462 if (from
> LGLYPH_FROM (this))
4463 from
= LGLYPH_FROM (this);
4464 if (to
< LGLYPH_TO (this))
4465 to
= LGLYPH_TO (this);
4471 glyph
= LGSTRING_GLYPH (gstring
, j
);
4472 LGLYPH_SET_FROM (glyph
, from
);
4473 LGLYPH_SET_TO (glyph
, to
);
4475 return composition_gstring_put_cache (gstring
, XINT (n
));
4478 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4480 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4481 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4483 VARIATION-SELECTOR is a chracter code of variation selection
4484 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4485 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4486 (font_object
, character
)
4487 Lisp_Object font_object
, character
;
4489 unsigned variations
[256];
4494 CHECK_FONT_OBJECT (font_object
);
4495 CHECK_CHARACTER (character
);
4496 font
= XFONT_OBJECT (font_object
);
4497 if (! font
->driver
->get_variation_glyphs
)
4499 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4503 for (i
= 0; i
< 255; i
++)
4507 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4508 /* Stops GCC whining about limited range of data type. */
4509 EMACS_INT var
= variations
[i
];
4511 if (var
> MOST_POSITIVE_FIXNUM
)
4512 code
= Fcons (make_number ((variations
[i
]) >> 16),
4513 make_number ((variations
[i
]) & 0xFFFF));
4515 code
= make_number (variations
[i
]);
4516 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4523 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4524 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4525 OTF-FEATURES specifies which features to apply in this format:
4526 (SCRIPT LANGSYS GSUB GPOS)
4528 SCRIPT is a symbol specifying a script tag of OpenType,
4529 LANGSYS is a symbol specifying a langsys tag of OpenType,
4530 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4532 If LANGYS is nil, the default langsys is selected.
4534 The features are applied in the order they appear in the list. The
4535 symbol `*' means to apply all available features not present in this
4536 list, and the remaining features are ignored. For instance, (vatu
4537 pstf * haln) is to apply vatu and pstf in this order, then to apply
4538 all available features other than vatu, pstf, and haln.
4540 The features are applied to the glyphs in the range FROM and TO of
4541 the glyph-string GSTRING-IN.
4543 If some feature is actually applicable, the resulting glyphs are
4544 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4545 this case, the value is the number of produced glyphs.
4547 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4550 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4551 produced in GSTRING-OUT, and the value is nil.
4553 See the documentation of `font-make-gstring' for the format of
4555 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4556 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4558 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4563 check_otf_features (otf_features
);
4564 CHECK_FONT_OBJECT (font_object
);
4565 font
= XFONT_OBJECT (font_object
);
4566 if (! font
->driver
->otf_drive
)
4567 error ("Font backend %s can't drive OpenType GSUB table",
4568 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4569 CHECK_CONS (otf_features
);
4570 CHECK_SYMBOL (XCAR (otf_features
));
4571 val
= XCDR (otf_features
);
4572 CHECK_SYMBOL (XCAR (val
));
4573 val
= XCDR (otf_features
);
4576 len
= check_gstring (gstring_in
);
4577 CHECK_VECTOR (gstring_out
);
4578 CHECK_NATNUM (from
);
4580 CHECK_NATNUM (index
);
4582 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4583 args_out_of_range_3 (from
, to
, make_number (len
));
4584 if (XINT (index
) >= ASIZE (gstring_out
))
4585 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4586 num
= font
->driver
->otf_drive (font
, otf_features
,
4587 gstring_in
, XINT (from
), XINT (to
),
4588 gstring_out
, XINT (index
), 0);
4591 return make_number (num
);
4594 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4596 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4597 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4599 (SCRIPT LANGSYS FEATURE ...)
4600 See the documentation of `font-drive-otf' for more detail.
4602 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4603 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4604 character code corresponding to the glyph or nil if there's no
4605 corresponding character. */)
4606 (font_object
, character
, otf_features
)
4607 Lisp_Object font_object
, character
, otf_features
;
4610 Lisp_Object gstring_in
, gstring_out
, g
;
4611 Lisp_Object alternates
;
4614 CHECK_FONT_GET_OBJECT (font_object
, font
);
4615 if (! font
->driver
->otf_drive
)
4616 error ("Font backend %s can't drive OpenType GSUB table",
4617 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4618 CHECK_CHARACTER (character
);
4619 CHECK_CONS (otf_features
);
4621 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4622 g
= LGSTRING_GLYPH (gstring_in
, 0);
4623 LGLYPH_SET_CHAR (g
, XINT (character
));
4624 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4625 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4626 gstring_out
, 0, 1)) < 0)
4627 gstring_out
= Ffont_make_gstring (font_object
,
4628 make_number (ASIZE (gstring_out
) * 2));
4630 for (i
= 0; i
< num
; i
++)
4632 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4633 int c
= LGLYPH_CHAR (g
);
4634 unsigned code
= LGLYPH_CODE (g
);
4636 alternates
= Fcons (Fcons (make_number (code
),
4637 c
> 0 ? make_number (c
) : Qnil
),
4640 return Fnreverse (alternates
);
4646 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4647 doc
: /* Open FONT-ENTITY. */)
4648 (font_entity
, size
, frame
)
4649 Lisp_Object font_entity
;
4655 CHECK_FONT_ENTITY (font_entity
);
4657 frame
= selected_frame
;
4658 CHECK_LIVE_FRAME (frame
);
4661 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4664 CHECK_NUMBER_OR_FLOAT (size
);
4666 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4668 isize
= XINT (size
);
4672 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4675 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4676 doc
: /* Close FONT-OBJECT. */)
4677 (font_object
, frame
)
4678 Lisp_Object font_object
, frame
;
4680 CHECK_FONT_OBJECT (font_object
);
4682 frame
= selected_frame
;
4683 CHECK_LIVE_FRAME (frame
);
4684 font_close_object (XFRAME (frame
), font_object
);
4688 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4689 doc
: /* Return information about FONT-OBJECT.
4690 The value is a vector:
4691 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4694 NAME is a string of the font name (or nil if the font backend doesn't
4697 FILENAME is a string of the font file (or nil if the font backend
4698 doesn't provide a file name).
4700 PIXEL-SIZE is a pixel size by which the font is opened.
4702 SIZE is a maximum advance width of the font in pixels.
4704 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4707 CAPABILITY is a list whose first element is a symbol representing the
4708 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4709 remaining elements describe the details of the font capability.
4711 If the font is OpenType font, the form of the list is
4712 \(opentype GSUB GPOS)
4713 where GSUB shows which "GSUB" features the font supports, and GPOS
4714 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4715 lists of the format:
4716 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4718 If the font is not OpenType font, currently the length of the form is
4721 SCRIPT is a symbol representing OpenType script tag.
4723 LANGSYS is a symbol representing OpenType langsys tag, or nil
4724 representing the default langsys.
4726 FEATURE is a symbol representing OpenType feature tag.
4728 If the font is not OpenType font, CAPABILITY is nil. */)
4730 Lisp_Object font_object
;
4735 CHECK_FONT_GET_OBJECT (font_object
, font
);
4737 val
= Fmake_vector (make_number (9), Qnil
);
4738 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4739 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4740 ASET (val
, 2, make_number (font
->pixel_size
));
4741 ASET (val
, 3, make_number (font
->max_width
));
4742 ASET (val
, 4, make_number (font
->ascent
));
4743 ASET (val
, 5, make_number (font
->descent
));
4744 ASET (val
, 6, make_number (font
->space_width
));
4745 ASET (val
, 7, make_number (font
->average_width
));
4746 if (font
->driver
->otf_capability
)
4747 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4751 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4752 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4753 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4754 (font_object
, string
)
4755 Lisp_Object font_object
, string
;
4761 CHECK_FONT_GET_OBJECT (font_object
, font
);
4762 CHECK_STRING (string
);
4763 len
= SCHARS (string
);
4764 vec
= Fmake_vector (make_number (len
), Qnil
);
4765 for (i
= 0; i
< len
; i
++)
4767 Lisp_Object ch
= Faref (string
, make_number (i
));
4772 struct font_metrics metrics
;
4774 cod
= code
= font
->driver
->encode_char (font
, c
);
4775 if (code
== FONT_INVALID_CODE
)
4777 val
= Fmake_vector (make_number (6), Qnil
);
4778 if (cod
<= MOST_POSITIVE_FIXNUM
)
4779 ASET (val
, 0, make_number (code
));
4781 ASET (val
, 0, Fcons (make_number (code
>> 16),
4782 make_number (code
& 0xFFFF)));
4783 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4784 ASET (val
, 1, make_number (metrics
.lbearing
));
4785 ASET (val
, 2, make_number (metrics
.rbearing
));
4786 ASET (val
, 3, make_number (metrics
.width
));
4787 ASET (val
, 4, make_number (metrics
.ascent
));
4788 ASET (val
, 5, make_number (metrics
.descent
));
4794 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4795 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4796 FONT is a font-spec, font-entity, or font-object. */)
4798 Lisp_Object spec
, font
;
4800 CHECK_FONT_SPEC (spec
);
4803 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4806 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4807 doc
: /* Return a font-object for displaying a character at POSITION.
4808 Optional second arg WINDOW, if non-nil, is a window displaying
4809 the current buffer. It defaults to the currently selected window. */)
4810 (position
, window
, string
)
4811 Lisp_Object position
, window
, string
;
4818 CHECK_NUMBER_COERCE_MARKER (position
);
4819 pos
= XINT (position
);
4820 if (pos
< BEGV
|| pos
>= ZV
)
4821 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4825 CHECK_NUMBER (position
);
4826 CHECK_STRING (string
);
4827 pos
= XINT (position
);
4828 if (pos
< 0 || pos
>= SCHARS (string
))
4829 args_out_of_range (string
, position
);
4832 window
= selected_window
;
4833 CHECK_LIVE_WINDOW (window
);
4834 w
= XWINDOW (window
);
4836 return font_at (-1, pos
, NULL
, w
, string
);
4840 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4841 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4842 The value is a number of glyphs drawn.
4843 Type C-l to recover what previously shown. */)
4844 (font_object
, string
)
4845 Lisp_Object font_object
, string
;
4847 Lisp_Object frame
= selected_frame
;
4848 FRAME_PTR f
= XFRAME (frame
);
4854 CHECK_FONT_GET_OBJECT (font_object
, font
);
4855 CHECK_STRING (string
);
4856 len
= SCHARS (string
);
4857 code
= alloca (sizeof (unsigned) * len
);
4858 for (i
= 0; i
< len
; i
++)
4860 Lisp_Object ch
= Faref (string
, make_number (i
));
4864 code
[i
] = font
->driver
->encode_char (font
, c
);
4865 if (code
[i
] == FONT_INVALID_CODE
)
4868 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4870 if (font
->driver
->prepare_face
)
4871 font
->driver
->prepare_face (f
, face
);
4872 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4873 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4874 if (font
->driver
->done_face
)
4875 font
->driver
->done_face (f
, face
);
4877 return make_number (len
);
4881 #endif /* FONT_DEBUG */
4883 #ifdef HAVE_WINDOW_SYSTEM
4885 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4886 doc
: /* Return information about a font named NAME on frame FRAME.
4887 If FRAME is omitted or nil, use the selected frame.
4888 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4889 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4891 OPENED-NAME is the name used for opening the font,
4892 FULL-NAME is the full name of the font,
4893 SIZE is the pixelsize of the font,
4894 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4895 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4896 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4897 how to compose characters.
4898 If the named font is not yet loaded, return nil. */)
4900 Lisp_Object name
, frame
;
4905 Lisp_Object font_object
;
4907 (*check_window_system_func
) ();
4910 CHECK_STRING (name
);
4912 frame
= selected_frame
;
4913 CHECK_LIVE_FRAME (frame
);
4918 int fontset
= fs_query_fontset (name
, 0);
4921 name
= fontset_ascii (fontset
);
4922 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4924 else if (FONT_OBJECT_P (name
))
4926 else if (FONT_ENTITY_P (name
))
4927 font_object
= font_open_entity (f
, name
, 0);
4930 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4931 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4933 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4935 if (NILP (font_object
))
4937 font
= XFONT_OBJECT (font_object
);
4939 info
= Fmake_vector (make_number (7), Qnil
);
4940 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4941 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
4942 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4943 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4944 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4945 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4946 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4949 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4950 close it now. Perhaps, we should manage font-objects
4951 by `reference-count'. */
4952 font_close_object (f
, font_object
);
4959 #define BUILD_STYLE_TABLE(TBL) \
4960 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4963 build_style_table (entry
, nelement
)
4964 struct table_entry
*entry
;
4968 Lisp_Object table
, elt
;
4970 table
= Fmake_vector (make_number (nelement
), Qnil
);
4971 for (i
= 0; i
< nelement
; i
++)
4973 for (j
= 0; entry
[i
].names
[j
]; j
++);
4974 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4975 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4976 for (j
= 0; entry
[i
].names
[j
]; j
++)
4977 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4978 ASET (table
, i
, elt
);
4983 static Lisp_Object Vfont_log
;
4984 static int font_log_env_checked
;
4986 /* The deferred font-log data of the form [ACTION ARG RESULT].
4987 If ACTION is not nil, that is added to the log when font_add_log is
4988 called next time. At that time, ACTION is set back to nil. */
4989 static Lisp_Object Vfont_log_deferred
;
4991 /* Prepend the font-related logging data in Vfont_log if it is not
4992 `t'. ACTION describes a kind of font-related action (e.g. listing,
4993 opening), ARG is the argument for the action, and RESULT is the
4994 result of the action. */
4996 font_add_log (action
, arg
, result
)
4998 Lisp_Object arg
, result
;
5000 Lisp_Object tail
, val
;
5003 if (! font_log_env_checked
)
5005 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
5006 font_log_env_checked
= 1;
5008 if (EQ (Vfont_log
, Qt
))
5010 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5012 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
5014 ASET (Vfont_log_deferred
, 0, Qnil
);
5015 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5016 AREF (Vfont_log_deferred
, 2));
5021 Lisp_Object tail
, elt
;
5022 Lisp_Object equalstr
= build_string ("=");
5024 val
= Ffont_xlfd_name (arg
, Qt
);
5025 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5029 if (EQ (XCAR (elt
), QCscript
)
5030 && SYMBOLP (XCDR (elt
)))
5031 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5032 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5033 else if (EQ (XCAR (elt
), QClang
)
5034 && SYMBOLP (XCDR (elt
)))
5035 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5036 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5037 else if (EQ (XCAR (elt
), QCotf
)
5038 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5039 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5041 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5047 val
= Ffont_xlfd_name (result
, Qt
);
5048 if (! FONT_SPEC_P (result
))
5049 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5050 build_string (":"), val
);
5053 else if (CONSP (result
))
5055 result
= Fcopy_sequence (result
);
5056 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5060 val
= Ffont_xlfd_name (val
, Qt
);
5061 XSETCAR (tail
, val
);
5064 else if (VECTORP (result
))
5066 result
= Fcopy_sequence (result
);
5067 for (i
= 0; i
< ASIZE (result
); i
++)
5069 val
= AREF (result
, i
);
5071 val
= Ffont_xlfd_name (val
, Qt
);
5072 ASET (result
, i
, val
);
5075 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5078 /* Record a font-related logging data to be added to Vfont_log when
5079 font_add_log is called next time. ACTION, ARG, RESULT are the same
5083 font_deferred_log (action
, arg
, result
)
5085 Lisp_Object arg
, result
;
5087 ASET (Vfont_log_deferred
, 0, build_string (action
));
5088 ASET (Vfont_log_deferred
, 1, arg
);
5089 ASET (Vfont_log_deferred
, 2, result
);
5092 extern void syms_of_ftfont
P_ (());
5093 extern void syms_of_xfont
P_ (());
5094 extern void syms_of_xftfont
P_ (());
5095 extern void syms_of_ftxfont
P_ (());
5096 extern void syms_of_bdffont
P_ (());
5097 extern void syms_of_w32font
P_ (());
5098 extern void syms_of_atmfont
P_ (());
5099 extern void syms_of_nsfont
P_ (());
5104 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5105 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5106 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5107 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5108 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5109 /* Note that the other elements in sort_shift_bits are not used. */
5111 staticpro (&font_charset_alist
);
5112 font_charset_alist
= Qnil
;
5114 DEFSYM (Qopentype
, "opentype");
5116 DEFSYM (Qascii_0
, "ascii-0");
5117 DEFSYM (Qiso8859_1
, "iso8859-1");
5118 DEFSYM (Qiso10646_1
, "iso10646-1");
5119 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5120 DEFSYM (Qunicode_sip
, "unicode-sip");
5124 DEFSYM (QCotf
, ":otf");
5125 DEFSYM (QClang
, ":lang");
5126 DEFSYM (QCscript
, ":script");
5127 DEFSYM (QCantialias
, ":antialias");
5129 DEFSYM (QCfoundry
, ":foundry");
5130 DEFSYM (QCadstyle
, ":adstyle");
5131 DEFSYM (QCregistry
, ":registry");
5132 DEFSYM (QCspacing
, ":spacing");
5133 DEFSYM (QCdpi
, ":dpi");
5134 DEFSYM (QCscalable
, ":scalable");
5135 DEFSYM (QCavgwidth
, ":avgwidth");
5136 DEFSYM (QCfont_entity
, ":font-entity");
5137 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5147 staticpro (&null_vector
);
5148 null_vector
= Fmake_vector (make_number (0), Qnil
);
5150 staticpro (&scratch_font_spec
);
5151 scratch_font_spec
= Ffont_spec (0, NULL
);
5152 staticpro (&scratch_font_prefer
);
5153 scratch_font_prefer
= Ffont_spec (0, NULL
);
5155 staticpro (&Vfont_log_deferred
);
5156 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5160 staticpro (&otf_list
);
5162 #endif /* HAVE_LIBOTF */
5166 defsubr (&Sfont_spec
);
5167 defsubr (&Sfont_get
);
5168 #ifdef HAVE_WINDOW_SYSTEM
5169 defsubr (&Sfont_face_attributes
);
5171 defsubr (&Sfont_put
);
5172 defsubr (&Slist_fonts
);
5173 defsubr (&Sfont_family_list
);
5174 defsubr (&Sfind_font
);
5175 defsubr (&Sfont_xlfd_name
);
5176 defsubr (&Sclear_font_cache
);
5177 defsubr (&Sfont_shape_gstring
);
5178 defsubr (&Sfont_variation_glyphs
);
5180 defsubr (&Sfont_drive_otf
);
5181 defsubr (&Sfont_otf_alternates
);
5185 defsubr (&Sopen_font
);
5186 defsubr (&Sclose_font
);
5187 defsubr (&Squery_font
);
5188 defsubr (&Sget_font_glyphs
);
5189 defsubr (&Sfont_match_p
);
5190 defsubr (&Sfont_at
);
5192 defsubr (&Sdraw_string
);
5194 #endif /* FONT_DEBUG */
5195 #ifdef HAVE_WINDOW_SYSTEM
5196 defsubr (&Sfont_info
);
5199 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5201 Alist of fontname patterns vs the corresponding encoding and repertory info.
5202 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5203 where ENCODING is a charset or a char-table,
5204 and REPERTORY is a charset, a char-table, or nil.
5206 If ENCODING and REPERTORY are the same, the element can have the form
5207 \(REGEXP . ENCODING).
5209 ENCODING is for converting a character to a glyph code of the font.
5210 If ENCODING is a charset, encoding a character by the charset gives
5211 the corresponding glyph code. If ENCODING is a char-table, looking up
5212 the table by a character gives the corresponding glyph code.
5214 REPERTORY specifies a repertory of characters supported by the font.
5215 If REPERTORY is a charset, all characters beloging to the charset are
5216 supported. If REPERTORY is a char-table, all characters who have a
5217 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5218 gets the repertory information by an opened font and ENCODING. */);
5219 Vfont_encoding_alist
= Qnil
;
5221 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5222 doc
: /* Vector of valid font weight values.
5223 Each element has the form:
5224 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5225 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5226 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5228 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5229 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5230 See `font-weight-table' for the format of the vector. */);
5231 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5233 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5234 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5235 See `font-weight-table' for the format of the vector. */);
5236 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5238 staticpro (&font_style_table
);
5239 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5240 ASET (font_style_table
, 0, Vfont_weight_table
);
5241 ASET (font_style_table
, 1, Vfont_slant_table
);
5242 ASET (font_style_table
, 2, Vfont_width_table
);
5244 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5245 *Logging list of font related actions and results.
5246 The value t means to suppress the logging.
5247 The initial value is set to nil if the environment variable
5248 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5251 #ifdef HAVE_WINDOW_SYSTEM
5252 #ifdef HAVE_FREETYPE
5254 #ifdef HAVE_X_WINDOWS
5259 #endif /* HAVE_XFT */
5260 #endif /* HAVE_X_WINDOWS */
5261 #else /* not HAVE_FREETYPE */
5262 #ifdef HAVE_X_WINDOWS
5264 #endif /* HAVE_X_WINDOWS */
5265 #endif /* not HAVE_FREETYPE */
5268 #endif /* HAVE_BDFFONT */
5271 #endif /* WINDOWSNT */
5274 #endif /* HAVE_NS */
5275 #endif /* HAVE_WINDOW_SYSTEM */
5278 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5279 (do not change this comment) */