1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
3 Copyright (C) 2006, 2007, 2008, 2009, 2010
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/>. */
32 #include "dispextern.h"
34 #include "character.h"
35 #include "composite.h"
41 #endif /* HAVE_X_WINDOWS */
45 #endif /* HAVE_NTGUI */
51 Lisp_Object Qopentype
;
53 /* Important character set strings. */
54 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
56 #define DEFAULT_ENCODING Qiso8859_1
58 /* Unicode category `Cf'. */
59 static Lisp_Object QCf
;
61 /* Special vector of zero length. This is repeatedly used by (struct
62 font_driver *)->list when a specified font is not found. */
63 static Lisp_Object null_vector
;
65 static Lisp_Object Vfont_weight_table
, Vfont_slant_table
, Vfont_width_table
;
67 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
68 static Lisp_Object font_style_table
;
70 /* Structure used for tables mapping weight, slant, and width numeric
71 values and their names. */
76 /* The first one is a valid name as a face attribute.
77 The second one (if any) is a typical name in XLFD field. */
81 /* Table of weight numeric values and their names. This table must be
82 sorted by numeric values in ascending order. */
84 static const struct table_entry weight_table
[] =
87 { 20, { "ultra-light", "ultralight" }},
88 { 40, { "extra-light", "extralight" }},
90 { 75, { "semi-light", "semilight", "demilight", "book" }},
91 { 100, { "normal", "medium", "regular", "unspecified" }},
92 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
94 { 205, { "extra-bold", "extrabold" }},
95 { 210, { "ultra-bold", "ultrabold", "black" }}
98 /* Table of slant numeric values and their names. This table must be
99 sorted by numeric values in ascending order. */
101 static const struct table_entry slant_table
[] =
103 { 0, { "reverse-oblique", "ro" }},
104 { 10, { "reverse-italic", "ri" }},
105 { 100, { "normal", "r", "unspecified" }},
106 { 200, { "italic" ,"i", "ot" }},
107 { 210, { "oblique", "o" }}
110 /* Table of width numeric values and their names. This table must be
111 sorted by numeric values in ascending order. */
113 static const struct table_entry width_table
[] =
115 { 50, { "ultra-condensed", "ultracondensed" }},
116 { 63, { "extra-condensed", "extracondensed" }},
117 { 75, { "condensed", "compressed", "narrow" }},
118 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
119 { 100, { "normal", "medium", "regular", "unspecified" }},
120 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
121 { 125, { "expanded" }},
122 { 150, { "extra-expanded", "extraexpanded" }},
123 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
126 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
;
127 /* Symbols representing keys of font extra info. */
128 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
129 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
130 /* Symbols representing values of font spacing property. */
131 Lisp_Object Qc
, Qm
, Qp
, Qd
;
132 /* Special ADSTYLE properties to avoid fonts used for Latin
133 characters; used in xfont.c and ftfont.c. */
134 Lisp_Object Qja
, Qko
;
136 Lisp_Object QCuser_spec
;
138 Lisp_Object Vfont_encoding_alist
;
140 /* Alist of font registry symbol and the corresponding charsets
141 information. The information is retrieved from
142 Vfont_encoding_alist on demand.
144 Eash element has the form:
145 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
149 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
150 encodes a character code to a glyph code of a font, and
151 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
152 character is supported by a font.
154 The latter form means that the information for REGISTRY couldn't be
156 static Lisp_Object font_charset_alist
;
158 /* List of all font drivers. Each font-backend (XXXfont.c) calls
159 register_font_driver in syms_of_XXXfont to register its font-driver
161 static struct font_driver_list
*font_driver_list
;
165 /* Creaters of font-related Lisp object. */
168 font_make_spec (void)
170 Lisp_Object font_spec
;
171 struct font_spec
*spec
172 = ((struct font_spec
*)
173 allocate_pseudovector (VECSIZE (struct font_spec
),
174 FONT_SPEC_MAX
, PVEC_FONT
));
175 XSETFONT (font_spec
, spec
);
180 font_make_entity (void)
182 Lisp_Object font_entity
;
183 struct font_entity
*entity
184 = ((struct font_entity
*)
185 allocate_pseudovector (VECSIZE (struct font_entity
),
186 FONT_ENTITY_MAX
, PVEC_FONT
));
187 XSETFONT (font_entity
, entity
);
191 /* Create a font-object whose structure size is SIZE. If ENTITY is
192 not nil, copy properties from ENTITY to the font-object. If
193 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
195 font_make_object (int size
, Lisp_Object entity
, int pixelsize
)
197 Lisp_Object font_object
;
199 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
202 XSETFONT (font_object
, font
);
206 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
207 font
->props
[i
] = AREF (entity
, i
);
208 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
209 font
->props
[FONT_EXTRA_INDEX
]
210 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
213 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
219 static int font_pixel_size (FRAME_PTR f
, Lisp_Object
);
220 static Lisp_Object
font_open_entity (FRAME_PTR
, Lisp_Object
, int);
221 static Lisp_Object
font_matching_entity (FRAME_PTR
, Lisp_Object
*,
224 /* Number of registered font drivers. */
225 static int num_font_drivers
;
228 /* Return a Lispy value of a font property value at STR and LEN bytes.
229 If STR is "*", it returns nil.
230 If FORCE_SYMBOL is zero and all characters in STR are digits, it
231 returns an integer. Otherwise, it returns a symbol interned from
235 font_intern_prop (const char *str
, int len
, int force_symbol
)
242 if (len
== 1 && *str
== '*')
244 if (!force_symbol
&& len
>=1 && isdigit (*str
))
246 for (i
= 1; i
< len
; i
++)
247 if (! isdigit (str
[i
]))
250 return make_number (atoi (str
));
253 /* The following code is copied from the function intern (in
254 lread.c), and modified to suite our purpose. */
256 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
257 obarray
= check_obarray (obarray
);
258 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
259 if (len
== nchars
|| len
!= nbytes
)
260 /* CONTENTS contains no multibyte sequences or contains an invalid
261 multibyte sequence. We'll make a unibyte string. */
262 tem
= oblookup (obarray
, str
, len
, len
);
264 tem
= oblookup (obarray
, str
, nchars
, len
);
267 if (len
== nchars
|| len
!= nbytes
)
268 tem
= make_unibyte_string (str
, len
);
270 tem
= make_multibyte_string (str
, nchars
, len
);
271 return Fintern (tem
, obarray
);
274 /* Return a pixel size of font-spec SPEC on frame F. */
277 font_pixel_size (FRAME_PTR f
, Lisp_Object spec
)
279 #ifdef HAVE_WINDOW_SYSTEM
280 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
289 font_assert (FLOATP (size
));
290 point_size
= XFLOAT_DATA (size
);
291 val
= AREF (spec
, FONT_DPI_INDEX
);
296 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
304 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
305 font vector. If VAL is not valid (i.e. not registered in
306 font_style_table), return -1 if NOERROR is zero, and return a
307 proper index if NOERROR is nonzero. In that case, register VAL in
308 font_style_table if VAL is a symbol, and return a closest index if
309 VAL is an integer. */
312 font_style_to_value (enum font_property_index prop
, Lisp_Object val
, int noerror
)
314 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
315 int len
= ASIZE (table
);
321 Lisp_Object args
[2], elt
;
323 /* At first try exact match. */
324 for (i
= 0; i
< len
; i
++)
325 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
326 if (EQ (val
, AREF (AREF (table
, i
), j
)))
327 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
328 | (i
<< 4) | (j
- 1));
329 /* Try also with case-folding match. */
330 s
= SDATA (SYMBOL_NAME (val
));
331 for (i
= 0; i
< len
; i
++)
332 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
334 elt
= AREF (AREF (table
, i
), j
);
335 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
336 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
337 | (i
<< 4) | (j
- 1));
343 elt
= Fmake_vector (make_number (2), make_number (100));
346 args
[1] = Fmake_vector (make_number (1), elt
);
347 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
348 return (100 << 8) | (i
<< 4);
353 int numeric
= XINT (val
);
355 for (i
= 0, last_n
= -1; i
< len
; i
++)
357 int n
= XINT (AREF (AREF (table
, i
), 0));
360 return (n
<< 8) | (i
<< 4);
365 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
366 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
372 return ((last_n
<< 8) | ((i
- 1) << 4));
377 font_style_symbolic (Lisp_Object font
, enum font_property_index prop
, int for_face
)
379 Lisp_Object val
= AREF (font
, prop
);
380 Lisp_Object table
, elt
;
385 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
386 i
= XINT (val
) & 0xFF;
387 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
388 elt
= AREF (table
, ((i
>> 4) & 0xF));
389 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
390 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
393 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
394 FONTNAME. ENCODING is a charset symbol that specifies the encoding
395 of the font. REPERTORY is a charset symbol or nil. */
398 find_font_encoding (Lisp_Object fontname
)
400 Lisp_Object tail
, elt
;
402 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
406 && STRINGP (XCAR (elt
))
407 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
408 && (SYMBOLP (XCDR (elt
))
409 ? CHARSETP (XCDR (elt
))
410 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
416 /* Return encoding charset and repertory charset for REGISTRY in
417 ENCODING and REPERTORY correspondingly. If correct information for
418 REGISTRY is available, return 0. Otherwise return -1. */
421 font_registry_charsets (Lisp_Object registry
, struct charset
**encoding
, struct charset
**repertory
)
424 int encoding_id
, repertory_id
;
426 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
432 encoding_id
= XINT (XCAR (val
));
433 repertory_id
= XINT (XCDR (val
));
437 val
= find_font_encoding (SYMBOL_NAME (registry
));
438 if (SYMBOLP (val
) && CHARSETP (val
))
440 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
442 else if (CONSP (val
))
444 if (! CHARSETP (XCAR (val
)))
446 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
447 if (NILP (XCDR (val
)))
451 if (! CHARSETP (XCDR (val
)))
453 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
458 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
460 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
464 *encoding
= CHARSET_FROM_ID (encoding_id
);
466 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
471 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
476 /* Font property value validaters. See the comment of
477 font_property_table for the meaning of the arguments. */
479 static Lisp_Object
font_prop_validate (int, Lisp_Object
, Lisp_Object
);
480 static Lisp_Object
font_prop_validate_symbol (Lisp_Object
, Lisp_Object
);
481 static Lisp_Object
font_prop_validate_style (Lisp_Object
, Lisp_Object
);
482 static Lisp_Object
font_prop_validate_non_neg (Lisp_Object
, Lisp_Object
);
483 static Lisp_Object
font_prop_validate_spacing (Lisp_Object
, Lisp_Object
);
484 static int get_font_prop_index (Lisp_Object
);
487 font_prop_validate_symbol (Lisp_Object prop
, Lisp_Object val
)
490 val
= Fintern (val
, Qnil
);
493 else if (EQ (prop
, QCregistry
))
494 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
500 font_prop_validate_style (Lisp_Object style
, Lisp_Object val
)
502 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
503 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
510 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
514 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
516 if ((n
& 0xF) + 1 >= ASIZE (elt
))
518 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
522 else if (SYMBOLP (val
))
524 int n
= font_style_to_value (prop
, val
, 0);
526 val
= n
>= 0 ? make_number (n
) : Qerror
;
534 font_prop_validate_non_neg (Lisp_Object prop
, Lisp_Object val
)
536 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
541 font_prop_validate_spacing (Lisp_Object prop
, Lisp_Object val
)
543 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
545 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
547 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
549 if (spacing
== 'c' || spacing
== 'C')
550 return make_number (FONT_SPACING_CHARCELL
);
551 if (spacing
== 'm' || spacing
== 'M')
552 return make_number (FONT_SPACING_MONO
);
553 if (spacing
== 'p' || spacing
== 'P')
554 return make_number (FONT_SPACING_PROPORTIONAL
);
555 if (spacing
== 'd' || spacing
== 'D')
556 return make_number (FONT_SPACING_DUAL
);
562 font_prop_validate_otf (Lisp_Object prop
, Lisp_Object val
)
564 Lisp_Object tail
, tmp
;
567 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
568 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
569 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
572 if (! SYMBOLP (XCAR (val
)))
577 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
579 for (i
= 0; i
< 2; i
++)
586 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
587 if (! SYMBOLP (XCAR (tmp
)))
595 /* Structure of known font property keys and validater of the
599 /* Pointer to the key symbol. */
601 /* Function to validate PROP's value VAL, or NULL if any value is
602 ok. The value is VAL or its regularized value if VAL is valid,
603 and Qerror if not. */
604 Lisp_Object (*validater
) (Lisp_Object prop
, Lisp_Object val
);
605 } font_property_table
[] =
606 { { &QCtype
, font_prop_validate_symbol
},
607 { &QCfoundry
, font_prop_validate_symbol
},
608 { &QCfamily
, font_prop_validate_symbol
},
609 { &QCadstyle
, font_prop_validate_symbol
},
610 { &QCregistry
, font_prop_validate_symbol
},
611 { &QCweight
, font_prop_validate_style
},
612 { &QCslant
, font_prop_validate_style
},
613 { &QCwidth
, font_prop_validate_style
},
614 { &QCsize
, font_prop_validate_non_neg
},
615 { &QCdpi
, font_prop_validate_non_neg
},
616 { &QCspacing
, font_prop_validate_spacing
},
617 { &QCavgwidth
, font_prop_validate_non_neg
},
618 /* The order of the above entries must match with enum
619 font_property_index. */
620 { &QClang
, font_prop_validate_symbol
},
621 { &QCscript
, font_prop_validate_symbol
},
622 { &QCotf
, font_prop_validate_otf
}
625 /* Size (number of elements) of the above table. */
626 #define FONT_PROPERTY_TABLE_SIZE \
627 ((sizeof font_property_table) / (sizeof *font_property_table))
629 /* Return an index number of font property KEY or -1 if KEY is not an
630 already known property. */
633 get_font_prop_index (Lisp_Object key
)
637 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
638 if (EQ (key
, *font_property_table
[i
].key
))
643 /* Validate the font property. The property key is specified by the
644 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
645 signal an error. The value is VAL or the regularized one. */
648 font_prop_validate (int idx
, Lisp_Object prop
, Lisp_Object val
)
650 Lisp_Object validated
;
655 prop
= *font_property_table
[idx
].key
;
658 idx
= get_font_prop_index (prop
);
662 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
663 if (EQ (validated
, Qerror
))
664 signal_error ("invalid font property", Fcons (prop
, val
));
669 /* Store VAL as a value of extra font property PROP in FONT while
670 keeping the sorting order. Don't check the validity of VAL. */
673 font_put_extra (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
675 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
676 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
680 Lisp_Object prev
= Qnil
;
683 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
684 prev
= extra
, extra
= XCDR (extra
);
687 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
689 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
695 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
700 /* Font name parser and unparser */
702 static int parse_matrix (const char *);
703 static int font_expand_wildcards (Lisp_Object
*, int);
704 static int font_parse_name (const char *, Lisp_Object
);
706 /* An enumerator for each field of an XLFD font name. */
707 enum xlfd_field_index
726 /* An enumerator for mask bit corresponding to each XLFD field. */
729 XLFD_FOUNDRY_MASK
= 0x0001,
730 XLFD_FAMILY_MASK
= 0x0002,
731 XLFD_WEIGHT_MASK
= 0x0004,
732 XLFD_SLANT_MASK
= 0x0008,
733 XLFD_SWIDTH_MASK
= 0x0010,
734 XLFD_ADSTYLE_MASK
= 0x0020,
735 XLFD_PIXEL_MASK
= 0x0040,
736 XLFD_POINT_MASK
= 0x0080,
737 XLFD_RESX_MASK
= 0x0100,
738 XLFD_RESY_MASK
= 0x0200,
739 XLFD_SPACING_MASK
= 0x0400,
740 XLFD_AVGWIDTH_MASK
= 0x0800,
741 XLFD_REGISTRY_MASK
= 0x1000,
742 XLFD_ENCODING_MASK
= 0x2000
746 /* Parse P pointing the pixel/point size field of the form
747 `[A B C D]' which specifies a transformation matrix:
753 by which all glyphs of the font are transformed. The spec says
754 that scalar value N for the pixel/point size is equivalent to:
755 A = N * resx/resy, B = C = 0, D = N.
757 Return the scalar value N if the form is valid. Otherwise return
761 parse_matrix (const char *p
)
767 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
770 matrix
[i
] = - strtod (p
+ 1, &end
);
772 matrix
[i
] = strtod (p
, &end
);
775 return (i
== 4 ? (int) matrix
[3] : -1);
778 /* Expand a wildcard field in FIELD (the first N fields are filled) to
779 multiple fields to fill in all 14 XLFD fields while restring a
780 field position by its contents. */
783 font_expand_wildcards (Lisp_Object
*field
, int n
)
786 Lisp_Object tmp
[XLFD_LAST_INDEX
];
787 /* Array of information about where this element can go. Nth
788 element is for Nth element of FIELD. */
790 /* Minimum possible field. */
792 /* Maxinum possible field. */
794 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
796 } range
[XLFD_LAST_INDEX
];
798 int range_from
, range_to
;
801 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
802 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
803 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
804 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
805 | XLFD_AVGWIDTH_MASK)
806 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
808 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
809 field. The value is shifted to left one bit by one in the
811 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
812 range_mask
= (range_mask
<< 1) | 1;
814 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
815 position-based retriction for FIELD[I]. */
816 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
817 i
++, range_from
++, range_to
++, range_mask
<<= 1)
819 Lisp_Object val
= field
[i
];
825 range
[i
].from
= range_from
;
826 range
[i
].to
= range_to
;
827 range
[i
].mask
= range_mask
;
831 /* The triplet FROM, TO, and MASK is a value-based
832 retriction for FIELD[I]. */
838 int numeric
= XINT (val
);
841 from
= to
= XLFD_ENCODING_INDEX
,
842 mask
= XLFD_ENCODING_MASK
;
843 else if (numeric
== 0)
844 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
845 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
846 else if (numeric
<= 48)
847 from
= to
= XLFD_PIXEL_INDEX
,
848 mask
= XLFD_PIXEL_MASK
;
850 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
851 mask
= XLFD_LARGENUM_MASK
;
853 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
854 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
855 mask
= XLFD_NULL_MASK
;
857 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
860 Lisp_Object name
= SYMBOL_NAME (val
);
862 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
863 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
864 mask
= XLFD_REGENC_MASK
;
866 from
= to
= XLFD_ENCODING_INDEX
,
867 mask
= XLFD_ENCODING_MASK
;
869 else if (range_from
<= XLFD_WEIGHT_INDEX
870 && range_to
>= XLFD_WEIGHT_INDEX
871 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
872 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
873 else if (range_from
<= XLFD_SLANT_INDEX
874 && range_to
>= XLFD_SLANT_INDEX
875 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
876 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
877 else if (range_from
<= XLFD_SWIDTH_INDEX
878 && range_to
>= XLFD_SWIDTH_INDEX
879 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
880 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
883 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
884 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
886 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
887 mask
= XLFD_SYMBOL_MASK
;
890 /* Merge position-based and value-based restrictions. */
892 while (from
< range_from
)
893 mask
&= ~(1 << from
++);
894 while (from
< 14 && ! (mask
& (1 << from
)))
896 while (to
> range_to
)
897 mask
&= ~(1 << to
--);
898 while (to
>= 0 && ! (mask
& (1 << to
)))
902 range
[i
].from
= from
;
904 range
[i
].mask
= mask
;
906 if (from
> range_from
|| to
< range_to
)
908 /* The range is narrowed by value-based restrictions.
909 Reflect it to the other fields. */
911 /* Following fields should be after FROM. */
913 /* Preceding fields should be before TO. */
914 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
916 /* Check FROM for non-wildcard field. */
917 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
919 while (range
[j
].from
< from
)
920 range
[j
].mask
&= ~(1 << range
[j
].from
++);
921 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
923 range
[j
].from
= from
;
926 from
= range
[j
].from
;
927 if (range
[j
].to
> to
)
929 while (range
[j
].to
> to
)
930 range
[j
].mask
&= ~(1 << range
[j
].to
--);
931 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
944 /* Decide all fileds from restrictions in RANGE. */
945 for (i
= j
= 0; i
< n
; i
++)
947 if (j
< range
[i
].from
)
949 if (i
== 0 || ! NILP (tmp
[i
- 1]))
950 /* None of TMP[X] corresponds to Jth field. */
952 for (; j
< range
[i
].from
; j
++)
957 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
959 for (; j
< XLFD_LAST_INDEX
; j
++)
961 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
962 field
[XLFD_ENCODING_INDEX
]
963 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
968 /* Parse NAME (null terminated) as XLFD and store information in FONT
969 (font-spec or font-entity). Size property of FONT is set as
971 specified XLFD fields FONT property
972 --------------------- -------------
973 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
974 POINT_SIZE and RESY calculated pixel size (Lisp integer)
975 POINT_SIZE POINT_SIZE/10 (Lisp float)
977 If NAME is successfully parsed, return 0. Otherwise return -1.
979 FONT is usually a font-spec, but when this function is called from
980 X font backend driver, it is a font-entity. In that case, NAME is
981 a fully specified XLFD. */
984 font_parse_xlfd (const char *name
, Lisp_Object font
)
986 int len
= strlen (name
);
988 char *f
[XLFD_LAST_INDEX
+ 1];
992 if (len
> 255 || !len
)
993 /* Maximum XLFD name length is 255. */
995 /* Accept "*-.." as a fully specified XLFD. */
996 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
997 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1000 for (p
= name
+ i
; *p
; p
++)
1004 if (i
== XLFD_LAST_INDEX
)
1009 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1010 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1012 if (i
== XLFD_LAST_INDEX
)
1014 /* Fully specified XLFD. */
1017 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1018 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1019 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1020 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1022 val
= INTERN_FIELD_SYM (i
);
1025 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1027 ASET (font
, j
, make_number (n
));
1030 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1031 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1032 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1034 ASET (font
, FONT_REGISTRY_INDEX
,
1035 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1036 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1038 p
= f
[XLFD_PIXEL_INDEX
];
1039 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1040 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1043 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1045 ASET (font
, FONT_SIZE_INDEX
, val
);
1046 else if (FONT_ENTITY_P (font
))
1050 double point_size
= -1;
1052 font_assert (FONT_SPEC_P (font
));
1053 p
= f
[XLFD_POINT_INDEX
];
1055 point_size
= parse_matrix (p
);
1056 else if (isdigit (*p
))
1057 point_size
= atoi (p
), point_size
/= 10;
1058 if (point_size
>= 0)
1059 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1063 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1064 if (! NILP (val
) && ! INTEGERP (val
))
1066 ASET (font
, FONT_DPI_INDEX
, val
);
1067 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1070 val
= font_prop_validate_spacing (QCspacing
, val
);
1071 if (! INTEGERP (val
))
1073 ASET (font
, FONT_SPACING_INDEX
, val
);
1075 p
= f
[XLFD_AVGWIDTH_INDEX
];
1078 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1079 if (! NILP (val
) && ! INTEGERP (val
))
1081 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1085 int wild_card_found
= 0;
1086 Lisp_Object prop
[XLFD_LAST_INDEX
];
1088 if (FONT_ENTITY_P (font
))
1090 for (j
= 0; j
< i
; j
++)
1094 if (f
[j
][1] && f
[j
][1] != '-')
1097 wild_card_found
= 1;
1100 prop
[j
] = INTERN_FIELD (j
);
1102 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1104 if (! wild_card_found
)
1106 if (font_expand_wildcards (prop
, i
) < 0)
1109 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1110 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1111 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1112 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1113 if (! NILP (prop
[i
]))
1115 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1117 ASET (font
, j
, make_number (n
));
1119 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1120 val
= prop
[XLFD_REGISTRY_INDEX
];
1123 val
= prop
[XLFD_ENCODING_INDEX
];
1125 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1127 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1128 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1130 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1131 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1133 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1135 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1136 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1137 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1139 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1141 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1144 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1145 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1146 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1148 val
= font_prop_validate_spacing (QCspacing
,
1149 prop
[XLFD_SPACING_INDEX
]);
1150 if (! INTEGERP (val
))
1152 ASET (font
, FONT_SPACING_INDEX
, val
);
1154 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1155 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1161 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1162 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1163 0, use PIXEL_SIZE instead. */
1166 font_unparse_xlfd (Lisp_Object font
, int pixel_size
, char *name
, int nbytes
)
1168 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1172 font_assert (FONTP (font
));
1174 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1177 if (i
== FONT_ADSTYLE_INDEX
)
1178 j
= XLFD_ADSTYLE_INDEX
;
1179 else if (i
== FONT_REGISTRY_INDEX
)
1180 j
= XLFD_REGISTRY_INDEX
;
1181 val
= AREF (font
, i
);
1184 if (j
== XLFD_REGISTRY_INDEX
)
1185 f
[j
] = "*-*", len
+= 4;
1187 f
[j
] = "*", len
+= 2;
1192 val
= SYMBOL_NAME (val
);
1193 if (j
== XLFD_REGISTRY_INDEX
1194 && ! strchr ((char *) SDATA (val
), '-'))
1196 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1197 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1199 f
[j
] = alloca (SBYTES (val
) + 3);
1200 sprintf (f
[j
], "%s-*", SDATA (val
));
1201 len
+= SBYTES (val
) + 3;
1205 f
[j
] = alloca (SBYTES (val
) + 4);
1206 sprintf (f
[j
], "%s*-*", SDATA (val
));
1207 len
+= SBYTES (val
) + 4;
1211 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1215 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1218 val
= font_style_symbolic (font
, i
, 0);
1220 f
[j
] = "*", len
+= 2;
1223 val
= SYMBOL_NAME (val
);
1224 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1228 val
= AREF (font
, FONT_SIZE_INDEX
);
1229 font_assert (NUMBERP (val
) || NILP (val
));
1237 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1238 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1241 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1243 else if (FLOATP (val
))
1245 i
= XFLOAT_DATA (val
) * 10;
1246 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1247 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1250 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1252 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1254 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1255 f
[XLFD_RESX_INDEX
] = alloca (22);
1256 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1260 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1261 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1263 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1265 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1266 : spacing
<= FONT_SPACING_DUAL
? "d"
1267 : spacing
<= FONT_SPACING_MONO
? "m"
1272 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1273 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1275 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1276 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
], "%ld",
1277 (long) XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1280 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1281 len
++; /* for terminating '\0'. */
1284 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1285 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1286 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1287 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1288 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1289 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1290 f
[XLFD_REGISTRY_INDEX
]);
1293 /* Parse NAME (null terminated) and store information in FONT
1294 (font-spec or font-entity). NAME is supplied in either the
1295 Fontconfig or GTK font name format. If NAME is successfully
1296 parsed, return 0. Otherwise return -1.
1298 The fontconfig format is
1300 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1304 FAMILY [PROPS...] [SIZE]
1306 This function tries to guess which format it is. */
1309 font_parse_fcname (const char *name
, Lisp_Object font
)
1312 char *size_beg
= NULL
, *size_end
= NULL
;
1313 char *props_beg
= NULL
, *family_end
= NULL
;
1314 int len
= strlen (name
);
1319 for (p
= name
; *p
; p
++)
1321 if (*p
== '\\' && p
[1])
1325 props_beg
= family_end
= p
;
1330 int decimal
= 0, size_found
= 1;
1331 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1334 if (*q
!= '.' || decimal
)
1353 Lisp_Object extra_props
= Qnil
;
1355 /* A fontconfig name with size and/or property data. */
1356 if (family_end
> name
)
1359 family
= font_intern_prop (name
, family_end
- name
, 1);
1360 ASET (font
, FONT_FAMILY_INDEX
, family
);
1364 double point_size
= strtod (size_beg
, &size_end
);
1365 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1366 if (*size_end
== ':' && size_end
[1])
1367 props_beg
= size_end
;
1371 /* Now parse ":KEY=VAL" patterns. */
1374 for (p
= props_beg
; *p
; p
= q
)
1376 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1379 /* Must be an enumerated value. */
1383 val
= font_intern_prop (p
, q
- p
, 1);
1385 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1387 if (PROP_MATCH ("light", 5)
1388 || PROP_MATCH ("medium", 6)
1389 || PROP_MATCH ("demibold", 8)
1390 || PROP_MATCH ("bold", 4)
1391 || PROP_MATCH ("black", 5))
1392 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1393 else if (PROP_MATCH ("roman", 5)
1394 || PROP_MATCH ("italic", 6)
1395 || PROP_MATCH ("oblique", 7))
1396 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1397 else if (PROP_MATCH ("charcell", 8))
1398 ASET (font
, FONT_SPACING_INDEX
,
1399 make_number (FONT_SPACING_CHARCELL
));
1400 else if (PROP_MATCH ("mono", 4))
1401 ASET (font
, FONT_SPACING_INDEX
,
1402 make_number (FONT_SPACING_MONO
));
1403 else if (PROP_MATCH ("proportional", 12))
1404 ASET (font
, FONT_SPACING_INDEX
,
1405 make_number (FONT_SPACING_PROPORTIONAL
));
1414 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1415 prop
= FONT_SIZE_INDEX
;
1418 key
= font_intern_prop (p
, q
- p
, 1);
1419 prop
= get_font_prop_index (key
);
1423 for (q
= p
; *q
&& *q
!= ':'; q
++);
1424 val
= font_intern_prop (p
, q
- p
, 0);
1426 if (prop
>= FONT_FOUNDRY_INDEX
1427 && prop
< FONT_EXTRA_INDEX
)
1428 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1431 extra_props
= nconc2 (extra_props
,
1432 Fcons (Fcons (key
, val
), Qnil
));
1439 if (! NILP (extra_props
))
1441 struct font_driver_list
*driver_list
= font_driver_list
;
1442 for ( ; driver_list
; driver_list
= driver_list
->next
)
1443 if (driver_list
->driver
->filter_properties
)
1444 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1450 /* Either a fontconfig-style name with no size and property
1451 data, or a GTK-style name. */
1453 int word_len
, prop_found
= 0;
1455 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1461 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1462 if (! isdigit (*q
) && *q
!= '.')
1469 double point_size
= strtod (p
, &q
);
1470 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1475 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1476 if (*q
== '\\' && q
[1])
1480 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1482 if (PROP_MATCH ("Ultra-Light", 11))
1485 prop
= font_intern_prop ("ultra-light", 11, 1);
1486 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1488 else if (PROP_MATCH ("Light", 5))
1491 prop
= font_intern_prop ("light", 5, 1);
1492 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1494 else if (PROP_MATCH ("Book", 4))
1497 prop
= font_intern_prop ("book", 4, 1);
1498 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1500 else if (PROP_MATCH ("Medium", 6))
1503 prop
= font_intern_prop ("medium", 6, 1);
1504 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1506 else if (PROP_MATCH ("Semi-Bold", 9))
1509 prop
= font_intern_prop ("semi-bold", 9, 1);
1510 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1512 else if (PROP_MATCH ("Bold", 4))
1515 prop
= font_intern_prop ("bold", 4, 1);
1516 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1518 else if (PROP_MATCH ("Italic", 6))
1521 prop
= font_intern_prop ("italic", 4, 1);
1522 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1524 else if (PROP_MATCH ("Oblique", 7))
1527 prop
= font_intern_prop ("oblique", 7, 1);
1528 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1530 else if (PROP_MATCH ("Semi-Condensed", 14))
1533 prop
= font_intern_prop ("semi-condensed", 14, 1);
1534 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, prop
);
1536 else if (PROP_MATCH ("Condensed", 9))
1539 prop
= font_intern_prop ("condensed", 9, 1);
1540 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, prop
);
1544 return -1; /* Unknown property in GTK-style font name. */
1553 family
= font_intern_prop (name
, family_end
- name
, 1);
1554 ASET (font
, FONT_FAMILY_INDEX
, family
);
1561 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1562 NAME (NBYTES length), and return the name length. If
1563 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1566 font_unparse_fcname (Lisp_Object font
, int pixel_size
, const char *name
, int nbytes
)
1568 Lisp_Object family
, foundry
;
1569 Lisp_Object tail
, val
;
1573 Lisp_Object styles
[3];
1574 const char *style_names
[3] = { "weight", "slant", "width" };
1577 family
= AREF (font
, FONT_FAMILY_INDEX
);
1578 if (! NILP (family
))
1580 if (SYMBOLP (family
))
1582 family
= SYMBOL_NAME (family
);
1583 len
+= SBYTES (family
);
1589 val
= AREF (font
, FONT_SIZE_INDEX
);
1592 if (XINT (val
) != 0)
1593 pixel_size
= XINT (val
);
1595 len
+= 21; /* for ":pixelsize=NUM" */
1597 else if (FLOATP (val
))
1600 point_size
= (int) XFLOAT_DATA (val
);
1601 len
+= 11; /* for "-NUM" */
1604 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1605 if (! NILP (foundry
))
1607 if (SYMBOLP (foundry
))
1609 foundry
= SYMBOL_NAME (foundry
);
1610 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1616 for (i
= 0; i
< 3; i
++)
1618 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1619 if (! NILP (styles
[i
]))
1620 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1621 SDATA (SYMBOL_NAME (styles
[i
])));
1624 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1625 len
+= sprintf (work
, ":dpi=%ld", (long)XINT (AREF (font
, FONT_DPI_INDEX
)));
1626 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1627 len
+= strlen (":spacing=100");
1628 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1629 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1630 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1632 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1634 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1636 len
+= SBYTES (val
);
1637 else if (INTEGERP (val
))
1638 len
+= sprintf (work
, "%ld", (long) XINT (val
));
1639 else if (SYMBOLP (val
))
1640 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1646 if (! NILP (family
))
1647 p
+= sprintf (p
, "%s", SDATA (family
));
1651 p
+= sprintf (p
, "%d", point_size
);
1653 p
+= sprintf (p
, "-%d", point_size
);
1655 else if (pixel_size
> 0)
1656 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1657 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1658 p
+= sprintf (p
, ":foundry=%s",
1659 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1660 for (i
= 0; i
< 3; i
++)
1661 if (! NILP (styles
[i
]))
1662 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1663 SDATA (SYMBOL_NAME (styles
[i
])));
1664 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1665 p
+= sprintf (p
, ":dpi=%ld", (long) XINT (AREF (font
, FONT_DPI_INDEX
)));
1666 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1667 p
+= sprintf (p
, ":spacing=%ld",
1668 (long) XINT (AREF (font
, FONT_SPACING_INDEX
)));
1669 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1671 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1672 p
+= sprintf (p
, ":scalable=true");
1674 p
+= sprintf (p
, ":scalable=false");
1679 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1680 NAME (NBYTES length), and return the name length. F is the frame
1681 on which the font is displayed; it is used to calculate the point
1685 font_unparse_gtkname (Lisp_Object font
, struct frame
*f
, char *name
, int nbytes
)
1689 Lisp_Object family
, weight
, slant
, size
;
1690 int point_size
= -1;
1692 family
= AREF (font
, FONT_FAMILY_INDEX
);
1693 if (! NILP (family
))
1695 if (! SYMBOLP (family
))
1697 family
= SYMBOL_NAME (family
);
1698 len
+= SBYTES (family
);
1701 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1702 if (EQ (weight
, Qnormal
))
1704 else if (! NILP (weight
))
1706 weight
= SYMBOL_NAME (weight
);
1707 len
+= SBYTES (weight
);
1710 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1711 if (EQ (slant
, Qnormal
))
1713 else if (! NILP (slant
))
1715 slant
= SYMBOL_NAME (slant
);
1716 len
+= SBYTES (slant
);
1719 size
= AREF (font
, FONT_SIZE_INDEX
);
1720 /* Convert pixel size to point size. */
1721 if (INTEGERP (size
))
1723 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1725 if (INTEGERP (font_dpi
))
1726 dpi
= XINT (font_dpi
);
1729 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1732 else if (FLOATP (size
))
1734 point_size
= (int) XFLOAT_DATA (size
);
1741 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1743 if (! NILP (weight
))
1746 p
+= sprintf (p
, " %s", SDATA (weight
));
1747 q
[1] = toupper (q
[1]);
1753 p
+= sprintf (p
, " %s", SDATA (slant
));
1754 q
[1] = toupper (q
[1]);
1758 p
+= sprintf (p
, " %d", point_size
);
1763 /* Parse NAME (null terminated) and store information in FONT
1764 (font-spec or font-entity). If NAME is successfully parsed, return
1765 0. Otherwise return -1. */
1768 font_parse_name (const char *name
, Lisp_Object font
)
1770 if (name
[0] == '-' || strchr (name
, '*') || strchr (name
, '?'))
1771 return font_parse_xlfd (name
, font
);
1772 return font_parse_fcname (name
, font
);
1776 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1777 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1781 font_parse_family_registry (Lisp_Object family
, Lisp_Object registry
, Lisp_Object font_spec
)
1787 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1789 CHECK_STRING (family
);
1790 len
= SBYTES (family
);
1791 p0
= (char *) SDATA (family
);
1792 p1
= strchr (p0
, '-');
1795 if ((*p0
!= '*' && p1
- p0
> 0)
1796 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1797 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1800 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1803 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1805 if (! NILP (registry
))
1807 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1808 CHECK_STRING (registry
);
1809 len
= SBYTES (registry
);
1810 p0
= (char *) SDATA (registry
);
1811 p1
= strchr (p0
, '-');
1814 if (SDATA (registry
)[len
- 1] == '*')
1815 registry
= concat2 (registry
, build_string ("-*"));
1817 registry
= concat2 (registry
, build_string ("*-*"));
1819 registry
= Fdowncase (registry
);
1820 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1825 /* This part (through the next ^L) is still experimental and not
1826 tested much. We may drastically change codes. */
1832 #define LGSTRING_HEADER_SIZE 6
1833 #define LGSTRING_GLYPH_SIZE 8
1836 check_gstring (gstring
)
1837 Lisp_Object gstring
;
1842 CHECK_VECTOR (gstring
);
1843 val
= AREF (gstring
, 0);
1845 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1847 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1848 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1849 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1850 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1851 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1852 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1853 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1854 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1855 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1856 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1857 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1859 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1861 val
= LGSTRING_GLYPH (gstring
, i
);
1863 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1865 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1867 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1868 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1869 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1870 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1871 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1872 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1873 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1874 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1876 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1878 if (ASIZE (val
) < 3)
1880 for (j
= 0; j
< 3; j
++)
1881 CHECK_NUMBER (AREF (val
, j
));
1886 error ("Invalid glyph-string format");
1891 check_otf_features (otf_features
)
1892 Lisp_Object otf_features
;
1896 CHECK_CONS (otf_features
);
1897 CHECK_SYMBOL (XCAR (otf_features
));
1898 otf_features
= XCDR (otf_features
);
1899 CHECK_CONS (otf_features
);
1900 CHECK_SYMBOL (XCAR (otf_features
));
1901 otf_features
= XCDR (otf_features
);
1902 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1904 CHECK_SYMBOL (Fcar (val
));
1905 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1906 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1908 otf_features
= XCDR (otf_features
);
1909 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1911 CHECK_SYMBOL (Fcar (val
));
1912 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1913 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1920 Lisp_Object otf_list
;
1923 otf_tag_symbol (tag
)
1928 OTF_tag_name (tag
, name
);
1929 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1936 Lisp_Object val
= Fassoc (file
, otf_list
);
1940 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1943 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1944 val
= make_save_value (otf
, 0);
1945 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1951 /* Return a list describing which scripts/languages FONT supports by
1952 which GSUB/GPOS features of OpenType tables. See the comment of
1953 (struct font_driver).otf_capability. */
1956 font_otf_capability (font
)
1960 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1963 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1966 for (i
= 0; i
< 2; i
++)
1968 OTF_GSUB_GPOS
*gsub_gpos
;
1969 Lisp_Object script_list
= Qnil
;
1972 if (OTF_get_features (otf
, i
== 0) < 0)
1974 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1975 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1977 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1978 Lisp_Object langsys_list
= Qnil
;
1979 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1982 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1984 OTF_LangSys
*langsys
;
1985 Lisp_Object feature_list
= Qnil
;
1986 Lisp_Object langsys_tag
;
1989 if (k
== script
->LangSysCount
)
1991 langsys
= &script
->DefaultLangSys
;
1996 langsys
= script
->LangSys
+ k
;
1998 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2000 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2002 OTF_Feature
*feature
2003 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2004 Lisp_Object feature_tag
2005 = otf_tag_symbol (feature
->FeatureTag
);
2007 feature_list
= Fcons (feature_tag
, feature_list
);
2009 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2012 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2017 XSETCAR (capability
, script_list
);
2019 XSETCDR (capability
, script_list
);
2025 /* Parse OTF features in SPEC and write a proper features spec string
2026 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2027 assured that the sufficient memory has already allocated for
2031 generate_otf_features (spec
, features
)
2041 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2047 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2052 else if (! asterisk
)
2054 val
= SYMBOL_NAME (val
);
2055 p
+= sprintf (p
, "%s", SDATA (val
));
2059 val
= SYMBOL_NAME (val
);
2060 p
+= sprintf (p
, "~%s", SDATA (val
));
2064 error ("OTF spec too long");
2068 font_otf_DeviceTable (device_table
)
2069 OTF_DeviceTable
*device_table
;
2071 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2073 return Fcons (make_number (len
),
2074 make_unibyte_string (device_table
->DeltaValue
, len
));
2078 font_otf_ValueRecord (value_format
, value_record
)
2080 OTF_ValueRecord
*value_record
;
2082 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2084 if (value_format
& OTF_XPlacement
)
2085 ASET (val
, 0, make_number (value_record
->XPlacement
));
2086 if (value_format
& OTF_YPlacement
)
2087 ASET (val
, 1, make_number (value_record
->YPlacement
));
2088 if (value_format
& OTF_XAdvance
)
2089 ASET (val
, 2, make_number (value_record
->XAdvance
));
2090 if (value_format
& OTF_YAdvance
)
2091 ASET (val
, 3, make_number (value_record
->YAdvance
));
2092 if (value_format
& OTF_XPlaDevice
)
2093 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2094 if (value_format
& OTF_YPlaDevice
)
2095 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2096 if (value_format
& OTF_XAdvDevice
)
2097 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2098 if (value_format
& OTF_YAdvDevice
)
2099 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2104 font_otf_Anchor (anchor
)
2109 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2110 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2111 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2112 if (anchor
->AnchorFormat
== 2)
2113 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2116 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2117 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2121 #endif /* HAVE_LIBOTF */
2127 static unsigned font_score (Lisp_Object
, Lisp_Object
*);
2128 static int font_compare (const void *, const void *);
2129 static Lisp_Object
font_sort_entities (Lisp_Object
, Lisp_Object
,
2133 font_rescale_ratio (Lisp_Object font_entity
)
2135 Lisp_Object tail
, elt
;
2136 Lisp_Object name
= Qnil
;
2138 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2141 if (FLOATP (XCDR (elt
)))
2143 if (STRINGP (XCAR (elt
)))
2146 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2147 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2148 return XFLOAT_DATA (XCDR (elt
));
2150 else if (FONT_SPEC_P (XCAR (elt
)))
2152 if (font_match_p (XCAR (elt
), font_entity
))
2153 return XFLOAT_DATA (XCDR (elt
));
2160 /* We sort fonts by scoring each of them against a specified
2161 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2162 the value is, the closer the font is to the font-spec.
2164 The lowest 2 bits of the score is used for driver type. The font
2165 available by the most preferred font driver is 0.
2167 Each 7-bit in the higher 28 bits are used for numeric properties
2168 WEIGHT, SLANT, WIDTH, and SIZE. */
2170 /* How many bits to shift to store the difference value of each font
2171 property in a score. Note that flots for FONT_TYPE_INDEX and
2172 FONT_REGISTRY_INDEX are not used. */
2173 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2175 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2176 The return value indicates how different ENTITY is compared with
2180 font_score (Lisp_Object entity
, Lisp_Object
*spec_prop
)
2185 /* Score three style numeric fields. Maximum difference is 127. */
2186 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2187 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2189 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2194 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2197 /* Score the size. Maximum difference is 127. */
2198 i
= FONT_SIZE_INDEX
;
2199 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2200 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2202 /* We use the higher 6-bit for the actual size difference. The
2203 lowest bit is set if the DPI is different. */
2205 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2207 if (CONSP (Vface_font_rescale_alist
))
2208 pixel_size
*= font_rescale_ratio (entity
);
2209 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2213 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2214 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2216 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2217 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2219 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2226 /* Concatenate all elements of LIST into one vector. LIST is a list
2227 of font-entity vectors. */
2230 font_vconcat_entity_vectors (Lisp_Object list
)
2232 int nargs
= XINT (Flength (list
));
2233 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2236 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2237 args
[i
] = XCAR (list
);
2238 return Fvconcat (nargs
, args
);
2242 /* The structure for elements being sorted by qsort. */
2243 struct font_sort_data
2246 int font_driver_preference
;
2251 /* The comparison function for qsort. */
2254 font_compare (const void *d1
, const void *d2
)
2256 const struct font_sort_data
*data1
= d1
;
2257 const struct font_sort_data
*data2
= d2
;
2259 if (data1
->score
< data2
->score
)
2261 else if (data1
->score
> data2
->score
)
2263 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2267 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2268 If PREFER specifies a point-size, calculate the corresponding
2269 pixel-size from QCdpi property of PREFER or from the Y-resolution
2270 of FRAME before sorting.
2272 If BEST-ONLY is nonzero, return the best matching entity (that
2273 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2274 if BEST-ONLY is negative). Otherwise, return the sorted result as
2275 a single vector of font-entities.
2277 This function does no optimization for the case that the total
2278 number of elements is 1. The caller should avoid calling this in
2282 font_sort_entities (Lisp_Object list
, Lisp_Object prefer
, Lisp_Object frame
, int best_only
)
2284 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2286 struct font_sort_data
*data
;
2287 unsigned best_score
;
2288 Lisp_Object best_entity
;
2289 struct frame
*f
= XFRAME (frame
);
2290 Lisp_Object tail
, vec
;
2293 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2294 prefer_prop
[i
] = AREF (prefer
, i
);
2295 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2296 prefer_prop
[FONT_SIZE_INDEX
]
2297 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2299 if (NILP (XCDR (list
)))
2301 /* What we have to take care of is this single vector. */
2303 maxlen
= ASIZE (vec
);
2307 /* We don't have to perform sort, so there's no need of creating
2308 a single vector. But, we must find the length of the longest
2311 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2312 if (maxlen
< ASIZE (XCAR (tail
)))
2313 maxlen
= ASIZE (XCAR (tail
));
2317 /* We have to create a single vector to sort it. */
2318 vec
= font_vconcat_entity_vectors (list
);
2319 maxlen
= ASIZE (vec
);
2322 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2323 best_score
= 0xFFFFFFFF;
2326 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2328 int font_driver_preference
= 0;
2329 Lisp_Object current_font_driver
;
2335 /* We are sure that the length of VEC > 0. */
2336 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2337 /* Score the elements. */
2338 for (i
= 0; i
< len
; i
++)
2340 data
[i
].entity
= AREF (vec
, i
);
2342 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2344 ? font_score (data
[i
].entity
, prefer_prop
)
2346 if (best_only
&& best_score
> data
[i
].score
)
2348 best_score
= data
[i
].score
;
2349 best_entity
= data
[i
].entity
;
2350 if (best_score
== 0)
2353 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2355 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2356 font_driver_preference
++;
2358 data
[i
].font_driver_preference
= font_driver_preference
;
2361 /* Sort if necessary. */
2364 qsort (data
, len
, sizeof *data
, font_compare
);
2365 for (i
= 0; i
< len
; i
++)
2366 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 (int *order
)
2391 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2393 int xlfd_idx
= order
[i
];
2395 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2396 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2397 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2398 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2399 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2400 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2402 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2407 font_check_otf_features (Lisp_Object script
, Lisp_Object langsys
, Lisp_Object features
, Lisp_Object table
)
2412 table
= assq_no_quit (script
, table
);
2415 table
= XCDR (table
);
2416 if (! NILP (langsys
))
2418 table
= assq_no_quit (langsys
, table
);
2424 val
= assq_no_quit (Qnil
, table
);
2426 table
= XCAR (table
);
2430 table
= XCDR (table
);
2431 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2433 if (NILP (XCAR (features
)))
2438 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2444 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2447 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2449 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2451 script
= XCAR (spec
);
2455 langsys
= XCAR (spec
);
2466 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2467 XCAR (otf_capability
)))
2469 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2470 XCDR (otf_capability
)))
2477 /* Check if FONT (font-entity or font-object) matches with the font
2478 specification SPEC. */
2481 font_match_p (Lisp_Object spec
, Lisp_Object font
)
2483 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2484 Lisp_Object extra
, font_extra
;
2487 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2488 if (! NILP (AREF (spec
, i
))
2489 && ! NILP (AREF (font
, i
))
2490 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2492 props
= XFONT_SPEC (spec
)->props
;
2493 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2495 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2496 prop
[i
] = AREF (spec
, i
);
2497 prop
[FONT_SIZE_INDEX
]
2498 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2502 if (font_score (font
, props
) > 0)
2504 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2505 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2506 for (; CONSP (extra
); extra
= XCDR (extra
))
2508 Lisp_Object key
= XCAR (XCAR (extra
));
2509 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2511 if (EQ (key
, QClang
))
2513 val2
= assq_no_quit (key
, font_extra
);
2522 if (NILP (Fmemq (val
, val2
)))
2527 ? NILP (Fmemq (val
, XCDR (val2
)))
2531 else if (EQ (key
, QCscript
))
2533 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2539 /* All characters in the list must be supported. */
2540 for (; CONSP (val2
); val2
= XCDR (val2
))
2542 if (! NATNUMP (XCAR (val2
)))
2544 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2545 == FONT_INVALID_CODE
)
2549 else if (VECTORP (val2
))
2551 /* At most one character in the vector must be supported. */
2552 for (i
= 0; i
< ASIZE (val2
); i
++)
2554 if (! NATNUMP (AREF (val2
, i
)))
2556 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2557 != FONT_INVALID_CODE
)
2560 if (i
== ASIZE (val2
))
2565 else if (EQ (key
, QCotf
))
2569 if (! FONT_OBJECT_P (font
))
2571 fontp
= XFONT_OBJECT (font
);
2572 if (! fontp
->driver
->otf_capability
)
2574 val2
= fontp
->driver
->otf_capability (fontp
);
2575 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2586 Each font backend has the callback function get_cache, and it
2587 returns a cons cell of which cdr part can be freely used for
2588 caching fonts. The cons cell may be shared by multiple frames
2589 and/or multiple font drivers. So, we arrange the cdr part as this:
2591 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2593 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2594 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2595 cons (FONT-SPEC FONT-ENTITY ...). */
2597 static void font_prepare_cache (FRAME_PTR
, struct font_driver
*);
2598 static void font_finish_cache (FRAME_PTR
, struct font_driver
*);
2599 static Lisp_Object
font_get_cache (FRAME_PTR
, struct font_driver
*);
2600 static void font_clear_cache (FRAME_PTR
, Lisp_Object
,
2601 struct font_driver
*);
2604 font_prepare_cache (FRAME_PTR f
, struct font_driver
*driver
)
2606 Lisp_Object cache
, val
;
2608 cache
= driver
->get_cache (f
);
2610 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2614 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2615 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2619 val
= XCDR (XCAR (val
));
2620 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2626 font_finish_cache (FRAME_PTR f
, struct font_driver
*driver
)
2628 Lisp_Object cache
, val
, tmp
;
2631 cache
= driver
->get_cache (f
);
2633 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2634 cache
= val
, val
= XCDR (val
);
2635 font_assert (! NILP (val
));
2636 tmp
= XCDR (XCAR (val
));
2637 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2638 if (XINT (XCAR (tmp
)) == 0)
2640 font_clear_cache (f
, XCAR (val
), driver
);
2641 XSETCDR (cache
, XCDR (val
));
2647 font_get_cache (FRAME_PTR f
, struct font_driver
*driver
)
2649 Lisp_Object val
= driver
->get_cache (f
);
2650 Lisp_Object type
= driver
->type
;
2652 font_assert (CONSP (val
));
2653 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2654 font_assert (CONSP (val
));
2655 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2656 val
= XCDR (XCAR (val
));
2660 static int num_fonts
;
2663 font_clear_cache (FRAME_PTR f
, Lisp_Object cache
, struct font_driver
*driver
)
2665 Lisp_Object tail
, elt
;
2666 Lisp_Object tail2
, entity
;
2668 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2669 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2672 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2673 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2675 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2677 entity
= XCAR (tail2
);
2679 if (FONT_ENTITY_P (entity
)
2680 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2682 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2684 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2686 Lisp_Object val
= XCAR (objlist
);
2687 struct font
*font
= XFONT_OBJECT (val
);
2689 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2691 font_assert (font
&& driver
== font
->driver
);
2692 driver
->close (f
, font
);
2696 if (driver
->free_entity
)
2697 driver
->free_entity (entity
);
2702 XSETCDR (cache
, Qnil
);
2706 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2708 /* Check each font-entity in VEC, and return a list of font-entities
2709 that satisfy this condition:
2710 (1) matches with SPEC and SIZE if SPEC is not nil, and
2711 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2715 font_delete_unmatched (Lisp_Object vec
, Lisp_Object spec
, int size
)
2717 Lisp_Object entity
, val
;
2718 enum font_property_index prop
;
2721 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2723 entity
= AREF (vec
, i
);
2724 if (! NILP (Vface_ignored_fonts
))
2727 Lisp_Object tail
, regexp
;
2729 if (font_unparse_xlfd (entity
, 0, name
, 256) >= 0)
2731 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2733 regexp
= XCAR (tail
);
2734 if (STRINGP (regexp
)
2735 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
2744 val
= Fcons (entity
, val
);
2747 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2748 if (INTEGERP (AREF (spec
, prop
))
2749 && ((XINT (AREF (spec
, prop
)) >> 8)
2750 != (XINT (AREF (entity
, prop
)) >> 8)))
2751 prop
= FONT_SPEC_MAX
;
2752 if (prop
< FONT_SPEC_MAX
2754 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2756 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2759 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2760 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2761 prop
= FONT_SPEC_MAX
;
2763 if (prop
< FONT_SPEC_MAX
2764 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2765 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2766 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2767 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2768 prop
= FONT_SPEC_MAX
;
2769 if (prop
< FONT_SPEC_MAX
2770 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2771 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2772 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2773 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2774 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2775 prop
= FONT_SPEC_MAX
;
2776 if (prop
< FONT_SPEC_MAX
)
2777 val
= Fcons (entity
, val
);
2779 return (Fvconcat (1, &val
));
2783 /* Return a list of vectors of font-entities matching with SPEC on
2784 FRAME. Each elements in the list is a vector of entities from the
2785 same font-driver. */
2788 font_list_entities (Lisp_Object frame
, Lisp_Object spec
)
2790 FRAME_PTR f
= XFRAME (frame
);
2791 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2792 Lisp_Object ftype
, val
;
2793 Lisp_Object list
= Qnil
;
2795 int need_filtering
= 0;
2798 font_assert (FONT_SPEC_P (spec
));
2800 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2801 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2802 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2803 size
= font_pixel_size (f
, spec
);
2807 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2808 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2809 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2810 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2812 ASET (scratch_font_spec
, i
, Qnil
);
2813 if (! NILP (AREF (spec
, i
)))
2815 if (i
== FONT_DPI_INDEX
)
2816 /* Skip FONT_SPACING_INDEX */
2819 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2820 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2822 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2824 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2826 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2828 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2829 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2836 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2840 val
= Fvconcat (1, &val
);
2841 copy
= Fcopy_font_spec (scratch_font_spec
);
2842 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2843 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2847 || ! NILP (Vface_ignored_fonts
)))
2848 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2849 if (ASIZE (val
) > 0)
2850 list
= Fcons (val
, list
);
2853 list
= Fnreverse (list
);
2854 FONT_ADD_LOG ("list", spec
, list
);
2859 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2860 nil, is an array of face's attributes, which specifies preferred
2861 font-related attributes. */
2864 font_matching_entity (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
2866 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2867 Lisp_Object ftype
, size
, entity
;
2869 Lisp_Object work
= Fcopy_font_spec (spec
);
2871 XSETFRAME (frame
, f
);
2872 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2873 size
= AREF (spec
, FONT_SIZE_INDEX
);
2876 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2877 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2878 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2879 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2882 for (; driver_list
; driver_list
= driver_list
->next
)
2884 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2886 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2889 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2890 entity
= assoc_no_quit (work
, XCDR (cache
));
2892 entity
= XCDR (entity
);
2895 entity
= driver_list
->driver
->match (frame
, work
);
2896 copy
= Fcopy_font_spec (work
);
2897 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2898 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2900 if (! NILP (entity
))
2903 FONT_ADD_LOG ("match", work
, entity
);
2908 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2909 opened font object. */
2912 font_open_entity (FRAME_PTR f
, Lisp_Object entity
, int pixel_size
)
2914 struct font_driver_list
*driver_list
;
2915 Lisp_Object objlist
, size
, val
, font_object
;
2917 int min_width
, height
;
2918 int scaled_pixel_size
;
2920 font_assert (FONT_ENTITY_P (entity
));
2921 size
= AREF (entity
, FONT_SIZE_INDEX
);
2922 if (XINT (size
) != 0)
2923 scaled_pixel_size
= pixel_size
= XINT (size
);
2924 else if (CONSP (Vface_font_rescale_alist
))
2925 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
2927 val
= AREF (entity
, FONT_TYPE_INDEX
);
2928 for (driver_list
= f
->font_driver_list
;
2929 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2930 driver_list
= driver_list
->next
);
2934 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2935 objlist
= XCDR (objlist
))
2937 Lisp_Object fn
= XCAR (objlist
);
2938 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
2939 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
2941 if (driver_list
->driver
->cached_font_ok
== NULL
2942 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
2947 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
2948 if (!NILP (font_object
))
2949 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2950 FONT_ADD_LOG ("open", entity
, font_object
);
2951 if (NILP (font_object
))
2953 ASET (entity
, FONT_OBJLIST_INDEX
,
2954 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2957 font
= XFONT_OBJECT (font_object
);
2958 min_width
= (font
->min_width
? font
->min_width
2959 : font
->average_width
? font
->average_width
2960 : font
->space_width
? font
->space_width
2962 height
= (font
->height
? font
->height
: 1);
2963 #ifdef HAVE_WINDOW_SYSTEM
2964 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2965 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2967 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2968 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2969 fonts_changed_p
= 1;
2973 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2974 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2975 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2976 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2984 /* Close FONT_OBJECT that is opened on frame F. */
2987 font_close_object (FRAME_PTR f
, Lisp_Object font_object
)
2989 struct font
*font
= XFONT_OBJECT (font_object
);
2991 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2992 /* Already closed. */
2994 FONT_ADD_LOG ("close", font_object
, Qnil
);
2995 font
->driver
->close (f
, font
);
2996 #ifdef HAVE_WINDOW_SYSTEM
2997 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2998 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
3004 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
3005 FONT is a font-entity and it must be opened to check. */
3008 font_has_char (FRAME_PTR f
, Lisp_Object font
, int c
)
3012 if (FONT_ENTITY_P (font
))
3014 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
3015 struct font_driver_list
*driver_list
;
3017 for (driver_list
= f
->font_driver_list
;
3018 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
3019 driver_list
= driver_list
->next
);
3022 if (! driver_list
->driver
->has_char
)
3024 return driver_list
->driver
->has_char (font
, c
);
3027 font_assert (FONT_OBJECT_P (font
));
3028 fontp
= XFONT_OBJECT (font
);
3029 if (fontp
->driver
->has_char
)
3031 int result
= fontp
->driver
->has_char (font
, c
);
3036 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
3040 /* Return the glyph ID of FONT_OBJECT for character C. */
3043 font_encode_char (Lisp_Object font_object
, int c
)
3047 font_assert (FONT_OBJECT_P (font_object
));
3048 font
= XFONT_OBJECT (font_object
);
3049 return font
->driver
->encode_char (font
, c
);
3053 /* Return the name of FONT_OBJECT. */
3056 font_get_name (Lisp_Object font_object
)
3058 font_assert (FONT_OBJECT_P (font_object
));
3059 return AREF (font_object
, FONT_NAME_INDEX
);
3063 /* Return the specification of FONT_OBJECT. */
3066 font_get_spec (Lisp_Object font_object
)
3068 Lisp_Object spec
= font_make_spec ();
3071 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
3072 ASET (spec
, i
, AREF (font_object
, i
));
3073 ASET (spec
, FONT_SIZE_INDEX
,
3074 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
3079 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3080 could not be parsed by font_parse_name, return Qnil. */
3083 font_spec_from_name (Lisp_Object font_name
)
3085 Lisp_Object spec
= Ffont_spec (0, NULL
);
3087 CHECK_STRING (font_name
);
3088 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3090 font_put_extra (spec
, QCname
, font_name
);
3091 font_put_extra (spec
, QCuser_spec
, font_name
);
3097 font_clear_prop (Lisp_Object
*attrs
, enum font_property_index prop
)
3099 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3104 if (! NILP (Ffont_get (font
, QCname
)))
3106 font
= Fcopy_font_spec (font
);
3107 font_put_extra (font
, QCname
, Qnil
);
3110 if (NILP (AREF (font
, prop
))
3111 && prop
!= FONT_FAMILY_INDEX
3112 && prop
!= FONT_FOUNDRY_INDEX
3113 && prop
!= FONT_WIDTH_INDEX
3114 && prop
!= FONT_SIZE_INDEX
)
3116 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3117 font
= Fcopy_font_spec (font
);
3118 ASET (font
, prop
, Qnil
);
3119 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3121 if (prop
== FONT_FAMILY_INDEX
)
3123 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3124 /* If we are setting the font family, we must also clear
3125 FONT_WIDTH_INDEX to avoid rejecting families that lack
3126 support for some widths. */
3127 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3129 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3130 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3131 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3132 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3133 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3134 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3136 else if (prop
== FONT_SIZE_INDEX
)
3138 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3139 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3140 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3142 else if (prop
== FONT_WIDTH_INDEX
)
3143 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3144 attrs
[LFACE_FONT_INDEX
] = font
;
3148 font_update_lface (FRAME_PTR f
, Lisp_Object
*attrs
)
3152 spec
= attrs
[LFACE_FONT_INDEX
];
3153 if (! FONT_SPEC_P (spec
))
3156 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3157 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3158 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3159 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3160 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3161 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3162 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3163 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);
3164 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3165 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3166 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3170 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3175 val
= Ffont_get (spec
, QCdpi
);
3178 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3180 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3182 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3184 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3185 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3191 /* Selecte a font from ENTITIES (list of font-entity vectors) that
3192 supports C and matches best with ATTRS and PIXEL_SIZE. */
3195 font_select_entity (Lisp_Object frame
, Lisp_Object entities
, Lisp_Object
*attrs
, int pixel_size
, int c
)
3197 Lisp_Object font_entity
;
3200 FRAME_PTR f
= XFRAME (frame
);
3202 if (NILP (XCDR (entities
))
3203 && ASIZE (XCAR (entities
)) == 1)
3205 font_entity
= AREF (XCAR (entities
), 0);
3207 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3212 /* Sort fonts by properties specified in ATTRS. */
3213 prefer
= scratch_font_prefer
;
3215 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3216 ASET (prefer
, i
, Qnil
);
3217 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3219 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3221 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3222 ASET (prefer
, i
, AREF (face_font
, i
));
3224 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3225 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3226 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3227 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3228 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3229 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3230 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3232 return font_sort_entities (entities
, prefer
, frame
, c
);
3235 /* Return a font-entity satisfying SPEC and best matching with face's
3236 font related attributes in ATTRS. C, if not negative, is a
3237 character that the entity must support. */
3240 font_find_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
, int c
)
3243 Lisp_Object frame
, entities
, val
;
3244 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3248 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3249 if (NILP (registry
[0]))
3251 registry
[0] = DEFAULT_ENCODING
;
3252 registry
[1] = Qascii_0
;
3253 registry
[2] = null_vector
;
3256 registry
[1] = null_vector
;
3258 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3260 struct charset
*encoding
, *repertory
;
3262 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3263 &encoding
, &repertory
) < 0)
3266 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3268 else if (c
> encoding
->max_char
)
3272 work
= Fcopy_font_spec (spec
);
3273 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3274 XSETFRAME (frame
, f
);
3275 size
= AREF (spec
, FONT_SIZE_INDEX
);
3276 pixel_size
= font_pixel_size (f
, spec
);
3277 if (pixel_size
== 0)
3279 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3281 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3283 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3284 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3285 if (! NILP (foundry
[0]))
3286 foundry
[1] = null_vector
;
3287 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3289 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3290 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3292 foundry
[2] = null_vector
;
3295 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3297 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3298 if (! NILP (adstyle
[0]))
3299 adstyle
[1] = null_vector
;
3300 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3302 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3304 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3306 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3308 adstyle
[2] = null_vector
;
3311 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3314 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3317 val
= AREF (work
, FONT_FAMILY_INDEX
);
3318 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3320 val
= attrs
[LFACE_FAMILY_INDEX
];
3321 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3325 family
= alloca ((sizeof family
[0]) * 2);
3327 family
[1] = null_vector
; /* terminator. */
3332 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3333 /* Font family names are case-sensitive under NS. */
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 (! NILP (entities
))
3376 val
= font_select_entity (frame
, entities
,
3377 attrs
, pixel_size
, c
);
3390 font_open_for_lface (FRAME_PTR f
, Lisp_Object entity
, Lisp_Object
*attrs
, Lisp_Object spec
)
3394 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3395 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3396 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3397 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3398 size
= font_pixel_size (f
, spec
);
3402 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3403 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3406 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3407 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3408 if (INTEGERP (height
))
3411 abort(); /* We should never end up here. */
3415 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3419 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3420 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3424 return font_open_entity (f
, entity
, size
);
3428 /* Find a font satisfying SPEC and best matching with face's
3429 attributes in ATTRS on FRAME, and return the opened
3433 font_load_for_lface (FRAME_PTR f
, Lisp_Object
*attrs
, Lisp_Object spec
)
3435 Lisp_Object entity
, name
;
3437 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3440 /* No font is listed for SPEC, but each font-backend may have
3441 the different criteria about "font matching". So, try
3443 entity
= font_matching_entity (f
, attrs
, spec
);
3447 /* Don't loose the original name that was put in initially. We need
3448 it to re-apply the font when font parameters (like hinting or dpi) have
3450 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3453 name
= Ffont_get (spec
, QCuser_spec
);
3454 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3460 /* Make FACE on frame F ready to use the font opened for FACE. */
3463 font_prepare_for_face (FRAME_PTR f
, struct face
*face
)
3465 if (face
->font
->driver
->prepare_face
)
3466 face
->font
->driver
->prepare_face (f
, face
);
3470 /* Make FACE on frame F stop using the font opened for FACE. */
3473 font_done_for_face (FRAME_PTR f
, struct face
*face
)
3475 if (face
->font
->driver
->done_face
)
3476 face
->font
->driver
->done_face (f
, face
);
3481 /* Open a font matching with font-spec SPEC on frame F. If no proper
3482 font is found, return Qnil. */
3485 font_open_by_spec (FRAME_PTR f
, Lisp_Object spec
)
3487 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3489 /* We set up the default font-related attributes of a face to prefer
3491 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3492 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3493 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3495 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3497 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3499 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3501 return font_load_for_lface (f
, attrs
, spec
);
3505 /* Open a font matching with NAME on frame F. If no proper font is
3506 found, return Qnil. */
3509 font_open_by_name (FRAME_PTR f
, const char *name
)
3511 Lisp_Object args
[2];
3512 Lisp_Object spec
, ret
;
3515 args
[1] = make_unibyte_string (name
, strlen (name
));
3516 spec
= Ffont_spec (2, args
);
3517 ret
= font_open_by_spec (f
, spec
);
3518 /* Do not loose name originally put in. */
3520 font_put_extra (ret
, QCuser_spec
, args
[1]);
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 (struct font_driver
*driver
, FRAME_PTR f
)
3541 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3542 struct font_driver_list
*prev
, *list
;
3544 if (f
&& ! driver
->draw
)
3545 error ("Unusable font driver for a frame: %s",
3546 SDATA (SYMBOL_NAME (driver
->type
)));
3548 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3549 if (EQ (list
->driver
->type
, driver
->type
))
3550 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3552 list
= xmalloc (sizeof (struct font_driver_list
));
3554 list
->driver
= driver
;
3559 f
->font_driver_list
= list
;
3561 font_driver_list
= list
;
3567 free_font_driver_list (FRAME_PTR f
)
3569 struct font_driver_list
*list
, *next
;
3571 for (list
= f
->font_driver_list
; list
; list
= next
)
3576 f
->font_driver_list
= NULL
;
3580 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3581 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3582 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3584 A caller must free all realized faces if any in advance. The
3585 return value is a list of font backends actually made used on
3589 font_update_drivers (FRAME_PTR f
, Lisp_Object new_drivers
)
3591 Lisp_Object active_drivers
= Qnil
;
3592 struct font_driver
*driver
;
3593 struct font_driver_list
*list
;
3595 /* At first, turn off non-requested drivers, and turn on requested
3597 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3599 driver
= list
->driver
;
3600 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3605 if (driver
->end_for_frame
)
3606 driver
->end_for_frame (f
);
3607 font_finish_cache (f
, driver
);
3612 if (! driver
->start_for_frame
3613 || driver
->start_for_frame (f
) == 0)
3615 font_prepare_cache (f
, driver
);
3622 if (NILP (new_drivers
))
3625 if (! EQ (new_drivers
, Qt
))
3627 /* Re-order the driver list according to new_drivers. */
3628 struct font_driver_list
**list_table
, **next
;
3632 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3633 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3635 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3636 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3639 list_table
[i
++] = list
;
3641 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3643 list_table
[i
++] = list
;
3644 list_table
[i
] = NULL
;
3646 next
= &f
->font_driver_list
;
3647 for (i
= 0; list_table
[i
]; i
++)
3649 *next
= list_table
[i
];
3650 next
= &(*next
)->next
;
3654 if (! f
->font_driver_list
->on
)
3655 { /* None of the drivers is enabled: enable them all.
3656 Happens if you set the list of drivers to (xft x) in your .emacs
3657 and then use it under w32 or ns. */
3658 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3660 struct font_driver
*driver
= list
->driver
;
3661 eassert (! list
->on
);
3662 if (! driver
->start_for_frame
3663 || driver
->start_for_frame (f
) == 0)
3665 font_prepare_cache (f
, driver
);
3672 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3674 active_drivers
= nconc2 (active_drivers
,
3675 Fcons (list
->driver
->type
, Qnil
));
3676 return active_drivers
;
3680 font_put_frame_data (FRAME_PTR f
, struct font_driver
*driver
, void *data
)
3682 struct font_data_list
*list
, *prev
;
3684 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3685 prev
= list
, list
= list
->next
)
3686 if (list
->driver
== driver
)
3693 prev
->next
= list
->next
;
3695 f
->font_data_list
= list
->next
;
3703 list
= xmalloc (sizeof (struct font_data_list
));
3704 list
->driver
= driver
;
3705 list
->next
= f
->font_data_list
;
3706 f
->font_data_list
= list
;
3714 font_get_frame_data (FRAME_PTR f
, struct font_driver
*driver
)
3716 struct font_data_list
*list
;
3718 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3719 if (list
->driver
== driver
)
3727 /* Return the font used to draw character C by FACE at buffer position
3728 POS in window W. If STRING is non-nil, it is a string containing C
3729 at index POS. If C is negative, get C from the current buffer or
3733 font_at (int c
, EMACS_INT pos
, struct face
*face
, struct window
*w
, Lisp_Object string
)
3737 Lisp_Object font_object
;
3739 multibyte
= (NILP (string
)
3740 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3741 : STRING_MULTIBYTE (string
));
3748 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3750 c
= FETCH_CHAR (pos_byte
);
3753 c
= FETCH_BYTE (pos
);
3759 multibyte
= STRING_MULTIBYTE (string
);
3762 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3764 str
= SDATA (string
) + pos_byte
;
3765 c
= STRING_CHAR (str
);
3768 c
= SDATA (string
)[pos
];
3772 f
= XFRAME (w
->frame
);
3773 if (! FRAME_WINDOW_P (f
))
3780 if (STRINGP (string
))
3781 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3782 DEFAULT_FACE_ID
, 0);
3784 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3786 face
= FACE_FROM_ID (f
, face_id
);
3790 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3791 face
= FACE_FROM_ID (f
, face_id
);
3796 XSETFONT (font_object
, face
->font
);
3801 #ifdef HAVE_WINDOW_SYSTEM
3803 /* Check how many characters after POS (at most to *LIMIT) can be
3804 displayed by the same font on the window W. FACE, if non-NULL, is
3805 the face selected for the character at POS. If STRING is not nil,
3806 it is the string to check instead of the current buffer. In that
3807 case, FACE must be not NULL.
3809 The return value is the font-object for the character at POS.
3810 *LIMIT is set to the position where that font can't be used.
3812 It is assured that the current buffer (or STRING) is multibyte. */
3815 font_range (EMACS_INT pos
, EMACS_INT
*limit
, struct window
*w
, struct face
*face
, Lisp_Object string
)
3817 EMACS_INT pos_byte
, ignore
;
3819 Lisp_Object font_object
= Qnil
;
3823 pos_byte
= CHAR_TO_BYTE (pos
);
3828 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
3830 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3836 pos_byte
= string_char_to_byte (string
, pos
);
3839 while (pos
< *limit
)
3841 Lisp_Object category
;
3844 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3846 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3847 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3848 if (EQ (category
, QCf
)
3849 || CHAR_VARIATION_SELECTOR_P (c
))
3851 if (NILP (font_object
))
3853 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3854 if (NILP (font_object
))
3858 if (font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3868 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3869 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3870 Return nil otherwise.
3871 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3872 which kind of font it is. It must be one of `font-spec', `font-entity',
3874 (Lisp_Object object
, Lisp_Object extra_type
)
3876 if (NILP (extra_type
))
3877 return (FONTP (object
) ? Qt
: Qnil
);
3878 if (EQ (extra_type
, Qfont_spec
))
3879 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3880 if (EQ (extra_type
, Qfont_entity
))
3881 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3882 if (EQ (extra_type
, Qfont_object
))
3883 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3884 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3887 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3888 doc
: /* Return a newly created font-spec with arguments as properties.
3890 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3891 valid font property name listed below:
3893 `:family', `:weight', `:slant', `:width'
3895 They are the same as face attributes of the same name. See
3896 `set-face-attribute'.
3900 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3904 VALUE must be a string or a symbol specifying the additional
3905 typographic style information of a font, e.g. ``sans''.
3909 VALUE must be a string or a symbol specifying the charset registry and
3910 encoding of a font, e.g. ``iso8859-1''.
3914 VALUE must be a non-negative integer or a floating point number
3915 specifying the font size. It specifies the font size in pixels (if
3916 VALUE is an integer), or in points (if VALUE is a float).
3920 VALUE must be a string of XLFD-style or fontconfig-style font name.
3924 VALUE must be a symbol representing a script that the font must
3925 support. It may be a symbol representing a subgroup of a script
3926 listed in the variable `script-representative-chars'.
3930 VALUE must be a symbol of two-letter ISO-639 language names,
3935 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
3936 required OpenType features.
3938 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
3939 LANGSYS-TAG: OpenType language system tag symbol,
3940 or nil for the default language system.
3941 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
3942 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
3944 GSUB and GPOS may contain `nil' element. In such a case, the font
3945 must not have any of the remaining elements.
3947 For instance, if the VALUE is `(thai nil nil (mark))', the font must
3948 be an OpenType font, and whose GPOS table of `thai' script's default
3949 language system must contain `mark' feature.
3951 usage: (font-spec ARGS...) */)
3952 (int nargs
, Lisp_Object
*args
)
3954 Lisp_Object spec
= font_make_spec ();
3957 for (i
= 0; i
< nargs
; i
+= 2)
3959 Lisp_Object key
= args
[i
], val
;
3963 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
3966 if (EQ (key
, QCname
))
3969 font_parse_name ((char *) SDATA (val
), spec
);
3970 font_put_extra (spec
, key
, val
);
3974 int idx
= get_font_prop_index (key
);
3978 val
= font_prop_validate (idx
, Qnil
, val
);
3979 if (idx
< FONT_EXTRA_INDEX
)
3980 ASET (spec
, idx
, val
);
3982 font_put_extra (spec
, key
, val
);
3985 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3991 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3992 doc
: /* Return a copy of FONT as a font-spec. */)
3995 Lisp_Object new_spec
, tail
, prev
, extra
;
3999 new_spec
= font_make_spec ();
4000 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
4001 ASET (new_spec
, i
, AREF (font
, i
));
4002 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
4003 /* We must remove :font-entity property. */
4004 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
4005 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
4008 extra
= XCDR (extra
);
4010 XSETCDR (prev
, XCDR (tail
));
4013 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
4017 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
4018 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
4019 Every specified properties in FROM override the corresponding
4020 properties in TO. */)
4021 (Lisp_Object from
, Lisp_Object to
)
4023 Lisp_Object extra
, tail
;
4028 to
= Fcopy_font_spec (to
);
4029 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
4030 ASET (to
, i
, AREF (from
, i
));
4031 extra
= AREF (to
, FONT_EXTRA_INDEX
);
4032 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
4033 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
4035 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
4038 XSETCDR (slot
, XCDR (XCAR (tail
)));
4040 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
4042 ASET (to
, FONT_EXTRA_INDEX
, extra
);
4046 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
4047 doc
: /* Return the value of FONT's property KEY.
4048 FONT is a font-spec, a font-entity, or a font-object.
4049 KEY is any symbol, but these are reserved for specific meanings:
4050 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4051 :size, :name, :script, :otf
4052 See the documentation of `font-spec' for their meanings.
4053 In addition, if FONT is a font-entity or a font-object, values of
4054 :script and :otf are different from those of a font-spec as below:
4056 The value of :script may be a list of scripts that are supported by the font.
4058 The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists
4059 representing the OpenType features supported by the font by this form:
4060 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4061 SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType
4063 (Lisp_Object font
, Lisp_Object key
)
4071 idx
= get_font_prop_index (key
);
4072 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4073 return font_style_symbolic (font
, idx
, 0);
4074 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4075 return AREF (font
, idx
);
4076 val
= Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
));
4077 if (NILP (val
) && EQ (key
, QCotf
) && FONT_OBJECT_P (font
))
4079 struct font
*fontp
= XFONT_OBJECT (font
);
4081 if (fontp
->driver
->otf_capability
)
4082 val
= fontp
->driver
->otf_capability (fontp
);
4084 val
= Fcons (Qnil
, Qnil
);
4085 font_put_extra (font
, QCotf
, val
);
4092 #ifdef HAVE_WINDOW_SYSTEM
4094 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4095 doc
: /* Return a plist of face attributes generated by FONT.
4096 FONT is a font name, a font-spec, a font-entity, or a font-object.
4097 The return value is a list of the form
4099 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4101 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4102 compatible with `set-face-attribute'. Some of these key-attribute pairs
4103 may be omitted from the list if they are not specified by FONT.
4105 The optional argument FRAME specifies the frame that the face attributes
4106 are to be displayed on. If omitted, the selected frame is used. */)
4107 (Lisp_Object font
, Lisp_Object frame
)
4110 Lisp_Object plist
[10];
4115 frame
= selected_frame
;
4116 CHECK_LIVE_FRAME (frame
);
4121 int fontset
= fs_query_fontset (font
, 0);
4122 Lisp_Object name
= font
;
4124 font
= fontset_ascii (fontset
);
4125 font
= font_spec_from_name (name
);
4127 signal_error ("Invalid font name", name
);
4129 else if (! FONTP (font
))
4130 signal_error ("Invalid font object", font
);
4132 val
= AREF (font
, FONT_FAMILY_INDEX
);
4135 plist
[n
++] = QCfamily
;
4136 plist
[n
++] = SYMBOL_NAME (val
);
4139 val
= AREF (font
, FONT_SIZE_INDEX
);
4142 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4143 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4144 plist
[n
++] = QCheight
;
4145 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4147 else if (FLOATP (val
))
4149 plist
[n
++] = QCheight
;
4150 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4153 val
= FONT_WEIGHT_FOR_FACE (font
);
4156 plist
[n
++] = QCweight
;
4160 val
= FONT_SLANT_FOR_FACE (font
);
4163 plist
[n
++] = QCslant
;
4167 val
= FONT_WIDTH_FOR_FACE (font
);
4170 plist
[n
++] = QCwidth
;
4174 return Flist (n
, plist
);
4179 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4180 doc
: /* Set one property of FONT: give property KEY value VAL.
4181 FONT is a font-spec, a font-entity, or a font-object.
4183 If FONT is a font-spec, KEY can be any symbol. But if KEY is the one
4184 accepted by the function `font-spec' (which see), VAL must be what
4185 allowed in `font-spec'.
4187 If FONT is a font-entity or a font-object, KEY must not be the one
4188 accepted by `font-spec'. */)
4189 (Lisp_Object font
, Lisp_Object prop
, Lisp_Object val
)
4193 idx
= get_font_prop_index (prop
);
4194 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4196 CHECK_FONT_SPEC (font
);
4197 ASET (font
, idx
, font_prop_validate (idx
, Qnil
, val
));
4201 if (EQ (prop
, QCname
)
4202 || EQ (prop
, QCscript
)
4203 || EQ (prop
, QClang
)
4204 || EQ (prop
, QCotf
))
4205 CHECK_FONT_SPEC (font
);
4208 font_put_extra (font
, prop
, font_prop_validate (0, prop
, val
));
4213 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4214 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4215 Optional 2nd argument FRAME specifies the target frame.
4216 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4217 Optional 4th argument PREFER, if non-nil, is a font-spec to
4218 control the order of the returned list. Fonts are sorted by
4219 how close they are to PREFER. */)
4220 (Lisp_Object font_spec
, Lisp_Object frame
, Lisp_Object num
, Lisp_Object prefer
)
4222 Lisp_Object vec
, list
;
4226 frame
= selected_frame
;
4227 CHECK_LIVE_FRAME (frame
);
4228 CHECK_FONT_SPEC (font_spec
);
4236 if (! NILP (prefer
))
4237 CHECK_FONT_SPEC (prefer
);
4239 list
= font_list_entities (frame
, font_spec
);
4242 if (NILP (XCDR (list
))
4243 && ASIZE (XCAR (list
)) == 1)
4244 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4246 if (! NILP (prefer
))
4247 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4249 vec
= font_vconcat_entity_vectors (list
);
4250 if (n
== 0 || n
>= ASIZE (vec
))
4252 Lisp_Object args
[2];
4256 list
= Fappend (2, args
);
4260 for (list
= Qnil
, n
--; n
>= 0; n
--)
4261 list
= Fcons (AREF (vec
, n
), list
);
4266 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4267 doc
: /* List available font families on the current frame.
4268 Optional argument FRAME, if non-nil, specifies the target frame. */)
4272 struct font_driver_list
*driver_list
;
4276 frame
= selected_frame
;
4277 CHECK_LIVE_FRAME (frame
);
4280 for (driver_list
= f
->font_driver_list
; driver_list
;
4281 driver_list
= driver_list
->next
)
4282 if (driver_list
->driver
->list_family
)
4284 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4285 Lisp_Object tail
= list
;
4287 for (; CONSP (val
); val
= XCDR (val
))
4288 if (NILP (Fmemq (XCAR (val
), tail
))
4289 && SYMBOLP (XCAR (val
)))
4290 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4295 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4296 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4297 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4298 (Lisp_Object font_spec
, Lisp_Object frame
)
4300 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4307 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4308 doc
: /* Return XLFD name of FONT.
4309 FONT is a font-spec, font-entity, or font-object.
4310 If the name is too long for XLFD (maximum 255 chars), return nil.
4311 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4312 the consecutive wildcards are folded to one. */)
4313 (Lisp_Object font
, Lisp_Object fold_wildcards
)
4320 if (FONT_OBJECT_P (font
))
4322 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4324 if (STRINGP (font_name
)
4325 && SDATA (font_name
)[0] == '-')
4327 if (NILP (fold_wildcards
))
4329 strcpy (name
, (char *) SDATA (font_name
));
4332 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4334 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4337 if (! NILP (fold_wildcards
))
4339 char *p0
= name
, *p1
;
4341 while ((p1
= strstr (p0
, "-*-*")))
4343 strcpy (p1
, p1
+ 2);
4348 return build_string (name
);
4351 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4352 doc
: /* Clear font cache. */)
4355 Lisp_Object list
, frame
;
4357 FOR_EACH_FRAME (list
, frame
)
4359 FRAME_PTR f
= XFRAME (frame
);
4360 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4362 for (; driver_list
; driver_list
= driver_list
->next
)
4363 if (driver_list
->on
)
4365 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4366 Lisp_Object val
, tmp
;
4370 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4372 font_assert (! NILP (val
));
4373 tmp
= XCDR (XCAR (val
));
4374 if (XINT (XCAR (tmp
)) == 0)
4376 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4377 XSETCDR (cache
, XCDR (val
));
4387 font_fill_lglyph_metrics (Lisp_Object glyph
, Lisp_Object font_object
)
4389 struct font
*font
= XFONT_OBJECT (font_object
);
4391 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4392 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4393 struct font_metrics metrics
;
4395 LGLYPH_SET_CODE (glyph
, ecode
);
4397 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4398 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4399 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4400 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4401 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4402 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4406 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4407 doc
: /* Shape the glyph-string GSTRING.
4408 Shaping means substituting glyphs and/or adjusting positions of glyphs
4409 to get the correct visual image of character sequences set in the
4410 header of the glyph-string.
4412 If the shaping was successful, the value is GSTRING itself or a newly
4413 created glyph-string. Otherwise, the value is nil. */)
4414 (Lisp_Object gstring
)
4417 Lisp_Object font_object
, n
, glyph
;
4420 if (! composition_gstring_p (gstring
))
4421 signal_error ("Invalid glyph-string: ", gstring
);
4422 if (! NILP (LGSTRING_ID (gstring
)))
4424 font_object
= LGSTRING_FONT (gstring
);
4425 CHECK_FONT_OBJECT (font_object
);
4426 font
= XFONT_OBJECT (font_object
);
4427 if (! font
->driver
->shape
)
4430 /* Try at most three times with larger gstring each time. */
4431 for (i
= 0; i
< 3; i
++)
4433 n
= font
->driver
->shape (gstring
);
4436 gstring
= larger_vector (gstring
,
4437 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4440 if (i
== 3 || XINT (n
) == 0)
4442 if (XINT (n
) < LGSTRING_GLYPH_LEN (gstring
))
4443 LGSTRING_SET_GLYPH (gstring
, XINT (n
), Qnil
);
4445 glyph
= LGSTRING_GLYPH (gstring
, 0);
4446 from
= LGLYPH_FROM (glyph
);
4447 to
= LGLYPH_TO (glyph
);
4448 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4450 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4454 if (NILP (LGLYPH_ADJUSTMENT (this)))
4459 glyph
= LGSTRING_GLYPH (gstring
, j
);
4460 LGLYPH_SET_FROM (glyph
, from
);
4461 LGLYPH_SET_TO (glyph
, to
);
4463 from
= LGLYPH_FROM (this);
4464 to
= LGLYPH_TO (this);
4469 if (from
> LGLYPH_FROM (this))
4470 from
= LGLYPH_FROM (this);
4471 if (to
< LGLYPH_TO (this))
4472 to
= LGLYPH_TO (this);
4478 glyph
= LGSTRING_GLYPH (gstring
, j
);
4479 LGLYPH_SET_FROM (glyph
, from
);
4480 LGLYPH_SET_TO (glyph
, to
);
4482 return composition_gstring_put_cache (gstring
, XINT (n
));
4485 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4487 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4488 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4490 VARIATION-SELECTOR is a chracter code of variation selection
4491 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4492 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4493 (Lisp_Object font_object
, Lisp_Object character
)
4495 unsigned variations
[256];
4500 CHECK_FONT_OBJECT (font_object
);
4501 CHECK_CHARACTER (character
);
4502 font
= XFONT_OBJECT (font_object
);
4503 if (! font
->driver
->get_variation_glyphs
)
4505 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4509 for (i
= 0; i
< 255; i
++)
4513 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4514 /* Stops GCC whining about limited range of data type. */
4515 EMACS_INT var
= variations
[i
];
4517 if (var
> MOST_POSITIVE_FIXNUM
)
4518 code
= Fcons (make_number ((variations
[i
]) >> 16),
4519 make_number ((variations
[i
]) & 0xFFFF));
4521 code
= make_number (variations
[i
]);
4522 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4529 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4530 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4531 OTF-FEATURES specifies which features to apply in this format:
4532 (SCRIPT LANGSYS GSUB GPOS)
4534 SCRIPT is a symbol specifying a script tag of OpenType,
4535 LANGSYS is a symbol specifying a langsys tag of OpenType,
4536 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4538 If LANGYS is nil, the default langsys is selected.
4540 The features are applied in the order they appear in the list. The
4541 symbol `*' means to apply all available features not present in this
4542 list, and the remaining features are ignored. For instance, (vatu
4543 pstf * haln) is to apply vatu and pstf in this order, then to apply
4544 all available features other than vatu, pstf, and haln.
4546 The features are applied to the glyphs in the range FROM and TO of
4547 the glyph-string GSTRING-IN.
4549 If some feature is actually applicable, the resulting glyphs are
4550 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4551 this case, the value is the number of produced glyphs.
4553 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4556 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4557 produced in GSTRING-OUT, and the value is nil.
4559 See the documentation of `font-make-gstring' for the format of
4561 (Lisp_Object otf_features
, Lisp_Object gstring_in
, Lisp_Object from
, Lisp_Object to
, Lisp_Object gstring_out
, Lisp_Object index
)
4563 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4568 check_otf_features (otf_features
);
4569 CHECK_FONT_OBJECT (font_object
);
4570 font
= XFONT_OBJECT (font_object
);
4571 if (! font
->driver
->otf_drive
)
4572 error ("Font backend %s can't drive OpenType GSUB table",
4573 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4574 CHECK_CONS (otf_features
);
4575 CHECK_SYMBOL (XCAR (otf_features
));
4576 val
= XCDR (otf_features
);
4577 CHECK_SYMBOL (XCAR (val
));
4578 val
= XCDR (otf_features
);
4581 len
= check_gstring (gstring_in
);
4582 CHECK_VECTOR (gstring_out
);
4583 CHECK_NATNUM (from
);
4585 CHECK_NATNUM (index
);
4587 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4588 args_out_of_range_3 (from
, to
, make_number (len
));
4589 if (XINT (index
) >= ASIZE (gstring_out
))
4590 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4591 num
= font
->driver
->otf_drive (font
, otf_features
,
4592 gstring_in
, XINT (from
), XINT (to
),
4593 gstring_out
, XINT (index
), 0);
4596 return make_number (num
);
4599 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4601 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4602 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4604 (SCRIPT LANGSYS FEATURE ...)
4605 See the documentation of `font-drive-otf' for more detail.
4607 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4608 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4609 character code corresponding to the glyph or nil if there's no
4610 corresponding character. */)
4611 (Lisp_Object font_object
, Lisp_Object character
, Lisp_Object otf_features
)
4614 Lisp_Object gstring_in
, gstring_out
, g
;
4615 Lisp_Object alternates
;
4618 CHECK_FONT_GET_OBJECT (font_object
, font
);
4619 if (! font
->driver
->otf_drive
)
4620 error ("Font backend %s can't drive OpenType GSUB table",
4621 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4622 CHECK_CHARACTER (character
);
4623 CHECK_CONS (otf_features
);
4625 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4626 g
= LGSTRING_GLYPH (gstring_in
, 0);
4627 LGLYPH_SET_CHAR (g
, XINT (character
));
4628 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4629 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4630 gstring_out
, 0, 1)) < 0)
4631 gstring_out
= Ffont_make_gstring (font_object
,
4632 make_number (ASIZE (gstring_out
) * 2));
4634 for (i
= 0; i
< num
; i
++)
4636 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4637 int c
= LGLYPH_CHAR (g
);
4638 unsigned code
= LGLYPH_CODE (g
);
4640 alternates
= Fcons (Fcons (make_number (code
),
4641 c
> 0 ? make_number (c
) : Qnil
),
4644 return Fnreverse (alternates
);
4650 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4651 doc
: /* Open FONT-ENTITY. */)
4652 (Lisp_Object font_entity
, Lisp_Object size
, Lisp_Object frame
)
4656 CHECK_FONT_ENTITY (font_entity
);
4658 frame
= selected_frame
;
4659 CHECK_LIVE_FRAME (frame
);
4662 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4665 CHECK_NUMBER_OR_FLOAT (size
);
4667 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4669 isize
= XINT (size
);
4673 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4676 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4677 doc
: /* Close FONT-OBJECT. */)
4678 (Lisp_Object font_object
, Lisp_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. */)
4729 (Lisp_Object font_object
)
4734 CHECK_FONT_GET_OBJECT (font_object
, font
);
4736 val
= Fmake_vector (make_number (9), Qnil
);
4737 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4738 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4739 ASET (val
, 2, make_number (font
->pixel_size
));
4740 ASET (val
, 3, make_number (font
->max_width
));
4741 ASET (val
, 4, make_number (font
->ascent
));
4742 ASET (val
, 5, make_number (font
->descent
));
4743 ASET (val
, 6, make_number (font
->space_width
));
4744 ASET (val
, 7, make_number (font
->average_width
));
4745 if (font
->driver
->otf_capability
)
4746 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4750 DEFUN ("font-get-glyphs", Ffont_get_glyphs
, Sfont_get_glyphs
, 3, 4, 0,
4752 /* Return a vector of FONT-OBJECT's glyphs for the specified characters.
4753 FROM and TO are positions (integers or markers) specifying a region
4754 of the current buffer.
4755 If the optional fourth arg OBJECT is not nil, it is a string or a
4756 vector containing the target characters.
4758 Each element is a vector containing information of a glyph in this format:
4759 [FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT ADJUSTMENT]
4761 FROM is an index numbers of a character the glyph corresponds to.
4762 TO is the same as FROM.
4763 C is the character of the glyph.
4764 CODE is the glyph-code of C in FONT-OBJECT.
4765 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4766 ADJUSTMENT is always nil.
4767 If FONT-OBJECT doesn't have a glyph for a character,
4768 the corresponding element is nil. */)
4769 (Lisp_Object font_object
, Lisp_Object from
, Lisp_Object to
,
4774 Lisp_Object
*chars
, vec
;
4777 CHECK_FONT_GET_OBJECT (font_object
, font
);
4780 EMACS_INT charpos
, bytepos
;
4782 validate_region (&from
, &to
);
4785 len
= XFASTINT (to
) - XFASTINT (from
);
4786 SAFE_ALLOCA_LISP (chars
, len
);
4787 charpos
= XFASTINT (from
);
4788 bytepos
= CHAR_TO_BYTE (charpos
);
4789 for (i
= 0; charpos
< XFASTINT (to
); i
++)
4791 FETCH_CHAR_ADVANCE (c
, charpos
, bytepos
);
4792 chars
[i
] = make_number (c
);
4795 else if (STRINGP (object
))
4797 const unsigned char *p
;
4799 CHECK_NUMBER (from
);
4801 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4802 || XINT (to
) > SCHARS (object
))
4803 args_out_of_range_3 (object
, from
, to
);
4806 len
= XFASTINT (to
) - XFASTINT (from
);
4807 SAFE_ALLOCA_LISP (chars
, len
);
4809 if (STRING_MULTIBYTE (object
))
4810 for (i
= 0; i
< len
; i
++)
4812 c
= STRING_CHAR_ADVANCE (p
);
4813 chars
[i
] = make_number (c
);
4816 for (i
= 0; i
< len
; i
++)
4817 chars
[i
] = make_number (p
[i
]);
4821 CHECK_VECTOR (object
);
4822 CHECK_NUMBER (from
);
4824 if (XINT (from
) < 0 || XINT (from
) > XINT (to
)
4825 || XINT (to
) > ASIZE (object
))
4826 args_out_of_range_3 (object
, from
, to
);
4829 len
= XFASTINT (to
) - XFASTINT (from
);
4830 for (i
= 0; i
< len
; i
++)
4832 Lisp_Object elt
= AREF (object
, XFASTINT (from
) + i
);
4833 CHECK_CHARACTER (elt
);
4835 chars
= &(AREF (object
, XFASTINT (from
)));
4838 vec
= Fmake_vector (make_number (len
), Qnil
);
4839 for (i
= 0; i
< len
; i
++)
4842 int c
= XFASTINT (chars
[i
]);
4845 struct font_metrics metrics
;
4847 cod
= code
= font
->driver
->encode_char (font
, c
);
4848 if (code
== FONT_INVALID_CODE
)
4850 g
= Fmake_vector (make_number (LGLYPH_SIZE
), Qnil
);
4851 LGLYPH_SET_FROM (g
, i
);
4852 LGLYPH_SET_TO (g
, i
);
4853 LGLYPH_SET_CHAR (g
, c
);
4854 LGLYPH_SET_CODE (g
, code
);
4855 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4856 LGLYPH_SET_WIDTH (g
, metrics
.width
);
4857 LGLYPH_SET_LBEARING (g
, metrics
.lbearing
);
4858 LGLYPH_SET_RBEARING (g
, metrics
.rbearing
);
4859 LGLYPH_SET_ASCENT (g
, metrics
.ascent
);
4860 LGLYPH_SET_DESCENT (g
, metrics
.descent
);
4863 if (! VECTORP (object
))
4868 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4869 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4870 FONT is a font-spec, font-entity, or font-object. */)
4871 (Lisp_Object spec
, Lisp_Object font
)
4873 CHECK_FONT_SPEC (spec
);
4876 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4879 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4880 doc
: /* Return a font-object for displaying a character at POSITION.
4881 Optional second arg WINDOW, if non-nil, is a window displaying
4882 the current buffer. It defaults to the currently selected window. */)
4883 (Lisp_Object position
, Lisp_Object window
, Lisp_Object string
)
4890 CHECK_NUMBER_COERCE_MARKER (position
);
4891 pos
= XINT (position
);
4892 if (pos
< BEGV
|| pos
>= ZV
)
4893 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4897 CHECK_NUMBER (position
);
4898 CHECK_STRING (string
);
4899 pos
= XINT (position
);
4900 if (pos
< 0 || pos
>= SCHARS (string
))
4901 args_out_of_range (string
, position
);
4904 window
= selected_window
;
4905 CHECK_LIVE_WINDOW (window
);
4906 w
= XWINDOW (window
);
4908 return font_at (-1, pos
, NULL
, w
, string
);
4912 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4913 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4914 The value is a number of glyphs drawn.
4915 Type C-l to recover what previously shown. */)
4916 (Lisp_Object font_object
, Lisp_Object string
)
4918 Lisp_Object frame
= selected_frame
;
4919 FRAME_PTR f
= XFRAME (frame
);
4925 CHECK_FONT_GET_OBJECT (font_object
, font
);
4926 CHECK_STRING (string
);
4927 len
= SCHARS (string
);
4928 code
= alloca (sizeof (unsigned) * len
);
4929 for (i
= 0; i
< len
; i
++)
4931 Lisp_Object ch
= Faref (string
, make_number (i
));
4935 code
[i
] = font
->driver
->encode_char (font
, c
);
4936 if (code
[i
] == FONT_INVALID_CODE
)
4939 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4941 if (font
->driver
->prepare_face
)
4942 font
->driver
->prepare_face (f
, face
);
4943 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4944 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4945 if (font
->driver
->done_face
)
4946 font
->driver
->done_face (f
, face
);
4948 return make_number (len
);
4952 #endif /* FONT_DEBUG */
4954 #ifdef HAVE_WINDOW_SYSTEM
4956 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4957 doc
: /* Return information about a font named NAME on frame FRAME.
4958 If FRAME is omitted or nil, use the selected frame.
4959 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
4960 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4962 OPENED-NAME is the name used for opening the font,
4963 FULL-NAME is the full name of the font,
4964 SIZE is the pixelsize of the font,
4965 HEIGHT is the pixel-height of the font (i.e ascent + descent),
4966 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4967 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4968 how to compose characters.
4969 If the named font is not yet loaded, return nil. */)
4970 (Lisp_Object name
, Lisp_Object frame
)
4975 Lisp_Object font_object
;
4977 (*check_window_system_func
) ();
4980 CHECK_STRING (name
);
4982 frame
= selected_frame
;
4983 CHECK_LIVE_FRAME (frame
);
4988 int fontset
= fs_query_fontset (name
, 0);
4991 name
= fontset_ascii (fontset
);
4992 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4994 else if (FONT_OBJECT_P (name
))
4996 else if (FONT_ENTITY_P (name
))
4997 font_object
= font_open_entity (f
, name
, 0);
5000 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5001 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
5003 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
5005 if (NILP (font_object
))
5007 font
= XFONT_OBJECT (font_object
);
5009 info
= Fmake_vector (make_number (7), Qnil
);
5010 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
5011 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
5012 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
5013 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
5014 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
5015 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
5016 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
5019 /* As font_object is still in FONT_OBJLIST of the entity, we can't
5020 close it now. Perhaps, we should manage font-objects
5021 by `reference-count'. */
5022 font_close_object (f
, font_object
);
5029 #define BUILD_STYLE_TABLE(TBL) \
5030 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
5033 build_style_table (const struct table_entry
*entry
, int nelement
)
5036 Lisp_Object table
, elt
;
5038 table
= Fmake_vector (make_number (nelement
), Qnil
);
5039 for (i
= 0; i
< nelement
; i
++)
5041 for (j
= 0; entry
[i
].names
[j
]; j
++);
5042 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
5043 ASET (elt
, 0, make_number (entry
[i
].numeric
));
5044 for (j
= 0; entry
[i
].names
[j
]; j
++)
5045 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
5046 ASET (table
, i
, elt
);
5051 Lisp_Object Vfont_log
;
5053 /* The deferred font-log data of the form [ACTION ARG RESULT].
5054 If ACTION is not nil, that is added to the log when font_add_log is
5055 called next time. At that time, ACTION is set back to nil. */
5056 static Lisp_Object Vfont_log_deferred
;
5058 /* Prepend the font-related logging data in Vfont_log if it is not
5059 `t'. ACTION describes a kind of font-related action (e.g. listing,
5060 opening), ARG is the argument for the action, and RESULT is the
5061 result of the action. */
5063 font_add_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5065 Lisp_Object tail
, val
;
5068 if (EQ (Vfont_log
, Qt
))
5070 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5072 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
5074 ASET (Vfont_log_deferred
, 0, Qnil
);
5075 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5076 AREF (Vfont_log_deferred
, 2));
5081 Lisp_Object tail
, elt
;
5082 Lisp_Object equalstr
= build_string ("=");
5084 val
= Ffont_xlfd_name (arg
, Qt
);
5085 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5089 if (EQ (XCAR (elt
), QCscript
)
5090 && SYMBOLP (XCDR (elt
)))
5091 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5092 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5093 else if (EQ (XCAR (elt
), QClang
)
5094 && SYMBOLP (XCDR (elt
)))
5095 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5096 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5097 else if (EQ (XCAR (elt
), QCotf
)
5098 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5099 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5101 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5107 && VECTORP (XCAR (result
))
5108 && ASIZE (XCAR (result
)) > 0
5109 && FONTP (AREF (XCAR (result
), 0)))
5110 result
= font_vconcat_entity_vectors (result
);
5113 val
= Ffont_xlfd_name (result
, Qt
);
5114 if (! FONT_SPEC_P (result
))
5115 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5116 build_string (":"), val
);
5119 else if (CONSP (result
))
5121 result
= Fcopy_sequence (result
);
5122 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5126 val
= Ffont_xlfd_name (val
, Qt
);
5127 XSETCAR (tail
, val
);
5130 else if (VECTORP (result
))
5132 result
= Fcopy_sequence (result
);
5133 for (i
= 0; i
< ASIZE (result
); i
++)
5135 val
= AREF (result
, i
);
5137 val
= Ffont_xlfd_name (val
, Qt
);
5138 ASET (result
, i
, val
);
5141 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5144 /* Record a font-related logging data to be added to Vfont_log when
5145 font_add_log is called next time. ACTION, ARG, RESULT are the same
5149 font_deferred_log (const char *action
, Lisp_Object arg
, Lisp_Object result
)
5151 if (EQ (Vfont_log
, Qt
))
5153 ASET (Vfont_log_deferred
, 0, build_string (action
));
5154 ASET (Vfont_log_deferred
, 1, arg
);
5155 ASET (Vfont_log_deferred
, 2, result
);
5161 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5162 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5163 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5164 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5165 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5166 /* Note that the other elements in sort_shift_bits are not used. */
5168 staticpro (&font_charset_alist
);
5169 font_charset_alist
= Qnil
;
5171 DEFSYM (Qopentype
, "opentype");
5173 DEFSYM (Qascii_0
, "ascii-0");
5174 DEFSYM (Qiso8859_1
, "iso8859-1");
5175 DEFSYM (Qiso10646_1
, "iso10646-1");
5176 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5177 DEFSYM (Qunicode_sip
, "unicode-sip");
5181 DEFSYM (QCotf
, ":otf");
5182 DEFSYM (QClang
, ":lang");
5183 DEFSYM (QCscript
, ":script");
5184 DEFSYM (QCantialias
, ":antialias");
5186 DEFSYM (QCfoundry
, ":foundry");
5187 DEFSYM (QCadstyle
, ":adstyle");
5188 DEFSYM (QCregistry
, ":registry");
5189 DEFSYM (QCspacing
, ":spacing");
5190 DEFSYM (QCdpi
, ":dpi");
5191 DEFSYM (QCscalable
, ":scalable");
5192 DEFSYM (QCavgwidth
, ":avgwidth");
5193 DEFSYM (QCfont_entity
, ":font-entity");
5194 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5204 DEFSYM (QCuser_spec
, "user-spec");
5206 staticpro (&null_vector
);
5207 null_vector
= Fmake_vector (make_number (0), Qnil
);
5209 staticpro (&scratch_font_spec
);
5210 scratch_font_spec
= Ffont_spec (0, NULL
);
5211 staticpro (&scratch_font_prefer
);
5212 scratch_font_prefer
= Ffont_spec (0, NULL
);
5214 staticpro (&Vfont_log_deferred
);
5215 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5219 staticpro (&otf_list
);
5221 #endif /* HAVE_LIBOTF */
5225 defsubr (&Sfont_spec
);
5226 defsubr (&Sfont_get
);
5227 #ifdef HAVE_WINDOW_SYSTEM
5228 defsubr (&Sfont_face_attributes
);
5230 defsubr (&Sfont_put
);
5231 defsubr (&Slist_fonts
);
5232 defsubr (&Sfont_family_list
);
5233 defsubr (&Sfind_font
);
5234 defsubr (&Sfont_xlfd_name
);
5235 defsubr (&Sclear_font_cache
);
5236 defsubr (&Sfont_shape_gstring
);
5237 defsubr (&Sfont_variation_glyphs
);
5239 defsubr (&Sfont_drive_otf
);
5240 defsubr (&Sfont_otf_alternates
);
5244 defsubr (&Sopen_font
);
5245 defsubr (&Sclose_font
);
5246 defsubr (&Squery_font
);
5247 defsubr (&Sfont_get_glyphs
);
5248 defsubr (&Sfont_match_p
);
5249 defsubr (&Sfont_at
);
5251 defsubr (&Sdraw_string
);
5253 #endif /* FONT_DEBUG */
5254 #ifdef HAVE_WINDOW_SYSTEM
5255 defsubr (&Sfont_info
);
5258 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5260 Alist of fontname patterns vs the corresponding encoding and repertory info.
5261 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5262 where ENCODING is a charset or a char-table,
5263 and REPERTORY is a charset, a char-table, or nil.
5265 If ENCODING and REPERTORY are the same, the element can have the form
5266 \(REGEXP . ENCODING).
5268 ENCODING is for converting a character to a glyph code of the font.
5269 If ENCODING is a charset, encoding a character by the charset gives
5270 the corresponding glyph code. If ENCODING is a char-table, looking up
5271 the table by a character gives the corresponding glyph code.
5273 REPERTORY specifies a repertory of characters supported by the font.
5274 If REPERTORY is a charset, all characters beloging to the charset are
5275 supported. If REPERTORY is a char-table, all characters who have a
5276 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5277 gets the repertory information by an opened font and ENCODING. */);
5278 Vfont_encoding_alist
= Qnil
;
5280 /* FIXME: These 3 vars are not quite what they appear: setq on them
5281 won't have any effect other than disconnect them from the style
5282 table used by the font display code. So we make them read-only,
5283 to avoid this confusing situation. */
5285 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5286 doc
: /* Vector of valid font weight values.
5287 Each element has the form:
5288 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5289 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5290 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5291 XSYMBOL (intern_c_string ("font-weight-table"))->constant
= 1;
5293 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5294 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5295 See `font-weight-table' for the format of the vector. */);
5296 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5297 XSYMBOL (intern_c_string ("font-slant-table"))->constant
= 1;
5299 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5300 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5301 See `font-weight-table' for the format of the vector. */);
5302 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5303 XSYMBOL (intern_c_string ("font-width-table"))->constant
= 1;
5305 staticpro (&font_style_table
);
5306 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5307 ASET (font_style_table
, 0, Vfont_weight_table
);
5308 ASET (font_style_table
, 1, Vfont_slant_table
);
5309 ASET (font_style_table
, 2, Vfont_width_table
);
5311 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5312 *Logging list of font related actions and results.
5313 The value t means to suppress the logging.
5314 The initial value is set to nil if the environment variable
5315 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5318 #ifdef HAVE_WINDOW_SYSTEM
5319 #ifdef HAVE_FREETYPE
5321 #ifdef HAVE_X_WINDOWS
5326 #endif /* HAVE_XFT */
5327 #endif /* HAVE_X_WINDOWS */
5328 #else /* not HAVE_FREETYPE */
5329 #ifdef HAVE_X_WINDOWS
5331 #endif /* HAVE_X_WINDOWS */
5332 #endif /* not HAVE_FREETYPE */
5335 #endif /* HAVE_BDFFONT */
5338 #endif /* WINDOWSNT */
5341 #endif /* HAVE_NS */
5342 #endif /* HAVE_WINDOW_SYSTEM */
5348 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
5351 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5352 (do not change this comment) */