1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
3 Copyright (C) 2006, 2007, 2008
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/>. */
34 #include "dispextern.h"
36 #include "character.h"
37 #include "composite.h"
43 #endif /* HAVE_X_WINDOWS */
47 #endif /* HAVE_NTGUI */
53 Lisp_Object Qfont_spec
, Qfont_entity
, Qfont_object
;
56 extern Lisp_Object Qfontsize
;
59 Lisp_Object Qopentype
;
61 /* Important character set strings. */
62 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
65 #define DEFAULT_ENCODING Qiso10646_1
67 #define DEFAULT_ENCODING Qiso8859_1
70 /* Unicode category `Cf'. */
71 static Lisp_Object QCf
;
73 /* Special vector of zero length. This is repeatedly used by (struct
74 font_driver *)->list when a specified font is not found. */
75 static Lisp_Object null_vector
;
77 static Lisp_Object Vfont_weight_table
, Vfont_slant_table
, Vfont_width_table
;
79 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
80 static Lisp_Object font_style_table
;
82 /* Structure used for tables mapping weight, slant, and width numeric
83 values and their names. */
88 /* The first one is a valid name as a face attribute.
89 The second one (if any) is a typical name in XLFD field. */
94 /* Table of weight numeric values and their names. This table must be
95 sorted by numeric values in ascending order. */
97 static struct table_entry weight_table
[] =
100 { 20, { "ultra-light", "ultralight" }},
101 { 40, { "extra-light", "extralight" }},
103 { 75, { "semi-light", "semilight", "demilight", "book" }},
104 { 100, { "normal", "medium", "regular" }},
105 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
107 { 205, { "extra-bold", "extrabold" }},
108 { 210, { "ultra-bold", "ultrabold", "black" }}
111 /* Table of slant numeric values and their names. This table must be
112 sorted by numeric values in ascending order. */
114 static struct table_entry slant_table
[] =
116 { 0, { "reverse-oblique", "ro" }},
117 { 10, { "reverse-italic", "ri" }},
118 { 100, { "normal", "r" }},
119 { 200, { "italic" ,"i", "ot" }},
120 { 210, { "oblique", "o" }}
123 /* Table of width numeric values and their names. This table must be
124 sorted by numeric values in ascending order. */
126 static struct table_entry width_table
[] =
128 { 50, { "ultra-condensed", "ultracondensed" }},
129 { 63, { "extra-condensed", "extracondensed" }},
130 { 75, { "condensed", "compressed", "narrow" }},
131 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
132 { 100, { "normal", "medium", "regular" }},
133 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
134 { 125, { "expanded" }},
135 { 150, { "extra-expanded", "extraexpanded" }},
136 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
139 extern Lisp_Object Qnormal
;
141 /* Symbols representing keys of normal font properties. */
142 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
;
143 extern Lisp_Object QCheight
, QCsize
, QCname
;
145 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
;
146 /* Symbols representing keys of font extra info. */
147 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
148 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
149 /* Symbols representing values of font spacing property. */
150 Lisp_Object Qc
, Qm
, Qp
, Qd
;
152 Lisp_Object Vfont_encoding_alist
;
154 /* Alist of font registry symbol and the corresponding charsets
155 information. The information is retrieved from
156 Vfont_encoding_alist on demand.
158 Eash element has the form:
159 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
163 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
164 encodes a character code to a glyph code of a font, and
165 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
166 character is supported by a font.
168 The latter form means that the information for REGISTRY couldn't be
170 static Lisp_Object font_charset_alist
;
172 /* List of all font drivers. Each font-backend (XXXfont.c) calls
173 register_font_driver in syms_of_XXXfont to register its font-driver
175 static struct font_driver_list
*font_driver_list
;
179 /* Creaters of font-related Lisp object. */
184 Lisp_Object font_spec
;
185 struct font_spec
*spec
186 = ((struct font_spec
*)
187 allocate_pseudovector (VECSIZE (struct font_spec
),
188 FONT_SPEC_MAX
, PVEC_FONT
));
189 XSETFONT (font_spec
, spec
);
196 Lisp_Object font_entity
;
197 struct font_entity
*entity
198 = ((struct font_entity
*)
199 allocate_pseudovector (VECSIZE (struct font_entity
),
200 FONT_ENTITY_MAX
, PVEC_FONT
));
201 XSETFONT (font_entity
, entity
);
205 /* Create a font-object whose structure size is SIZE. If ENTITY is
206 not nil, copy properties from ENTITY to the font-object. If
207 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
209 font_make_object (size
, entity
, pixelsize
)
214 Lisp_Object font_object
;
216 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
219 XSETFONT (font_object
, font
);
223 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
224 font
->props
[i
] = AREF (entity
, i
);
225 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
226 font
->props
[FONT_EXTRA_INDEX
]
227 = Fcopy_sequence (AREF (entity
, FONT_EXTRA_INDEX
));
230 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
236 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
237 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
238 static Lisp_Object font_matching_entity
P_ ((FRAME_PTR
, Lisp_Object
*,
241 /* Number of registered font drivers. */
242 static int num_font_drivers
;
245 /* Return a Lispy value of a font property value at STR and LEN bytes.
246 If STR is "*", it returns nil.
247 If FORCE_SYMBOL is zero and all characters in STR are digits, it
248 returns an integer. Otherwise, it returns a symbol interned from
252 font_intern_prop (str
, len
, force_symbol
)
261 if (len
== 1 && *str
== '*')
263 if (!force_symbol
&& len
>=1 && isdigit (*str
))
265 for (i
= 1; i
< len
; i
++)
266 if (! isdigit (str
[i
]))
269 return make_number (atoi (str
));
272 /* The following code is copied from the function intern (in lread.c). */
274 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
275 obarray
= check_obarray (obarray
);
276 tem
= oblookup (obarray
, str
, len
, len
);
279 return Fintern (make_unibyte_string (str
, len
), obarray
);
282 /* Return a pixel size of font-spec SPEC on frame F. */
285 font_pixel_size (f
, spec
)
289 #ifdef HAVE_WINDOW_SYSTEM
290 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
299 font_assert (FLOATP (size
));
300 point_size
= XFLOAT_DATA (size
);
301 val
= AREF (spec
, FONT_DPI_INDEX
);
306 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
314 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
315 font vector. If VAL is not valid (i.e. not registered in
316 font_style_table), return -1 if NOERROR is zero, and return a
317 proper index if NOERROR is nonzero. In that case, register VAL in
318 font_style_table if VAL is a symbol, and return a closest index if
319 VAL is an integer. */
322 font_style_to_value (prop
, val
, noerror
)
323 enum font_property_index prop
;
327 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
328 int len
= ASIZE (table
);
334 Lisp_Object args
[2], elt
;
336 /* At first try exact match. */
337 for (i
= 0; i
< len
; i
++)
338 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
339 if (EQ (val
, AREF (AREF (table
, i
), j
)))
340 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
341 | (i
<< 4) | (j
- 1));
342 /* Try also with case-folding match. */
343 s
= SDATA (SYMBOL_NAME (val
));
344 for (i
= 0; i
< len
; i
++)
345 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
347 elt
= AREF (AREF (table
, i
), j
);
348 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
349 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
350 | (i
<< 4) | (j
- 1));
356 elt
= Fmake_vector (make_number (2), make_number (255));
359 args
[1] = Fmake_vector (make_number (1), elt
);
360 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
361 return (255 << 8) | (i
<< 4);
366 int numeric
= XINT (val
);
368 for (i
= 0, last_n
= -1; i
< len
; i
++)
370 int n
= XINT (AREF (AREF (table
, i
), 0));
373 return (n
<< 8) | (i
<< 4);
378 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
379 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
385 return ((last_n
<< 8) | ((i
- 1) << 4));
390 font_style_symbolic (font
, prop
, for_face
)
392 enum font_property_index prop
;
395 Lisp_Object val
= AREF (font
, prop
);
396 Lisp_Object table
, elt
;
401 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
402 i
= XINT (val
) & 0xFF;
403 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
404 elt
= AREF (table
, ((i
>> 4) & 0xF));
405 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
406 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
409 extern Lisp_Object Vface_alternative_font_family_alist
;
411 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
414 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
415 FONTNAME. ENCODING is a charset symbol that specifies the encoding
416 of the font. REPERTORY is a charset symbol or nil. */
419 find_font_encoding (fontname
)
420 Lisp_Object fontname
;
422 Lisp_Object tail
, elt
;
424 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
428 && STRINGP (XCAR (elt
))
429 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
430 && (SYMBOLP (XCDR (elt
))
431 ? CHARSETP (XCDR (elt
))
432 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
435 /* We don't know the encoding of this font. Let's assume `ascii'. */
439 /* Return encoding charset and repertory charset for REGISTRY in
440 ENCODING and REPERTORY correspondingly. If correct information for
441 REGISTRY is available, return 0. Otherwise return -1. */
444 font_registry_charsets (registry
, encoding
, repertory
)
445 Lisp_Object registry
;
446 struct charset
**encoding
, **repertory
;
449 int encoding_id
, repertory_id
;
451 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
457 encoding_id
= XINT (XCAR (val
));
458 repertory_id
= XINT (XCDR (val
));
462 val
= find_font_encoding (SYMBOL_NAME (registry
));
463 if (SYMBOLP (val
) && CHARSETP (val
))
465 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
467 else if (CONSP (val
))
469 if (! CHARSETP (XCAR (val
)))
471 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
472 if (NILP (XCDR (val
)))
476 if (! CHARSETP (XCDR (val
)))
478 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
483 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
485 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
489 *encoding
= CHARSET_FROM_ID (encoding_id
);
491 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
496 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
501 /* Font property value validaters. See the comment of
502 font_property_table for the meaning of the arguments. */
504 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
505 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
506 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
507 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
508 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
509 static int get_font_prop_index
P_ ((Lisp_Object
));
512 font_prop_validate_symbol (prop
, val
)
513 Lisp_Object prop
, val
;
516 val
= Fintern (val
, Qnil
);
519 else if (EQ (prop
, QCregistry
))
520 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
526 font_prop_validate_style (style
, val
)
527 Lisp_Object style
, val
;
529 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
530 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
537 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
541 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
543 if ((n
& 0xF) + 1 >= ASIZE (elt
))
545 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
549 else if (SYMBOLP (val
))
551 int n
= font_style_to_value (prop
, val
, 0);
553 val
= n
>= 0 ? make_number (n
) : Qerror
;
561 font_prop_validate_non_neg (prop
, val
)
562 Lisp_Object prop
, val
;
564 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
569 font_prop_validate_spacing (prop
, val
)
570 Lisp_Object prop
, val
;
572 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
574 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
576 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
578 if (spacing
== 'c' || spacing
== 'C')
579 return make_number (FONT_SPACING_CHARCELL
);
580 if (spacing
== 'm' || spacing
== 'M')
581 return make_number (FONT_SPACING_MONO
);
582 if (spacing
== 'p' || spacing
== 'P')
583 return make_number (FONT_SPACING_PROPORTIONAL
);
584 if (spacing
== 'd' || spacing
== 'D')
585 return make_number (FONT_SPACING_DUAL
);
591 font_prop_validate_otf (prop
, val
)
592 Lisp_Object prop
, val
;
594 Lisp_Object tail
, tmp
;
597 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
598 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
599 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
602 if (! SYMBOLP (XCAR (val
)))
607 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
609 for (i
= 0; i
< 2; i
++)
616 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
617 if (! SYMBOLP (XCAR (tmp
)))
625 /* Structure of known font property keys and validater of the
629 /* Pointer to the key symbol. */
631 /* Function to validate PROP's value VAL, or NULL if any value is
632 ok. The value is VAL or its regularized value if VAL is valid,
633 and Qerror if not. */
634 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
635 } font_property_table
[] =
636 { { &QCtype
, font_prop_validate_symbol
},
637 { &QCfoundry
, font_prop_validate_symbol
},
638 { &QCfamily
, font_prop_validate_symbol
},
639 { &QCadstyle
, font_prop_validate_symbol
},
640 { &QCregistry
, font_prop_validate_symbol
},
641 { &QCweight
, font_prop_validate_style
},
642 { &QCslant
, font_prop_validate_style
},
643 { &QCwidth
, font_prop_validate_style
},
644 { &QCsize
, font_prop_validate_non_neg
},
645 { &QCdpi
, font_prop_validate_non_neg
},
646 { &QCspacing
, font_prop_validate_spacing
},
647 { &QCavgwidth
, font_prop_validate_non_neg
},
648 /* The order of the above entries must match with enum
649 font_property_index. */
650 { &QClang
, font_prop_validate_symbol
},
651 { &QCscript
, font_prop_validate_symbol
},
652 { &QCotf
, font_prop_validate_otf
}
655 /* Size (number of elements) of the above table. */
656 #define FONT_PROPERTY_TABLE_SIZE \
657 ((sizeof font_property_table) / (sizeof *font_property_table))
659 /* Return an index number of font property KEY or -1 if KEY is not an
660 already known property. */
663 get_font_prop_index (key
)
668 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
669 if (EQ (key
, *font_property_table
[i
].key
))
674 /* Validate the font property. The property key is specified by the
675 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
676 signal an error. The value is VAL or the regularized one. */
679 font_prop_validate (idx
, prop
, val
)
681 Lisp_Object prop
, val
;
683 Lisp_Object validated
;
688 prop
= *font_property_table
[idx
].key
;
691 idx
= get_font_prop_index (prop
);
695 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
696 if (EQ (validated
, Qerror
))
697 signal_error ("invalid font property", Fcons (prop
, val
));
702 /* Store VAL as a value of extra font property PROP in FONT while
703 keeping the sorting order. Don't check the validity of VAL. */
706 font_put_extra (font
, prop
, val
)
707 Lisp_Object font
, prop
, val
;
709 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
710 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
714 Lisp_Object prev
= Qnil
;
717 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
718 prev
= extra
, extra
= XCDR (extra
);
720 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
722 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
730 /* Font name parser and unparser */
732 static int parse_matrix
P_ ((char *));
733 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
734 static int font_parse_name
P_ ((char *, Lisp_Object
));
736 /* An enumerator for each field of an XLFD font name. */
737 enum xlfd_field_index
756 /* An enumerator for mask bit corresponding to each XLFD field. */
759 XLFD_FOUNDRY_MASK
= 0x0001,
760 XLFD_FAMILY_MASK
= 0x0002,
761 XLFD_WEIGHT_MASK
= 0x0004,
762 XLFD_SLANT_MASK
= 0x0008,
763 XLFD_SWIDTH_MASK
= 0x0010,
764 XLFD_ADSTYLE_MASK
= 0x0020,
765 XLFD_PIXEL_MASK
= 0x0040,
766 XLFD_POINT_MASK
= 0x0080,
767 XLFD_RESX_MASK
= 0x0100,
768 XLFD_RESY_MASK
= 0x0200,
769 XLFD_SPACING_MASK
= 0x0400,
770 XLFD_AVGWIDTH_MASK
= 0x0800,
771 XLFD_REGISTRY_MASK
= 0x1000,
772 XLFD_ENCODING_MASK
= 0x2000
776 /* Parse P pointing the pixel/point size field of the form
777 `[A B C D]' which specifies a transformation matrix:
783 by which all glyphs of the font are transformed. The spec says
784 that scalar value N for the pixel/point size is equivalent to:
785 A = N * resx/resy, B = C = 0, D = N.
787 Return the scalar value N if the form is valid. Otherwise return
798 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
801 matrix
[i
] = - strtod (p
+ 1, &end
);
803 matrix
[i
] = strtod (p
, &end
);
806 return (i
== 4 ? (int) matrix
[3] : -1);
809 /* Expand a wildcard field in FIELD (the first N fields are filled) to
810 multiple fields to fill in all 14 XLFD fields while restring a
811 field position by its contents. */
814 font_expand_wildcards (field
, n
)
815 Lisp_Object field
[XLFD_LAST_INDEX
];
819 Lisp_Object tmp
[XLFD_LAST_INDEX
];
820 /* Array of information about where this element can go. Nth
821 element is for Nth element of FIELD. */
823 /* Minimum possible field. */
825 /* Maxinum possible field. */
827 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
829 } range
[XLFD_LAST_INDEX
];
831 int range_from
, range_to
;
834 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
835 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
836 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
837 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
838 | XLFD_AVGWIDTH_MASK)
839 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
841 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
842 field. The value is shifted to left one bit by one in the
844 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
845 range_mask
= (range_mask
<< 1) | 1;
847 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
848 position-based retriction for FIELD[I]. */
849 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
850 i
++, range_from
++, range_to
++, range_mask
<<= 1)
852 Lisp_Object val
= field
[i
];
858 range
[i
].from
= range_from
;
859 range
[i
].to
= range_to
;
860 range
[i
].mask
= range_mask
;
864 /* The triplet FROM, TO, and MASK is a value-based
865 retriction for FIELD[I]. */
871 int numeric
= XINT (val
);
874 from
= to
= XLFD_ENCODING_INDEX
,
875 mask
= XLFD_ENCODING_MASK
;
876 else if (numeric
== 0)
877 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
878 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
879 else if (numeric
<= 48)
880 from
= to
= XLFD_PIXEL_INDEX
,
881 mask
= XLFD_PIXEL_MASK
;
883 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
884 mask
= XLFD_LARGENUM_MASK
;
886 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
887 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
888 mask
= XLFD_NULL_MASK
;
890 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
893 Lisp_Object name
= SYMBOL_NAME (val
);
895 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
896 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
897 mask
= XLFD_REGENC_MASK
;
899 from
= to
= XLFD_ENCODING_INDEX
,
900 mask
= XLFD_ENCODING_MASK
;
902 else if (range_from
<= XLFD_WEIGHT_INDEX
903 && range_to
>= XLFD_WEIGHT_INDEX
904 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
905 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
906 else if (range_from
<= XLFD_SLANT_INDEX
907 && range_to
>= XLFD_SLANT_INDEX
908 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
909 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
910 else if (range_from
<= XLFD_SWIDTH_INDEX
911 && range_to
>= XLFD_SWIDTH_INDEX
912 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
913 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
916 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
917 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
919 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
920 mask
= XLFD_SYMBOL_MASK
;
923 /* Merge position-based and value-based restrictions. */
925 while (from
< range_from
)
926 mask
&= ~(1 << from
++);
927 while (from
< 14 && ! (mask
& (1 << from
)))
929 while (to
> range_to
)
930 mask
&= ~(1 << to
--);
931 while (to
>= 0 && ! (mask
& (1 << to
)))
935 range
[i
].from
= from
;
937 range
[i
].mask
= mask
;
939 if (from
> range_from
|| to
< range_to
)
941 /* The range is narrowed by value-based restrictions.
942 Reflect it to the other fields. */
944 /* Following fields should be after FROM. */
946 /* Preceding fields should be before TO. */
947 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
949 /* Check FROM for non-wildcard field. */
950 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
952 while (range
[j
].from
< from
)
953 range
[j
].mask
&= ~(1 << range
[j
].from
++);
954 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
956 range
[j
].from
= from
;
959 from
= range
[j
].from
;
960 if (range
[j
].to
> to
)
962 while (range
[j
].to
> to
)
963 range
[j
].mask
&= ~(1 << range
[j
].to
--);
964 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
977 /* Decide all fileds from restrictions in RANGE. */
978 for (i
= j
= 0; i
< n
; i
++)
980 if (j
< range
[i
].from
)
982 if (i
== 0 || ! NILP (tmp
[i
- 1]))
983 /* None of TMP[X] corresponds to Jth field. */
985 for (; j
< range
[i
].from
; j
++)
990 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
992 for (; j
< XLFD_LAST_INDEX
; j
++)
994 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
995 field
[XLFD_ENCODING_INDEX
]
996 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
1001 #ifdef ENABLE_CHECKING
1002 /* Match a 14-field XLFD pattern against a full XLFD font name. */
1004 font_match_xlfd (char *pattern
, char *name
)
1006 while (*pattern
&& *name
)
1008 if (*pattern
== *name
)
1010 else if (*pattern
== '*')
1011 if (*name
== pattern
[1])
1022 /* Make sure the font object matches the XLFD font name. */
1024 font_check_xlfd_parse (Lisp_Object font
, char *name
)
1026 char name_check
[256];
1027 font_unparse_xlfd (font
, 0, name_check
, 255);
1028 return font_match_xlfd (name_check
, name
);
1034 /* Parse NAME (null terminated) as XLFD and store information in FONT
1035 (font-spec or font-entity). Size property of FONT is set as
1037 specified XLFD fields FONT property
1038 --------------------- -------------
1039 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1040 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1041 POINT_SIZE POINT_SIZE/10 (Lisp float)
1043 If NAME is successfully parsed, return 0. Otherwise return -1.
1045 FONT is usually a font-spec, but when this function is called from
1046 X font backend driver, it is a font-entity. In that case, NAME is
1047 a fully specified XLFD. */
1050 font_parse_xlfd (name
, font
)
1054 int len
= strlen (name
);
1056 char *f
[XLFD_LAST_INDEX
+ 1];
1061 /* Maximum XLFD name length is 255. */
1063 /* Accept "*-.." as a fully specified XLFD. */
1064 if (name
[0] == '*' && name
[1] == '-')
1065 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1068 for (p
= name
+ i
; *p
; p
++)
1072 if (i
== XLFD_LAST_INDEX
)
1077 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1078 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1080 if (i
== XLFD_LAST_INDEX
)
1082 /* Fully specified XLFD. */
1085 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1086 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1087 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1088 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1090 val
= INTERN_FIELD_SYM (i
);
1093 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1095 ASET (font
, j
, make_number (n
));
1098 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1099 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1100 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1102 ASET (font
, FONT_REGISTRY_INDEX
,
1103 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1104 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1106 p
= f
[XLFD_PIXEL_INDEX
];
1107 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1108 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1111 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1113 ASET (font
, FONT_SIZE_INDEX
, val
);
1116 double point_size
= -1;
1118 font_assert (FONT_SPEC_P (font
));
1119 p
= f
[XLFD_POINT_INDEX
];
1121 point_size
= parse_matrix (p
);
1122 else if (isdigit (*p
))
1123 point_size
= atoi (p
), point_size
/= 10;
1124 if (point_size
>= 0)
1125 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1129 ASET (font
, FONT_DPI_INDEX
, INTERN_FIELD (XLFD_RESY_INDEX
));
1130 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1133 val
= font_prop_validate_spacing (QCspacing
, val
);
1134 if (! INTEGERP (val
))
1136 ASET (font
, FONT_SPACING_INDEX
, val
);
1138 p
= f
[XLFD_AVGWIDTH_INDEX
];
1141 ASET (font
, FONT_AVGWIDTH_INDEX
,
1142 font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0));
1146 int wild_card_found
= 0;
1147 Lisp_Object prop
[XLFD_LAST_INDEX
];
1149 if (FONT_ENTITY_P (font
))
1151 for (j
= 0; j
< i
; j
++)
1155 if (f
[j
][1] && f
[j
][1] != '-')
1158 wild_card_found
= 1;
1161 prop
[j
] = INTERN_FIELD (j
);
1163 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1165 if (! wild_card_found
)
1167 if (font_expand_wildcards (prop
, i
) < 0)
1170 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1171 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1172 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1173 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1174 if (! NILP (prop
[i
]))
1176 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1178 ASET (font
, j
, make_number (n
));
1180 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1181 val
= prop
[XLFD_REGISTRY_INDEX
];
1184 val
= prop
[XLFD_ENCODING_INDEX
];
1186 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1188 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1189 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1191 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1192 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1194 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1196 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1197 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1198 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1200 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1202 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1205 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1206 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1207 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1209 val
= font_prop_validate_spacing (QCspacing
,
1210 prop
[XLFD_SPACING_INDEX
]);
1211 if (! INTEGERP (val
))
1213 ASET (font
, FONT_SPACING_INDEX
, val
);
1215 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1216 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1222 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1223 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1224 0, use PIXEL_SIZE instead. */
1227 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1233 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1237 font_assert (FONTP (font
));
1239 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1242 if (i
== FONT_ADSTYLE_INDEX
)
1243 j
= XLFD_ADSTYLE_INDEX
;
1244 else if (i
== FONT_REGISTRY_INDEX
)
1245 j
= XLFD_REGISTRY_INDEX
;
1246 val
= AREF (font
, i
);
1249 if (j
== XLFD_REGISTRY_INDEX
)
1250 f
[j
] = "*-*", len
+= 4;
1252 f
[j
] = "*", len
+= 2;
1257 val
= SYMBOL_NAME (val
);
1258 if (j
== XLFD_REGISTRY_INDEX
1259 && ! strchr ((char *) SDATA (val
), '-'))
1261 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1262 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1264 f
[j
] = alloca (SBYTES (val
) + 3);
1265 sprintf (f
[j
], "%s-*", SDATA (val
));
1266 len
+= SBYTES (val
) + 3;
1270 f
[j
] = alloca (SBYTES (val
) + 4);
1271 sprintf (f
[j
], "%s*-*", SDATA (val
));
1272 len
+= SBYTES (val
) + 4;
1276 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1280 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1283 val
= font_style_symbolic (font
, i
, 0);
1285 f
[j
] = "*", len
+= 2;
1288 val
= SYMBOL_NAME (val
);
1289 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1293 val
= AREF (font
, FONT_SIZE_INDEX
);
1294 font_assert (NUMBERP (val
) || NILP (val
));
1302 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1303 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1306 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1308 else if (FLOATP (val
))
1310 i
= XFLOAT_DATA (val
) * 10;
1311 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1312 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1315 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1317 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1319 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1320 f
[XLFD_RESX_INDEX
] = alloca (22);
1321 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1325 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1326 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1328 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1330 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1331 : spacing
<= FONT_SPACING_DUAL
? "d"
1332 : spacing
<= FONT_SPACING_MONO
? "m"
1337 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1338 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1340 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1341 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
],
1342 "%d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1345 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1346 len
++; /* for terminating '\0'. */
1349 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1350 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1351 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1352 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1353 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1354 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1355 f
[XLFD_REGISTRY_INDEX
]);
1358 /* Parse NAME (null terminated) and store information in FONT
1359 (font-spec or font-entity). NAME is supplied in either the
1360 Fontconfig or GTK font name format. If NAME is successfully
1361 parsed, return 0. Otherwise return -1.
1363 The fontconfig format is
1365 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1369 FAMILY [PROPS...] [SIZE]
1371 This function tries to guess which format it is. */
1374 font_parse_fcname (name
, font
)
1379 char *size_beg
= NULL
, *size_end
= NULL
;
1380 char *props_beg
= NULL
, *family_end
= NULL
;
1381 int len
= strlen (name
);
1386 for (p
= name
; *p
; p
++)
1388 if (*p
== '\\' && p
[1])
1392 props_beg
= family_end
= p
;
1397 int decimal
= 0, size_found
= 1;
1398 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1401 if (*q
!= '.' || decimal
)
1420 /* A fontconfig name with size and/or property data. */
1421 if (family_end
> name
)
1424 family
= font_intern_prop (name
, family_end
- name
, 1);
1425 ASET (font
, FONT_FAMILY_INDEX
, family
);
1429 double point_size
= strtod (size_beg
, &size_end
);
1430 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1431 if (*size_end
== ':' && size_end
[1])
1432 props_beg
= size_end
;
1436 /* Now parse ":KEY=VAL" patterns. */
1439 for (p
= props_beg
; *p
; p
= q
)
1441 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1444 /* Must be an enumerated value. */
1448 val
= font_intern_prop (p
, q
- p
, 1);
1450 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1452 if (PROP_MATCH ("light", 5)
1453 || PROP_MATCH ("medium", 6)
1454 || PROP_MATCH ("demibold", 8)
1455 || PROP_MATCH ("bold", 4)
1456 || PROP_MATCH ("black", 5))
1457 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1458 else if (PROP_MATCH ("roman", 5)
1459 || PROP_MATCH ("italic", 6)
1460 || PROP_MATCH ("oblique", 7))
1461 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1462 else if (PROP_MATCH ("charcell", 8))
1463 ASET (font
, FONT_SPACING_INDEX
,
1464 make_number (FONT_SPACING_CHARCELL
));
1465 else if (PROP_MATCH ("mono", 4))
1466 ASET (font
, FONT_SPACING_INDEX
,
1467 make_number (FONT_SPACING_MONO
));
1468 else if (PROP_MATCH ("proportional", 12))
1469 ASET (font
, FONT_SPACING_INDEX
,
1470 make_number (FONT_SPACING_PROPORTIONAL
));
1479 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1480 prop
= FONT_SIZE_INDEX
;
1483 key
= font_intern_prop (p
, q
- p
, 1);
1484 prop
= get_font_prop_index (key
);
1488 for (q
= p
; *q
&& *q
!= ':'; q
++);
1489 val
= font_intern_prop (p
, q
- p
, 0);
1491 if (prop
>= FONT_FOUNDRY_INDEX
1492 && prop
< FONT_EXTRA_INDEX
)
1493 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1495 Ffont_put (font
, key
, val
);
1503 /* Either a fontconfig-style name with no size and property
1504 data, or a GTK-style name. */
1506 int word_len
, prop_found
= 0;
1508 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1514 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1522 double point_size
= strtod (p
, &q
);
1523 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1528 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1529 if (*q
== '\\' && q
[1])
1533 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1535 if (PROP_MATCH ("Ultra-Light", 11))
1538 prop
= font_intern_prop ("ultra-light", 11, 1);
1539 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1541 else if (PROP_MATCH ("Light", 5))
1544 prop
= font_intern_prop ("light", 5, 1);
1545 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1547 else if (PROP_MATCH ("Semi-Bold", 9))
1550 prop
= font_intern_prop ("semi-bold", 9, 1);
1551 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1553 else if (PROP_MATCH ("Bold", 4))
1556 prop
= font_intern_prop ("bold", 4, 1);
1557 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1559 else if (PROP_MATCH ("Italic", 6))
1562 prop
= font_intern_prop ("italic", 4, 1);
1563 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1565 else if (PROP_MATCH ("Oblique", 7))
1568 prop
= font_intern_prop ("oblique", 7, 1);
1569 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1573 return -1; /* Unknown property in GTK-style font name. */
1582 family
= font_intern_prop (name
, family_end
- name
, 1);
1583 ASET (font
, FONT_FAMILY_INDEX
, family
);
1590 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1591 NAME (NBYTES length), and return the name length. If
1592 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1595 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1601 Lisp_Object family
, foundry
;
1602 Lisp_Object tail
, val
;
1607 Lisp_Object styles
[3];
1608 char *style_names
[3] = { "weight", "slant", "width" };
1611 family
= AREF (font
, FONT_FAMILY_INDEX
);
1612 if (! NILP (family
))
1614 if (SYMBOLP (family
))
1616 family
= SYMBOL_NAME (family
);
1617 len
+= SBYTES (family
);
1623 val
= AREF (font
, FONT_SIZE_INDEX
);
1626 if (XINT (val
) != 0)
1627 pixel_size
= XINT (val
);
1629 len
+= 21; /* for ":pixelsize=NUM" */
1631 else if (FLOATP (val
))
1634 point_size
= (int) XFLOAT_DATA (val
);
1635 len
+= 11; /* for "-NUM" */
1638 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1639 if (! NILP (foundry
))
1641 if (SYMBOLP (foundry
))
1643 foundry
= SYMBOL_NAME (foundry
);
1644 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1650 for (i
= 0; i
< 3; i
++)
1652 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1653 if (! NILP (styles
[i
]))
1654 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1655 SDATA (SYMBOL_NAME (styles
[i
])));
1658 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1659 len
+= sprintf (work
, ":dpi=%d", dpi
);
1660 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1661 len
+= strlen (":spacing=100");
1662 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1663 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1664 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1666 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1668 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1670 len
+= SBYTES (val
);
1671 else if (INTEGERP (val
))
1672 len
+= sprintf (work
, "%d", XINT (val
));
1673 else if (SYMBOLP (val
))
1674 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1680 if (! NILP (family
))
1681 p
+= sprintf (p
, "%s", SDATA (family
));
1685 p
+= sprintf (p
, "%d", point_size
);
1687 p
+= sprintf (p
, "-%d", point_size
);
1689 else if (pixel_size
> 0)
1690 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1691 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1692 p
+= sprintf (p
, ":foundry=%s",
1693 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1694 for (i
= 0; i
< 3; i
++)
1695 if (! NILP (styles
[i
]))
1696 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1697 SDATA (SYMBOL_NAME (styles
[i
])));
1698 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1699 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1700 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1701 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1702 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1704 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1705 p
+= sprintf (p
, ":scalable=true");
1707 p
+= sprintf (p
, ":scalable=false");
1712 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1713 NAME (NBYTES length), and return the name length. F is the frame
1714 on which the font is displayed; it is used to calculate the point
1718 font_unparse_gtkname (font
, f
, name
, nbytes
)
1726 Lisp_Object family
, weight
, slant
, size
;
1727 int point_size
= -1;
1729 family
= AREF (font
, FONT_FAMILY_INDEX
);
1730 if (! NILP (family
))
1732 if (! SYMBOLP (family
))
1734 family
= SYMBOL_NAME (family
);
1735 len
+= SBYTES (family
);
1738 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1739 if (EQ (weight
, Qnormal
))
1741 else if (! NILP (weight
))
1743 weight
= SYMBOL_NAME (weight
);
1744 len
+= SBYTES (weight
);
1747 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1748 if (EQ (slant
, Qnormal
))
1750 else if (! NILP (slant
))
1752 slant
= SYMBOL_NAME (slant
);
1753 len
+= SBYTES (slant
);
1756 size
= AREF (font
, FONT_SIZE_INDEX
);
1757 /* Convert pixel size to point size. */
1758 if (INTEGERP (size
))
1760 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1762 if (INTEGERP (font_dpi
))
1763 dpi
= XINT (font_dpi
);
1766 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1769 else if (FLOATP (size
))
1771 point_size
= (int) XFLOAT_DATA (size
);
1778 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1780 if (! NILP (weight
))
1783 p
+= sprintf (p
, " %s", SDATA (weight
));
1784 q
[1] = toupper (q
[1]);
1790 p
+= sprintf (p
, " %s", SDATA (slant
));
1791 q
[1] = toupper (q
[1]);
1795 p
+= sprintf (p
, " %d", point_size
);
1800 /* Parse NAME (null terminated) and store information in FONT
1801 (font-spec or font-entity). If NAME is successfully parsed, return
1802 0. Otherwise return -1. */
1805 font_parse_name (name
, font
)
1809 if (name
[0] == '-' || index (name
, '*'))
1810 return font_parse_xlfd (name
, font
);
1811 return font_parse_fcname (name
, font
);
1815 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1816 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1820 font_parse_family_registry (family
, registry
, font_spec
)
1821 Lisp_Object family
, registry
, font_spec
;
1827 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1829 CHECK_STRING (family
);
1830 len
= SBYTES (family
);
1831 p0
= (char *) SDATA (family
);
1832 p1
= index (p0
, '-');
1835 if ((*p0
!= '*' || p1
- p0
> 1)
1836 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1837 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1840 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1843 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1845 if (! NILP (registry
))
1847 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1848 CHECK_STRING (registry
);
1849 len
= SBYTES (registry
);
1850 p0
= (char *) SDATA (registry
);
1851 p1
= index (p0
, '-');
1854 if (SDATA (registry
)[len
- 1] == '*')
1855 registry
= concat2 (registry
, build_string ("-*"));
1857 registry
= concat2 (registry
, build_string ("*-*"));
1859 registry
= Fdowncase (registry
);
1860 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1865 /* This part (through the next ^L) is still experimental and not
1866 tested much. We may drastically change codes. */
1872 #define LGSTRING_HEADER_SIZE 6
1873 #define LGSTRING_GLYPH_SIZE 8
1876 check_gstring (gstring
)
1877 Lisp_Object gstring
;
1882 CHECK_VECTOR (gstring
);
1883 val
= AREF (gstring
, 0);
1885 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1887 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1888 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1889 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1890 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1891 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1892 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1893 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1894 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1895 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1896 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1897 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1899 for (i
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
1901 val
= LGSTRING_GLYPH (gstring
, i
);
1903 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1905 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1907 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1908 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1909 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1910 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1911 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1912 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1913 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1914 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1916 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1918 if (ASIZE (val
) < 3)
1920 for (j
= 0; j
< 3; j
++)
1921 CHECK_NUMBER (AREF (val
, j
));
1926 error ("Invalid glyph-string format");
1931 check_otf_features (otf_features
)
1932 Lisp_Object otf_features
;
1936 CHECK_CONS (otf_features
);
1937 CHECK_SYMBOL (XCAR (otf_features
));
1938 otf_features
= XCDR (otf_features
);
1939 CHECK_CONS (otf_features
);
1940 CHECK_SYMBOL (XCAR (otf_features
));
1941 otf_features
= XCDR (otf_features
);
1942 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1944 CHECK_SYMBOL (Fcar (val
));
1945 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1946 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1948 otf_features
= XCDR (otf_features
);
1949 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1951 CHECK_SYMBOL (Fcar (val
));
1952 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1953 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1960 Lisp_Object otf_list
;
1963 otf_tag_symbol (tag
)
1968 OTF_tag_name (tag
, name
);
1969 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1976 Lisp_Object val
= Fassoc (file
, otf_list
);
1980 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1983 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1984 val
= make_save_value (otf
, 0);
1985 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1991 /* Return a list describing which scripts/languages FONT supports by
1992 which GSUB/GPOS features of OpenType tables. See the comment of
1993 (struct font_driver).otf_capability. */
1996 font_otf_capability (font
)
2000 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
2003 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
2006 for (i
= 0; i
< 2; i
++)
2008 OTF_GSUB_GPOS
*gsub_gpos
;
2009 Lisp_Object script_list
= Qnil
;
2012 if (OTF_get_features (otf
, i
== 0) < 0)
2014 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2015 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2017 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2018 Lisp_Object langsys_list
= Qnil
;
2019 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2022 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2024 OTF_LangSys
*langsys
;
2025 Lisp_Object feature_list
= Qnil
;
2026 Lisp_Object langsys_tag
;
2029 if (k
== script
->LangSysCount
)
2031 langsys
= &script
->DefaultLangSys
;
2036 langsys
= script
->LangSys
+ k
;
2038 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2040 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2042 OTF_Feature
*feature
2043 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2044 Lisp_Object feature_tag
2045 = otf_tag_symbol (feature
->FeatureTag
);
2047 feature_list
= Fcons (feature_tag
, feature_list
);
2049 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2052 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2057 XSETCAR (capability
, script_list
);
2059 XSETCDR (capability
, script_list
);
2065 /* Parse OTF features in SPEC and write a proper features spec string
2066 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2067 assured that the sufficient memory has already allocated for
2071 generate_otf_features (spec
, features
)
2081 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2087 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2092 else if (! asterisk
)
2094 val
= SYMBOL_NAME (val
);
2095 p
+= sprintf (p
, "%s", SDATA (val
));
2099 val
= SYMBOL_NAME (val
);
2100 p
+= sprintf (p
, "~%s", SDATA (val
));
2104 error ("OTF spec too long");
2108 font_otf_DeviceTable (device_table
)
2109 OTF_DeviceTable
*device_table
;
2111 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2113 return Fcons (make_number (len
),
2114 make_unibyte_string (device_table
->DeltaValue
, len
));
2118 font_otf_ValueRecord (value_format
, value_record
)
2120 OTF_ValueRecord
*value_record
;
2122 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2124 if (value_format
& OTF_XPlacement
)
2125 ASET (val
, 0, make_number (value_record
->XPlacement
));
2126 if (value_format
& OTF_YPlacement
)
2127 ASET (val
, 1, make_number (value_record
->YPlacement
));
2128 if (value_format
& OTF_XAdvance
)
2129 ASET (val
, 2, make_number (value_record
->XAdvance
));
2130 if (value_format
& OTF_YAdvance
)
2131 ASET (val
, 3, make_number (value_record
->YAdvance
));
2132 if (value_format
& OTF_XPlaDevice
)
2133 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2134 if (value_format
& OTF_YPlaDevice
)
2135 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2136 if (value_format
& OTF_XAdvDevice
)
2137 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2138 if (value_format
& OTF_YAdvDevice
)
2139 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2144 font_otf_Anchor (anchor
)
2149 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2150 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2151 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2152 if (anchor
->AnchorFormat
== 2)
2153 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2156 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2157 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2161 #endif /* HAVE_LIBOTF */
2167 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2168 static int font_compare
P_ ((const void *, const void *));
2169 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
2172 /* We sort fonts by scoring each of them against a specified
2173 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2174 the value is, the closer the font is to the font-spec.
2176 The lowest 2 bits of the score is used for driver type. The font
2177 available by the most preferred font driver is 0.
2179 Each 7-bit in the higher 28 bits are used for numeric properties
2180 WEIGHT, SLANT, WIDTH, and SIZE. */
2182 /* How many bits to shift to store the difference value of each font
2183 property in a score. Note that flots for FONT_TYPE_INDEX and
2184 FONT_REGISTRY_INDEX are not used. */
2185 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2187 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2188 The return value indicates how different ENTITY is compared with
2192 font_score (entity
, spec_prop
)
2193 Lisp_Object entity
, *spec_prop
;
2198 /* Score three style numeric fields. Maximum difference is 127. */
2199 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2200 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2202 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2207 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2210 /* Score the size. Maximum difference is 127. */
2211 i
= FONT_SIZE_INDEX
;
2212 if (! NILP (spec_prop
[i
]) && XINT (AREF (entity
, i
)) > 0)
2214 /* We use the higher 6-bit for the actual size difference. The
2215 lowest bit is set if the DPI is different. */
2216 int diff
= XINT (spec_prop
[i
]) - XINT (AREF (entity
, i
));
2221 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2222 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2224 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2231 /* The comparison function for qsort. */
2234 font_compare (d1
, d2
)
2235 const void *d1
, *d2
;
2237 return (*(unsigned *) d1
- *(unsigned *) d2
);
2241 /* The structure for elements being sorted by qsort. */
2242 struct font_sort_data
2249 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2250 If PREFER specifies a point-size, calculate the corresponding
2251 pixel-size from QCdpi property of PREFER or from the Y-resolution
2252 of FRAME before sorting.
2254 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2255 return the sorted VEC. */
2258 font_sort_entites (vec
, prefer
, frame
, best_only
)
2259 Lisp_Object vec
, prefer
, frame
;
2262 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2264 struct font_sort_data
*data
;
2265 unsigned best_score
;
2266 Lisp_Object best_entity
, driver_type
;
2268 struct frame
*f
= XFRAME (frame
);
2269 struct font_driver_list
*list
;
2274 return best_only
? AREF (vec
, 0) : vec
;
2276 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_DPI_INDEX
; i
++)
2277 prefer_prop
[i
] = AREF (prefer
, i
);
2278 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2279 prefer_prop
[FONT_SIZE_INDEX
]
2280 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2282 /* Scoring and sorting. */
2283 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2284 best_score
= 0xFFFFFFFF;
2285 /* We are sure that the length of VEC > 1. */
2286 driver_type
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2287 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2288 driver_order
++, list
= list
->next
)
2289 if (EQ (driver_type
, list
->driver
->type
))
2291 best_entity
= data
[0].entity
= AREF (vec
, 0);
2292 best_score
= data
[0].score
2293 = font_score (data
[0].entity
, prefer_prop
) | driver_order
;
2294 for (i
= 0; i
< len
; i
++)
2296 if (!EQ (driver_type
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2297 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2298 driver_order
++, list
= list
->next
)
2299 if (EQ (driver_type
, list
->driver
->type
))
2301 data
[i
].entity
= AREF (vec
, i
);
2302 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
) | driver_order
;
2303 if (best_only
&& best_score
> data
[i
].score
)
2305 best_score
= data
[i
].score
;
2306 best_entity
= data
[i
].entity
;
2307 if (best_score
== 0)
2313 qsort (data
, len
, sizeof *data
, font_compare
);
2314 for (i
= 0; i
< len
; i
++)
2315 ASET (vec
, i
, data
[i
].entity
);
2321 font_add_log ("sort-by", prefer
, vec
);
2326 /* API of Font Service Layer. */
2328 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2329 sort_shift_bits. Finternal_set_font_selection_order calls this
2330 function with font_sort_order after setting up it. */
2333 font_update_sort_order (order
)
2338 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2340 int xlfd_idx
= order
[i
];
2342 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2343 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2344 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2345 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2346 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2347 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2349 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2354 font_check_otf_features (script
, langsys
, features
, table
)
2355 Lisp_Object script
, langsys
, features
, table
;
2360 table
= assq_no_quit (script
, table
);
2363 table
= XCDR (table
);
2364 if (! NILP (langsys
))
2366 table
= assq_no_quit (langsys
, table
);
2372 val
= assq_no_quit (Qnil
, table
);
2374 table
= XCAR (table
);
2378 table
= XCDR (table
);
2379 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2381 if (NILP (XCAR (features
)))
2383 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2389 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2392 font_check_otf (Lisp_Object spec
, Lisp_Object otf_capability
)
2394 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2396 script
= XCAR (spec
);
2400 langsys
= XCAR (spec
);
2411 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2412 XCAR (otf_capability
)))
2414 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2415 XCDR (otf_capability
)))
2422 /* Check if FONT (font-entity or font-object) matches with the font
2423 specification SPEC. */
2426 font_match_p (spec
, font
)
2427 Lisp_Object spec
, font
;
2429 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2430 Lisp_Object extra
, font_extra
;
2433 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2434 if (! NILP (AREF (spec
, i
))
2435 && ! NILP (AREF (font
, i
))
2436 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2438 props
= XFONT_SPEC (spec
)->props
;
2439 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2441 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2442 prop
[i
] = AREF (spec
, i
);
2443 prop
[FONT_SIZE_INDEX
]
2444 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2448 if (font_score (font
, props
) > 0)
2450 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2451 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2452 for (; CONSP (extra
); extra
= XCDR (extra
))
2454 Lisp_Object key
= XCAR (XCAR (extra
));
2455 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2457 if (EQ (key
, QClang
))
2459 val2
= assq_no_quit (key
, font_extra
);
2468 if (NILP (Fmemq (val
, val2
)))
2473 ? NILP (Fmemq (val
, XCDR (val2
)))
2477 else if (EQ (key
, QCscript
))
2479 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2481 for (val2
= XCDR (val2
); CONSP (val2
); val2
= XCDR (val2
))
2482 if (font_encode_char (font
, XINT (XCAR (val2
)))
2483 == FONT_INVALID_CODE
)
2486 else if (EQ (key
, QCotf
))
2490 if (! FONT_OBJECT_P (font
))
2492 fontp
= XFONT_OBJECT (font
);
2493 if (! fontp
->driver
->otf_capability
)
2495 val2
= fontp
->driver
->otf_capability (fontp
);
2496 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2507 Each font backend has the callback function get_cache, and it
2508 returns a cons cell of which cdr part can be freely used for
2509 caching fonts. The cons cell may be shared by multiple frames
2510 and/or multiple font drivers. So, we arrange the cdr part as this:
2512 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2514 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2515 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2516 cons (FONT-SPEC FONT-ENTITY ...). */
2518 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2519 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2520 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2521 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2522 struct font_driver
*));
2525 font_prepare_cache (f
, driver
)
2527 struct font_driver
*driver
;
2529 Lisp_Object cache
, val
;
2531 cache
= driver
->get_cache (f
);
2533 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2537 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2538 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2542 val
= XCDR (XCAR (val
));
2543 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2549 font_finish_cache (f
, driver
)
2551 struct font_driver
*driver
;
2553 Lisp_Object cache
, val
, tmp
;
2556 cache
= driver
->get_cache (f
);
2558 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2559 cache
= val
, val
= XCDR (val
);
2560 font_assert (! NILP (val
));
2561 tmp
= XCDR (XCAR (val
));
2562 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2563 if (XINT (XCAR (tmp
)) == 0)
2565 font_clear_cache (f
, XCAR (val
), driver
);
2566 XSETCDR (cache
, XCDR (val
));
2572 font_get_cache (f
, driver
)
2574 struct font_driver
*driver
;
2576 Lisp_Object val
= driver
->get_cache (f
);
2577 Lisp_Object type
= driver
->type
;
2579 font_assert (CONSP (val
));
2580 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2581 font_assert (CONSP (val
));
2582 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2583 val
= XCDR (XCAR (val
));
2587 static int num_fonts
;
2590 font_clear_cache (f
, cache
, driver
)
2593 struct font_driver
*driver
;
2595 Lisp_Object tail
, elt
;
2597 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2598 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2601 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)) && VECTORP (XCDR (elt
)))
2603 Lisp_Object vec
= XCDR (elt
);
2606 for (i
= 0; i
< ASIZE (vec
); i
++)
2608 Lisp_Object entity
= AREF (vec
, i
);
2610 if (EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2612 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2614 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2616 Lisp_Object val
= XCAR (objlist
);
2617 struct font
*font
= XFONT_OBJECT (val
);
2619 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2621 font_assert (font
&& driver
== font
->driver
);
2622 driver
->close (f
, font
);
2626 if (driver
->free_entity
)
2627 driver
->free_entity (entity
);
2632 XSETCDR (cache
, Qnil
);
2636 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2639 font_delete_unmatched (list
, spec
, size
)
2640 Lisp_Object list
, spec
;
2643 Lisp_Object entity
, val
;
2644 enum font_property_index prop
;
2646 for (val
= Qnil
; CONSP (list
); list
= XCDR (list
))
2648 entity
= XCAR (list
);
2649 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2650 if (INTEGERP (AREF (spec
, prop
))
2651 && ((XINT (AREF (spec
, prop
)) >> 8)
2652 != (XINT (AREF (entity
, prop
)) >> 8)))
2653 prop
= FONT_SPEC_MAX
;
2654 if (prop
< FONT_SPEC_MAX
2656 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2658 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2661 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2662 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2663 prop
= FONT_SPEC_MAX
;
2665 if (prop
< FONT_SPEC_MAX
2666 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2667 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2668 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2669 prop
= FONT_SPEC_MAX
;
2670 if (prop
< FONT_SPEC_MAX
2671 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2672 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2673 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2674 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2675 prop
= FONT_SPEC_MAX
;
2676 if (prop
< FONT_SPEC_MAX
)
2677 val
= Fcons (entity
, val
);
2683 /* Return a vector of font-entities matching with SPEC on FRAME. */
2686 font_list_entities (frame
, spec
)
2687 Lisp_Object frame
, spec
;
2689 FRAME_PTR f
= XFRAME (frame
);
2690 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2691 Lisp_Object ftype
, val
;
2694 int need_filtering
= 0;
2697 font_assert (FONT_SPEC_P (spec
));
2699 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2700 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2701 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2702 size
= font_pixel_size (f
, spec
);
2706 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2707 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2708 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2709 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2711 ASET (scratch_font_spec
, i
, Qnil
);
2712 if (! NILP (AREF (spec
, i
)))
2714 if (i
== FONT_DPI_INDEX
)
2715 /* Skip FONT_SPACING_INDEX */
2718 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2719 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2721 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2725 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2727 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2729 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2731 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2732 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2739 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2740 copy
= Fcopy_font_spec (scratch_font_spec
);
2741 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2742 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2744 if (! NILP (val
) && need_filtering
)
2745 val
= font_delete_unmatched (val
, spec
, size
);
2750 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2751 font_add_log ("list", spec
, val
);
2756 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2757 nil, is an array of face's attributes, which specifies preferred
2758 font-related attributes. */
2761 font_matching_entity (f
, attrs
, spec
)
2763 Lisp_Object
*attrs
, spec
;
2765 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2766 Lisp_Object ftype
, size
, entity
;
2769 XSETFRAME (frame
, f
);
2770 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2771 size
= AREF (spec
, FONT_SIZE_INDEX
);
2773 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2775 for (; driver_list
; driver_list
= driver_list
->next
)
2777 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2779 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2782 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2783 entity
= assoc_no_quit (spec
, XCDR (cache
));
2785 entity
= XCDR (entity
);
2788 entity
= driver_list
->driver
->match (frame
, spec
);
2789 copy
= Fcopy_font_spec (spec
);
2790 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2791 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2793 if (! NILP (entity
))
2796 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2797 ASET (spec
, FONT_SIZE_INDEX
, size
);
2798 font_add_log ("match", spec
, entity
);
2803 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2804 opened font object. */
2807 font_open_entity (f
, entity
, pixel_size
)
2812 struct font_driver_list
*driver_list
;
2813 Lisp_Object objlist
, size
, val
, font_object
;
2815 int min_width
, height
;
2817 font_assert (FONT_ENTITY_P (entity
));
2818 size
= AREF (entity
, FONT_SIZE_INDEX
);
2819 if (XINT (size
) != 0)
2820 pixel_size
= XINT (size
);
2822 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2823 objlist
= XCDR (objlist
))
2824 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2825 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2826 return XCAR (objlist
);
2828 val
= AREF (entity
, FONT_TYPE_INDEX
);
2829 for (driver_list
= f
->font_driver_list
;
2830 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2831 driver_list
= driver_list
->next
);
2835 font_object
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2836 font_add_log ("open", entity
, font_object
);
2837 if (NILP (font_object
))
2839 ASET (entity
, FONT_OBJLIST_INDEX
,
2840 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2841 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
2844 font
= XFONT_OBJECT (font_object
);
2845 min_width
= (font
->min_width
? font
->min_width
2846 : font
->average_width
? font
->average_width
2847 : font
->space_width
? font
->space_width
2849 height
= (font
->height
? font
->height
: 1);
2850 #ifdef HAVE_WINDOW_SYSTEM
2851 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2852 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2854 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2855 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2856 fonts_changed_p
= 1;
2860 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2861 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2862 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2863 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2871 /* Close FONT_OBJECT that is opened on frame F. */
2874 font_close_object (f
, font_object
)
2876 Lisp_Object font_object
;
2878 struct font
*font
= XFONT_OBJECT (font_object
);
2880 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2881 /* Already closed. */
2883 font_add_log ("close", font_object
, Qnil
);
2884 font
->driver
->close (f
, font
);
2885 #ifdef HAVE_WINDOW_SYSTEM
2886 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2887 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2893 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2894 FONT is a font-entity and it must be opened to check. */
2897 font_has_char (f
, font
, c
)
2904 if (FONT_ENTITY_P (font
))
2906 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2907 struct font_driver_list
*driver_list
;
2909 for (driver_list
= f
->font_driver_list
;
2910 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2911 driver_list
= driver_list
->next
);
2914 if (! driver_list
->driver
->has_char
)
2916 return driver_list
->driver
->has_char (font
, c
);
2919 font_assert (FONT_OBJECT_P (font
));
2920 fontp
= XFONT_OBJECT (font
);
2921 if (fontp
->driver
->has_char
)
2923 int result
= fontp
->driver
->has_char (font
, c
);
2928 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2932 /* Return the glyph ID of FONT_OBJECT for character C. */
2935 font_encode_char (font_object
, c
)
2936 Lisp_Object font_object
;
2941 font_assert (FONT_OBJECT_P (font_object
));
2942 font
= XFONT_OBJECT (font_object
);
2943 return font
->driver
->encode_char (font
, c
);
2947 /* Return the name of FONT_OBJECT. */
2950 font_get_name (font_object
)
2951 Lisp_Object font_object
;
2953 font_assert (FONT_OBJECT_P (font_object
));
2954 return AREF (font_object
, FONT_NAME_INDEX
);
2958 /* Return the specification of FONT_OBJECT. */
2961 font_get_spec (font_object
)
2962 Lisp_Object font_object
;
2964 Lisp_Object spec
= font_make_spec ();
2967 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2968 ASET (spec
, i
, AREF (font_object
, i
));
2969 ASET (spec
, FONT_SIZE_INDEX
,
2970 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2975 font_spec_from_name (font_name
)
2976 Lisp_Object font_name
;
2978 Lisp_Object args
[2];
2981 args
[1] = font_name
;
2982 return Ffont_spec (2, args
);
2987 font_clear_prop (attrs
, prop
)
2989 enum font_property_index prop
;
2991 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2995 if (NILP (AREF (font
, prop
))
2996 && prop
!= FONT_FAMILY_INDEX
&& prop
!= FONT_FOUNDRY_INDEX
2997 && prop
!= FONT_SIZE_INDEX
)
2999 font
= Fcopy_font_spec (font
);
3000 ASET (font
, prop
, Qnil
);
3001 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3003 if (prop
== FONT_FAMILY_INDEX
)
3004 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3005 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3006 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3007 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3008 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3009 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3010 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3012 else if (prop
== FONT_SIZE_INDEX
)
3014 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3015 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3016 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3018 attrs
[LFACE_FONT_INDEX
] = font
;
3022 font_update_lface (f
, attrs
)
3028 spec
= attrs
[LFACE_FONT_INDEX
];
3029 if (! FONT_SPEC_P (spec
))
3032 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3033 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3034 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3035 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3036 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3037 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3038 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3039 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);;
3040 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3041 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3042 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3046 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3051 val
= Ffont_get (spec
, QCdpi
);
3054 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3057 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3058 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3059 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3064 /* Return a font-entity satisfying SPEC and best matching with face's
3065 font related attributes in ATTRS. C, if not negative, is a
3066 character that the entity must support. */
3069 font_find_for_lface (f
, attrs
, spec
, c
)
3076 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
3077 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3079 int i
, j
, k
, l
, result
;
3081 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3082 if (NILP (registry
[0]))
3084 registry
[0] = DEFAULT_ENCODING
;
3085 registry
[1] = Qascii_0
;
3086 registry
[2] = null_vector
;
3089 registry
[1] = null_vector
;
3091 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3093 struct charset
*encoding
, *repertory
;
3095 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3096 &encoding
, &repertory
) < 0)
3100 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3102 /* Any font of this registry support C. So, let's
3103 suppress the further checking. */
3106 else if (c
> encoding
->max_char
)
3110 work
= Fcopy_font_spec (spec
);
3111 XSETFRAME (frame
, f
);
3112 size
= AREF (spec
, FONT_SIZE_INDEX
);
3113 pixel_size
= font_pixel_size (f
, spec
);
3114 if (pixel_size
== 0)
3116 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3118 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3120 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3121 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3122 if (! NILP (foundry
[0]))
3123 foundry
[1] = null_vector
;
3124 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3126 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3127 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3129 foundry
[2] = null_vector
;
3132 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3134 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3135 if (! NILP (adstyle
[0]))
3136 adstyle
[1] = null_vector
;
3137 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3139 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3141 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3143 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3145 adstyle
[2] = null_vector
;
3148 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3151 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3154 val
= AREF (work
, FONT_FAMILY_INDEX
);
3155 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3157 val
= attrs
[LFACE_FAMILY_INDEX
];
3158 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3162 family
= alloca ((sizeof family
[0]) * 2);
3164 family
[1] = null_vector
; /* terminator. */
3169 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3171 if (! NILP (alters
))
3173 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3174 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3175 family
[i
] = XCAR (alters
);
3176 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3178 family
[i
] = null_vector
;
3182 family
= alloca ((sizeof family
[0]) * 3);
3185 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3187 family
[i
] = null_vector
;
3191 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3193 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3194 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3196 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3197 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3199 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3200 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3202 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3203 entities
= font_list_entities (frame
, work
);
3204 if (ASIZE (entities
) > 0)
3212 if (ASIZE (entities
) == 1)
3215 return AREF (entities
, 0);
3219 /* Sort fonts by properties specified in LFACE. */
3220 Lisp_Object prefer
= scratch_font_prefer
;
3222 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3223 ASET (prefer
, i
, AREF (work
, i
));
3224 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3226 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3228 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3229 if (NILP (AREF (prefer
, i
)))
3230 ASET (prefer
, i
, AREF (face_font
, i
));
3232 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3233 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3234 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3235 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3236 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3237 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3238 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3239 entities
= font_sort_entites (entities
, prefer
, frame
, c
< 0);
3244 for (i
= 0; i
< ASIZE (entities
); i
++)
3248 val
= AREF (entities
, i
);
3251 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3252 if (! EQ (AREF (val
, j
), props
[j
]))
3254 if (j
> FONT_REGISTRY_INDEX
)
3257 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3258 props
[j
] = AREF (val
, j
);
3259 result
= font_has_char (f
, val
, c
);
3264 val
= font_open_for_lface (f
, val
, attrs
, spec
);
3267 result
= font_has_char (f
, val
, c
);
3268 font_close_object (f
, val
);
3270 return AREF (entities
, i
);
3277 font_open_for_lface (f
, entity
, attrs
, spec
)
3285 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3286 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3287 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3288 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3289 size
= font_pixel_size (f
, spec
);
3292 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3295 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3299 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3300 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3304 return font_open_entity (f
, entity
, size
);
3308 /* Find a font satisfying SPEC and best matching with face's
3309 attributes in ATTRS on FRAME, and return the opened
3313 font_load_for_lface (f
, attrs
, spec
)
3315 Lisp_Object
*attrs
, spec
;
3319 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3322 /* No font is listed for SPEC, but each font-backend may have
3323 the different criteria about "font matching". So, try
3325 entity
= font_matching_entity (f
, attrs
, spec
);
3329 return font_open_for_lface (f
, entity
, attrs
, spec
);
3333 /* Make FACE on frame F ready to use the font opened for FACE. */
3336 font_prepare_for_face (f
, face
)
3340 if (face
->font
->driver
->prepare_face
)
3341 face
->font
->driver
->prepare_face (f
, face
);
3345 /* Make FACE on frame F stop using the font opened for FACE. */
3348 font_done_for_face (f
, face
)
3352 if (face
->font
->driver
->done_face
)
3353 face
->font
->driver
->done_face (f
, face
);
3358 /* Open a font best matching with NAME on frame F. If no proper font
3359 is found, return Qnil. */
3362 font_open_by_name (f
, name
)
3366 Lisp_Object args
[2];
3367 Lisp_Object spec
, attrs
[LFACE_VECTOR_SIZE
];
3370 args
[1] = make_unibyte_string (name
, strlen (name
));
3371 spec
= Ffont_spec (2, args
);
3372 /* We set up the default font-related attributes of a face to prefer
3374 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3375 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3376 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3378 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3380 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3382 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3384 return font_load_for_lface (f
, attrs
, spec
);
3388 /* Register font-driver DRIVER. This function is used in two ways.
3390 The first is with frame F non-NULL. In this case, make DRIVER
3391 available (but not yet activated) on F. All frame creaters
3392 (e.g. Fx_create_frame) must call this function at least once with
3393 an available font-driver.
3395 The second is with frame F NULL. In this case, DRIVER is globally
3396 registered in the variable `font_driver_list'. All font-driver
3397 implementations must call this function in its syms_of_XXXX
3398 (e.g. syms_of_xfont). */
3401 register_font_driver (driver
, f
)
3402 struct font_driver
*driver
;
3405 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3406 struct font_driver_list
*prev
, *list
;
3408 if (f
&& ! driver
->draw
)
3409 error ("Unusable font driver for a frame: %s",
3410 SDATA (SYMBOL_NAME (driver
->type
)));
3412 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3413 if (EQ (list
->driver
->type
, driver
->type
))
3414 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3416 list
= malloc (sizeof (struct font_driver_list
));
3418 list
->driver
= driver
;
3423 f
->font_driver_list
= list
;
3425 font_driver_list
= list
;
3431 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3432 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3433 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3435 A caller must free all realized faces if any in advance. The
3436 return value is a list of font backends actually made used on
3440 font_update_drivers (f
, new_drivers
)
3442 Lisp_Object new_drivers
;
3444 Lisp_Object active_drivers
= Qnil
;
3445 struct font_driver
*driver
;
3446 struct font_driver_list
*list
;
3448 /* At first, turn off non-requested drivers, and turn on requested
3450 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3452 driver
= list
->driver
;
3453 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3458 if (driver
->end_for_frame
)
3459 driver
->end_for_frame (f
);
3460 font_finish_cache (f
, driver
);
3465 if (! driver
->start_for_frame
3466 || driver
->start_for_frame (f
) == 0)
3468 font_prepare_cache (f
, driver
);
3475 if (NILP (new_drivers
))
3478 if (! EQ (new_drivers
, Qt
))
3480 /* Re-order the driver list according to new_drivers. */
3481 struct font_driver_list
**list_table
, **next
;
3485 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3486 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3488 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3489 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3492 list_table
[i
++] = list
;
3494 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3496 list_table
[i
] = list
;
3497 list_table
[i
] = NULL
;
3499 next
= &f
->font_driver_list
;
3500 for (i
= 0; list_table
[i
]; i
++)
3502 *next
= list_table
[i
];
3503 next
= &(*next
)->next
;
3508 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3510 active_drivers
= nconc2 (active_drivers
,
3511 Fcons (list
->driver
->type
, Qnil
));
3512 return active_drivers
;
3516 font_put_frame_data (f
, driver
, data
)
3518 struct font_driver
*driver
;
3521 struct font_data_list
*list
, *prev
;
3523 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3524 prev
= list
, list
= list
->next
)
3525 if (list
->driver
== driver
)
3532 prev
->next
= list
->next
;
3534 f
->font_data_list
= list
->next
;
3542 list
= malloc (sizeof (struct font_data_list
));
3545 list
->driver
= driver
;
3546 list
->next
= f
->font_data_list
;
3547 f
->font_data_list
= list
;
3555 font_get_frame_data (f
, driver
)
3557 struct font_driver
*driver
;
3559 struct font_data_list
*list
;
3561 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3562 if (list
->driver
== driver
)
3570 /* Return the font used to draw character C by FACE at buffer position
3571 POS in window W. If STRING is non-nil, it is a string containing C
3572 at index POS. If C is negative, get C from the current buffer or
3576 font_at (c
, pos
, face
, w
, string
)
3585 Lisp_Object font_object
;
3591 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3594 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3596 c
= FETCH_CHAR (pos_byte
);
3599 c
= FETCH_BYTE (pos
);
3605 multibyte
= STRING_MULTIBYTE (string
);
3608 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3610 str
= SDATA (string
) + pos_byte
;
3611 c
= STRING_CHAR (str
, 0);
3614 c
= SDATA (string
)[pos
];
3618 f
= XFRAME (w
->frame
);
3619 if (! FRAME_WINDOW_P (f
))
3626 if (STRINGP (string
))
3627 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3628 DEFAULT_FACE_ID
, 0);
3630 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3632 face
= FACE_FROM_ID (f
, face_id
);
3636 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3637 face
= FACE_FROM_ID (f
, face_id
);
3642 XSETFONT (font_object
, face
->font
);
3647 #ifdef HAVE_WINDOW_SYSTEM
3649 /* Check how many characters after POS (at most to *LIMIT) can be
3650 displayed by the same font on the window W. FACE, if non-NULL, is
3651 the face selected for the character at POS. If STRING is not nil,
3652 it is the string to check instead of the current buffer. In that
3653 case, FACE must be not NULL.
3655 The return value is the font-object for the character at POS.
3656 *LIMIT is set to the position where that font can't be used.
3658 It is assured that the current buffer (or STRING) is multibyte. */
3661 font_range (pos
, limit
, w
, face
, string
)
3662 EMACS_INT pos
, *limit
;
3667 EMACS_INT pos_byte
, ignore
, start
, start_byte
;
3669 Lisp_Object font_object
= Qnil
;
3673 pos_byte
= CHAR_TO_BYTE (pos
);
3678 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
, *limit
, 0);
3679 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3685 pos_byte
= string_char_to_byte (string
, pos
);
3688 start
= pos
, start_byte
= pos_byte
;
3689 while (pos
< *limit
)
3691 Lisp_Object category
;
3694 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3696 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3697 if (NILP (font_object
))
3699 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3700 if (NILP (font_object
))
3705 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3706 if (! EQ (category
, QCf
)
3707 && font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3709 Lisp_Object f
= font_for_char (face
, c
, pos
- 1, string
);
3710 EMACS_INT i
, i_byte
;
3718 i
= start
, i_byte
= start_byte
;
3723 FETCH_CHAR_ADVANCE_NO_CHECK (c
, i
, i_byte
);
3725 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, i
, i_byte
);
3726 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3727 if (! EQ (category
, QCf
)
3728 && font_encode_char (f
, c
) == FONT_INVALID_CODE
)
3744 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3745 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3746 Return nil otherwise.
3747 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3748 which kind of font it is. It must be one of `font-spec', `font-entity',
3750 (object
, extra_type
)
3751 Lisp_Object object
, extra_type
;
3753 if (NILP (extra_type
))
3754 return (FONTP (object
) ? Qt
: Qnil
);
3755 if (EQ (extra_type
, Qfont_spec
))
3756 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3757 if (EQ (extra_type
, Qfont_entity
))
3758 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3759 if (EQ (extra_type
, Qfont_object
))
3760 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3761 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3764 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3765 doc
: /* Return a newly created font-spec with arguments as properties.
3767 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3768 valid font property name listed below:
3770 `:family', `:weight', `:slant', `:width'
3772 They are the same as face attributes of the same name. See
3773 `set-face-attribute'.
3777 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3781 VALUE must be a string or a symbol specifying the additional
3782 typographic style information of a font, e.g. ``sans''.
3786 VALUE must be a string or a symbol specifying the charset registry and
3787 encoding of a font, e.g. ``iso8859-1''.
3791 VALUE must be a non-negative integer or a floating point number
3792 specifying the font size. It specifies the font size in pixels
3793 (if VALUE is an integer), or in points (if VALUE is a float).
3797 VALUE must be a string of XLFD-style or fontconfig-style font name.
3798 usage: (font-spec ARGS ...) */)
3803 Lisp_Object spec
= font_make_spec ();
3806 for (i
= 0; i
< nargs
; i
+= 2)
3808 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3810 if (EQ (key
, QCname
))
3813 font_parse_name ((char *) SDATA (val
), spec
);
3814 font_put_extra (spec
, key
, val
);
3818 int idx
= get_font_prop_index (key
);
3822 val
= font_prop_validate (idx
, Qnil
, val
);
3823 if (idx
< FONT_EXTRA_INDEX
)
3824 ASET (spec
, idx
, val
);
3826 font_put_extra (spec
, key
, val
);
3829 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3835 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3836 doc
: /* Return a copy of FONT as a font-spec. */)
3840 Lisp_Object new_spec
, tail
, prev
, extra
;
3844 new_spec
= font_make_spec ();
3845 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3846 ASET (new_spec
, i
, AREF (font
, i
));
3847 extra
= Fcopy_sequence (AREF (font
, FONT_EXTRA_INDEX
));
3848 /* We must remove :font-entity property. */
3849 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3850 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3853 extra
= XCDR (extra
);
3855 XSETCDR (prev
, XCDR (tail
));
3858 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3862 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3863 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3864 Every specified properties in FROM override the corresponding
3865 properties in TO. */)
3867 Lisp_Object from
, to
;
3869 Lisp_Object extra
, tail
;
3874 to
= Fcopy_font_spec (to
);
3875 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3876 ASET (to
, i
, AREF (from
, i
));
3877 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3878 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3879 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3881 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3884 XSETCDR (slot
, XCDR (XCAR (tail
)));
3886 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3888 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3892 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3893 doc
: /* Return the value of FONT's property KEY.
3894 FONT is a font-spec, a font-entity, or a font-object. */)
3896 Lisp_Object font
, key
;
3903 idx
= get_font_prop_index (key
);
3904 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3905 return font_style_symbolic (font
, idx
, 0);
3906 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3907 return AREF (font
, idx
);
3908 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3911 #ifdef HAVE_WINDOW_SYSTEM
3913 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3914 doc
: /* Return a plist of face attributes generated by FONT.
3915 FONT is a font name, a font-spec, a font-entity, or a font-object.
3916 The return value is a list of the form
3918 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3920 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3921 compatible with `set-face-attribute'. Some of these key-attribute pairs
3922 may be omitted from the list if they are not specified by FONT.
3924 The optional argument FRAME specifies the frame that the face attributes
3925 are to be displayed on. If omitted, the selected frame is used. */)
3927 Lisp_Object font
, frame
;
3930 Lisp_Object plist
[10];
3935 frame
= selected_frame
;
3936 CHECK_LIVE_FRAME (frame
);
3941 int fontset
= fs_query_fontset (font
, 0);
3942 Lisp_Object name
= font
;
3944 font
= fontset_ascii (fontset
);
3945 font
= font_spec_from_name (name
);
3947 signal_error ("Invalid font name", name
);
3949 else if (! FONTP (font
))
3950 signal_error ("Invalid font object", font
);
3952 val
= AREF (font
, FONT_FAMILY_INDEX
);
3955 plist
[n
++] = QCfamily
;
3956 plist
[n
++] = SYMBOL_NAME (val
);
3959 val
= AREF (font
, FONT_SIZE_INDEX
);
3962 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
3963 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
3964 plist
[n
++] = QCheight
;
3965 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
3967 else if (FLOATP (val
))
3969 plist
[n
++] = QCheight
;
3970 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
3973 val
= FONT_WEIGHT_FOR_FACE (font
);
3976 plist
[n
++] = QCweight
;
3980 val
= FONT_SLANT_FOR_FACE (font
);
3983 plist
[n
++] = QCslant
;
3987 val
= FONT_WIDTH_FOR_FACE (font
);
3990 plist
[n
++] = QCwidth
;
3994 return Flist (n
, plist
);
3999 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4000 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
4001 (font_spec
, prop
, val
)
4002 Lisp_Object font_spec
, prop
, val
;
4006 CHECK_FONT_SPEC (font_spec
);
4007 idx
= get_font_prop_index (prop
);
4008 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4009 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
4011 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
4015 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4016 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4017 Optional 2nd argument FRAME specifies the target frame.
4018 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4019 Optional 4th argument PREFER, if non-nil, is a font-spec to
4020 control the order of the returned list. Fonts are sorted by
4021 how close they are to PREFER. */)
4022 (font_spec
, frame
, num
, prefer
)
4023 Lisp_Object font_spec
, frame
, num
, prefer
;
4025 Lisp_Object vec
, list
, tail
;
4029 frame
= selected_frame
;
4030 CHECK_LIVE_FRAME (frame
);
4031 CHECK_FONT_SPEC (font_spec
);
4039 if (! NILP (prefer
))
4040 CHECK_FONT_SPEC (prefer
);
4042 vec
= font_list_entities (frame
, font_spec
);
4047 return Fcons (AREF (vec
, 0), Qnil
);
4049 if (! NILP (prefer
))
4050 vec
= font_sort_entites (vec
, prefer
, frame
, 0);
4052 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
4053 if (n
== 0 || n
> len
)
4055 for (i
= 1; i
< n
; i
++)
4057 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
4059 XSETCDR (tail
, val
);
4065 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4066 doc
: /* List available font families on the current frame.
4067 Optional argument FRAME, if non-nil, specifies the target frame. */)
4072 struct font_driver_list
*driver_list
;
4076 frame
= selected_frame
;
4077 CHECK_LIVE_FRAME (frame
);
4080 for (driver_list
= f
->font_driver_list
; driver_list
;
4081 driver_list
= driver_list
->next
)
4082 if (driver_list
->driver
->list_family
)
4084 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4090 Lisp_Object tail
= list
;
4092 for (; CONSP (val
); val
= XCDR (val
))
4093 if (NILP (Fmemq (XCAR (val
), tail
)))
4094 list
= Fcons (XCAR (val
), list
);
4100 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4101 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4102 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4104 Lisp_Object font_spec
, frame
;
4106 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4113 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4114 doc
: /* Return XLFD name of FONT.
4115 FONT is a font-spec, font-entity, or font-object.
4116 If the name is too long for XLFD (maximum 255 chars), return nil.
4117 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4118 the consecutive wildcards are folded to one. */)
4119 (font
, fold_wildcards
)
4120 Lisp_Object font
, fold_wildcards
;
4127 if (FONT_OBJECT_P (font
))
4129 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4131 if (STRINGP (font_name
)
4132 && SDATA (font_name
)[0] == '-')
4134 if (NILP (fold_wildcards
))
4136 strcpy (name
, (char *) SDATA (font_name
));
4139 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4141 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4144 if (! NILP (fold_wildcards
))
4146 char *p0
= name
, *p1
;
4148 while ((p1
= strstr (p0
, "-*-*")))
4150 strcpy (p1
, p1
+ 2);
4155 return build_string (name
);
4158 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4159 doc
: /* Clear font cache. */)
4162 Lisp_Object list
, frame
;
4164 FOR_EACH_FRAME (list
, frame
)
4166 FRAME_PTR f
= XFRAME (frame
);
4167 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4169 for (; driver_list
; driver_list
= driver_list
->next
)
4170 if (driver_list
->on
)
4172 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4177 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4179 font_assert (! NILP (val
));
4180 val
= XCDR (XCAR (val
));
4181 if (XINT (XCAR (val
)) == 0)
4183 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4184 XSETCDR (cache
, XCDR (val
));
4194 font_fill_lglyph_metrics (glyph
, font_object
)
4195 Lisp_Object glyph
, font_object
;
4197 struct font
*font
= XFONT_OBJECT (font_object
);
4199 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4200 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4201 struct font_metrics metrics
;
4203 LGLYPH_SET_CODE (glyph
, ecode
);
4205 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4206 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4207 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4208 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4209 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4210 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4214 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4215 doc
: /* Shape the glyph-string GSTRING.
4216 Shaping means substituting glyphs and/or adjusting positions of glyphs
4217 to get the correct visual image of character sequences set in the
4218 header of the glyph-string.
4220 If the shaping was successful, the value is GSTRING itself or a newly
4221 created glyph-string. Otherwise, the value is nil. */)
4223 Lisp_Object gstring
;
4226 Lisp_Object font_object
, n
, glyph
;
4229 if (! composition_gstring_p (gstring
))
4230 signal_error ("Invalid glyph-string: ", gstring
);
4231 if (! NILP (LGSTRING_ID (gstring
)))
4233 font_object
= LGSTRING_FONT (gstring
);
4234 CHECK_FONT_OBJECT (font_object
);
4235 font
= XFONT_OBJECT (font_object
);
4236 if (! font
->driver
->shape
)
4239 /* Try at most three times with larger gstring each time. */
4240 for (i
= 0; i
< 3; i
++)
4242 n
= font
->driver
->shape (gstring
);
4245 gstring
= larger_vector (gstring
,
4246 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4249 if (i
== 3 || XINT (n
) == 0)
4252 glyph
= LGSTRING_GLYPH (gstring
, 0);
4253 from
= LGLYPH_FROM (glyph
);
4254 to
= LGLYPH_TO (glyph
);
4255 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4257 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4261 if (NILP (LGLYPH_ADJUSTMENT (this)))
4266 glyph
= LGSTRING_GLYPH (gstring
, j
);
4267 LGLYPH_SET_FROM (glyph
, from
);
4268 LGLYPH_SET_TO (glyph
, to
);
4270 from
= LGLYPH_FROM (this);
4271 to
= LGLYPH_TO (this);
4276 if (from
> LGLYPH_FROM (this))
4277 from
= LGLYPH_FROM (this);
4278 if (to
< LGLYPH_TO (this))
4279 to
= LGLYPH_TO (this);
4285 glyph
= LGSTRING_GLYPH (gstring
, j
);
4286 LGLYPH_SET_FROM (glyph
, from
);
4287 LGLYPH_SET_TO (glyph
, to
);
4289 return composition_gstring_put_cache (gstring
, XINT (n
));
4294 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4295 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4296 OTF-FEATURES specifies which features to apply in this format:
4297 (SCRIPT LANGSYS GSUB GPOS)
4299 SCRIPT is a symbol specifying a script tag of OpenType,
4300 LANGSYS is a symbol specifying a langsys tag of OpenType,
4301 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4303 If LANGYS is nil, the default langsys is selected.
4305 The features are applied in the order they appear in the list. The
4306 symbol `*' means to apply all available features not present in this
4307 list, and the remaining features are ignored. For instance, (vatu
4308 pstf * haln) is to apply vatu and pstf in this order, then to apply
4309 all available features other than vatu, pstf, and haln.
4311 The features are applied to the glyphs in the range FROM and TO of
4312 the glyph-string GSTRING-IN.
4314 If some feature is actually applicable, the resulting glyphs are
4315 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4316 this case, the value is the number of produced glyphs.
4318 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4321 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4322 produced in GSTRING-OUT, and the value is nil.
4324 See the documentation of `font-make-gstring' for the format of
4326 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4327 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4329 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4334 check_otf_features (otf_features
);
4335 CHECK_FONT_OBJECT (font_object
);
4336 font
= XFONT_OBJECT (font_object
);
4337 if (! font
->driver
->otf_drive
)
4338 error ("Font backend %s can't drive OpenType GSUB table",
4339 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4340 CHECK_CONS (otf_features
);
4341 CHECK_SYMBOL (XCAR (otf_features
));
4342 val
= XCDR (otf_features
);
4343 CHECK_SYMBOL (XCAR (val
));
4344 val
= XCDR (otf_features
);
4347 len
= check_gstring (gstring_in
);
4348 CHECK_VECTOR (gstring_out
);
4349 CHECK_NATNUM (from
);
4351 CHECK_NATNUM (index
);
4353 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4354 args_out_of_range_3 (from
, to
, make_number (len
));
4355 if (XINT (index
) >= ASIZE (gstring_out
))
4356 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4357 num
= font
->driver
->otf_drive (font
, otf_features
,
4358 gstring_in
, XINT (from
), XINT (to
),
4359 gstring_out
, XINT (index
), 0);
4362 return make_number (num
);
4365 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4367 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4368 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4370 (SCRIPT LANGSYS FEATURE ...)
4371 See the documentation of `font-drive-otf' for more detail.
4373 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4374 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4375 character code corresponding to the glyph or nil if there's no
4376 corresponding character. */)
4377 (font_object
, character
, otf_features
)
4378 Lisp_Object font_object
, character
, otf_features
;
4381 Lisp_Object gstring_in
, gstring_out
, g
;
4382 Lisp_Object alternates
;
4385 CHECK_FONT_GET_OBJECT (font_object
, font
);
4386 if (! font
->driver
->otf_drive
)
4387 error ("Font backend %s can't drive OpenType GSUB table",
4388 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4389 CHECK_CHARACTER (character
);
4390 CHECK_CONS (otf_features
);
4392 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4393 g
= LGSTRING_GLYPH (gstring_in
, 0);
4394 LGLYPH_SET_CHAR (g
, XINT (character
));
4395 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4396 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4397 gstring_out
, 0, 1)) < 0)
4398 gstring_out
= Ffont_make_gstring (font_object
,
4399 make_number (ASIZE (gstring_out
) * 2));
4401 for (i
= 0; i
< num
; i
++)
4403 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4404 int c
= LGLYPH_CHAR (g
);
4405 unsigned code
= LGLYPH_CODE (g
);
4407 alternates
= Fcons (Fcons (make_number (code
),
4408 c
> 0 ? make_number (c
) : Qnil
),
4411 return Fnreverse (alternates
);
4417 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4418 doc
: /* Open FONT-ENTITY. */)
4419 (font_entity
, size
, frame
)
4420 Lisp_Object font_entity
;
4426 CHECK_FONT_ENTITY (font_entity
);
4428 frame
= selected_frame
;
4429 CHECK_LIVE_FRAME (frame
);
4432 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4435 CHECK_NUMBER_OR_FLOAT (size
);
4437 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
4439 isize
= XINT (size
);
4443 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4446 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4447 doc
: /* Close FONT-OBJECT. */)
4448 (font_object
, frame
)
4449 Lisp_Object font_object
, frame
;
4451 CHECK_FONT_OBJECT (font_object
);
4453 frame
= selected_frame
;
4454 CHECK_LIVE_FRAME (frame
);
4455 font_close_object (XFRAME (frame
), font_object
);
4459 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4460 doc
: /* Return information about FONT-OBJECT.
4461 The value is a vector:
4462 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4465 NAME is a string of the font name (or nil if the font backend doesn't
4468 FILENAME is a string of the font file (or nil if the font backend
4469 doesn't provide a file name).
4471 PIXEL-SIZE is a pixel size by which the font is opened.
4473 SIZE is a maximum advance width of the font in pixels.
4475 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4478 CAPABILITY is a list whose first element is a symbol representing the
4479 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4480 remaining elements describe the details of the font capability.
4482 If the font is OpenType font, the form of the list is
4483 \(opentype GSUB GPOS)
4484 where GSUB shows which "GSUB" features the font supports, and GPOS
4485 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4486 lists of the format:
4487 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4489 If the font is not OpenType font, currently the length of the form is
4492 SCRIPT is a symbol representing OpenType script tag.
4494 LANGSYS is a symbol representing OpenType langsys tag, or nil
4495 representing the default langsys.
4497 FEATURE is a symbol representing OpenType feature tag.
4499 If the font is not OpenType font, CAPABILITY is nil. */)
4501 Lisp_Object font_object
;
4506 CHECK_FONT_GET_OBJECT (font_object
, font
);
4508 val
= Fmake_vector (make_number (9), Qnil
);
4509 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4510 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4511 ASET (val
, 2, make_number (font
->pixel_size
));
4512 ASET (val
, 3, make_number (font
->max_width
));
4513 ASET (val
, 4, make_number (font
->ascent
));
4514 ASET (val
, 5, make_number (font
->descent
));
4515 ASET (val
, 6, make_number (font
->space_width
));
4516 ASET (val
, 7, make_number (font
->average_width
));
4517 if (font
->driver
->otf_capability
)
4518 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4522 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4523 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4524 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4525 (font_object
, string
)
4526 Lisp_Object font_object
, string
;
4532 CHECK_FONT_GET_OBJECT (font_object
, font
);
4533 CHECK_STRING (string
);
4534 len
= SCHARS (string
);
4535 vec
= Fmake_vector (make_number (len
), Qnil
);
4536 for (i
= 0; i
< len
; i
++)
4538 Lisp_Object ch
= Faref (string
, make_number (i
));
4543 struct font_metrics metrics
;
4545 cod
= code
= font
->driver
->encode_char (font
, c
);
4546 if (code
== FONT_INVALID_CODE
)
4548 val
= Fmake_vector (make_number (6), Qnil
);
4549 if (cod
<= MOST_POSITIVE_FIXNUM
)
4550 ASET (val
, 0, make_number (code
));
4552 ASET (val
, 0, Fcons (make_number (code
>> 16),
4553 make_number (code
& 0xFFFF)));
4554 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4555 ASET (val
, 1, make_number (metrics
.lbearing
));
4556 ASET (val
, 2, make_number (metrics
.rbearing
));
4557 ASET (val
, 3, make_number (metrics
.width
));
4558 ASET (val
, 4, make_number (metrics
.ascent
));
4559 ASET (val
, 5, make_number (metrics
.descent
));
4565 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4566 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4567 FONT is a font-spec, font-entity, or font-object. */)
4569 Lisp_Object spec
, font
;
4571 CHECK_FONT_SPEC (spec
);
4574 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4577 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4578 doc
: /* Return a font-object for displaying a character at POSITION.
4579 Optional second arg WINDOW, if non-nil, is a window displaying
4580 the current buffer. It defaults to the currently selected window. */)
4581 (position
, window
, string
)
4582 Lisp_Object position
, window
, string
;
4589 CHECK_NUMBER_COERCE_MARKER (position
);
4590 pos
= XINT (position
);
4591 if (pos
< BEGV
|| pos
>= ZV
)
4592 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4596 CHECK_NUMBER (position
);
4597 CHECK_STRING (string
);
4598 pos
= XINT (position
);
4599 if (pos
< 0 || pos
>= SCHARS (string
))
4600 args_out_of_range (string
, position
);
4603 window
= selected_window
;
4604 CHECK_LIVE_WINDOW (window
);
4605 w
= XWINDOW (window
);
4607 return font_at (-1, pos
, NULL
, w
, string
);
4611 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4612 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4613 The value is a number of glyphs drawn.
4614 Type C-l to recover what previously shown. */)
4615 (font_object
, string
)
4616 Lisp_Object font_object
, string
;
4618 Lisp_Object frame
= selected_frame
;
4619 FRAME_PTR f
= XFRAME (frame
);
4625 CHECK_FONT_GET_OBJECT (font_object
, font
);
4626 CHECK_STRING (string
);
4627 len
= SCHARS (string
);
4628 code
= alloca (sizeof (unsigned) * len
);
4629 for (i
= 0; i
< len
; i
++)
4631 Lisp_Object ch
= Faref (string
, make_number (i
));
4635 code
[i
] = font
->driver
->encode_char (font
, c
);
4636 if (code
[i
] == FONT_INVALID_CODE
)
4639 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4641 if (font
->driver
->prepare_face
)
4642 font
->driver
->prepare_face (f
, face
);
4643 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4644 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4645 if (font
->driver
->done_face
)
4646 font
->driver
->done_face (f
, face
);
4648 return make_number (len
);
4652 #endif /* FONT_DEBUG */
4654 #ifdef HAVE_WINDOW_SYSTEM
4656 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4657 doc
: /* Return information about a font named NAME on frame FRAME.
4658 If FRAME is omitted or nil, use the selected frame.
4659 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4660 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4662 OPENED-NAME is the name used for opening the font,
4663 FULL-NAME is the full name of the font,
4664 SIZE is the maximum bound width of the font,
4665 HEIGHT is the height of the font,
4666 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4667 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4668 how to compose characters.
4669 If the named font is not yet loaded, return nil. */)
4671 Lisp_Object name
, frame
;
4676 Lisp_Object font_object
;
4678 (*check_window_system_func
) ();
4681 CHECK_STRING (name
);
4683 frame
= selected_frame
;
4684 CHECK_LIVE_FRAME (frame
);
4689 int fontset
= fs_query_fontset (name
, 0);
4692 name
= fontset_ascii (fontset
);
4693 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4695 else if (FONT_OBJECT_P (name
))
4697 else if (FONT_ENTITY_P (name
))
4698 font_object
= font_open_entity (f
, name
, 0);
4701 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4702 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4704 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4706 if (NILP (font_object
))
4708 font
= XFONT_OBJECT (font_object
);
4710 info
= Fmake_vector (make_number (7), Qnil
);
4711 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4712 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4713 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4714 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4715 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4716 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4717 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4720 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4721 close it now. Perhaps, we should manage font-objects
4722 by `reference-count'. */
4723 font_close_object (f
, font_object
);
4730 #define BUILD_STYLE_TABLE(TBL) \
4731 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4734 build_style_table (entry
, nelement
)
4735 struct table_entry
*entry
;
4739 Lisp_Object table
, elt
;
4741 table
= Fmake_vector (make_number (nelement
), Qnil
);
4742 for (i
= 0; i
< nelement
; i
++)
4744 for (j
= 0; entry
[i
].names
[j
]; j
++);
4745 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4746 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4747 for (j
= 0; entry
[i
].names
[j
]; j
++)
4748 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4749 ASET (table
, i
, elt
);
4754 static Lisp_Object Vfont_log
;
4755 static int font_log_env_checked
;
4757 /* The deferred font-log data of the form [ACTION ARG RESULT].
4758 If ACTION is not nil, that is added to the log when font_add_log is
4759 called next time. At that time, ACTION is set back to nil. */
4760 static Lisp_Object Vfont_log_deferred
;
4762 /* Prepend the font-related logging data in Vfont_log if it is not
4763 `t'. ACTION describes a kind of font-related action (e.g. listing,
4764 opening), ARG is the argument for the action, and RESULT is the
4765 result of the action. */
4767 font_add_log (action
, arg
, result
)
4769 Lisp_Object arg
, result
;
4771 Lisp_Object tail
, val
;
4774 if (! font_log_env_checked
)
4776 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
4777 font_log_env_checked
= 1;
4779 if (EQ (Vfont_log
, Qt
))
4781 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4783 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
4785 ASET (Vfont_log_deferred
, 0, Qnil
);
4786 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4787 AREF (Vfont_log_deferred
, 2));
4792 Lisp_Object tail
, elt
;
4793 Lisp_Object equalstr
= build_string ("=");
4795 val
= Ffont_xlfd_name (arg
, Qt
);
4796 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4800 if (EQ (XCAR (elt
), QCscript
))
4801 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4802 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4803 else if (EQ (XCAR (elt
), QClang
))
4804 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4805 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4806 else if (EQ (XCAR (elt
), QCotf
) && CONSP (XCDR (elt
)))
4807 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4809 SYMBOL_NAME (XCAR (XCDR (elt
)))));
4815 val
= Ffont_xlfd_name (result
, Qt
);
4816 if (! FONT_SPEC_P (result
))
4817 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4818 build_string (":"), val
);
4821 else if (CONSP (result
))
4823 result
= Fcopy_sequence (result
);
4824 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4828 val
= Ffont_xlfd_name (val
, Qt
);
4829 XSETCAR (tail
, val
);
4832 else if (VECTORP (result
))
4834 result
= Fcopy_sequence (result
);
4835 for (i
= 0; i
< ASIZE (result
); i
++)
4837 val
= AREF (result
, i
);
4839 val
= Ffont_xlfd_name (val
, Qt
);
4840 ASET (result
, i
, val
);
4843 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4846 /* Record a font-related logging data to be added to Vfont_log when
4847 font_add_log is called next time. ACTION, ARG, RESULT are the same
4851 font_deferred_log (action
, arg
, result
)
4853 Lisp_Object arg
, result
;
4855 ASET (Vfont_log_deferred
, 0, build_string (action
));
4856 ASET (Vfont_log_deferred
, 1, arg
);
4857 ASET (Vfont_log_deferred
, 2, result
);
4860 extern void syms_of_ftfont
P_ (());
4861 extern void syms_of_xfont
P_ (());
4862 extern void syms_of_xftfont
P_ (());
4863 extern void syms_of_ftxfont
P_ (());
4864 extern void syms_of_bdffont
P_ (());
4865 extern void syms_of_w32font
P_ (());
4866 extern void syms_of_atmfont
P_ (());
4867 extern void syms_of_nsfont
P_ (());
4872 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
4873 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
4874 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
4875 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
4876 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
4877 /* Note that the other elements in sort_shift_bits are not used. */
4879 staticpro (&font_charset_alist
);
4880 font_charset_alist
= Qnil
;
4882 DEFSYM (Qfont_spec
, "font-spec");
4883 DEFSYM (Qfont_entity
, "font-entity");
4884 DEFSYM (Qfont_object
, "font-object");
4886 DEFSYM (Qopentype
, "opentype");
4888 DEFSYM (Qascii_0
, "ascii-0");
4889 DEFSYM (Qiso8859_1
, "iso8859-1");
4890 DEFSYM (Qiso10646_1
, "iso10646-1");
4891 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4892 DEFSYM (Qunicode_sip
, "unicode-sip");
4896 DEFSYM (QCotf
, ":otf");
4897 DEFSYM (QClang
, ":lang");
4898 DEFSYM (QCscript
, ":script");
4899 DEFSYM (QCantialias
, ":antialias");
4901 DEFSYM (QCfoundry
, ":foundry");
4902 DEFSYM (QCadstyle
, ":adstyle");
4903 DEFSYM (QCregistry
, ":registry");
4904 DEFSYM (QCspacing
, ":spacing");
4905 DEFSYM (QCdpi
, ":dpi");
4906 DEFSYM (QCscalable
, ":scalable");
4907 DEFSYM (QCavgwidth
, ":avgwidth");
4908 DEFSYM (QCfont_entity
, ":font-entity");
4909 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
4916 staticpro (&null_vector
);
4917 null_vector
= Fmake_vector (make_number (0), Qnil
);
4919 staticpro (&scratch_font_spec
);
4920 scratch_font_spec
= Ffont_spec (0, NULL
);
4921 staticpro (&scratch_font_prefer
);
4922 scratch_font_prefer
= Ffont_spec (0, NULL
);
4924 staticpro (&Vfont_log_deferred
);
4925 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
4929 staticpro (&otf_list
);
4931 #endif /* HAVE_LIBOTF */
4935 defsubr (&Sfont_spec
);
4936 defsubr (&Sfont_get
);
4937 #ifdef HAVE_WINDOW_SYSTEM
4938 defsubr (&Sfont_face_attributes
);
4940 defsubr (&Sfont_put
);
4941 defsubr (&Slist_fonts
);
4942 defsubr (&Sfont_family_list
);
4943 defsubr (&Sfind_font
);
4944 defsubr (&Sfont_xlfd_name
);
4945 defsubr (&Sclear_font_cache
);
4946 defsubr (&Sfont_shape_gstring
);
4948 defsubr (&Sfont_drive_otf
);
4949 defsubr (&Sfont_otf_alternates
);
4953 defsubr (&Sopen_font
);
4954 defsubr (&Sclose_font
);
4955 defsubr (&Squery_font
);
4956 defsubr (&Sget_font_glyphs
);
4957 defsubr (&Sfont_match_p
);
4958 defsubr (&Sfont_at
);
4960 defsubr (&Sdraw_string
);
4962 #endif /* FONT_DEBUG */
4963 #ifdef HAVE_WINDOW_SYSTEM
4964 defsubr (&Sfont_info
);
4967 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
4969 Alist of fontname patterns vs the corresponding encoding and repertory info.
4970 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
4971 where ENCODING is a charset or a char-table,
4972 and REPERTORY is a charset, a char-table, or nil.
4974 If ENCODING and REPERTORY are the same, the element can have the form
4975 \(REGEXP . ENCODING).
4977 ENCODING is for converting a character to a glyph code of the font.
4978 If ENCODING is a charset, encoding a character by the charset gives
4979 the corresponding glyph code. If ENCODING is a char-table, looking up
4980 the table by a character gives the corresponding glyph code.
4982 REPERTORY specifies a repertory of characters supported by the font.
4983 If REPERTORY is a charset, all characters beloging to the charset are
4984 supported. If REPERTORY is a char-table, all characters who have a
4985 non-nil value in the table are supported. If REPERTORY is nil, Emacs
4986 gets the repertory information by an opened font and ENCODING. */);
4987 Vfont_encoding_alist
= Qnil
;
4989 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
4990 doc
: /* Vector of valid font weight values.
4991 Each element has the form:
4992 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
4993 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
4994 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
4996 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
4997 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
4998 See `font-weight-table' for the format of the vector. */);
4999 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5001 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5002 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5003 See `font-weight-table' for the format of the vector. */);
5004 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5006 staticpro (&font_style_table
);
5007 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5008 ASET (font_style_table
, 0, Vfont_weight_table
);
5009 ASET (font_style_table
, 1, Vfont_slant_table
);
5010 ASET (font_style_table
, 2, Vfont_width_table
);
5012 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5013 *Logging list of font related actions and results.
5014 The value t means to suppress the logging.
5015 The initial value is set to nil if the environment variable
5016 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5019 #ifdef HAVE_WINDOW_SYSTEM
5020 #ifdef HAVE_FREETYPE
5022 #ifdef HAVE_X_WINDOWS
5027 #endif /* HAVE_XFT */
5028 #endif /* HAVE_X_WINDOWS */
5029 #else /* not HAVE_FREETYPE */
5030 #ifdef HAVE_X_WINDOWS
5032 #endif /* HAVE_X_WINDOWS */
5033 #endif /* not HAVE_FREETYPE */
5036 #endif /* HAVE_BDFFONT */
5039 #endif /* WINDOWSNT */
5042 #endif /* HAVE_NS */
5043 #endif /* HAVE_WINDOW_SYSTEM */
5046 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5047 (do not change this comment) */