1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
3 Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011
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 */
52 extern Lisp_Object Qfontsize
;
55 Lisp_Object Qopentype
;
57 /* Important character set strings. */
58 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
60 #define DEFAULT_ENCODING Qiso8859_1
62 /* Unicode category `Cf'. */
63 static Lisp_Object QCf
;
65 /* Special vector of zero length. This is repeatedly used by (struct
66 font_driver *)->list when a specified font is not found. */
67 static Lisp_Object null_vector
;
69 static Lisp_Object Vfont_weight_table
, Vfont_slant_table
, Vfont_width_table
;
71 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
72 static Lisp_Object font_style_table
;
74 /* Structure used for tables mapping weight, slant, and width numeric
75 values and their names. */
80 /* The first one is a valid name as a face attribute.
81 The second one (if any) is a typical name in XLFD field. */
85 /* Table of weight numeric values and their names. This table must be
86 sorted by numeric values in ascending order. */
88 static const struct table_entry weight_table
[] =
91 { 20, { "ultra-light", "ultralight" }},
92 { 40, { "extra-light", "extralight" }},
94 { 75, { "semi-light", "semilight", "demilight", "book" }},
95 { 100, { "normal", "medium", "regular", "unspecified" }},
96 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
98 { 205, { "extra-bold", "extrabold" }},
99 { 210, { "ultra-bold", "ultrabold", "black" }}
102 /* Table of slant numeric values and their names. This table must be
103 sorted by numeric values in ascending order. */
105 static const struct table_entry slant_table
[] =
107 { 0, { "reverse-oblique", "ro" }},
108 { 10, { "reverse-italic", "ri" }},
109 { 100, { "normal", "r", "unspecified" }},
110 { 200, { "italic" ,"i", "ot" }},
111 { 210, { "oblique", "o" }}
114 /* Table of width numeric values and their names. This table must be
115 sorted by numeric values in ascending order. */
117 static const struct table_entry width_table
[] =
119 { 50, { "ultra-condensed", "ultracondensed" }},
120 { 63, { "extra-condensed", "extracondensed" }},
121 { 75, { "condensed", "compressed", "narrow" }},
122 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
123 { 100, { "normal", "medium", "regular", "unspecified" }},
124 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
125 { 125, { "expanded" }},
126 { 150, { "extra-expanded", "extraexpanded" }},
127 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
130 extern Lisp_Object Qnormal
;
132 /* Symbols representing keys of normal font properties. */
133 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
;
134 extern Lisp_Object QCheight
, QCsize
, QCname
;
136 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
;
137 /* Symbols representing keys of font extra info. */
138 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
139 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
140 /* Symbols representing values of font spacing property. */
141 Lisp_Object Qc
, Qm
, Qp
, Qd
;
142 /* Special ADSTYLE properties to avoid fonts used for Latin
143 characters; used in xfont.c and ftfont.c. */
144 Lisp_Object Qja
, Qko
;
146 Lisp_Object QCuser_spec
;
148 Lisp_Object Vfont_encoding_alist
;
150 /* Alist of font registry symbol and the corresponding charsets
151 information. The information is retrieved from
152 Vfont_encoding_alist on demand.
154 Eash element has the form:
155 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
159 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
160 encodes a character code to a glyph code of a font, and
161 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
162 character is supported by a font.
164 The latter form means that the information for REGISTRY couldn't be
166 static Lisp_Object font_charset_alist
;
168 /* List of all font drivers. Each font-backend (XXXfont.c) calls
169 register_font_driver in syms_of_XXXfont to register its font-driver
171 static struct font_driver_list
*font_driver_list
;
175 /* Creaters of font-related Lisp object. */
180 Lisp_Object font_spec
;
181 struct font_spec
*spec
182 = ((struct font_spec
*)
183 allocate_pseudovector (VECSIZE (struct font_spec
),
184 FONT_SPEC_MAX
, PVEC_FONT
));
185 XSETFONT (font_spec
, spec
);
192 Lisp_Object font_entity
;
193 struct font_entity
*entity
194 = ((struct font_entity
*)
195 allocate_pseudovector (VECSIZE (struct font_entity
),
196 FONT_ENTITY_MAX
, PVEC_FONT
));
197 XSETFONT (font_entity
, entity
);
201 /* Create a font-object whose structure size is SIZE. If ENTITY is
202 not nil, copy properties from ENTITY to the font-object. If
203 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
205 font_make_object (size
, entity
, pixelsize
)
210 Lisp_Object font_object
;
212 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
215 XSETFONT (font_object
, font
);
219 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
220 font
->props
[i
] = AREF (entity
, i
);
221 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
222 font
->props
[FONT_EXTRA_INDEX
]
223 = Fcopy_alist (AREF (entity
, FONT_EXTRA_INDEX
));
226 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
232 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
233 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
234 static Lisp_Object font_matching_entity
P_ ((FRAME_PTR
, Lisp_Object
*,
237 /* Number of registered font drivers. */
238 static int num_font_drivers
;
241 /* Return a Lispy value of a font property value at STR and LEN bytes.
242 If STR is "*", it returns nil.
243 If FORCE_SYMBOL is zero and all characters in STR are digits, it
244 returns an integer. Otherwise, it returns a symbol interned from
248 font_intern_prop (str
, len
, force_symbol
)
258 if (len
== 1 && *str
== '*')
260 if (!force_symbol
&& len
>=1 && isdigit (*str
))
262 for (i
= 1; i
< len
; i
++)
263 if (! isdigit (str
[i
]))
266 return make_number (atoi (str
));
269 /* The following code is copied from the function intern (in
270 lread.c), and modified to suite our purpose. */
272 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
273 obarray
= check_obarray (obarray
);
274 parse_str_as_multibyte ((unsigned char *) str
, len
, &nchars
, &nbytes
);
275 if (len
== nchars
|| len
!= nbytes
)
276 /* CONTENTS contains no multibyte sequences or contains an invalid
277 multibyte sequence. We'll make a unibyte string. */
278 tem
= oblookup (obarray
, str
, len
, len
);
280 tem
= oblookup (obarray
, str
, nchars
, len
);
283 if (len
== nchars
|| len
!= nbytes
)
284 tem
= make_unibyte_string (str
, len
);
286 tem
= make_multibyte_string (str
, nchars
, len
);
287 return Fintern (tem
, obarray
);
290 /* Return a pixel size of font-spec SPEC on frame F. */
293 font_pixel_size (f
, spec
)
297 #ifdef HAVE_WINDOW_SYSTEM
298 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
307 font_assert (FLOATP (size
));
308 point_size
= XFLOAT_DATA (size
);
309 val
= AREF (spec
, FONT_DPI_INDEX
);
314 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
322 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
323 font vector. If VAL is not valid (i.e. not registered in
324 font_style_table), return -1 if NOERROR is zero, and return a
325 proper index if NOERROR is nonzero. In that case, register VAL in
326 font_style_table if VAL is a symbol, and return a closest index if
327 VAL is an integer. */
330 font_style_to_value (prop
, val
, noerror
)
331 enum font_property_index prop
;
335 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
336 int len
= ASIZE (table
);
342 Lisp_Object args
[2], elt
;
344 /* At first try exact match. */
345 for (i
= 0; i
< len
; i
++)
346 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
347 if (EQ (val
, AREF (AREF (table
, i
), j
)))
348 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
349 | (i
<< 4) | (j
- 1));
350 /* Try also with case-folding match. */
351 s
= SDATA (SYMBOL_NAME (val
));
352 for (i
= 0; i
< len
; i
++)
353 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
355 elt
= AREF (AREF (table
, i
), j
);
356 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
357 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
358 | (i
<< 4) | (j
- 1));
364 elt
= Fmake_vector (make_number (2), make_number (100));
367 args
[1] = Fmake_vector (make_number (1), elt
);
368 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
369 return (100 << 8) | (i
<< 4);
374 int numeric
= XINT (val
);
376 for (i
= 0, last_n
= -1; i
< len
; i
++)
378 int n
= XINT (AREF (AREF (table
, i
), 0));
381 return (n
<< 8) | (i
<< 4);
386 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
387 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
393 return ((last_n
<< 8) | ((i
- 1) << 4));
398 font_style_symbolic (font
, prop
, for_face
)
400 enum font_property_index prop
;
403 Lisp_Object val
= AREF (font
, prop
);
404 Lisp_Object table
, elt
;
409 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
410 i
= XINT (val
) & 0xFF;
411 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
412 elt
= AREF (table
, ((i
>> 4) & 0xF));
413 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
414 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
417 extern Lisp_Object Vface_alternative_font_family_alist
;
419 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
422 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
423 FONTNAME. ENCODING is a charset symbol that specifies the encoding
424 of the font. REPERTORY is a charset symbol or nil. */
427 find_font_encoding (fontname
)
428 Lisp_Object fontname
;
430 Lisp_Object tail
, elt
;
432 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
436 && STRINGP (XCAR (elt
))
437 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
438 && (SYMBOLP (XCDR (elt
))
439 ? CHARSETP (XCDR (elt
))
440 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
446 /* Return encoding charset and repertory charset for REGISTRY in
447 ENCODING and REPERTORY correspondingly. If correct information for
448 REGISTRY is available, return 0. Otherwise return -1. */
451 font_registry_charsets (registry
, encoding
, repertory
)
452 Lisp_Object registry
;
453 struct charset
**encoding
, **repertory
;
456 int encoding_id
, repertory_id
;
458 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
464 encoding_id
= XINT (XCAR (val
));
465 repertory_id
= XINT (XCDR (val
));
469 val
= find_font_encoding (SYMBOL_NAME (registry
));
470 if (SYMBOLP (val
) && CHARSETP (val
))
472 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
474 else if (CONSP (val
))
476 if (! CHARSETP (XCAR (val
)))
478 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
479 if (NILP (XCDR (val
)))
483 if (! CHARSETP (XCDR (val
)))
485 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
490 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
492 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
496 *encoding
= CHARSET_FROM_ID (encoding_id
);
498 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
503 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
508 /* Font property value validaters. See the comment of
509 font_property_table for the meaning of the arguments. */
511 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
512 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
513 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
514 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
515 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
516 static int get_font_prop_index
P_ ((Lisp_Object
));
519 font_prop_validate_symbol (prop
, val
)
520 Lisp_Object prop
, val
;
523 val
= Fintern (val
, Qnil
);
526 else if (EQ (prop
, QCregistry
))
527 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
533 font_prop_validate_style (style
, val
)
534 Lisp_Object style
, val
;
536 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
537 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
544 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
548 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
550 if ((n
& 0xF) + 1 >= ASIZE (elt
))
552 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
556 else if (SYMBOLP (val
))
558 int n
= font_style_to_value (prop
, val
, 0);
560 val
= n
>= 0 ? make_number (n
) : Qerror
;
568 font_prop_validate_non_neg (prop
, val
)
569 Lisp_Object prop
, val
;
571 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
576 font_prop_validate_spacing (prop
, val
)
577 Lisp_Object prop
, val
;
579 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
581 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
583 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
585 if (spacing
== 'c' || spacing
== 'C')
586 return make_number (FONT_SPACING_CHARCELL
);
587 if (spacing
== 'm' || spacing
== 'M')
588 return make_number (FONT_SPACING_MONO
);
589 if (spacing
== 'p' || spacing
== 'P')
590 return make_number (FONT_SPACING_PROPORTIONAL
);
591 if (spacing
== 'd' || spacing
== 'D')
592 return make_number (FONT_SPACING_DUAL
);
598 font_prop_validate_otf (prop
, val
)
599 Lisp_Object prop
, val
;
601 Lisp_Object tail
, tmp
;
604 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
605 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
606 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
609 if (! SYMBOLP (XCAR (val
)))
614 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
616 for (i
= 0; i
< 2; i
++)
623 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
624 if (! SYMBOLP (XCAR (tmp
)))
632 /* Structure of known font property keys and validater of the
636 /* Pointer to the key symbol. */
638 /* Function to validate PROP's value VAL, or NULL if any value is
639 ok. The value is VAL or its regularized value if VAL is valid,
640 and Qerror if not. */
641 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
642 } font_property_table
[] =
643 { { &QCtype
, font_prop_validate_symbol
},
644 { &QCfoundry
, font_prop_validate_symbol
},
645 { &QCfamily
, font_prop_validate_symbol
},
646 { &QCadstyle
, font_prop_validate_symbol
},
647 { &QCregistry
, font_prop_validate_symbol
},
648 { &QCweight
, font_prop_validate_style
},
649 { &QCslant
, font_prop_validate_style
},
650 { &QCwidth
, font_prop_validate_style
},
651 { &QCsize
, font_prop_validate_non_neg
},
652 { &QCdpi
, font_prop_validate_non_neg
},
653 { &QCspacing
, font_prop_validate_spacing
},
654 { &QCavgwidth
, font_prop_validate_non_neg
},
655 /* The order of the above entries must match with enum
656 font_property_index. */
657 { &QClang
, font_prop_validate_symbol
},
658 { &QCscript
, font_prop_validate_symbol
},
659 { &QCotf
, font_prop_validate_otf
}
662 /* Size (number of elements) of the above table. */
663 #define FONT_PROPERTY_TABLE_SIZE \
664 ((sizeof font_property_table) / (sizeof *font_property_table))
666 /* Return an index number of font property KEY or -1 if KEY is not an
667 already known property. */
670 get_font_prop_index (key
)
675 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
676 if (EQ (key
, *font_property_table
[i
].key
))
681 /* Validate the font property. The property key is specified by the
682 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
683 signal an error. The value is VAL or the regularized one. */
686 font_prop_validate (idx
, prop
, val
)
688 Lisp_Object prop
, val
;
690 Lisp_Object validated
;
695 prop
= *font_property_table
[idx
].key
;
698 idx
= get_font_prop_index (prop
);
702 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
703 if (EQ (validated
, Qerror
))
704 signal_error ("invalid font property", Fcons (prop
, val
));
709 /* Store VAL as a value of extra font property PROP in FONT while
710 keeping the sorting order. Don't check the validity of VAL. */
713 font_put_extra (font
, prop
, val
)
714 Lisp_Object font
, prop
, val
;
716 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
717 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
721 Lisp_Object prev
= Qnil
;
724 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
725 prev
= extra
, extra
= XCDR (extra
);
728 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
730 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
736 ASET (font
, FONT_EXTRA_INDEX
, Fdelq (slot
, extra
));
741 /* Font name parser and unparser */
743 static int parse_matrix
P_ ((char *));
744 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
745 static int font_parse_name
P_ ((char *, Lisp_Object
));
747 /* An enumerator for each field of an XLFD font name. */
748 enum xlfd_field_index
767 /* An enumerator for mask bit corresponding to each XLFD field. */
770 XLFD_FOUNDRY_MASK
= 0x0001,
771 XLFD_FAMILY_MASK
= 0x0002,
772 XLFD_WEIGHT_MASK
= 0x0004,
773 XLFD_SLANT_MASK
= 0x0008,
774 XLFD_SWIDTH_MASK
= 0x0010,
775 XLFD_ADSTYLE_MASK
= 0x0020,
776 XLFD_PIXEL_MASK
= 0x0040,
777 XLFD_POINT_MASK
= 0x0080,
778 XLFD_RESX_MASK
= 0x0100,
779 XLFD_RESY_MASK
= 0x0200,
780 XLFD_SPACING_MASK
= 0x0400,
781 XLFD_AVGWIDTH_MASK
= 0x0800,
782 XLFD_REGISTRY_MASK
= 0x1000,
783 XLFD_ENCODING_MASK
= 0x2000
787 /* Parse P pointing the pixel/point size field of the form
788 `[A B C D]' which specifies a transformation matrix:
794 by which all glyphs of the font are transformed. The spec says
795 that scalar value N for the pixel/point size is equivalent to:
796 A = N * resx/resy, B = C = 0, D = N.
798 Return the scalar value N if the form is valid. Otherwise return
809 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
812 matrix
[i
] = - strtod (p
+ 1, &end
);
814 matrix
[i
] = strtod (p
, &end
);
817 return (i
== 4 ? (int) matrix
[3] : -1);
820 /* Expand a wildcard field in FIELD (the first N fields are filled) to
821 multiple fields to fill in all 14 XLFD fields while restring a
822 field position by its contents. */
825 font_expand_wildcards (field
, n
)
826 Lisp_Object field
[XLFD_LAST_INDEX
];
830 Lisp_Object tmp
[XLFD_LAST_INDEX
];
831 /* Array of information about where this element can go. Nth
832 element is for Nth element of FIELD. */
834 /* Minimum possible field. */
836 /* Maxinum possible field. */
838 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
840 } range
[XLFD_LAST_INDEX
];
842 int range_from
, range_to
;
845 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
846 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
847 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
848 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
849 | XLFD_AVGWIDTH_MASK)
850 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
852 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
853 field. The value is shifted to left one bit by one in the
855 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
856 range_mask
= (range_mask
<< 1) | 1;
858 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
859 position-based retriction for FIELD[I]. */
860 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
861 i
++, range_from
++, range_to
++, range_mask
<<= 1)
863 Lisp_Object val
= field
[i
];
869 range
[i
].from
= range_from
;
870 range
[i
].to
= range_to
;
871 range
[i
].mask
= range_mask
;
875 /* The triplet FROM, TO, and MASK is a value-based
876 retriction for FIELD[I]. */
882 int numeric
= XINT (val
);
885 from
= to
= XLFD_ENCODING_INDEX
,
886 mask
= XLFD_ENCODING_MASK
;
887 else if (numeric
== 0)
888 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
889 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
890 else if (numeric
<= 48)
891 from
= to
= XLFD_PIXEL_INDEX
,
892 mask
= XLFD_PIXEL_MASK
;
894 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
895 mask
= XLFD_LARGENUM_MASK
;
897 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
898 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
899 mask
= XLFD_NULL_MASK
;
901 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
904 Lisp_Object name
= SYMBOL_NAME (val
);
906 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
907 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
908 mask
= XLFD_REGENC_MASK
;
910 from
= to
= XLFD_ENCODING_INDEX
,
911 mask
= XLFD_ENCODING_MASK
;
913 else if (range_from
<= XLFD_WEIGHT_INDEX
914 && range_to
>= XLFD_WEIGHT_INDEX
915 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
916 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
917 else if (range_from
<= XLFD_SLANT_INDEX
918 && range_to
>= XLFD_SLANT_INDEX
919 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
920 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
921 else if (range_from
<= XLFD_SWIDTH_INDEX
922 && range_to
>= XLFD_SWIDTH_INDEX
923 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
924 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
927 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
928 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
930 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
931 mask
= XLFD_SYMBOL_MASK
;
934 /* Merge position-based and value-based restrictions. */
936 while (from
< range_from
)
937 mask
&= ~(1 << from
++);
938 while (from
< 14 && ! (mask
& (1 << from
)))
940 while (to
> range_to
)
941 mask
&= ~(1 << to
--);
942 while (to
>= 0 && ! (mask
& (1 << to
)))
946 range
[i
].from
= from
;
948 range
[i
].mask
= mask
;
950 if (from
> range_from
|| to
< range_to
)
952 /* The range is narrowed by value-based restrictions.
953 Reflect it to the other fields. */
955 /* Following fields should be after FROM. */
957 /* Preceding fields should be before TO. */
958 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
960 /* Check FROM for non-wildcard field. */
961 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
963 while (range
[j
].from
< from
)
964 range
[j
].mask
&= ~(1 << range
[j
].from
++);
965 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
967 range
[j
].from
= from
;
970 from
= range
[j
].from
;
971 if (range
[j
].to
> to
)
973 while (range
[j
].to
> to
)
974 range
[j
].mask
&= ~(1 << range
[j
].to
--);
975 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
988 /* Decide all fileds from restrictions in RANGE. */
989 for (i
= j
= 0; i
< n
; i
++)
991 if (j
< range
[i
].from
)
993 if (i
== 0 || ! NILP (tmp
[i
- 1]))
994 /* None of TMP[X] corresponds to Jth field. */
996 for (; j
< range
[i
].from
; j
++)
1001 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
1003 for (; j
< XLFD_LAST_INDEX
; j
++)
1005 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
1006 field
[XLFD_ENCODING_INDEX
]
1007 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1012 #ifdef ENABLE_CHECKING
1013 /* Match a 14-field XLFD pattern against a full XLFD font name. */
1015 font_match_xlfd (char *pattern
, char *name
)
1017 while (*pattern
&& *name
)
1019 if (*pattern
== *name
)
1021 else if (*pattern
== '*')
1022 if (*name
== pattern
[1])
1033 /* Make sure the font object matches the XLFD font name. */
1035 font_check_xlfd_parse (Lisp_Object font
, char *name
)
1037 char name_check
[256];
1038 font_unparse_xlfd (font
, 0, name_check
, 255);
1039 return font_match_xlfd (name_check
, name
);
1045 /* Parse NAME (null terminated) as XLFD and store information in FONT
1046 (font-spec or font-entity). Size property of FONT is set as
1048 specified XLFD fields FONT property
1049 --------------------- -------------
1050 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1051 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1052 POINT_SIZE POINT_SIZE/10 (Lisp float)
1054 If NAME is successfully parsed, return 0. Otherwise return -1.
1056 FONT is usually a font-spec, but when this function is called from
1057 X font backend driver, it is a font-entity. In that case, NAME is
1058 a fully specified XLFD. */
1061 font_parse_xlfd (name
, font
)
1065 int len
= strlen (name
);
1067 char *f
[XLFD_LAST_INDEX
+ 1];
1071 if (len
> 255 || !len
)
1072 /* Maximum XLFD name length is 255. */
1074 /* Accept "*-.." as a fully specified XLFD. */
1075 if (name
[0] == '*' && (len
== 1 || name
[1] == '-'))
1076 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1079 for (p
= name
+ i
; *p
; p
++)
1083 if (i
== XLFD_LAST_INDEX
)
1088 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1089 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1091 if (i
== XLFD_LAST_INDEX
)
1093 /* Fully specified XLFD. */
1096 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1097 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1098 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1099 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1101 val
= INTERN_FIELD_SYM (i
);
1104 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1106 ASET (font
, j
, make_number (n
));
1109 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1110 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1111 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1113 ASET (font
, FONT_REGISTRY_INDEX
,
1114 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1115 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1117 p
= f
[XLFD_PIXEL_INDEX
];
1118 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1119 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1122 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1124 ASET (font
, FONT_SIZE_INDEX
, val
);
1125 else if (FONT_ENTITY_P (font
))
1129 double point_size
= -1;
1131 font_assert (FONT_SPEC_P (font
));
1132 p
= f
[XLFD_POINT_INDEX
];
1134 point_size
= parse_matrix (p
);
1135 else if (isdigit (*p
))
1136 point_size
= atoi (p
), point_size
/= 10;
1137 if (point_size
>= 0)
1138 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1142 val
= INTERN_FIELD (XLFD_RESY_INDEX
);
1143 if (! NILP (val
) && ! INTEGERP (val
))
1145 ASET (font
, FONT_DPI_INDEX
, val
);
1146 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1149 val
= font_prop_validate_spacing (QCspacing
, val
);
1150 if (! INTEGERP (val
))
1152 ASET (font
, FONT_SPACING_INDEX
, val
);
1154 p
= f
[XLFD_AVGWIDTH_INDEX
];
1157 val
= font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0);
1158 if (! NILP (val
) && ! INTEGERP (val
))
1160 ASET (font
, FONT_AVGWIDTH_INDEX
, val
);
1164 int wild_card_found
= 0;
1165 Lisp_Object prop
[XLFD_LAST_INDEX
];
1167 if (FONT_ENTITY_P (font
))
1169 for (j
= 0; j
< i
; j
++)
1173 if (f
[j
][1] && f
[j
][1] != '-')
1176 wild_card_found
= 1;
1179 prop
[j
] = INTERN_FIELD (j
);
1181 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1183 if (! wild_card_found
)
1185 if (font_expand_wildcards (prop
, i
) < 0)
1188 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1189 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1190 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1191 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1192 if (! NILP (prop
[i
]))
1194 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1196 ASET (font
, j
, make_number (n
));
1198 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1199 val
= prop
[XLFD_REGISTRY_INDEX
];
1202 val
= prop
[XLFD_ENCODING_INDEX
];
1204 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1206 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1207 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1209 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1210 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1212 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1214 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1215 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1216 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1218 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1220 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1223 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1224 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1225 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1227 val
= font_prop_validate_spacing (QCspacing
,
1228 prop
[XLFD_SPACING_INDEX
]);
1229 if (! INTEGERP (val
))
1231 ASET (font
, FONT_SPACING_INDEX
, val
);
1233 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1234 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1240 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1241 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1242 0, use PIXEL_SIZE instead. */
1245 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1251 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1255 font_assert (FONTP (font
));
1257 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1260 if (i
== FONT_ADSTYLE_INDEX
)
1261 j
= XLFD_ADSTYLE_INDEX
;
1262 else if (i
== FONT_REGISTRY_INDEX
)
1263 j
= XLFD_REGISTRY_INDEX
;
1264 val
= AREF (font
, i
);
1267 if (j
== XLFD_REGISTRY_INDEX
)
1268 f
[j
] = "*-*", len
+= 4;
1270 f
[j
] = "*", len
+= 2;
1275 val
= SYMBOL_NAME (val
);
1276 if (j
== XLFD_REGISTRY_INDEX
1277 && ! strchr ((char *) SDATA (val
), '-'))
1279 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1280 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1282 f
[j
] = alloca (SBYTES (val
) + 3);
1283 sprintf (f
[j
], "%s-*", SDATA (val
));
1284 len
+= SBYTES (val
) + 3;
1288 f
[j
] = alloca (SBYTES (val
) + 4);
1289 sprintf (f
[j
], "%s*-*", SDATA (val
));
1290 len
+= SBYTES (val
) + 4;
1294 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1298 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1301 val
= font_style_symbolic (font
, i
, 0);
1303 f
[j
] = "*", len
+= 2;
1306 val
= SYMBOL_NAME (val
);
1307 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1311 val
= AREF (font
, FONT_SIZE_INDEX
);
1312 font_assert (NUMBERP (val
) || NILP (val
));
1320 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1321 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1324 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1326 else if (FLOATP (val
))
1328 i
= XFLOAT_DATA (val
) * 10;
1329 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1330 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1333 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1335 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1337 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1338 f
[XLFD_RESX_INDEX
] = alloca (22);
1339 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1343 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1344 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1346 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1348 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1349 : spacing
<= FONT_SPACING_DUAL
? "d"
1350 : spacing
<= FONT_SPACING_MONO
? "m"
1355 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1356 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1358 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1359 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
], "%ld",
1360 (long) XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1363 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1364 len
++; /* for terminating '\0'. */
1367 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1368 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1369 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1370 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1371 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1372 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1373 f
[XLFD_REGISTRY_INDEX
]);
1376 /* Parse NAME (null terminated) and store information in FONT
1377 (font-spec or font-entity). NAME is supplied in either the
1378 Fontconfig or GTK font name format. If NAME is successfully
1379 parsed, return 0. Otherwise return -1.
1381 The fontconfig format is
1383 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1387 FAMILY [PROPS...] [SIZE]
1389 This function tries to guess which format it is. */
1392 font_parse_fcname (name
, font
)
1397 char *size_beg
= NULL
, *size_end
= NULL
;
1398 char *props_beg
= NULL
, *family_end
= NULL
;
1399 int len
= strlen (name
);
1404 for (p
= name
; *p
; p
++)
1406 if (*p
== '\\' && p
[1])
1410 props_beg
= family_end
= p
;
1415 int decimal
= 0, size_found
= 1;
1416 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1419 if (*q
!= '.' || decimal
)
1438 Lisp_Object extra_props
= Qnil
;
1440 /* A fontconfig name with size and/or property data. */
1441 if (family_end
> name
)
1444 family
= font_intern_prop (name
, family_end
- name
, 1);
1445 ASET (font
, FONT_FAMILY_INDEX
, family
);
1449 double point_size
= strtod (size_beg
, &size_end
);
1450 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1451 if (*size_end
== ':' && size_end
[1])
1452 props_beg
= size_end
;
1456 /* Now parse ":KEY=VAL" patterns. */
1459 for (p
= props_beg
; *p
; p
= q
)
1461 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1464 /* Must be an enumerated value. */
1468 val
= font_intern_prop (p
, q
- p
, 1);
1470 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1472 if (PROP_MATCH ("light", 5)
1473 || PROP_MATCH ("medium", 6)
1474 || PROP_MATCH ("demibold", 8)
1475 || PROP_MATCH ("bold", 4)
1476 || PROP_MATCH ("black", 5))
1477 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1478 else if (PROP_MATCH ("roman", 5)
1479 || PROP_MATCH ("italic", 6)
1480 || PROP_MATCH ("oblique", 7))
1481 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1482 else if (PROP_MATCH ("charcell", 8))
1483 ASET (font
, FONT_SPACING_INDEX
,
1484 make_number (FONT_SPACING_CHARCELL
));
1485 else if (PROP_MATCH ("mono", 4))
1486 ASET (font
, FONT_SPACING_INDEX
,
1487 make_number (FONT_SPACING_MONO
));
1488 else if (PROP_MATCH ("proportional", 12))
1489 ASET (font
, FONT_SPACING_INDEX
,
1490 make_number (FONT_SPACING_PROPORTIONAL
));
1499 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1500 prop
= FONT_SIZE_INDEX
;
1503 key
= font_intern_prop (p
, q
- p
, 1);
1504 prop
= get_font_prop_index (key
);
1508 for (q
= p
; *q
&& *q
!= ':'; q
++);
1509 val
= font_intern_prop (p
, q
- p
, 0);
1511 if (prop
>= FONT_FOUNDRY_INDEX
1512 && prop
< FONT_EXTRA_INDEX
)
1513 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1516 extra_props
= nconc2 (extra_props
,
1517 Fcons (Fcons (key
, val
), Qnil
));
1524 if (! NILP (extra_props
))
1526 struct font_driver_list
*driver_list
= font_driver_list
;
1527 for ( ; driver_list
; driver_list
= driver_list
->next
)
1528 if (driver_list
->driver
->filter_properties
)
1529 (*driver_list
->driver
->filter_properties
) (font
, extra_props
);
1535 /* Either a fontconfig-style name with no size and property
1536 data, or a GTK-style name. */
1538 int word_len
, prop_found
= 0;
1540 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1546 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1552 /* GTK font sizes must occur at the end. */
1553 if (size_found
&& *q
== '\0')
1555 double point_size
= strtod (p
, &q
);
1556 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1561 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1562 if (*q
== '\\' && q
[1])
1566 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1568 if (PROP_MATCH ("Ultra-Light", 11))
1571 prop
= font_intern_prop ("ultra-light", 11, 1);
1572 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1574 else if (PROP_MATCH ("Light", 5))
1577 prop
= font_intern_prop ("light", 5, 1);
1578 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1580 else if (PROP_MATCH ("Book", 4))
1583 prop
= font_intern_prop ("book", 4, 1);
1584 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1586 else if (PROP_MATCH ("Medium", 6))
1589 prop
= font_intern_prop ("medium", 6, 1);
1590 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1592 else if (PROP_MATCH ("Semi-Bold", 9))
1595 prop
= font_intern_prop ("semi-bold", 9, 1);
1596 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1598 else if (PROP_MATCH ("Bold", 4))
1601 prop
= font_intern_prop ("bold", 4, 1);
1602 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1604 else if (PROP_MATCH ("Italic", 6))
1607 prop
= font_intern_prop ("italic", 6, 1);
1608 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1610 else if (PROP_MATCH ("Oblique", 7))
1613 prop
= font_intern_prop ("oblique", 7, 1);
1614 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1616 else if (PROP_MATCH ("Semi-Condensed", 14))
1619 prop
= font_intern_prop ("semi-condensed", 14, 1);
1620 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, prop
);
1622 else if (PROP_MATCH ("Condensed", 9))
1625 prop
= font_intern_prop ("condensed", 9, 1);
1626 FONT_SET_STYLE (font
, FONT_WIDTH_INDEX
, prop
);
1630 return -1; /* Unknown property in GTK-style font name. */
1639 family
= font_intern_prop (name
, family_end
- name
, 1);
1640 ASET (font
, FONT_FAMILY_INDEX
, family
);
1647 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1648 NAME (NBYTES length), and return the name length. If
1649 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1652 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1658 Lisp_Object family
, foundry
;
1659 Lisp_Object tail
, val
;
1663 Lisp_Object styles
[3];
1664 char *style_names
[3] = { "weight", "slant", "width" };
1667 family
= AREF (font
, FONT_FAMILY_INDEX
);
1668 if (! NILP (family
))
1670 if (SYMBOLP (family
))
1672 family
= SYMBOL_NAME (family
);
1673 len
+= SBYTES (family
);
1679 val
= AREF (font
, FONT_SIZE_INDEX
);
1682 if (XINT (val
) != 0)
1683 pixel_size
= XINT (val
);
1685 len
+= 21; /* for ":pixelsize=NUM" */
1687 else if (FLOATP (val
))
1690 point_size
= (int) XFLOAT_DATA (val
);
1691 len
+= 11; /* for "-NUM" */
1694 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1695 if (! NILP (foundry
))
1697 if (SYMBOLP (foundry
))
1699 foundry
= SYMBOL_NAME (foundry
);
1700 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1706 for (i
= 0; i
< 3; i
++)
1708 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1709 if (! NILP (styles
[i
]))
1710 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1711 SDATA (SYMBOL_NAME (styles
[i
])));
1714 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1715 len
+= sprintf (work
, ":dpi=%ld", (long)XINT (AREF (font
, FONT_DPI_INDEX
)));
1716 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1717 len
+= strlen (":spacing=100");
1718 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1719 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1720 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1722 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1724 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1726 len
+= SBYTES (val
);
1727 else if (INTEGERP (val
))
1728 len
+= sprintf (work
, "%ld", (long) XINT (val
));
1729 else if (SYMBOLP (val
))
1730 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1736 if (! NILP (family
))
1737 p
+= sprintf (p
, "%s", SDATA (family
));
1741 p
+= sprintf (p
, "%d", point_size
);
1743 p
+= sprintf (p
, "-%d", point_size
);
1745 else if (pixel_size
> 0)
1746 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1747 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1748 p
+= sprintf (p
, ":foundry=%s",
1749 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1750 for (i
= 0; i
< 3; i
++)
1751 if (! NILP (styles
[i
]))
1752 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1753 SDATA (SYMBOL_NAME (styles
[i
])));
1754 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1755 p
+= sprintf (p
, ":dpi=%ld", (long) XINT (AREF (font
, FONT_DPI_INDEX
)));
1756 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1757 p
+= sprintf (p
, ":spacing=%ld",
1758 (long) XINT (AREF (font
, FONT_SPACING_INDEX
)));
1759 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1761 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1762 p
+= sprintf (p
, ":scalable=true");
1764 p
+= sprintf (p
, ":scalable=false");
1769 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1770 NAME (NBYTES length), and return the name length. F is the frame
1771 on which the font is displayed; it is used to calculate the point
1775 font_unparse_gtkname (font
, f
, name
, nbytes
)
1783 Lisp_Object family
, weight
, slant
, size
;
1784 int point_size
= -1;
1786 family
= AREF (font
, FONT_FAMILY_INDEX
);
1787 if (! NILP (family
))
1789 if (! SYMBOLP (family
))
1791 family
= SYMBOL_NAME (family
);
1792 len
+= SBYTES (family
);
1795 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1796 if (EQ (weight
, Qnormal
))
1798 else if (! NILP (weight
))
1800 weight
= SYMBOL_NAME (weight
);
1801 len
+= SBYTES (weight
);
1804 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1805 if (EQ (slant
, Qnormal
))
1807 else if (! NILP (slant
))
1809 slant
= SYMBOL_NAME (slant
);
1810 len
+= SBYTES (slant
);
1813 size
= AREF (font
, FONT_SIZE_INDEX
);
1814 /* Convert pixel size to point size. */
1815 if (INTEGERP (size
))
1817 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1819 if (INTEGERP (font_dpi
))
1820 dpi
= XINT (font_dpi
);
1823 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1826 else if (FLOATP (size
))
1828 point_size
= (int) XFLOAT_DATA (size
);
1835 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1837 if (! NILP (weight
))
1840 p
+= sprintf (p
, " %s", SDATA (weight
));
1841 q
[1] = toupper (q
[1]);
1847 p
+= sprintf (p
, " %s", SDATA (slant
));
1848 q
[1] = toupper (q
[1]);
1852 p
+= sprintf (p
, " %d", point_size
);
1857 /* Parse NAME (null terminated) and store information in FONT
1858 (font-spec or font-entity). If NAME is successfully parsed, return
1859 0. Otherwise return -1. */
1862 font_parse_name (name
, font
)
1866 if (name
[0] == '-' || index (name
, '*') || index (name
, '?'))
1867 return font_parse_xlfd (name
, font
);
1868 return font_parse_fcname (name
, font
);
1872 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1873 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1877 font_parse_family_registry (family
, registry
, font_spec
)
1878 Lisp_Object family
, registry
, font_spec
;
1884 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1886 CHECK_STRING (family
);
1887 len
= SBYTES (family
);
1888 p0
= (char *) SDATA (family
);
1889 p1
= index (p0
, '-');
1892 if ((*p0
!= '*' && p1
- p0
> 0)
1893 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1894 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1897 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1900 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1902 if (! NILP (registry
))
1904 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1905 CHECK_STRING (registry
);
1906 len
= SBYTES (registry
);
1907 p0
= (char *) SDATA (registry
);
1908 p1
= index (p0
, '-');
1911 if (SDATA (registry
)[len
- 1] == '*')
1912 registry
= concat2 (registry
, build_string ("-*"));
1914 registry
= concat2 (registry
, build_string ("*-*"));
1916 registry
= Fdowncase (registry
);
1917 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1922 /* This part (through the next ^L) is still experimental and not
1923 tested much. We may drastically change codes. */
1929 #define LGSTRING_HEADER_SIZE 6
1930 #define LGSTRING_GLYPH_SIZE 8
1933 check_gstring (gstring
)
1934 Lisp_Object gstring
;
1939 CHECK_VECTOR (gstring
);
1940 val
= AREF (gstring
, 0);
1942 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1944 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1945 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1946 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1947 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1948 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1949 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1950 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1951 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1952 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1953 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1954 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1956 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1958 val
= LGSTRING_GLYPH (gstring
, i
);
1960 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1962 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1964 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1965 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1966 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1967 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1968 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1969 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1970 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1971 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1973 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1975 if (ASIZE (val
) < 3)
1977 for (j
= 0; j
< 3; j
++)
1978 CHECK_NUMBER (AREF (val
, j
));
1983 error ("Invalid glyph-string format");
1988 check_otf_features (otf_features
)
1989 Lisp_Object otf_features
;
1993 CHECK_CONS (otf_features
);
1994 CHECK_SYMBOL (XCAR (otf_features
));
1995 otf_features
= XCDR (otf_features
);
1996 CHECK_CONS (otf_features
);
1997 CHECK_SYMBOL (XCAR (otf_features
));
1998 otf_features
= XCDR (otf_features
);
1999 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
2001 CHECK_SYMBOL (Fcar (val
));
2002 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
2003 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
2005 otf_features
= XCDR (otf_features
);
2006 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
2008 CHECK_SYMBOL (Fcar (val
));
2009 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
2010 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
2017 Lisp_Object otf_list
;
2020 otf_tag_symbol (tag
)
2025 OTF_tag_name (tag
, name
);
2026 return Fintern (make_unibyte_string (name
, 4), Qnil
);
2033 Lisp_Object val
= Fassoc (file
, otf_list
);
2037 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
2040 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
2041 val
= make_save_value (otf
, 0);
2042 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
2048 /* Return a list describing which scripts/languages FONT supports by
2049 which GSUB/GPOS features of OpenType tables. See the comment of
2050 (struct font_driver).otf_capability. */
2053 font_otf_capability (font
)
2057 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
2060 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
2063 for (i
= 0; i
< 2; i
++)
2065 OTF_GSUB_GPOS
*gsub_gpos
;
2066 Lisp_Object script_list
= Qnil
;
2069 if (OTF_get_features (otf
, i
== 0) < 0)
2071 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2072 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2074 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2075 Lisp_Object langsys_list
= Qnil
;
2076 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2079 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2081 OTF_LangSys
*langsys
;
2082 Lisp_Object feature_list
= Qnil
;
2083 Lisp_Object langsys_tag
;
2086 if (k
== script
->LangSysCount
)
2088 langsys
= &script
->DefaultLangSys
;
2093 langsys
= script
->LangSys
+ k
;
2095 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2097 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2099 OTF_Feature
*feature
2100 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2101 Lisp_Object feature_tag
2102 = otf_tag_symbol (feature
->FeatureTag
);
2104 feature_list
= Fcons (feature_tag
, feature_list
);
2106 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2109 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2114 XSETCAR (capability
, script_list
);
2116 XSETCDR (capability
, script_list
);
2122 /* Parse OTF features in SPEC and write a proper features spec string
2123 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2124 assured that the sufficient memory has already allocated for
2128 generate_otf_features (spec
, features
)
2138 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2144 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2149 else if (! asterisk
)
2151 val
= SYMBOL_NAME (val
);
2152 p
+= sprintf (p
, "%s", SDATA (val
));
2156 val
= SYMBOL_NAME (val
);
2157 p
+= sprintf (p
, "~%s", SDATA (val
));
2161 error ("OTF spec too long");
2165 font_otf_DeviceTable (device_table
)
2166 OTF_DeviceTable
*device_table
;
2168 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2170 return Fcons (make_number (len
),
2171 make_unibyte_string (device_table
->DeltaValue
, len
));
2175 font_otf_ValueRecord (value_format
, value_record
)
2177 OTF_ValueRecord
*value_record
;
2179 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2181 if (value_format
& OTF_XPlacement
)
2182 ASET (val
, 0, make_number (value_record
->XPlacement
));
2183 if (value_format
& OTF_YPlacement
)
2184 ASET (val
, 1, make_number (value_record
->YPlacement
));
2185 if (value_format
& OTF_XAdvance
)
2186 ASET (val
, 2, make_number (value_record
->XAdvance
));
2187 if (value_format
& OTF_YAdvance
)
2188 ASET (val
, 3, make_number (value_record
->YAdvance
));
2189 if (value_format
& OTF_XPlaDevice
)
2190 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2191 if (value_format
& OTF_YPlaDevice
)
2192 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2193 if (value_format
& OTF_XAdvDevice
)
2194 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2195 if (value_format
& OTF_YAdvDevice
)
2196 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2201 font_otf_Anchor (anchor
)
2206 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2207 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2208 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2209 if (anchor
->AnchorFormat
== 2)
2210 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2213 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2214 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2218 #endif /* HAVE_LIBOTF */
2224 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2225 static int font_compare
P_ ((const void *, const void *));
2226 static Lisp_Object font_sort_entities
P_ ((Lisp_Object
, Lisp_Object
,
2229 /* Return a rescaling ratio of FONT_ENTITY. */
2230 extern Lisp_Object Vface_font_rescale_alist
;
2233 font_rescale_ratio (font_entity
)
2234 Lisp_Object font_entity
;
2236 Lisp_Object tail
, elt
;
2237 Lisp_Object name
= Qnil
;
2239 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2242 if (FLOATP (XCDR (elt
)))
2244 if (STRINGP (XCAR (elt
)))
2247 name
= Ffont_xlfd_name (font_entity
, Qnil
);
2248 if (fast_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2249 return XFLOAT_DATA (XCDR (elt
));
2251 else if (FONT_SPEC_P (XCAR (elt
)))
2253 if (font_match_p (XCAR (elt
), font_entity
))
2254 return XFLOAT_DATA (XCDR (elt
));
2261 /* We sort fonts by scoring each of them against a specified
2262 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2263 the value is, the closer the font is to the font-spec.
2265 The lowest 2 bits of the score is used for driver type. The font
2266 available by the most preferred font driver is 0.
2268 Each 7-bit in the higher 28 bits are used for numeric properties
2269 WEIGHT, SLANT, WIDTH, and SIZE. */
2271 /* How many bits to shift to store the difference value of each font
2272 property in a score. Note that flots for FONT_TYPE_INDEX and
2273 FONT_REGISTRY_INDEX are not used. */
2274 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2276 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2277 The return value indicates how different ENTITY is compared with
2281 font_score (entity
, spec_prop
)
2282 Lisp_Object entity
, *spec_prop
;
2287 /* Score three style numeric fields. Maximum difference is 127. */
2288 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2289 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2291 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2296 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2299 /* Score the size. Maximum difference is 127. */
2300 i
= FONT_SIZE_INDEX
;
2301 if (! NILP (spec_prop
[FONT_SIZE_INDEX
])
2302 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2304 /* We use the higher 6-bit for the actual size difference. The
2305 lowest bit is set if the DPI is different. */
2307 int pixel_size
= XINT (spec_prop
[FONT_SIZE_INDEX
]);
2309 if (CONSP (Vface_font_rescale_alist
))
2310 pixel_size
*= font_rescale_ratio (entity
);
2311 diff
= pixel_size
- XINT (AREF (entity
, FONT_SIZE_INDEX
));
2315 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2316 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2318 if (! NILP (spec_prop
[FONT_AVGWIDTH_INDEX
])
2319 && ! EQ (spec_prop
[FONT_AVGWIDTH_INDEX
], AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2321 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2328 /* Concatenate all elements of LIST into one vector. LIST is a list
2329 of font-entity vectors. */
2332 font_vconcat_entity_vectors (Lisp_Object list
)
2334 int nargs
= XINT (Flength (list
));
2335 Lisp_Object
*args
= alloca (sizeof (Lisp_Object
) * nargs
);
2338 for (i
= 0; i
< nargs
; i
++, list
= XCDR (list
))
2339 args
[i
] = XCAR (list
);
2340 return Fvconcat (nargs
, args
);
2344 /* The structure for elements being sorted by qsort. */
2345 struct font_sort_data
2348 int font_driver_preference
;
2353 /* The comparison function for qsort. */
2356 font_compare (d1
, d2
)
2357 const void *d1
, *d2
;
2359 const struct font_sort_data
*data1
= d1
;
2360 const struct font_sort_data
*data2
= d2
;
2362 if (data1
->score
< data2
->score
)
2364 else if (data1
->score
> data2
->score
)
2366 return (data1
->font_driver_preference
- data2
->font_driver_preference
);
2370 /* Sort each font-entity vector in LIST by closeness to font-spec PREFER.
2371 If PREFER specifies a point-size, calculate the corresponding
2372 pixel-size from QCdpi property of PREFER or from the Y-resolution
2373 of FRAME before sorting.
2375 If BEST-ONLY is nonzero, return the best matching entity (that
2376 supports the character BEST-ONLY if BEST-ONLY is positive, or any
2377 if BEST-ONLY is negative). Otherwise, return the sorted result as
2378 a single vector of font-entities.
2380 This function does no optimization for the case that the total
2381 number of elements is 1. The caller should avoid calling this in
2385 font_sort_entities (list
, prefer
, frame
, best_only
)
2386 Lisp_Object list
, prefer
, frame
;
2389 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2391 struct font_sort_data
*data
;
2392 unsigned best_score
;
2393 Lisp_Object best_entity
;
2394 struct frame
*f
= XFRAME (frame
);
2395 Lisp_Object tail
, vec
;
2398 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_AVGWIDTH_INDEX
; i
++)
2399 prefer_prop
[i
] = AREF (prefer
, i
);
2400 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2401 prefer_prop
[FONT_SIZE_INDEX
]
2402 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2404 if (NILP (XCDR (list
)))
2406 /* What we have to take care of is this single vector. */
2408 maxlen
= ASIZE (vec
);
2412 /* We don't have to perform sort, so there's no need of creating
2413 a single vector. But, we must find the length of the longest
2416 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2417 if (maxlen
< ASIZE (XCAR (tail
)))
2418 maxlen
= ASIZE (XCAR (tail
));
2422 /* We have to create a single vector to sort it. */
2423 vec
= font_vconcat_entity_vectors (list
);
2424 maxlen
= ASIZE (vec
);
2427 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * maxlen
);
2428 best_score
= 0xFFFFFFFF;
2431 for (tail
= list
; CONSP (tail
); tail
= XCDR (tail
))
2433 int font_driver_preference
= 0;
2434 Lisp_Object current_font_driver
;
2440 /* We are sure that the length of VEC > 0. */
2441 current_font_driver
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2442 /* Score the elements. */
2443 for (i
= 0; i
< len
; i
++)
2445 data
[i
].entity
= AREF (vec
, i
);
2447 = ((best_only
<= 0 || font_has_char (f
, data
[i
].entity
, best_only
)
2449 ? font_score (data
[i
].entity
, prefer_prop
)
2451 if (best_only
&& best_score
> data
[i
].score
)
2453 best_score
= data
[i
].score
;
2454 best_entity
= data
[i
].entity
;
2455 if (best_score
== 0)
2458 if (! EQ (current_font_driver
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2460 current_font_driver
= AREF (AREF (vec
, i
), FONT_TYPE_INDEX
);
2461 font_driver_preference
++;
2463 data
[i
].font_driver_preference
= font_driver_preference
;
2466 /* Sort if necessary. */
2469 qsort (data
, len
, sizeof *data
, font_compare
);
2470 for (i
= 0; i
< len
; i
++)
2471 ASET (vec
, i
, data
[i
].entity
);
2480 FONT_ADD_LOG ("sort-by", prefer
, vec
);
2485 /* API of Font Service Layer. */
2487 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2488 sort_shift_bits. Finternal_set_font_selection_order calls this
2489 function with font_sort_order after setting up it. */
2492 font_update_sort_order (order
)
2497 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2499 int xlfd_idx
= order
[i
];
2501 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2502 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2503 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2504 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2505 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2506 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2508 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2513 font_check_otf_features (script
, langsys
, features
, table
)
2514 Lisp_Object script
, langsys
, features
, table
;
2519 table
= assq_no_quit (script
, table
);
2522 table
= XCDR (table
);
2523 if (! NILP (langsys
))
2525 table
= assq_no_quit (langsys
, table
);
2531 val
= assq_no_quit (Qnil
, table
);
2533 table
= XCAR (table
);
2537 table
= XCDR (table
);
2538 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2540 if (NILP (XCAR (features
)))
2545 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2551 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2554 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2556 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2558 script
= XCAR (spec
);
2562 langsys
= XCAR (spec
);
2573 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2574 XCAR (otf_capability
)))
2576 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2577 XCDR (otf_capability
)))
2584 /* Check if FONT (font-entity or font-object) matches with the font
2585 specification SPEC. */
2588 font_match_p (spec
, font
)
2589 Lisp_Object spec
, font
;
2591 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2592 Lisp_Object extra
, font_extra
;
2595 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2596 if (! NILP (AREF (spec
, i
))
2597 && ! NILP (AREF (font
, i
))
2598 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2600 props
= XFONT_SPEC (spec
)->props
;
2601 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2603 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2604 prop
[i
] = AREF (spec
, i
);
2605 prop
[FONT_SIZE_INDEX
]
2606 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2610 if (font_score (font
, props
) > 0)
2612 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2613 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2614 for (; CONSP (extra
); extra
= XCDR (extra
))
2616 Lisp_Object key
= XCAR (XCAR (extra
));
2617 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2619 if (EQ (key
, QClang
))
2621 val2
= assq_no_quit (key
, font_extra
);
2630 if (NILP (Fmemq (val
, val2
)))
2635 ? NILP (Fmemq (val
, XCDR (val2
)))
2639 else if (EQ (key
, QCscript
))
2641 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2647 /* All characters in the list must be supported. */
2648 for (; CONSP (val2
); val2
= XCDR (val2
))
2650 if (! NATNUMP (XCAR (val2
)))
2652 if (font_encode_char (font
, XFASTINT (XCAR (val2
)))
2653 == FONT_INVALID_CODE
)
2657 else if (VECTORP (val2
))
2659 /* At most one character in the vector must be supported. */
2660 for (i
= 0; i
< ASIZE (val2
); i
++)
2662 if (! NATNUMP (AREF (val2
, i
)))
2664 if (font_encode_char (font
, XFASTINT (AREF (val2
, i
)))
2665 != FONT_INVALID_CODE
)
2668 if (i
== ASIZE (val2
))
2673 else if (EQ (key
, QCotf
))
2677 if (! FONT_OBJECT_P (font
))
2679 fontp
= XFONT_OBJECT (font
);
2680 if (! fontp
->driver
->otf_capability
)
2682 val2
= fontp
->driver
->otf_capability (fontp
);
2683 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2694 Each font backend has the callback function get_cache, and it
2695 returns a cons cell of which cdr part can be freely used for
2696 caching fonts. The cons cell may be shared by multiple frames
2697 and/or multiple font drivers. So, we arrange the cdr part as this:
2699 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2701 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2702 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2703 cons (FONT-SPEC FONT-ENTITY ...). */
2705 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2706 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2707 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2708 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2709 struct font_driver
*));
2712 font_prepare_cache (f
, driver
)
2714 struct font_driver
*driver
;
2716 Lisp_Object cache
, val
;
2718 cache
= driver
->get_cache (f
);
2720 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2724 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2725 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2729 val
= XCDR (XCAR (val
));
2730 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2736 font_finish_cache (f
, driver
)
2738 struct font_driver
*driver
;
2740 Lisp_Object cache
, val
, tmp
;
2743 cache
= driver
->get_cache (f
);
2745 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2746 cache
= val
, val
= XCDR (val
);
2747 font_assert (! NILP (val
));
2748 tmp
= XCDR (XCAR (val
));
2749 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2750 if (XINT (XCAR (tmp
)) == 0)
2752 font_clear_cache (f
, XCAR (val
), driver
);
2753 XSETCDR (cache
, XCDR (val
));
2759 font_get_cache (f
, driver
)
2761 struct font_driver
*driver
;
2763 Lisp_Object val
= driver
->get_cache (f
);
2764 Lisp_Object type
= driver
->type
;
2766 font_assert (CONSP (val
));
2767 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2768 font_assert (CONSP (val
));
2769 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2770 val
= XCDR (XCAR (val
));
2774 static int num_fonts
;
2777 font_clear_cache (f
, cache
, driver
)
2780 struct font_driver
*driver
;
2782 Lisp_Object tail
, elt
;
2783 Lisp_Object tail2
, entity
;
2785 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2786 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2789 /* elt should have the form (FONT-SPEC FONT-ENTITY ...) */
2790 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2792 for (tail2
= XCDR (elt
); CONSP (tail2
); tail2
= XCDR (tail2
))
2794 entity
= XCAR (tail2
);
2796 if (FONT_ENTITY_P (entity
)
2797 && EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2799 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2801 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2803 Lisp_Object val
= XCAR (objlist
);
2804 struct font
*font
= XFONT_OBJECT (val
);
2806 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2808 font_assert (font
&& driver
== font
->driver
);
2809 driver
->close (f
, font
);
2813 if (driver
->free_entity
)
2814 driver
->free_entity (entity
);
2819 XSETCDR (cache
, Qnil
);
2823 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2825 /* Check each font-entity in VEC, and return a list of font-entities
2826 that satisfy this condition:
2827 (1) matches with SPEC and SIZE if SPEC is not nil, and
2828 (2) doesn't match with any regexps in Vface_ignored_fonts (if non-nil).
2831 extern Lisp_Object Vface_ignored_fonts
;
2834 font_delete_unmatched (vec
, spec
, size
)
2835 Lisp_Object vec
, spec
;
2838 Lisp_Object entity
, val
;
2839 enum font_property_index prop
;
2842 for (val
= Qnil
, i
= ASIZE (vec
) - 1; i
>= 0; i
--)
2844 entity
= AREF (vec
, i
);
2845 if (! NILP (Vface_ignored_fonts
))
2848 Lisp_Object tail
, regexp
;
2850 if (font_unparse_xlfd (entity
, 0, name
, 256) >= 0)
2852 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2854 regexp
= XCAR (tail
);
2855 if (STRINGP (regexp
)
2856 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
2865 val
= Fcons (entity
, val
);
2868 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2869 if (INTEGERP (AREF (spec
, prop
))
2870 && ((XINT (AREF (spec
, prop
)) >> 8)
2871 != (XINT (AREF (entity
, prop
)) >> 8)))
2872 prop
= FONT_SPEC_MAX
;
2873 if (prop
< FONT_SPEC_MAX
2875 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2877 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2880 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2881 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2882 prop
= FONT_SPEC_MAX
;
2884 if (prop
< FONT_SPEC_MAX
2885 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2886 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2887 && XINT (AREF (entity
, FONT_DPI_INDEX
)) != 0
2888 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2889 prop
= FONT_SPEC_MAX
;
2890 if (prop
< FONT_SPEC_MAX
2891 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2892 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2893 && XINT (AREF (entity
, FONT_AVGWIDTH_INDEX
)) != 0
2894 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2895 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2896 prop
= FONT_SPEC_MAX
;
2897 if (prop
< FONT_SPEC_MAX
)
2898 val
= Fcons (entity
, val
);
2900 return (Fvconcat (1, &val
));
2904 /* Return a list of vectors of font-entities matching with SPEC on
2905 FRAME. Each elements in the list is a vector of entities from the
2906 same font-driver. */
2909 font_list_entities (frame
, spec
)
2910 Lisp_Object frame
, spec
;
2912 FRAME_PTR f
= XFRAME (frame
);
2913 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2914 Lisp_Object ftype
, val
;
2915 Lisp_Object list
= Qnil
;
2917 int need_filtering
= 0;
2920 font_assert (FONT_SPEC_P (spec
));
2922 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2923 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2924 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2925 size
= font_pixel_size (f
, spec
);
2929 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2930 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2931 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2932 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2934 ASET (scratch_font_spec
, i
, Qnil
);
2935 if (! NILP (AREF (spec
, i
)))
2937 if (i
== FONT_DPI_INDEX
)
2938 /* Skip FONT_SPACING_INDEX */
2941 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2942 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2944 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2946 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2948 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2950 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2951 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2958 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2962 val
= Fvconcat (1, &val
);
2963 copy
= Fcopy_font_spec (scratch_font_spec
);
2964 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2965 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2969 || ! NILP (Vface_ignored_fonts
)))
2970 val
= font_delete_unmatched (val
, need_filtering
? spec
: Qnil
, size
);
2971 if (ASIZE (val
) > 0)
2972 list
= Fcons (val
, list
);
2975 list
= Fnreverse (list
);
2976 FONT_ADD_LOG ("list", spec
, list
);
2981 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2982 nil, is an array of face's attributes, which specifies preferred
2983 font-related attributes. */
2986 font_matching_entity (f
, attrs
, spec
)
2988 Lisp_Object
*attrs
, spec
;
2990 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2991 Lisp_Object ftype
, size
, entity
;
2993 Lisp_Object work
= Fcopy_font_spec (spec
);
2995 XSETFRAME (frame
, f
);
2996 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2997 size
= AREF (spec
, FONT_SIZE_INDEX
);
3000 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
3001 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3002 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3003 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3006 for (; driver_list
; driver_list
= driver_list
->next
)
3008 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
3010 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
3013 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
3014 entity
= assoc_no_quit (work
, XCDR (cache
));
3016 entity
= XCDR (entity
);
3019 entity
= driver_list
->driver
->match (frame
, work
);
3020 copy
= Fcopy_font_spec (work
);
3021 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
3022 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
3024 if (! NILP (entity
))
3027 FONT_ADD_LOG ("match", work
, entity
);
3032 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
3033 opened font object. */
3036 font_open_entity (f
, entity
, pixel_size
)
3041 struct font_driver_list
*driver_list
;
3042 Lisp_Object objlist
, size
, val
, font_object
;
3044 int min_width
, height
;
3045 int scaled_pixel_size
;
3047 font_assert (FONT_ENTITY_P (entity
));
3048 size
= AREF (entity
, FONT_SIZE_INDEX
);
3049 if (XINT (size
) != 0)
3050 scaled_pixel_size
= pixel_size
= XINT (size
);
3051 else if (CONSP (Vface_font_rescale_alist
))
3052 scaled_pixel_size
= pixel_size
* font_rescale_ratio (entity
);
3054 val
= AREF (entity
, FONT_TYPE_INDEX
);
3055 for (driver_list
= f
->font_driver_list
;
3056 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
3057 driver_list
= driver_list
->next
);
3061 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
3062 objlist
= XCDR (objlist
))
3064 Lisp_Object fn
= XCAR (objlist
);
3065 if (! NILP (AREF (fn
, FONT_TYPE_INDEX
))
3066 && XFONT_OBJECT (fn
)->pixel_size
== pixel_size
)
3068 if (driver_list
->driver
->cached_font_ok
== NULL
3069 || driver_list
->driver
->cached_font_ok (f
, fn
, entity
))
3074 font_object
= driver_list
->driver
->open (f
, entity
, scaled_pixel_size
);
3075 if (!NILP (font_object
))
3076 ASET (font_object
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3077 FONT_ADD_LOG ("open", entity
, font_object
);
3078 if (NILP (font_object
))
3080 ASET (entity
, FONT_OBJLIST_INDEX
,
3081 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
3082 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
3085 font
= XFONT_OBJECT (font_object
);
3086 min_width
= (font
->min_width
? font
->min_width
3087 : font
->average_width
? font
->average_width
3088 : font
->space_width
? font
->space_width
3090 height
= (font
->height
? font
->height
: 1);
3091 #ifdef HAVE_WINDOW_SYSTEM
3092 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
3093 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
3095 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
3096 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
3097 fonts_changed_p
= 1;
3101 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
3102 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
3103 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
3104 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
3112 /* Close FONT_OBJECT that is opened on frame F. */
3115 font_close_object (f
, font_object
)
3117 Lisp_Object font_object
;
3119 struct font
*font
= XFONT_OBJECT (font_object
);
3121 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
3122 /* Already closed. */
3124 FONT_ADD_LOG ("close", font_object
, Qnil
);
3125 font
->driver
->close (f
, font
);
3126 #ifdef HAVE_WINDOW_SYSTEM
3127 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
3128 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
3134 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
3135 FONT is a font-entity and it must be opened to check. */
3138 font_has_char (f
, font
, c
)
3145 if (FONT_ENTITY_P (font
))
3147 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
3148 struct font_driver_list
*driver_list
;
3150 for (driver_list
= f
->font_driver_list
;
3151 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
3152 driver_list
= driver_list
->next
);
3155 if (! driver_list
->driver
->has_char
)
3157 return driver_list
->driver
->has_char (font
, c
);
3160 font_assert (FONT_OBJECT_P (font
));
3161 fontp
= XFONT_OBJECT (font
);
3162 if (fontp
->driver
->has_char
)
3164 int result
= fontp
->driver
->has_char (font
, c
);
3169 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
3173 /* Return the glyph ID of FONT_OBJECT for character C. */
3176 font_encode_char (font_object
, c
)
3177 Lisp_Object font_object
;
3182 font_assert (FONT_OBJECT_P (font_object
));
3183 font
= XFONT_OBJECT (font_object
);
3184 return font
->driver
->encode_char (font
, c
);
3188 /* Return the name of FONT_OBJECT. */
3191 font_get_name (font_object
)
3192 Lisp_Object font_object
;
3194 font_assert (FONT_OBJECT_P (font_object
));
3195 return AREF (font_object
, FONT_NAME_INDEX
);
3199 /* Return the specification of FONT_OBJECT. */
3202 font_get_spec (font_object
)
3203 Lisp_Object font_object
;
3205 Lisp_Object spec
= font_make_spec ();
3208 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
3209 ASET (spec
, i
, AREF (font_object
, i
));
3210 ASET (spec
, FONT_SIZE_INDEX
,
3211 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
3216 /* Create a new font spec from FONT_NAME, and return it. If FONT_NAME
3217 could not be parsed by font_parse_name, return Qnil. */
3220 font_spec_from_name (font_name
)
3221 Lisp_Object font_name
;
3223 Lisp_Object spec
= Ffont_spec (0, NULL
);
3225 CHECK_STRING (font_name
);
3226 if (font_parse_name ((char *) SDATA (font_name
), spec
) == -1)
3228 font_put_extra (spec
, QCname
, font_name
);
3229 font_put_extra (spec
, QCuser_spec
, font_name
);
3235 font_clear_prop (attrs
, prop
)
3237 enum font_property_index prop
;
3239 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3244 if (! NILP (Ffont_get (font
, QCname
)))
3246 font
= Fcopy_font_spec (font
);
3247 font_put_extra (font
, QCname
, Qnil
);
3250 if (NILP (AREF (font
, prop
))
3251 && prop
!= FONT_FAMILY_INDEX
3252 && prop
!= FONT_FOUNDRY_INDEX
3253 && prop
!= FONT_WIDTH_INDEX
3254 && prop
!= FONT_SIZE_INDEX
)
3256 if (EQ (font
, attrs
[LFACE_FONT_INDEX
]))
3257 font
= Fcopy_font_spec (font
);
3258 ASET (font
, prop
, Qnil
);
3259 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3261 if (prop
== FONT_FAMILY_INDEX
)
3263 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3264 /* If we are setting the font family, we must also clear
3265 FONT_WIDTH_INDEX to avoid rejecting families that lack
3266 support for some widths. */
3267 ASET (font
, FONT_WIDTH_INDEX
, Qnil
);
3269 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3270 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3271 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3272 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3273 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3274 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3276 else if (prop
== FONT_SIZE_INDEX
)
3278 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3279 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3280 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3282 else if (prop
== FONT_WIDTH_INDEX
)
3283 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3284 attrs
[LFACE_FONT_INDEX
] = font
;
3288 font_update_lface (f
, attrs
)
3294 spec
= attrs
[LFACE_FONT_INDEX
];
3295 if (! FONT_SPEC_P (spec
))
3298 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3299 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3300 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3301 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3302 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3303 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3304 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3305 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);
3306 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3307 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3308 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3312 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3317 val
= Ffont_get (spec
, QCdpi
);
3320 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3322 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3324 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3326 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3327 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3333 /* Selecte a font from ENTITIES (list of font-entity vectors) that
3334 supports C and matches best with ATTRS and PIXEL_SIZE. */
3337 font_select_entity (frame
, entities
, attrs
, pixel_size
, c
)
3338 Lisp_Object frame
, entities
, *attrs
;
3341 Lisp_Object font_entity
;
3344 FRAME_PTR f
= XFRAME (frame
);
3346 if (NILP (XCDR (entities
))
3347 && ASIZE (XCAR (entities
)) == 1)
3349 font_entity
= AREF (XCAR (entities
), 0);
3351 || (result
= font_has_char (f
, font_entity
, c
)) > 0)
3356 /* Sort fonts by properties specified in ATTRS. */
3357 prefer
= scratch_font_prefer
;
3359 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3360 ASET (prefer
, i
, Qnil
);
3361 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3363 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3365 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
3366 ASET (prefer
, i
, AREF (face_font
, i
));
3368 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3369 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3370 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3371 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3372 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3373 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3374 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3376 return font_sort_entities (entities
, prefer
, frame
, c
);
3379 /* Return a font-entity satisfying SPEC and best matching with face's
3380 font related attributes in ATTRS. C, if not negative, is a
3381 character that the entity must support. */
3384 font_find_for_lface (f
, attrs
, spec
, c
)
3391 Lisp_Object frame
, entities
, val
;
3392 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3396 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3397 if (NILP (registry
[0]))
3399 registry
[0] = DEFAULT_ENCODING
;
3400 registry
[1] = Qascii_0
;
3401 registry
[2] = null_vector
;
3404 registry
[1] = null_vector
;
3406 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3408 struct charset
*encoding
, *repertory
;
3410 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3411 &encoding
, &repertory
) < 0)
3414 && ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3416 else if (c
> encoding
->max_char
)
3420 work
= Fcopy_font_spec (spec
);
3421 ASET (work
, FONT_TYPE_INDEX
, AREF (spec
, FONT_TYPE_INDEX
));
3422 XSETFRAME (frame
, f
);
3423 size
= AREF (spec
, FONT_SIZE_INDEX
);
3424 pixel_size
= font_pixel_size (f
, spec
);
3425 if (pixel_size
== 0)
3427 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3429 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3431 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3432 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3433 if (! NILP (foundry
[0]))
3434 foundry
[1] = null_vector
;
3435 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3437 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3438 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3440 foundry
[2] = null_vector
;
3443 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3445 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3446 if (! NILP (adstyle
[0]))
3447 adstyle
[1] = null_vector
;
3448 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3450 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3452 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3454 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3456 adstyle
[2] = null_vector
;
3459 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3462 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3465 val
= AREF (work
, FONT_FAMILY_INDEX
);
3466 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3468 val
= attrs
[LFACE_FAMILY_INDEX
];
3469 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3473 family
= alloca ((sizeof family
[0]) * 2);
3475 family
[1] = null_vector
; /* terminator. */
3480 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3481 /* Font family names are case-sensitive under NS. */
3489 if (! NILP (alters
))
3491 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3492 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3493 family
[i
] = XCAR (alters
);
3494 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3496 family
[i
] = null_vector
;
3500 family
= alloca ((sizeof family
[0]) * 3);
3503 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3505 family
[i
] = null_vector
;
3509 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3511 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3512 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3514 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3515 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3517 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3518 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3520 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3521 entities
= font_list_entities (frame
, work
);
3522 if (! NILP (entities
))
3524 val
= font_select_entity (frame
, entities
,
3525 attrs
, pixel_size
, c
);
3538 font_open_for_lface (f
, entity
, attrs
, spec
)
3546 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3547 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3548 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3549 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3550 size
= font_pixel_size (f
, spec
);
3554 if (INTEGERP (attrs
[LFACE_HEIGHT_INDEX
]))
3555 pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3558 struct face
*def
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3559 Lisp_Object height
= def
->lface
[LFACE_HEIGHT_INDEX
];
3560 if (INTEGERP (height
))
3563 abort(); /* We should never end up here. */
3567 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3571 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3572 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3576 return font_open_entity (f
, entity
, size
);
3580 /* Find a font satisfying SPEC and best matching with face's
3581 attributes in ATTRS on FRAME, and return the opened
3585 font_load_for_lface (f
, attrs
, spec
)
3587 Lisp_Object
*attrs
, spec
;
3589 Lisp_Object entity
, name
;
3591 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3594 /* No font is listed for SPEC, but each font-backend may have
3595 the different criteria about "font matching". So, try
3597 entity
= font_matching_entity (f
, attrs
, spec
);
3601 /* Don't loose the original name that was put in initially. We need
3602 it to re-apply the font when font parameters (like hinting or dpi) have
3604 entity
= font_open_for_lface (f
, entity
, attrs
, spec
);
3607 name
= Ffont_get (spec
, QCuser_spec
);
3608 if (STRINGP (name
)) font_put_extra (entity
, QCuser_spec
, name
);
3614 /* Make FACE on frame F ready to use the font opened for FACE. */
3617 font_prepare_for_face (f
, face
)
3621 if (face
->font
->driver
->prepare_face
)
3622 face
->font
->driver
->prepare_face (f
, face
);
3626 /* Make FACE on frame F stop using the font opened for FACE. */
3629 font_done_for_face (f
, face
)
3633 if (face
->font
->driver
->done_face
)
3634 face
->font
->driver
->done_face (f
, face
);
3639 /* Open a font matching with font-spec SPEC on frame F. If no proper
3640 font is found, return Qnil. */
3643 font_open_by_spec (f
, spec
)
3647 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3649 /* We set up the default font-related attributes of a face to prefer
3651 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3652 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3653 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3655 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3657 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3659 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3661 return font_load_for_lface (f
, attrs
, spec
);
3665 /* Open a font matching with NAME on frame F. If no proper font is
3666 found, return Qnil. */
3669 font_open_by_name (f
, name
)
3673 Lisp_Object args
[2];
3674 Lisp_Object spec
, ret
;
3677 args
[1] = make_unibyte_string (name
, strlen (name
));
3678 spec
= Ffont_spec (2, args
);
3679 ret
= font_open_by_spec (f
, spec
);
3680 /* Do not loose name originally put in. */
3682 font_put_extra (ret
, QCuser_spec
, args
[1]);
3688 /* Register font-driver DRIVER. This function is used in two ways.
3690 The first is with frame F non-NULL. In this case, make DRIVER
3691 available (but not yet activated) on F. All frame creaters
3692 (e.g. Fx_create_frame) must call this function at least once with
3693 an available font-driver.
3695 The second is with frame F NULL. In this case, DRIVER is globally
3696 registered in the variable `font_driver_list'. All font-driver
3697 implementations must call this function in its syms_of_XXXX
3698 (e.g. syms_of_xfont). */
3701 register_font_driver (driver
, f
)
3702 struct font_driver
*driver
;
3705 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3706 struct font_driver_list
*prev
, *list
;
3708 if (f
&& ! driver
->draw
)
3709 error ("Unusable font driver for a frame: %s",
3710 SDATA (SYMBOL_NAME (driver
->type
)));
3712 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3713 if (EQ (list
->driver
->type
, driver
->type
))
3714 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3716 list
= xmalloc (sizeof (struct font_driver_list
));
3718 list
->driver
= driver
;
3723 f
->font_driver_list
= list
;
3725 font_driver_list
= list
;
3731 free_font_driver_list (f
)
3734 struct font_driver_list
*list
, *next
;
3736 for (list
= f
->font_driver_list
; list
; list
= next
)
3741 f
->font_driver_list
= NULL
;
3745 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3746 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3747 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3749 A caller must free all realized faces if any in advance. The
3750 return value is a list of font backends actually made used on
3754 font_update_drivers (f
, new_drivers
)
3756 Lisp_Object new_drivers
;
3758 Lisp_Object active_drivers
= Qnil
;
3759 struct font_driver
*driver
;
3760 struct font_driver_list
*list
;
3762 /* At first, turn off non-requested drivers, and turn on requested
3764 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3766 driver
= list
->driver
;
3767 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3772 if (driver
->end_for_frame
)
3773 driver
->end_for_frame (f
);
3774 font_finish_cache (f
, driver
);
3779 if (! driver
->start_for_frame
3780 || driver
->start_for_frame (f
) == 0)
3782 font_prepare_cache (f
, driver
);
3789 if (NILP (new_drivers
))
3792 if (! EQ (new_drivers
, Qt
))
3794 /* Re-order the driver list according to new_drivers. */
3795 struct font_driver_list
**list_table
, **next
;
3799 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3800 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3802 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3803 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3806 list_table
[i
++] = list
;
3808 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3810 list_table
[i
++] = list
;
3811 list_table
[i
] = NULL
;
3813 next
= &f
->font_driver_list
;
3814 for (i
= 0; list_table
[i
]; i
++)
3816 *next
= list_table
[i
];
3817 next
= &(*next
)->next
;
3821 if (! f
->font_driver_list
->on
)
3822 { /* None of the drivers is enabled: enable them all.
3823 Happens if you set the list of drivers to (xft x) in your .emacs
3824 and then use it under w32 or ns. */
3825 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3827 struct font_driver
*driver
= list
->driver
;
3828 eassert (! list
->on
);
3829 if (! driver
->start_for_frame
3830 || driver
->start_for_frame (f
) == 0)
3832 font_prepare_cache (f
, driver
);
3839 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3841 active_drivers
= nconc2 (active_drivers
,
3842 Fcons (list
->driver
->type
, Qnil
));
3843 return active_drivers
;
3847 font_put_frame_data (f
, driver
, data
)
3849 struct font_driver
*driver
;
3852 struct font_data_list
*list
, *prev
;
3854 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3855 prev
= list
, list
= list
->next
)
3856 if (list
->driver
== driver
)
3863 prev
->next
= list
->next
;
3865 f
->font_data_list
= list
->next
;
3873 list
= xmalloc (sizeof (struct font_data_list
));
3874 list
->driver
= driver
;
3875 list
->next
= f
->font_data_list
;
3876 f
->font_data_list
= list
;
3884 font_get_frame_data (f
, driver
)
3886 struct font_driver
*driver
;
3888 struct font_data_list
*list
;
3890 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3891 if (list
->driver
== driver
)
3899 /* Sets attributes on a font. Any properties that appear in ALIST and
3900 BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font.
3901 BOOLEAN_PROPERTIES and NON_BOOLEAN_PROPERTIES are NULL-terminated
3902 arrays of strings. This function is intended for use by the font
3903 drivers to implement their specific font_filter_properties. */
3905 font_filter_properties (font
, alist
, boolean_properties
, non_boolean_properties
)
3908 const char *boolean_properties
[];
3909 const char *non_boolean_properties
[];
3914 /* Set boolean values to Qt or Qnil */
3915 for (i
= 0; boolean_properties
[i
] != NULL
; ++i
)
3916 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3918 Lisp_Object key
= XCAR (XCAR (it
));
3919 Lisp_Object val
= XCDR (XCAR (it
));
3920 char *keystr
= SDATA (SYMBOL_NAME (key
));
3922 if (strcmp (boolean_properties
[i
], keystr
) == 0)
3924 const char *str
= INTEGERP (val
) ? (XINT (val
) ? "true" : "false")
3925 : SYMBOLP (val
) ? (const char *) SDATA (SYMBOL_NAME (val
))
3928 if (strcmp ("false", str
) == 0 || strcmp ("False", str
) == 0
3929 || strcmp ("FALSE", str
) == 0 || strcmp ("FcFalse", str
) == 0
3930 || strcmp ("off", str
) == 0 || strcmp ("OFF", str
) == 0
3931 || strcmp ("Off", str
) == 0)
3936 Ffont_put (font
, key
, val
);
3940 for (i
= 0; non_boolean_properties
[i
] != NULL
; ++i
)
3941 for (it
= alist
; ! NILP (it
); it
= XCDR (it
))
3943 Lisp_Object key
= XCAR (XCAR (it
));
3944 Lisp_Object val
= XCDR (XCAR (it
));
3945 char *keystr
= SDATA (SYMBOL_NAME (key
));
3946 if (strcmp (non_boolean_properties
[i
], keystr
) == 0)
3947 Ffont_put (font
, key
, val
);
3952 /* Return the font used to draw character C by FACE at buffer position
3953 POS in window W. If STRING is non-nil, it is a string containing C
3954 at index POS. If C is negative, get C from the current buffer or
3958 font_at (c
, pos
, face
, w
, string
)
3967 Lisp_Object font_object
;
3969 multibyte
= (NILP (string
)
3970 ? ! NILP (current_buffer
->enable_multibyte_characters
)
3971 : STRING_MULTIBYTE (string
));
3978 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3980 c
= FETCH_CHAR (pos_byte
);
3983 c
= FETCH_BYTE (pos
);
3989 multibyte
= STRING_MULTIBYTE (string
);
3992 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3994 str
= SDATA (string
) + pos_byte
;
3995 c
= STRING_CHAR (str
);
3998 c
= SDATA (string
)[pos
];
4002 f
= XFRAME (w
->frame
);
4003 if (! FRAME_WINDOW_P (f
))
4010 if (STRINGP (string
))
4011 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
4012 DEFAULT_FACE_ID
, 0);
4014 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
4016 face
= FACE_FROM_ID (f
, face_id
);
4020 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
4021 face
= FACE_FROM_ID (f
, face_id
);
4026 XSETFONT (font_object
, face
->font
);
4031 #ifdef HAVE_WINDOW_SYSTEM
4033 /* Check how many characters after POS (at most to *LIMIT) can be
4034 displayed by the same font on the window W. FACE, if non-NULL, is
4035 the face selected for the character at POS. If STRING is not nil,
4036 it is the string to check instead of the current buffer. In that
4037 case, FACE must be not NULL.
4039 The return value is the font-object for the character at POS.
4040 *LIMIT is set to the position where that font can't be used.
4042 It is assured that the current buffer (or STRING) is multibyte. */
4045 font_range (pos
, limit
, w
, face
, string
)
4046 EMACS_INT pos
, *limit
;
4051 EMACS_INT pos_byte
, ignore
, start
, start_byte
;
4053 Lisp_Object font_object
= Qnil
;
4057 pos_byte
= CHAR_TO_BYTE (pos
);
4062 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
,
4064 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
4070 pos_byte
= string_char_to_byte (string
, pos
);
4073 start
= pos
, start_byte
= pos_byte
;
4074 while (pos
< *limit
)
4076 Lisp_Object category
;
4079 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
4081 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
4082 if (NILP (font_object
))
4084 font_object
= font_for_char (face
, c
, pos
- 1, string
);
4085 if (NILP (font_object
))
4090 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
4091 if (! EQ (category
, QCf
)
4092 && ! CHAR_VARIATION_SELECTOR_P (c
)
4093 && font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
4095 Lisp_Object f
= font_for_char (face
, c
, pos
- 1, string
);
4096 EMACS_INT i
, i_byte
;
4104 i
= start
, i_byte
= start_byte
;
4109 FETCH_CHAR_ADVANCE_NO_CHECK (c
, i
, i_byte
);
4111 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, i
, i_byte
);
4112 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
4113 if (! EQ (category
, QCf
)
4114 && ! CHAR_VARIATION_SELECTOR_P (c
)
4115 && font_encode_char (f
, c
) == FONT_INVALID_CODE
)
4131 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
4132 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
4133 Return nil otherwise.
4134 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
4135 which kind of font it is. It must be one of `font-spec', `font-entity',
4137 (object
, extra_type
)
4138 Lisp_Object object
, extra_type
;
4140 if (NILP (extra_type
))
4141 return (FONTP (object
) ? Qt
: Qnil
);
4142 if (EQ (extra_type
, Qfont_spec
))
4143 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
4144 if (EQ (extra_type
, Qfont_entity
))
4145 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
4146 if (EQ (extra_type
, Qfont_object
))
4147 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
4148 wrong_type_argument (intern ("font-extra-type"), extra_type
);
4151 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
4152 doc
: /* Return a newly created font-spec with arguments as properties.
4154 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
4155 valid font property name listed below:
4157 `:family', `:weight', `:slant', `:width'
4159 They are the same as face attributes of the same name. See
4160 `set-face-attribute'.
4164 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
4168 VALUE must be a string or a symbol specifying the additional
4169 typographic style information of a font, e.g. ``sans''.
4173 VALUE must be a string or a symbol specifying the charset registry and
4174 encoding of a font, e.g. ``iso8859-1''.
4178 VALUE must be a non-negative integer or a floating point number
4179 specifying the font size. It specifies the font size in pixels (if
4180 VALUE is an integer), or in points (if VALUE is a float).
4184 VALUE must be a string of XLFD-style or fontconfig-style font name.
4188 VALUE must be a symbol representing a script that the font must
4189 support. It may be a symbol representing a subgroup of a script
4190 listed in the variable `script-representative-chars'.
4194 VALUE must be a symbol of two-letter ISO-639 language names,
4199 VALUE must be a list (SCRIPT-TAG LANGSYS-TAG GSUB [ GPOS ]) to specify
4200 required OpenType features.
4202 SCRIPT-TAG: OpenType script tag symbol (e.g. `deva').
4203 LANGSYS-TAG: OpenType language system tag symbol,
4204 or nil for the default language system.
4205 GSUB: List of OpenType GSUB feature tag symbols, or nil if none required.
4206 GPOS: List of OpenType GPOS feature tag symbols, or nil if none required.
4208 GSUB and GPOS may contain `nil' element. In such a case, the font
4209 must not have any of the remaining elements.
4211 For instance, if the VALUE is `(thai nil nil (mark))', the font must
4212 be an OpenType font, and whose GPOS table of `thai' script's default
4213 language system must contain `mark' feature.
4215 usage: (font-spec ARGS...) */)
4220 Lisp_Object spec
= font_make_spec ();
4223 for (i
= 0; i
< nargs
; i
+= 2)
4225 Lisp_Object key
= args
[i
], val
;
4229 error ("No value for key `%s'", SDATA (SYMBOL_NAME (key
)));
4232 if (EQ (key
, QCname
))
4235 font_parse_name ((char *) SDATA (val
), spec
);
4236 font_put_extra (spec
, key
, val
);
4240 int idx
= get_font_prop_index (key
);
4244 val
= font_prop_validate (idx
, Qnil
, val
);
4245 if (idx
< FONT_EXTRA_INDEX
)
4246 ASET (spec
, idx
, val
);
4248 font_put_extra (spec
, key
, val
);
4251 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
4257 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
4258 doc
: /* Return a copy of FONT as a font-spec. */)
4262 Lisp_Object new_spec
, tail
, prev
, extra
;
4266 new_spec
= font_make_spec ();
4267 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
4268 ASET (new_spec
, i
, AREF (font
, i
));
4269 extra
= Fcopy_alist (AREF (font
, FONT_EXTRA_INDEX
));
4270 /* We must remove :font-entity property. */
4271 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
4272 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
4275 extra
= XCDR (extra
);
4277 XSETCDR (prev
, XCDR (tail
));
4280 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
4284 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
4285 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
4286 Every specified properties in FROM override the corresponding
4287 properties in TO. */)
4289 Lisp_Object from
, to
;
4291 Lisp_Object extra
, tail
;
4296 to
= Fcopy_font_spec (to
);
4297 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
4298 ASET (to
, i
, AREF (from
, i
));
4299 extra
= AREF (to
, FONT_EXTRA_INDEX
);
4300 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
4301 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
4303 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
4306 XSETCDR (slot
, XCDR (XCAR (tail
)));
4308 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
4310 ASET (to
, FONT_EXTRA_INDEX
, extra
);
4314 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
4315 doc
: /* Return the value of FONT's property KEY.
4316 FONT is a font-spec, a font-entity, or a font-object.
4317 KEY must be one of these symbols:
4318 :family, :weight, :slant, :width, :foundry, :adstyle, :registry,
4319 :size, :name, :script
4320 See the documentation of `font-spec' for their meanings.
4321 If FONT is a font-entity or font-object, the value of :script may be
4322 a list of scripts that are supported by the font. */)
4324 Lisp_Object font
, key
;
4331 idx
= get_font_prop_index (key
);
4332 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
4333 return font_style_symbolic (font
, idx
, 0);
4334 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4335 return AREF (font
, idx
);
4336 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
4339 #ifdef HAVE_WINDOW_SYSTEM
4341 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
4342 doc
: /* Return a plist of face attributes generated by FONT.
4343 FONT is a font name, a font-spec, a font-entity, or a font-object.
4344 The return value is a list of the form
4346 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
4348 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
4349 compatible with `set-face-attribute'. Some of these key-attribute pairs
4350 may be omitted from the list if they are not specified by FONT.
4352 The optional argument FRAME specifies the frame that the face attributes
4353 are to be displayed on. If omitted, the selected frame is used. */)
4355 Lisp_Object font
, frame
;
4358 Lisp_Object plist
[10];
4363 frame
= selected_frame
;
4364 CHECK_LIVE_FRAME (frame
);
4369 int fontset
= fs_query_fontset (font
, 0);
4370 Lisp_Object name
= font
;
4372 font
= fontset_ascii (fontset
);
4373 font
= font_spec_from_name (name
);
4375 signal_error ("Invalid font name", name
);
4377 else if (! FONTP (font
))
4378 signal_error ("Invalid font object", font
);
4380 val
= AREF (font
, FONT_FAMILY_INDEX
);
4383 plist
[n
++] = QCfamily
;
4384 plist
[n
++] = SYMBOL_NAME (val
);
4387 val
= AREF (font
, FONT_SIZE_INDEX
);
4390 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
4391 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
4392 plist
[n
++] = QCheight
;
4393 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
4395 else if (FLOATP (val
))
4397 plist
[n
++] = QCheight
;
4398 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
4401 val
= FONT_WEIGHT_FOR_FACE (font
);
4404 plist
[n
++] = QCweight
;
4408 val
= FONT_SLANT_FOR_FACE (font
);
4411 plist
[n
++] = QCslant
;
4415 val
= FONT_WIDTH_FOR_FACE (font
);
4418 plist
[n
++] = QCwidth
;
4422 return Flist (n
, plist
);
4427 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4428 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
4429 (font_spec
, prop
, val
)
4430 Lisp_Object font_spec
, prop
, val
;
4434 CHECK_FONT_SPEC (font_spec
);
4435 idx
= get_font_prop_index (prop
);
4436 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4437 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
4439 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
4443 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4444 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4445 Optional 2nd argument FRAME specifies the target frame.
4446 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4447 Optional 4th argument PREFER, if non-nil, is a font-spec to
4448 control the order of the returned list. Fonts are sorted by
4449 how close they are to PREFER. */)
4450 (font_spec
, frame
, num
, prefer
)
4451 Lisp_Object font_spec
, frame
, num
, prefer
;
4453 Lisp_Object vec
, list
;
4457 frame
= selected_frame
;
4458 CHECK_LIVE_FRAME (frame
);
4459 CHECK_FONT_SPEC (font_spec
);
4467 if (! NILP (prefer
))
4468 CHECK_FONT_SPEC (prefer
);
4470 list
= font_list_entities (frame
, font_spec
);
4473 if (NILP (XCDR (list
))
4474 && ASIZE (XCAR (list
)) == 1)
4475 return Fcons (AREF (XCAR (list
), 0), Qnil
);
4477 if (! NILP (prefer
))
4478 vec
= font_sort_entities (list
, prefer
, frame
, 0);
4480 vec
= font_vconcat_entity_vectors (list
);
4481 if (n
== 0 || n
>= ASIZE (vec
))
4483 Lisp_Object args
[2];
4487 list
= Fappend (2, args
);
4491 for (list
= Qnil
, n
--; n
>= 0; n
--)
4492 list
= Fcons (AREF (vec
, n
), list
);
4497 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4498 doc
: /* List available font families on the current frame.
4499 Optional argument FRAME, if non-nil, specifies the target frame. */)
4504 struct font_driver_list
*driver_list
;
4508 frame
= selected_frame
;
4509 CHECK_LIVE_FRAME (frame
);
4512 for (driver_list
= f
->font_driver_list
; driver_list
;
4513 driver_list
= driver_list
->next
)
4514 if (driver_list
->driver
->list_family
)
4516 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4517 Lisp_Object tail
= list
;
4519 for (; CONSP (val
); val
= XCDR (val
))
4520 if (NILP (Fmemq (XCAR (val
), tail
))
4521 && SYMBOLP (XCAR (val
)))
4522 list
= Fcons (SYMBOL_NAME (XCAR (val
)), list
);
4527 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4528 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4529 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4531 Lisp_Object font_spec
, frame
;
4533 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4540 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4541 doc
: /* Return XLFD name of FONT.
4542 FONT is a font-spec, font-entity, or font-object.
4543 If the name is too long for XLFD (maximum 255 chars), return nil.
4544 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4545 the consecutive wildcards are folded to one. */)
4546 (font
, fold_wildcards
)
4547 Lisp_Object font
, fold_wildcards
;
4554 if (FONT_OBJECT_P (font
))
4556 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4558 if (STRINGP (font_name
)
4559 && SDATA (font_name
)[0] == '-')
4561 if (NILP (fold_wildcards
))
4563 strcpy (name
, (char *) SDATA (font_name
));
4566 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4568 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4571 if (! NILP (fold_wildcards
))
4573 char *p0
= name
, *p1
;
4575 while ((p1
= strstr (p0
, "-*-*")))
4577 strcpy (p1
, p1
+ 2);
4582 return build_string (name
);
4585 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4586 doc
: /* Clear font cache. */)
4589 Lisp_Object list
, frame
;
4591 FOR_EACH_FRAME (list
, frame
)
4593 FRAME_PTR f
= XFRAME (frame
);
4594 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4596 for (; driver_list
; driver_list
= driver_list
->next
)
4597 if (driver_list
->on
)
4599 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4600 Lisp_Object val
, tmp
;
4604 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4606 font_assert (! NILP (val
));
4607 tmp
= XCDR (XCAR (val
));
4608 if (XINT (XCAR (tmp
)) == 0)
4610 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4611 XSETCDR (cache
, XCDR (val
));
4621 font_fill_lglyph_metrics (glyph
, font_object
)
4622 Lisp_Object glyph
, font_object
;
4624 struct font
*font
= XFONT_OBJECT (font_object
);
4626 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4627 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4628 struct font_metrics metrics
;
4630 LGLYPH_SET_CODE (glyph
, ecode
);
4632 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4633 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4634 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4635 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4636 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4637 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4641 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4642 doc
: /* Shape the glyph-string GSTRING.
4643 Shaping means substituting glyphs and/or adjusting positions of glyphs
4644 to get the correct visual image of character sequences set in the
4645 header of the glyph-string.
4647 If the shaping was successful, the value is GSTRING itself or a newly
4648 created glyph-string. Otherwise, the value is nil. */)
4650 Lisp_Object gstring
;
4653 Lisp_Object font_object
, n
, glyph
;
4656 if (! composition_gstring_p (gstring
))
4657 signal_error ("Invalid glyph-string: ", gstring
);
4658 if (! NILP (LGSTRING_ID (gstring
)))
4660 font_object
= LGSTRING_FONT (gstring
);
4661 CHECK_FONT_OBJECT (font_object
);
4662 font
= XFONT_OBJECT (font_object
);
4663 if (! font
->driver
->shape
)
4666 /* Try at most three times with larger gstring each time. */
4667 for (i
= 0; i
< 3; i
++)
4669 n
= font
->driver
->shape (gstring
);
4672 gstring
= larger_vector (gstring
,
4673 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4676 if (i
== 3 || XINT (n
) == 0)
4679 glyph
= LGSTRING_GLYPH (gstring
, 0);
4680 from
= LGLYPH_FROM (glyph
);
4681 to
= LGLYPH_TO (glyph
);
4682 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4684 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4688 if (NILP (LGLYPH_ADJUSTMENT (this)))
4693 glyph
= LGSTRING_GLYPH (gstring
, j
);
4694 LGLYPH_SET_FROM (glyph
, from
);
4695 LGLYPH_SET_TO (glyph
, to
);
4697 from
= LGLYPH_FROM (this);
4698 to
= LGLYPH_TO (this);
4703 if (from
> LGLYPH_FROM (this))
4704 from
= LGLYPH_FROM (this);
4705 if (to
< LGLYPH_TO (this))
4706 to
= LGLYPH_TO (this);
4712 glyph
= LGSTRING_GLYPH (gstring
, j
);
4713 LGLYPH_SET_FROM (glyph
, from
);
4714 LGLYPH_SET_TO (glyph
, to
);
4716 return composition_gstring_put_cache (gstring
, XINT (n
));
4719 DEFUN ("font-variation-glyphs", Ffont_variation_glyphs
, Sfont_variation_glyphs
,
4721 doc
: /* Return a list of variation glyphs for CHAR in FONT-OBJECT.
4722 Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID),
4724 VARIATION-SELECTOR is a character code of variation selection
4725 (#xFE00..#xFE0F or #xE0100..#xE01EF)
4726 GLYPH-ID is a glyph code of the corresponding variation glyph. */)
4727 (font_object
, character
)
4728 Lisp_Object font_object
, character
;
4730 unsigned variations
[256];
4735 CHECK_FONT_OBJECT (font_object
);
4736 CHECK_CHARACTER (character
);
4737 font
= XFONT_OBJECT (font_object
);
4738 if (! font
->driver
->get_variation_glyphs
)
4740 n
= font
->driver
->get_variation_glyphs (font
, XINT (character
), variations
);
4744 for (i
= 0; i
< 255; i
++)
4748 int vs
= (i
< 16 ? 0xFE00 + i
: 0xE0100 + (i
- 16));
4749 /* Stops GCC whining about limited range of data type. */
4750 EMACS_INT var
= variations
[i
];
4752 if (var
> MOST_POSITIVE_FIXNUM
)
4753 code
= Fcons (make_number ((variations
[i
]) >> 16),
4754 make_number ((variations
[i
]) & 0xFFFF));
4756 code
= make_number (variations
[i
]);
4757 val
= Fcons (Fcons (make_number (vs
), code
), val
);
4764 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4765 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4766 OTF-FEATURES specifies which features to apply in this format:
4767 (SCRIPT LANGSYS GSUB GPOS)
4769 SCRIPT is a symbol specifying a script tag of OpenType,
4770 LANGSYS is a symbol specifying a langsys tag of OpenType,
4771 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4773 If LANGYS is nil, the default langsys is selected.
4775 The features are applied in the order they appear in the list. The
4776 symbol `*' means to apply all available features not present in this
4777 list, and the remaining features are ignored. For instance, (vatu
4778 pstf * haln) is to apply vatu and pstf in this order, then to apply
4779 all available features other than vatu, pstf, and haln.
4781 The features are applied to the glyphs in the range FROM and TO of
4782 the glyph-string GSTRING-IN.
4784 If some feature is actually applicable, the resulting glyphs are
4785 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4786 this case, the value is the number of produced glyphs.
4788 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4791 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4792 produced in GSTRING-OUT, and the value is nil.
4794 See the documentation of `font-make-gstring' for the format of
4796 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4797 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4799 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4804 check_otf_features (otf_features
);
4805 CHECK_FONT_OBJECT (font_object
);
4806 font
= XFONT_OBJECT (font_object
);
4807 if (! font
->driver
->otf_drive
)
4808 error ("Font backend %s can't drive OpenType GSUB table",
4809 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4810 CHECK_CONS (otf_features
);
4811 CHECK_SYMBOL (XCAR (otf_features
));
4812 val
= XCDR (otf_features
);
4813 CHECK_SYMBOL (XCAR (val
));
4814 val
= XCDR (otf_features
);
4817 len
= check_gstring (gstring_in
);
4818 CHECK_VECTOR (gstring_out
);
4819 CHECK_NATNUM (from
);
4821 CHECK_NATNUM (index
);
4823 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4824 args_out_of_range_3 (from
, to
, make_number (len
));
4825 if (XINT (index
) >= ASIZE (gstring_out
))
4826 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4827 num
= font
->driver
->otf_drive (font
, otf_features
,
4828 gstring_in
, XINT (from
), XINT (to
),
4829 gstring_out
, XINT (index
), 0);
4832 return make_number (num
);
4835 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4837 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4838 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4840 (SCRIPT LANGSYS FEATURE ...)
4841 See the documentation of `font-drive-otf' for more detail.
4843 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4844 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4845 character code corresponding to the glyph or nil if there's no
4846 corresponding character. */)
4847 (font_object
, character
, otf_features
)
4848 Lisp_Object font_object
, character
, otf_features
;
4851 Lisp_Object gstring_in
, gstring_out
, g
;
4852 Lisp_Object alternates
;
4855 CHECK_FONT_GET_OBJECT (font_object
, font
);
4856 if (! font
->driver
->otf_drive
)
4857 error ("Font backend %s can't drive OpenType GSUB table",
4858 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4859 CHECK_CHARACTER (character
);
4860 CHECK_CONS (otf_features
);
4862 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4863 g
= LGSTRING_GLYPH (gstring_in
, 0);
4864 LGLYPH_SET_CHAR (g
, XINT (character
));
4865 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4866 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4867 gstring_out
, 0, 1)) < 0)
4868 gstring_out
= Ffont_make_gstring (font_object
,
4869 make_number (ASIZE (gstring_out
) * 2));
4871 for (i
= 0; i
< num
; i
++)
4873 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4874 int c
= LGLYPH_CHAR (g
);
4875 unsigned code
= LGLYPH_CODE (g
);
4877 alternates
= Fcons (Fcons (make_number (code
),
4878 c
> 0 ? make_number (c
) : Qnil
),
4881 return Fnreverse (alternates
);
4887 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4888 doc
: /* Open FONT-ENTITY. */)
4889 (font_entity
, size
, frame
)
4890 Lisp_Object font_entity
;
4896 CHECK_FONT_ENTITY (font_entity
);
4898 frame
= selected_frame
;
4899 CHECK_LIVE_FRAME (frame
);
4902 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4905 CHECK_NUMBER_OR_FLOAT (size
);
4907 isize
= POINT_TO_PIXEL (XFLOAT_DATA (size
), XFRAME (frame
)->resy
);
4909 isize
= XINT (size
);
4913 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4916 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4917 doc
: /* Close FONT-OBJECT. */)
4918 (font_object
, frame
)
4919 Lisp_Object font_object
, frame
;
4921 CHECK_FONT_OBJECT (font_object
);
4923 frame
= selected_frame
;
4924 CHECK_LIVE_FRAME (frame
);
4925 font_close_object (XFRAME (frame
), font_object
);
4929 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4930 doc
: /* Return information about FONT-OBJECT.
4931 The value is a vector:
4932 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4935 NAME is a string of the font name (or nil if the font backend doesn't
4938 FILENAME is a string of the font file (or nil if the font backend
4939 doesn't provide a file name).
4941 PIXEL-SIZE is a pixel size by which the font is opened.
4943 SIZE is a maximum advance width of the font in pixels.
4945 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4948 CAPABILITY is a list whose first element is a symbol representing the
4949 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4950 remaining elements describe the details of the font capability.
4952 If the font is OpenType font, the form of the list is
4953 \(opentype GSUB GPOS)
4954 where GSUB shows which "GSUB" features the font supports, and GPOS
4955 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4956 lists of the format:
4957 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4959 If the font is not OpenType font, currently the length of the form is
4962 SCRIPT is a symbol representing OpenType script tag.
4964 LANGSYS is a symbol representing OpenType langsys tag, or nil
4965 representing the default langsys.
4967 FEATURE is a symbol representing OpenType feature tag.
4969 If the font is not OpenType font, CAPABILITY is nil. */)
4971 Lisp_Object font_object
;
4976 CHECK_FONT_GET_OBJECT (font_object
, font
);
4978 val
= Fmake_vector (make_number (9), Qnil
);
4979 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4980 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4981 ASET (val
, 2, make_number (font
->pixel_size
));
4982 ASET (val
, 3, make_number (font
->max_width
));
4983 ASET (val
, 4, make_number (font
->ascent
));
4984 ASET (val
, 5, make_number (font
->descent
));
4985 ASET (val
, 6, make_number (font
->space_width
));
4986 ASET (val
, 7, make_number (font
->average_width
));
4987 if (font
->driver
->otf_capability
)
4988 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4992 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4993 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4994 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4995 (font_object
, string
)
4996 Lisp_Object font_object
, string
;
5002 CHECK_FONT_GET_OBJECT (font_object
, font
);
5003 CHECK_STRING (string
);
5004 len
= SCHARS (string
);
5005 vec
= Fmake_vector (make_number (len
), Qnil
);
5006 for (i
= 0; i
< len
; i
++)
5008 Lisp_Object ch
= Faref (string
, make_number (i
));
5013 struct font_metrics metrics
;
5015 cod
= code
= font
->driver
->encode_char (font
, c
);
5016 if (code
== FONT_INVALID_CODE
)
5018 val
= Fmake_vector (make_number (6), Qnil
);
5019 if (cod
<= MOST_POSITIVE_FIXNUM
)
5020 ASET (val
, 0, make_number (code
));
5022 ASET (val
, 0, Fcons (make_number (code
>> 16),
5023 make_number (code
& 0xFFFF)));
5024 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
5025 ASET (val
, 1, make_number (metrics
.lbearing
));
5026 ASET (val
, 2, make_number (metrics
.rbearing
));
5027 ASET (val
, 3, make_number (metrics
.width
));
5028 ASET (val
, 4, make_number (metrics
.ascent
));
5029 ASET (val
, 5, make_number (metrics
.descent
));
5035 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
5036 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
5037 FONT is a font-spec, font-entity, or font-object. */)
5039 Lisp_Object spec
, font
;
5041 CHECK_FONT_SPEC (spec
);
5044 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
5047 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
5048 doc
: /* Return a font-object for displaying a character at POSITION.
5049 Optional second arg WINDOW, if non-nil, is a window displaying
5050 the current buffer. It defaults to the currently selected window. */)
5051 (position
, window
, string
)
5052 Lisp_Object position
, window
, string
;
5059 CHECK_NUMBER_COERCE_MARKER (position
);
5060 pos
= XINT (position
);
5061 if (pos
< BEGV
|| pos
>= ZV
)
5062 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
5066 CHECK_NUMBER (position
);
5067 CHECK_STRING (string
);
5068 pos
= XINT (position
);
5069 if (pos
< 0 || pos
>= SCHARS (string
))
5070 args_out_of_range (string
, position
);
5073 window
= selected_window
;
5074 CHECK_LIVE_WINDOW (window
);
5075 w
= XWINDOW (window
);
5077 return font_at (-1, pos
, NULL
, w
, string
);
5081 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
5082 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
5083 The value is a number of glyphs drawn.
5084 Type C-l to recover what previously shown. */)
5085 (font_object
, string
)
5086 Lisp_Object font_object
, string
;
5088 Lisp_Object frame
= selected_frame
;
5089 FRAME_PTR f
= XFRAME (frame
);
5095 CHECK_FONT_GET_OBJECT (font_object
, font
);
5096 CHECK_STRING (string
);
5097 len
= SCHARS (string
);
5098 code
= alloca (sizeof (unsigned) * len
);
5099 for (i
= 0; i
< len
; i
++)
5101 Lisp_Object ch
= Faref (string
, make_number (i
));
5105 code
[i
] = font
->driver
->encode_char (font
, c
);
5106 if (code
[i
] == FONT_INVALID_CODE
)
5109 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5111 if (font
->driver
->prepare_face
)
5112 font
->driver
->prepare_face (f
, face
);
5113 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
5114 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
5115 if (font
->driver
->done_face
)
5116 font
->driver
->done_face (f
, face
);
5118 return make_number (len
);
5122 #endif /* FONT_DEBUG */
5124 #ifdef HAVE_WINDOW_SYSTEM
5126 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
5127 doc
: /* Return information about a font named NAME on frame FRAME.
5128 If FRAME is omitted or nil, use the selected frame.
5129 The returned value is a vector of OPENED-NAME, FULL-NAME, SIZE,
5130 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
5132 OPENED-NAME is the name used for opening the font,
5133 FULL-NAME is the full name of the font,
5134 SIZE is the pixelsize of the font,
5135 HEIGHT is the pixel-height of the font (i.e ascent + descent),
5136 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
5137 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
5138 how to compose characters.
5139 If the named font is not yet loaded, return nil. */)
5141 Lisp_Object name
, frame
;
5146 Lisp_Object font_object
;
5148 (*check_window_system_func
) ();
5151 CHECK_STRING (name
);
5153 frame
= selected_frame
;
5154 CHECK_LIVE_FRAME (frame
);
5159 int fontset
= fs_query_fontset (name
, 0);
5162 name
= fontset_ascii (fontset
);
5163 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
5165 else if (FONT_OBJECT_P (name
))
5167 else if (FONT_ENTITY_P (name
))
5168 font_object
= font_open_entity (f
, name
, 0);
5171 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5172 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
5174 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
5176 if (NILP (font_object
))
5178 font
= XFONT_OBJECT (font_object
);
5180 info
= Fmake_vector (make_number (7), Qnil
);
5181 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
5182 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_FULLNAME_INDEX
);
5183 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
5184 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
5185 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
5186 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
5187 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
5190 /* As font_object is still in FONT_OBJLIST of the entity, we can't
5191 close it now. Perhaps, we should manage font-objects
5192 by `reference-count'. */
5193 font_close_object (f
, font_object
);
5200 #define BUILD_STYLE_TABLE(TBL) \
5201 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
5204 build_style_table (entry
, nelement
)
5205 struct table_entry
*entry
;
5209 Lisp_Object table
, elt
;
5211 table
= Fmake_vector (make_number (nelement
), Qnil
);
5212 for (i
= 0; i
< nelement
; i
++)
5214 for (j
= 0; entry
[i
].names
[j
]; j
++);
5215 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
5216 ASET (elt
, 0, make_number (entry
[i
].numeric
));
5217 for (j
= 0; entry
[i
].names
[j
]; j
++)
5218 ASET (elt
, j
+ 1, intern_c_string (entry
[i
].names
[j
]));
5219 ASET (table
, i
, elt
);
5224 Lisp_Object Vfont_log
;
5226 /* The deferred font-log data of the form [ACTION ARG RESULT].
5227 If ACTION is not nil, that is added to the log when font_add_log is
5228 called next time. At that time, ACTION is set back to nil. */
5229 static Lisp_Object Vfont_log_deferred
;
5231 /* Prepend the font-related logging data in Vfont_log if it is not
5232 `t'. ACTION describes a kind of font-related action (e.g. listing,
5233 opening), ARG is the argument for the action, and RESULT is the
5234 result of the action. */
5236 font_add_log (action
, arg
, result
)
5238 Lisp_Object arg
, result
;
5240 Lisp_Object tail
, val
;
5243 if (EQ (Vfont_log
, Qt
))
5245 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
5247 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
5249 ASET (Vfont_log_deferred
, 0, Qnil
);
5250 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
5251 AREF (Vfont_log_deferred
, 2));
5256 Lisp_Object tail
, elt
;
5257 Lisp_Object equalstr
= build_string ("=");
5259 val
= Ffont_xlfd_name (arg
, Qt
);
5260 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
5264 if (EQ (XCAR (elt
), QCscript
)
5265 && SYMBOLP (XCDR (elt
)))
5266 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
5267 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5268 else if (EQ (XCAR (elt
), QClang
)
5269 && SYMBOLP (XCDR (elt
)))
5270 val
= concat3 (val
, SYMBOL_NAME (QClang
),
5271 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
5272 else if (EQ (XCAR (elt
), QCotf
)
5273 && CONSP (XCDR (elt
)) && SYMBOLP (XCAR (XCDR (elt
))))
5274 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
5276 SYMBOL_NAME (XCAR (XCDR (elt
)))));
5282 && VECTORP (XCAR (result
))
5283 && ASIZE (XCAR (result
)) > 0
5284 && FONTP (AREF (XCAR (result
), 0)))
5285 result
= font_vconcat_entity_vectors (result
);
5288 val
= Ffont_xlfd_name (result
, Qt
);
5289 if (! FONT_SPEC_P (result
))
5290 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
5291 build_string (":"), val
);
5294 else if (CONSP (result
))
5296 result
= Fcopy_sequence (result
);
5297 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
5301 val
= Ffont_xlfd_name (val
, Qt
);
5302 XSETCAR (tail
, val
);
5305 else if (VECTORP (result
))
5307 result
= Fcopy_sequence (result
);
5308 for (i
= 0; i
< ASIZE (result
); i
++)
5310 val
= AREF (result
, i
);
5312 val
= Ffont_xlfd_name (val
, Qt
);
5313 ASET (result
, i
, val
);
5316 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
5319 /* Record a font-related logging data to be added to Vfont_log when
5320 font_add_log is called next time. ACTION, ARG, RESULT are the same
5324 font_deferred_log (action
, arg
, result
)
5326 Lisp_Object arg
, result
;
5328 if (EQ (Vfont_log
, Qt
))
5330 ASET (Vfont_log_deferred
, 0, build_string (action
));
5331 ASET (Vfont_log_deferred
, 1, arg
);
5332 ASET (Vfont_log_deferred
, 2, result
);
5335 extern void syms_of_ftfont
P_ (());
5336 extern void syms_of_xfont
P_ (());
5337 extern void syms_of_xftfont
P_ (());
5338 extern void syms_of_ftxfont
P_ (());
5339 extern void syms_of_bdffont
P_ (());
5340 extern void syms_of_w32font
P_ (());
5341 extern void syms_of_atmfont
P_ (());
5342 extern void syms_of_nsfont
P_ (());
5347 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
5348 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
5349 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
5350 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
5351 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
5352 /* Note that the other elements in sort_shift_bits are not used. */
5354 staticpro (&font_charset_alist
);
5355 font_charset_alist
= Qnil
;
5357 DEFSYM (Qopentype
, "opentype");
5359 DEFSYM (Qascii_0
, "ascii-0");
5360 DEFSYM (Qiso8859_1
, "iso8859-1");
5361 DEFSYM (Qiso10646_1
, "iso10646-1");
5362 DEFSYM (Qunicode_bmp
, "unicode-bmp");
5363 DEFSYM (Qunicode_sip
, "unicode-sip");
5367 DEFSYM (QCotf
, ":otf");
5368 DEFSYM (QClang
, ":lang");
5369 DEFSYM (QCscript
, ":script");
5370 DEFSYM (QCantialias
, ":antialias");
5372 DEFSYM (QCfoundry
, ":foundry");
5373 DEFSYM (QCadstyle
, ":adstyle");
5374 DEFSYM (QCregistry
, ":registry");
5375 DEFSYM (QCspacing
, ":spacing");
5376 DEFSYM (QCdpi
, ":dpi");
5377 DEFSYM (QCscalable
, ":scalable");
5378 DEFSYM (QCavgwidth
, ":avgwidth");
5379 DEFSYM (QCfont_entity
, ":font-entity");
5380 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5390 DEFSYM (QCuser_spec
, "user-spec");
5392 staticpro (&null_vector
);
5393 null_vector
= Fmake_vector (make_number (0), Qnil
);
5395 staticpro (&scratch_font_spec
);
5396 scratch_font_spec
= Ffont_spec (0, NULL
);
5397 staticpro (&scratch_font_prefer
);
5398 scratch_font_prefer
= Ffont_spec (0, NULL
);
5400 staticpro (&Vfont_log_deferred
);
5401 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
5405 staticpro (&otf_list
);
5407 #endif /* HAVE_LIBOTF */
5411 defsubr (&Sfont_spec
);
5412 defsubr (&Sfont_get
);
5413 #ifdef HAVE_WINDOW_SYSTEM
5414 defsubr (&Sfont_face_attributes
);
5416 defsubr (&Sfont_put
);
5417 defsubr (&Slist_fonts
);
5418 defsubr (&Sfont_family_list
);
5419 defsubr (&Sfind_font
);
5420 defsubr (&Sfont_xlfd_name
);
5421 defsubr (&Sclear_font_cache
);
5422 defsubr (&Sfont_shape_gstring
);
5423 defsubr (&Sfont_variation_glyphs
);
5425 defsubr (&Sfont_drive_otf
);
5426 defsubr (&Sfont_otf_alternates
);
5430 defsubr (&Sopen_font
);
5431 defsubr (&Sclose_font
);
5432 defsubr (&Squery_font
);
5433 defsubr (&Sget_font_glyphs
);
5434 defsubr (&Sfont_match_p
);
5435 defsubr (&Sfont_at
);
5437 defsubr (&Sdraw_string
);
5439 #endif /* FONT_DEBUG */
5440 #ifdef HAVE_WINDOW_SYSTEM
5441 defsubr (&Sfont_info
);
5444 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5446 Alist of fontname patterns vs the corresponding encoding and repertory info.
5447 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5448 where ENCODING is a charset or a char-table,
5449 and REPERTORY is a charset, a char-table, or nil.
5451 If ENCODING and REPERTORY are the same, the element can have the form
5452 \(REGEXP . ENCODING).
5454 ENCODING is for converting a character to a glyph code of the font.
5455 If ENCODING is a charset, encoding a character by the charset gives
5456 the corresponding glyph code. If ENCODING is a char-table, looking up
5457 the table by a character gives the corresponding glyph code.
5459 REPERTORY specifies a repertory of characters supported by the font.
5460 If REPERTORY is a charset, all characters beloging to the charset are
5461 supported. If REPERTORY is a char-table, all characters who have a
5462 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5463 gets the repertory information by an opened font and ENCODING. */);
5464 Vfont_encoding_alist
= Qnil
;
5466 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5467 doc
: /* Vector of valid font weight values.
5468 Each element has the form:
5469 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5470 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5471 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5473 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5474 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5475 See `font-weight-table' for the format of the vector. */);
5476 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5478 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5479 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5480 See `font-weight-table' for the format of the vector. */);
5481 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5483 staticpro (&font_style_table
);
5484 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5485 ASET (font_style_table
, 0, Vfont_weight_table
);
5486 ASET (font_style_table
, 1, Vfont_slant_table
);
5487 ASET (font_style_table
, 2, Vfont_width_table
);
5489 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5490 *Logging list of font related actions and results.
5491 The value t means to suppress the logging.
5492 The initial value is set to nil if the environment variable
5493 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5496 #ifdef HAVE_WINDOW_SYSTEM
5497 #ifdef HAVE_FREETYPE
5499 #ifdef HAVE_X_WINDOWS
5504 #endif /* HAVE_XFT */
5505 #endif /* HAVE_X_WINDOWS */
5506 #else /* not HAVE_FREETYPE */
5507 #ifdef HAVE_X_WINDOWS
5509 #endif /* HAVE_X_WINDOWS */
5510 #endif /* not HAVE_FREETYPE */
5513 #endif /* HAVE_BDFFONT */
5516 #endif /* WINDOWSNT */
5519 #endif /* HAVE_NS */
5520 #endif /* HAVE_WINDOW_SYSTEM */
5526 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
5529 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5530 (do not change this comment) */