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
;
2768 Lisp_Object work
= Fcopy_font_spec (spec
);
2770 XSETFRAME (frame
, f
);
2771 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2772 size
= AREF (spec
, FONT_SIZE_INDEX
);
2775 ASET (work
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2776 FONT_SET_STYLE (work
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2777 FONT_SET_STYLE (work
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2778 FONT_SET_STYLE (work
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2781 for (; driver_list
; driver_list
= driver_list
->next
)
2783 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2785 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2788 ASET (work
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2789 entity
= assoc_no_quit (work
, XCDR (cache
));
2791 entity
= XCDR (entity
);
2794 entity
= driver_list
->driver
->match (frame
, work
);
2795 copy
= Fcopy_font_spec (work
);
2796 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2797 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2799 if (! NILP (entity
))
2802 font_add_log ("match", work
, entity
);
2807 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2808 opened font object. */
2811 font_open_entity (f
, entity
, pixel_size
)
2816 struct font_driver_list
*driver_list
;
2817 Lisp_Object objlist
, size
, val
, font_object
;
2819 int min_width
, height
;
2821 font_assert (FONT_ENTITY_P (entity
));
2822 size
= AREF (entity
, FONT_SIZE_INDEX
);
2823 if (XINT (size
) != 0)
2824 pixel_size
= XINT (size
);
2826 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2827 objlist
= XCDR (objlist
))
2828 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2829 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2830 return XCAR (objlist
);
2832 val
= AREF (entity
, FONT_TYPE_INDEX
);
2833 for (driver_list
= f
->font_driver_list
;
2834 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2835 driver_list
= driver_list
->next
);
2839 font_object
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2840 font_add_log ("open", entity
, font_object
);
2841 if (NILP (font_object
))
2843 ASET (entity
, FONT_OBJLIST_INDEX
,
2844 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2845 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
2848 font
= XFONT_OBJECT (font_object
);
2849 min_width
= (font
->min_width
? font
->min_width
2850 : font
->average_width
? font
->average_width
2851 : font
->space_width
? font
->space_width
2853 height
= (font
->height
? font
->height
: 1);
2854 #ifdef HAVE_WINDOW_SYSTEM
2855 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2856 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2858 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2859 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2860 fonts_changed_p
= 1;
2864 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2865 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2866 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2867 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2875 /* Close FONT_OBJECT that is opened on frame F. */
2878 font_close_object (f
, font_object
)
2880 Lisp_Object font_object
;
2882 struct font
*font
= XFONT_OBJECT (font_object
);
2884 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2885 /* Already closed. */
2887 font_add_log ("close", font_object
, Qnil
);
2888 font
->driver
->close (f
, font
);
2889 #ifdef HAVE_WINDOW_SYSTEM
2890 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2891 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2897 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2898 FONT is a font-entity and it must be opened to check. */
2901 font_has_char (f
, font
, c
)
2908 if (FONT_ENTITY_P (font
))
2910 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2911 struct font_driver_list
*driver_list
;
2913 for (driver_list
= f
->font_driver_list
;
2914 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2915 driver_list
= driver_list
->next
);
2918 if (! driver_list
->driver
->has_char
)
2920 return driver_list
->driver
->has_char (font
, c
);
2923 font_assert (FONT_OBJECT_P (font
));
2924 fontp
= XFONT_OBJECT (font
);
2925 if (fontp
->driver
->has_char
)
2927 int result
= fontp
->driver
->has_char (font
, c
);
2932 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2936 /* Return the glyph ID of FONT_OBJECT for character C. */
2939 font_encode_char (font_object
, c
)
2940 Lisp_Object font_object
;
2945 font_assert (FONT_OBJECT_P (font_object
));
2946 font
= XFONT_OBJECT (font_object
);
2947 return font
->driver
->encode_char (font
, c
);
2951 /* Return the name of FONT_OBJECT. */
2954 font_get_name (font_object
)
2955 Lisp_Object font_object
;
2957 font_assert (FONT_OBJECT_P (font_object
));
2958 return AREF (font_object
, FONT_NAME_INDEX
);
2962 /* Return the specification of FONT_OBJECT. */
2965 font_get_spec (font_object
)
2966 Lisp_Object font_object
;
2968 Lisp_Object spec
= font_make_spec ();
2971 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2972 ASET (spec
, i
, AREF (font_object
, i
));
2973 ASET (spec
, FONT_SIZE_INDEX
,
2974 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2979 font_spec_from_name (font_name
)
2980 Lisp_Object font_name
;
2982 Lisp_Object args
[2];
2985 args
[1] = font_name
;
2986 return Ffont_spec (2, args
);
2991 font_clear_prop (attrs
, prop
)
2993 enum font_property_index prop
;
2995 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2999 if (NILP (AREF (font
, prop
))
3000 && prop
!= FONT_FAMILY_INDEX
&& prop
!= FONT_FOUNDRY_INDEX
3001 && prop
!= FONT_SIZE_INDEX
)
3003 font
= Fcopy_font_spec (font
);
3004 ASET (font
, prop
, Qnil
);
3005 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3007 if (prop
== FONT_FAMILY_INDEX
)
3008 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3009 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3010 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3011 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3012 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3013 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3014 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3016 else if (prop
== FONT_SIZE_INDEX
)
3018 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3019 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3020 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3022 attrs
[LFACE_FONT_INDEX
] = font
;
3026 font_update_lface (f
, attrs
)
3032 spec
= attrs
[LFACE_FONT_INDEX
];
3033 if (! FONT_SPEC_P (spec
))
3036 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3037 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3038 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3039 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3040 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3041 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3042 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3043 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);;
3044 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3045 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3046 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3050 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3055 val
= Ffont_get (spec
, QCdpi
);
3058 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3061 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3062 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3063 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3068 /* Return a font-entity satisfying SPEC and best matching with face's
3069 font related attributes in ATTRS. C, if not negative, is a
3070 character that the entity must support. */
3073 font_find_for_lface (f
, attrs
, spec
, c
)
3080 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
3081 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3083 int i
, j
, k
, l
, result
;
3085 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3086 if (NILP (registry
[0]))
3088 registry
[0] = DEFAULT_ENCODING
;
3089 registry
[1] = Qascii_0
;
3090 registry
[2] = null_vector
;
3093 registry
[1] = null_vector
;
3095 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3097 struct charset
*encoding
, *repertory
;
3099 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3100 &encoding
, &repertory
) < 0)
3104 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3106 /* Any font of this registry support C. So, let's
3107 suppress the further checking. */
3110 else if (c
> encoding
->max_char
)
3114 work
= Fcopy_font_spec (spec
);
3115 XSETFRAME (frame
, f
);
3116 size
= AREF (spec
, FONT_SIZE_INDEX
);
3117 pixel_size
= font_pixel_size (f
, spec
);
3118 if (pixel_size
== 0)
3120 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3122 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3124 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3125 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3126 if (! NILP (foundry
[0]))
3127 foundry
[1] = null_vector
;
3128 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3130 val
= attrs
[LFACE_FOUNDRY_INDEX
];
3131 foundry
[0] = font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3133 foundry
[2] = null_vector
;
3136 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3138 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3139 if (! NILP (adstyle
[0]))
3140 adstyle
[1] = null_vector
;
3141 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3143 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3145 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3147 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3149 adstyle
[2] = null_vector
;
3152 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3155 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3158 val
= AREF (work
, FONT_FAMILY_INDEX
);
3159 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3161 val
= attrs
[LFACE_FAMILY_INDEX
];
3162 val
= font_intern_prop ((char *) SDATA (val
), SBYTES (val
), 1);
3166 family
= alloca ((sizeof family
[0]) * 2);
3168 family
[1] = null_vector
; /* terminator. */
3173 = Fassoc_string (val
, Vface_alternative_font_family_alist
,
3181 if (! NILP (alters
))
3183 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3184 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3185 family
[i
] = XCAR (alters
);
3186 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3188 family
[i
] = null_vector
;
3192 family
= alloca ((sizeof family
[0]) * 3);
3195 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3197 family
[i
] = null_vector
;
3201 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3203 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3204 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3206 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3207 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3209 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3210 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3212 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3213 entities
= font_list_entities (frame
, work
);
3214 if (ASIZE (entities
) > 0)
3222 if (ASIZE (entities
) == 1)
3225 return AREF (entities
, 0);
3229 /* Sort fonts by properties specified in LFACE. */
3230 Lisp_Object prefer
= scratch_font_prefer
;
3232 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3233 ASET (prefer
, i
, AREF (work
, i
));
3234 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3236 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3238 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3239 if (NILP (AREF (prefer
, i
)))
3240 ASET (prefer
, i
, AREF (face_font
, i
));
3242 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3243 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3244 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3245 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3246 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3247 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3248 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3249 entities
= font_sort_entites (entities
, prefer
, frame
, c
< 0);
3254 for (i
= 0; i
< ASIZE (entities
); i
++)
3258 val
= AREF (entities
, i
);
3261 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3262 if (! EQ (AREF (val
, j
), props
[j
]))
3264 if (j
> FONT_REGISTRY_INDEX
)
3267 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3268 props
[j
] = AREF (val
, j
);
3269 result
= font_has_char (f
, val
, c
);
3274 val
= font_open_for_lface (f
, val
, attrs
, spec
);
3277 result
= font_has_char (f
, val
, c
);
3278 font_close_object (f
, val
);
3280 return AREF (entities
, i
);
3287 font_open_for_lface (f
, entity
, attrs
, spec
)
3295 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3296 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3297 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3298 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3299 size
= font_pixel_size (f
, spec
);
3302 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3305 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3309 Lisp_Object ffsize
= get_frame_param(f
, Qfontsize
);
3310 size
= NUMBERP (ffsize
) ? POINT_TO_PIXEL (XINT (ffsize
), f
->resy
) : 0;
3314 return font_open_entity (f
, entity
, size
);
3318 /* Find a font satisfying SPEC and best matching with face's
3319 attributes in ATTRS on FRAME, and return the opened
3323 font_load_for_lface (f
, attrs
, spec
)
3325 Lisp_Object
*attrs
, spec
;
3329 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3332 /* No font is listed for SPEC, but each font-backend may have
3333 the different criteria about "font matching". So, try
3335 entity
= font_matching_entity (f
, attrs
, spec
);
3339 return font_open_for_lface (f
, entity
, attrs
, spec
);
3343 /* Make FACE on frame F ready to use the font opened for FACE. */
3346 font_prepare_for_face (f
, face
)
3350 if (face
->font
->driver
->prepare_face
)
3351 face
->font
->driver
->prepare_face (f
, face
);
3355 /* Make FACE on frame F stop using the font opened for FACE. */
3358 font_done_for_face (f
, face
)
3362 if (face
->font
->driver
->done_face
)
3363 face
->font
->driver
->done_face (f
, face
);
3368 /* Open a font best matching with NAME on frame F. If no proper font
3369 is found, return Qnil. */
3372 font_open_by_name (f
, name
)
3376 Lisp_Object args
[2];
3377 Lisp_Object spec
, attrs
[LFACE_VECTOR_SIZE
];
3380 args
[1] = make_unibyte_string (name
, strlen (name
));
3381 spec
= Ffont_spec (2, args
);
3382 /* We set up the default font-related attributes of a face to prefer
3384 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3385 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3386 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3388 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3390 attrs
[LFACE_HEIGHT_INDEX
] = make_number (0);
3392 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3394 return font_load_for_lface (f
, attrs
, spec
);
3398 /* Register font-driver DRIVER. This function is used in two ways.
3400 The first is with frame F non-NULL. In this case, make DRIVER
3401 available (but not yet activated) on F. All frame creaters
3402 (e.g. Fx_create_frame) must call this function at least once with
3403 an available font-driver.
3405 The second is with frame F NULL. In this case, DRIVER is globally
3406 registered in the variable `font_driver_list'. All font-driver
3407 implementations must call this function in its syms_of_XXXX
3408 (e.g. syms_of_xfont). */
3411 register_font_driver (driver
, f
)
3412 struct font_driver
*driver
;
3415 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3416 struct font_driver_list
*prev
, *list
;
3418 if (f
&& ! driver
->draw
)
3419 error ("Unusable font driver for a frame: %s",
3420 SDATA (SYMBOL_NAME (driver
->type
)));
3422 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3423 if (EQ (list
->driver
->type
, driver
->type
))
3424 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3426 list
= malloc (sizeof (struct font_driver_list
));
3428 list
->driver
= driver
;
3433 f
->font_driver_list
= list
;
3435 font_driver_list
= list
;
3441 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3442 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3443 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3445 A caller must free all realized faces if any in advance. The
3446 return value is a list of font backends actually made used on
3450 font_update_drivers (f
, new_drivers
)
3452 Lisp_Object new_drivers
;
3454 Lisp_Object active_drivers
= Qnil
;
3455 struct font_driver
*driver
;
3456 struct font_driver_list
*list
;
3458 /* At first, turn off non-requested drivers, and turn on requested
3460 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3462 driver
= list
->driver
;
3463 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3468 if (driver
->end_for_frame
)
3469 driver
->end_for_frame (f
);
3470 font_finish_cache (f
, driver
);
3475 if (! driver
->start_for_frame
3476 || driver
->start_for_frame (f
) == 0)
3478 font_prepare_cache (f
, driver
);
3485 if (NILP (new_drivers
))
3488 if (! EQ (new_drivers
, Qt
))
3490 /* Re-order the driver list according to new_drivers. */
3491 struct font_driver_list
**list_table
, **next
;
3495 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3496 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3498 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3499 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3502 list_table
[i
++] = list
;
3504 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3506 list_table
[i
] = list
;
3507 list_table
[i
] = NULL
;
3509 next
= &f
->font_driver_list
;
3510 for (i
= 0; list_table
[i
]; i
++)
3512 *next
= list_table
[i
];
3513 next
= &(*next
)->next
;
3518 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3520 active_drivers
= nconc2 (active_drivers
,
3521 Fcons (list
->driver
->type
, Qnil
));
3522 return active_drivers
;
3526 font_put_frame_data (f
, driver
, data
)
3528 struct font_driver
*driver
;
3531 struct font_data_list
*list
, *prev
;
3533 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3534 prev
= list
, list
= list
->next
)
3535 if (list
->driver
== driver
)
3542 prev
->next
= list
->next
;
3544 f
->font_data_list
= list
->next
;
3552 list
= malloc (sizeof (struct font_data_list
));
3555 list
->driver
= driver
;
3556 list
->next
= f
->font_data_list
;
3557 f
->font_data_list
= list
;
3565 font_get_frame_data (f
, driver
)
3567 struct font_driver
*driver
;
3569 struct font_data_list
*list
;
3571 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3572 if (list
->driver
== driver
)
3580 /* Return the font used to draw character C by FACE at buffer position
3581 POS in window W. If STRING is non-nil, it is a string containing C
3582 at index POS. If C is negative, get C from the current buffer or
3586 font_at (c
, pos
, face
, w
, string
)
3595 Lisp_Object font_object
;
3601 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3604 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3606 c
= FETCH_CHAR (pos_byte
);
3609 c
= FETCH_BYTE (pos
);
3615 multibyte
= STRING_MULTIBYTE (string
);
3618 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3620 str
= SDATA (string
) + pos_byte
;
3621 c
= STRING_CHAR (str
, 0);
3624 c
= SDATA (string
)[pos
];
3628 f
= XFRAME (w
->frame
);
3629 if (! FRAME_WINDOW_P (f
))
3636 if (STRINGP (string
))
3637 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3638 DEFAULT_FACE_ID
, 0);
3640 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3642 face
= FACE_FROM_ID (f
, face_id
);
3646 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3647 face
= FACE_FROM_ID (f
, face_id
);
3652 XSETFONT (font_object
, face
->font
);
3657 #ifdef HAVE_WINDOW_SYSTEM
3659 /* Check how many characters after POS (at most to *LIMIT) can be
3660 displayed by the same font on the window W. FACE, if non-NULL, is
3661 the face selected for the character at POS. If STRING is not nil,
3662 it is the string to check instead of the current buffer. In that
3663 case, FACE must be not NULL.
3665 The return value is the font-object for the character at POS.
3666 *LIMIT is set to the position where that font can't be used.
3668 It is assured that the current buffer (or STRING) is multibyte. */
3671 font_range (pos
, limit
, w
, face
, string
)
3672 EMACS_INT pos
, *limit
;
3677 EMACS_INT pos_byte
, ignore
, start
, start_byte
;
3679 Lisp_Object font_object
= Qnil
;
3683 pos_byte
= CHAR_TO_BYTE (pos
);
3688 face_id
= face_at_buffer_position (w
, pos
, 0, 0, &ignore
, *limit
, 0);
3689 face
= FACE_FROM_ID (XFRAME (w
->frame
), face_id
);
3695 pos_byte
= string_char_to_byte (string
, pos
);
3698 start
= pos
, start_byte
= pos_byte
;
3699 while (pos
< *limit
)
3701 Lisp_Object category
;
3704 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3706 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3707 if (NILP (font_object
))
3709 font_object
= font_for_char (face
, c
, pos
- 1, string
);
3710 if (NILP (font_object
))
3715 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3716 if (! EQ (category
, QCf
)
3717 && font_encode_char (font_object
, c
) == FONT_INVALID_CODE
)
3719 Lisp_Object f
= font_for_char (face
, c
, pos
- 1, string
);
3720 EMACS_INT i
, i_byte
;
3728 i
= start
, i_byte
= start_byte
;
3733 FETCH_CHAR_ADVANCE_NO_CHECK (c
, i
, i_byte
);
3735 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, i
, i_byte
);
3736 category
= CHAR_TABLE_REF (Vunicode_category_table
, c
);
3737 if (! EQ (category
, QCf
)
3738 && font_encode_char (f
, c
) == FONT_INVALID_CODE
)
3754 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3755 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3756 Return nil otherwise.
3757 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3758 which kind of font it is. It must be one of `font-spec', `font-entity',
3760 (object
, extra_type
)
3761 Lisp_Object object
, extra_type
;
3763 if (NILP (extra_type
))
3764 return (FONTP (object
) ? Qt
: Qnil
);
3765 if (EQ (extra_type
, Qfont_spec
))
3766 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3767 if (EQ (extra_type
, Qfont_entity
))
3768 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3769 if (EQ (extra_type
, Qfont_object
))
3770 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3771 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3774 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3775 doc
: /* Return a newly created font-spec with arguments as properties.
3777 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3778 valid font property name listed below:
3780 `:family', `:weight', `:slant', `:width'
3782 They are the same as face attributes of the same name. See
3783 `set-face-attribute'.
3787 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3791 VALUE must be a string or a symbol specifying the additional
3792 typographic style information of a font, e.g. ``sans''.
3796 VALUE must be a string or a symbol specifying the charset registry and
3797 encoding of a font, e.g. ``iso8859-1''.
3801 VALUE must be a non-negative integer or a floating point number
3802 specifying the font size. It specifies the font size in pixels
3803 (if VALUE is an integer), or in points (if VALUE is a float).
3807 VALUE must be a string of XLFD-style or fontconfig-style font name.
3808 usage: (font-spec ARGS ...) */)
3813 Lisp_Object spec
= font_make_spec ();
3816 for (i
= 0; i
< nargs
; i
+= 2)
3818 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3820 if (EQ (key
, QCname
))
3823 font_parse_name ((char *) SDATA (val
), spec
);
3824 font_put_extra (spec
, key
, val
);
3828 int idx
= get_font_prop_index (key
);
3832 val
= font_prop_validate (idx
, Qnil
, val
);
3833 if (idx
< FONT_EXTRA_INDEX
)
3834 ASET (spec
, idx
, val
);
3836 font_put_extra (spec
, key
, val
);
3839 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3845 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3846 doc
: /* Return a copy of FONT as a font-spec. */)
3850 Lisp_Object new_spec
, tail
, prev
, extra
;
3854 new_spec
= font_make_spec ();
3855 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3856 ASET (new_spec
, i
, AREF (font
, i
));
3857 extra
= Fcopy_sequence (AREF (font
, FONT_EXTRA_INDEX
));
3858 /* We must remove :font-entity property. */
3859 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3860 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3863 extra
= XCDR (extra
);
3865 XSETCDR (prev
, XCDR (tail
));
3868 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3872 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3873 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3874 Every specified properties in FROM override the corresponding
3875 properties in TO. */)
3877 Lisp_Object from
, to
;
3879 Lisp_Object extra
, tail
;
3884 to
= Fcopy_font_spec (to
);
3885 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3886 ASET (to
, i
, AREF (from
, i
));
3887 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3888 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3889 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3891 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3894 XSETCDR (slot
, XCDR (XCAR (tail
)));
3896 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3898 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3902 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3903 doc
: /* Return the value of FONT's property KEY.
3904 FONT is a font-spec, a font-entity, or a font-object. */)
3906 Lisp_Object font
, key
;
3913 idx
= get_font_prop_index (key
);
3914 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3915 return font_style_symbolic (font
, idx
, 0);
3916 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3917 return AREF (font
, idx
);
3918 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3921 #ifdef HAVE_WINDOW_SYSTEM
3923 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3924 doc
: /* Return a plist of face attributes generated by FONT.
3925 FONT is a font name, a font-spec, a font-entity, or a font-object.
3926 The return value is a list of the form
3928 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3930 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3931 compatible with `set-face-attribute'. Some of these key-attribute pairs
3932 may be omitted from the list if they are not specified by FONT.
3934 The optional argument FRAME specifies the frame that the face attributes
3935 are to be displayed on. If omitted, the selected frame is used. */)
3937 Lisp_Object font
, frame
;
3940 Lisp_Object plist
[10];
3945 frame
= selected_frame
;
3946 CHECK_LIVE_FRAME (frame
);
3951 int fontset
= fs_query_fontset (font
, 0);
3952 Lisp_Object name
= font
;
3954 font
= fontset_ascii (fontset
);
3955 font
= font_spec_from_name (name
);
3957 signal_error ("Invalid font name", name
);
3959 else if (! FONTP (font
))
3960 signal_error ("Invalid font object", font
);
3962 val
= AREF (font
, FONT_FAMILY_INDEX
);
3965 plist
[n
++] = QCfamily
;
3966 plist
[n
++] = SYMBOL_NAME (val
);
3969 val
= AREF (font
, FONT_SIZE_INDEX
);
3972 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
3973 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
3974 plist
[n
++] = QCheight
;
3975 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
3977 else if (FLOATP (val
))
3979 plist
[n
++] = QCheight
;
3980 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
3983 val
= FONT_WEIGHT_FOR_FACE (font
);
3986 plist
[n
++] = QCweight
;
3990 val
= FONT_SLANT_FOR_FACE (font
);
3993 plist
[n
++] = QCslant
;
3997 val
= FONT_WIDTH_FOR_FACE (font
);
4000 plist
[n
++] = QCwidth
;
4004 return Flist (n
, plist
);
4009 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
4010 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
4011 (font_spec
, prop
, val
)
4012 Lisp_Object font_spec
, prop
, val
;
4016 CHECK_FONT_SPEC (font_spec
);
4017 idx
= get_font_prop_index (prop
);
4018 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
4019 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
4021 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
4025 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
4026 doc
: /* List available fonts matching FONT-SPEC on the current frame.
4027 Optional 2nd argument FRAME specifies the target frame.
4028 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
4029 Optional 4th argument PREFER, if non-nil, is a font-spec to
4030 control the order of the returned list. Fonts are sorted by
4031 how close they are to PREFER. */)
4032 (font_spec
, frame
, num
, prefer
)
4033 Lisp_Object font_spec
, frame
, num
, prefer
;
4035 Lisp_Object vec
, list
, tail
;
4039 frame
= selected_frame
;
4040 CHECK_LIVE_FRAME (frame
);
4041 CHECK_FONT_SPEC (font_spec
);
4049 if (! NILP (prefer
))
4050 CHECK_FONT_SPEC (prefer
);
4052 vec
= font_list_entities (frame
, font_spec
);
4057 return Fcons (AREF (vec
, 0), Qnil
);
4059 if (! NILP (prefer
))
4060 vec
= font_sort_entites (vec
, prefer
, frame
, 0);
4062 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
4063 if (n
== 0 || n
> len
)
4065 for (i
= 1; i
< n
; i
++)
4067 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
4069 XSETCDR (tail
, val
);
4075 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4076 doc
: /* List available font families on the current frame.
4077 Optional argument FRAME, if non-nil, specifies the target frame. */)
4082 struct font_driver_list
*driver_list
;
4086 frame
= selected_frame
;
4087 CHECK_LIVE_FRAME (frame
);
4090 for (driver_list
= f
->font_driver_list
; driver_list
;
4091 driver_list
= driver_list
->next
)
4092 if (driver_list
->driver
->list_family
)
4094 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4100 Lisp_Object tail
= list
;
4102 for (; CONSP (val
); val
= XCDR (val
))
4103 if (NILP (Fmemq (XCAR (val
), tail
)))
4104 list
= Fcons (XCAR (val
), list
);
4110 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4111 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4112 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4114 Lisp_Object font_spec
, frame
;
4116 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4123 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4124 doc
: /* Return XLFD name of FONT.
4125 FONT is a font-spec, font-entity, or font-object.
4126 If the name is too long for XLFD (maximum 255 chars), return nil.
4127 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4128 the consecutive wildcards are folded to one. */)
4129 (font
, fold_wildcards
)
4130 Lisp_Object font
, fold_wildcards
;
4137 if (FONT_OBJECT_P (font
))
4139 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4141 if (STRINGP (font_name
)
4142 && SDATA (font_name
)[0] == '-')
4144 if (NILP (fold_wildcards
))
4146 strcpy (name
, (char *) SDATA (font_name
));
4149 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4151 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4154 if (! NILP (fold_wildcards
))
4156 char *p0
= name
, *p1
;
4158 while ((p1
= strstr (p0
, "-*-*")))
4160 strcpy (p1
, p1
+ 2);
4165 return build_string (name
);
4168 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4169 doc
: /* Clear font cache. */)
4172 Lisp_Object list
, frame
;
4174 FOR_EACH_FRAME (list
, frame
)
4176 FRAME_PTR f
= XFRAME (frame
);
4177 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4179 for (; driver_list
; driver_list
= driver_list
->next
)
4180 if (driver_list
->on
)
4182 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4187 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4189 font_assert (! NILP (val
));
4190 val
= XCDR (XCAR (val
));
4191 if (XINT (XCAR (val
)) == 0)
4193 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4194 XSETCDR (cache
, XCDR (val
));
4204 font_fill_lglyph_metrics (glyph
, font_object
)
4205 Lisp_Object glyph
, font_object
;
4207 struct font
*font
= XFONT_OBJECT (font_object
);
4209 /* ecode used in LGLYPH_SET_CODE to avoid compiler warnings. */
4210 EMACS_INT ecode
= font
->driver
->encode_char (font
, LGLYPH_CHAR (glyph
));
4211 struct font_metrics metrics
;
4213 LGLYPH_SET_CODE (glyph
, ecode
);
4215 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4216 LGLYPH_SET_LBEARING (glyph
, metrics
.lbearing
);
4217 LGLYPH_SET_RBEARING (glyph
, metrics
.rbearing
);
4218 LGLYPH_SET_WIDTH (glyph
, metrics
.width
);
4219 LGLYPH_SET_ASCENT (glyph
, metrics
.ascent
);
4220 LGLYPH_SET_DESCENT (glyph
, metrics
.descent
);
4224 DEFUN ("font-shape-gstring", Ffont_shape_gstring
, Sfont_shape_gstring
, 1, 1, 0,
4225 doc
: /* Shape the glyph-string GSTRING.
4226 Shaping means substituting glyphs and/or adjusting positions of glyphs
4227 to get the correct visual image of character sequences set in the
4228 header of the glyph-string.
4230 If the shaping was successful, the value is GSTRING itself or a newly
4231 created glyph-string. Otherwise, the value is nil. */)
4233 Lisp_Object gstring
;
4236 Lisp_Object font_object
, n
, glyph
;
4239 if (! composition_gstring_p (gstring
))
4240 signal_error ("Invalid glyph-string: ", gstring
);
4241 if (! NILP (LGSTRING_ID (gstring
)))
4243 font_object
= LGSTRING_FONT (gstring
);
4244 CHECK_FONT_OBJECT (font_object
);
4245 font
= XFONT_OBJECT (font_object
);
4246 if (! font
->driver
->shape
)
4249 /* Try at most three times with larger gstring each time. */
4250 for (i
= 0; i
< 3; i
++)
4252 n
= font
->driver
->shape (gstring
);
4255 gstring
= larger_vector (gstring
,
4256 ASIZE (gstring
) + LGSTRING_GLYPH_LEN (gstring
),
4259 if (i
== 3 || XINT (n
) == 0)
4262 glyph
= LGSTRING_GLYPH (gstring
, 0);
4263 from
= LGLYPH_FROM (glyph
);
4264 to
= LGLYPH_TO (glyph
);
4265 for (i
= 1, j
= 0; i
< LGSTRING_GLYPH_LEN (gstring
); i
++)
4267 Lisp_Object
this = LGSTRING_GLYPH (gstring
, i
);
4271 if (NILP (LGLYPH_ADJUSTMENT (this)))
4276 glyph
= LGSTRING_GLYPH (gstring
, j
);
4277 LGLYPH_SET_FROM (glyph
, from
);
4278 LGLYPH_SET_TO (glyph
, to
);
4280 from
= LGLYPH_FROM (this);
4281 to
= LGLYPH_TO (this);
4286 if (from
> LGLYPH_FROM (this))
4287 from
= LGLYPH_FROM (this);
4288 if (to
< LGLYPH_TO (this))
4289 to
= LGLYPH_TO (this);
4295 glyph
= LGSTRING_GLYPH (gstring
, j
);
4296 LGLYPH_SET_FROM (glyph
, from
);
4297 LGLYPH_SET_TO (glyph
, to
);
4299 return composition_gstring_put_cache (gstring
, XINT (n
));
4304 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4305 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4306 OTF-FEATURES specifies which features to apply in this format:
4307 (SCRIPT LANGSYS GSUB GPOS)
4309 SCRIPT is a symbol specifying a script tag of OpenType,
4310 LANGSYS is a symbol specifying a langsys tag of OpenType,
4311 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4313 If LANGYS is nil, the default langsys is selected.
4315 The features are applied in the order they appear in the list. The
4316 symbol `*' means to apply all available features not present in this
4317 list, and the remaining features are ignored. For instance, (vatu
4318 pstf * haln) is to apply vatu and pstf in this order, then to apply
4319 all available features other than vatu, pstf, and haln.
4321 The features are applied to the glyphs in the range FROM and TO of
4322 the glyph-string GSTRING-IN.
4324 If some feature is actually applicable, the resulting glyphs are
4325 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4326 this case, the value is the number of produced glyphs.
4328 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4331 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4332 produced in GSTRING-OUT, and the value is nil.
4334 See the documentation of `font-make-gstring' for the format of
4336 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4337 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4339 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4344 check_otf_features (otf_features
);
4345 CHECK_FONT_OBJECT (font_object
);
4346 font
= XFONT_OBJECT (font_object
);
4347 if (! font
->driver
->otf_drive
)
4348 error ("Font backend %s can't drive OpenType GSUB table",
4349 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4350 CHECK_CONS (otf_features
);
4351 CHECK_SYMBOL (XCAR (otf_features
));
4352 val
= XCDR (otf_features
);
4353 CHECK_SYMBOL (XCAR (val
));
4354 val
= XCDR (otf_features
);
4357 len
= check_gstring (gstring_in
);
4358 CHECK_VECTOR (gstring_out
);
4359 CHECK_NATNUM (from
);
4361 CHECK_NATNUM (index
);
4363 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4364 args_out_of_range_3 (from
, to
, make_number (len
));
4365 if (XINT (index
) >= ASIZE (gstring_out
))
4366 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4367 num
= font
->driver
->otf_drive (font
, otf_features
,
4368 gstring_in
, XINT (from
), XINT (to
),
4369 gstring_out
, XINT (index
), 0);
4372 return make_number (num
);
4375 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4377 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4378 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4380 (SCRIPT LANGSYS FEATURE ...)
4381 See the documentation of `font-drive-otf' for more detail.
4383 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4384 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4385 character code corresponding to the glyph or nil if there's no
4386 corresponding character. */)
4387 (font_object
, character
, otf_features
)
4388 Lisp_Object font_object
, character
, otf_features
;
4391 Lisp_Object gstring_in
, gstring_out
, g
;
4392 Lisp_Object alternates
;
4395 CHECK_FONT_GET_OBJECT (font_object
, font
);
4396 if (! font
->driver
->otf_drive
)
4397 error ("Font backend %s can't drive OpenType GSUB table",
4398 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4399 CHECK_CHARACTER (character
);
4400 CHECK_CONS (otf_features
);
4402 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4403 g
= LGSTRING_GLYPH (gstring_in
, 0);
4404 LGLYPH_SET_CHAR (g
, XINT (character
));
4405 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4406 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4407 gstring_out
, 0, 1)) < 0)
4408 gstring_out
= Ffont_make_gstring (font_object
,
4409 make_number (ASIZE (gstring_out
) * 2));
4411 for (i
= 0; i
< num
; i
++)
4413 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4414 int c
= LGLYPH_CHAR (g
);
4415 unsigned code
= LGLYPH_CODE (g
);
4417 alternates
= Fcons (Fcons (make_number (code
),
4418 c
> 0 ? make_number (c
) : Qnil
),
4421 return Fnreverse (alternates
);
4427 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4428 doc
: /* Open FONT-ENTITY. */)
4429 (font_entity
, size
, frame
)
4430 Lisp_Object font_entity
;
4436 CHECK_FONT_ENTITY (font_entity
);
4438 frame
= selected_frame
;
4439 CHECK_LIVE_FRAME (frame
);
4442 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4445 CHECK_NUMBER_OR_FLOAT (size
);
4447 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
4449 isize
= XINT (size
);
4453 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4456 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4457 doc
: /* Close FONT-OBJECT. */)
4458 (font_object
, frame
)
4459 Lisp_Object font_object
, frame
;
4461 CHECK_FONT_OBJECT (font_object
);
4463 frame
= selected_frame
;
4464 CHECK_LIVE_FRAME (frame
);
4465 font_close_object (XFRAME (frame
), font_object
);
4469 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4470 doc
: /* Return information about FONT-OBJECT.
4471 The value is a vector:
4472 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4475 NAME is a string of the font name (or nil if the font backend doesn't
4478 FILENAME is a string of the font file (or nil if the font backend
4479 doesn't provide a file name).
4481 PIXEL-SIZE is a pixel size by which the font is opened.
4483 SIZE is a maximum advance width of the font in pixels.
4485 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4488 CAPABILITY is a list whose first element is a symbol representing the
4489 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4490 remaining elements describe the details of the font capability.
4492 If the font is OpenType font, the form of the list is
4493 \(opentype GSUB GPOS)
4494 where GSUB shows which "GSUB" features the font supports, and GPOS
4495 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4496 lists of the format:
4497 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4499 If the font is not OpenType font, currently the length of the form is
4502 SCRIPT is a symbol representing OpenType script tag.
4504 LANGSYS is a symbol representing OpenType langsys tag, or nil
4505 representing the default langsys.
4507 FEATURE is a symbol representing OpenType feature tag.
4509 If the font is not OpenType font, CAPABILITY is nil. */)
4511 Lisp_Object font_object
;
4516 CHECK_FONT_GET_OBJECT (font_object
, font
);
4518 val
= Fmake_vector (make_number (9), Qnil
);
4519 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4520 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4521 ASET (val
, 2, make_number (font
->pixel_size
));
4522 ASET (val
, 3, make_number (font
->max_width
));
4523 ASET (val
, 4, make_number (font
->ascent
));
4524 ASET (val
, 5, make_number (font
->descent
));
4525 ASET (val
, 6, make_number (font
->space_width
));
4526 ASET (val
, 7, make_number (font
->average_width
));
4527 if (font
->driver
->otf_capability
)
4528 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4532 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4533 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4534 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4535 (font_object
, string
)
4536 Lisp_Object font_object
, string
;
4542 CHECK_FONT_GET_OBJECT (font_object
, font
);
4543 CHECK_STRING (string
);
4544 len
= SCHARS (string
);
4545 vec
= Fmake_vector (make_number (len
), Qnil
);
4546 for (i
= 0; i
< len
; i
++)
4548 Lisp_Object ch
= Faref (string
, make_number (i
));
4553 struct font_metrics metrics
;
4555 cod
= code
= font
->driver
->encode_char (font
, c
);
4556 if (code
== FONT_INVALID_CODE
)
4558 val
= Fmake_vector (make_number (6), Qnil
);
4559 if (cod
<= MOST_POSITIVE_FIXNUM
)
4560 ASET (val
, 0, make_number (code
));
4562 ASET (val
, 0, Fcons (make_number (code
>> 16),
4563 make_number (code
& 0xFFFF)));
4564 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4565 ASET (val
, 1, make_number (metrics
.lbearing
));
4566 ASET (val
, 2, make_number (metrics
.rbearing
));
4567 ASET (val
, 3, make_number (metrics
.width
));
4568 ASET (val
, 4, make_number (metrics
.ascent
));
4569 ASET (val
, 5, make_number (metrics
.descent
));
4575 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4576 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4577 FONT is a font-spec, font-entity, or font-object. */)
4579 Lisp_Object spec
, font
;
4581 CHECK_FONT_SPEC (spec
);
4584 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4587 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4588 doc
: /* Return a font-object for displaying a character at POSITION.
4589 Optional second arg WINDOW, if non-nil, is a window displaying
4590 the current buffer. It defaults to the currently selected window. */)
4591 (position
, window
, string
)
4592 Lisp_Object position
, window
, string
;
4599 CHECK_NUMBER_COERCE_MARKER (position
);
4600 pos
= XINT (position
);
4601 if (pos
< BEGV
|| pos
>= ZV
)
4602 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4606 CHECK_NUMBER (position
);
4607 CHECK_STRING (string
);
4608 pos
= XINT (position
);
4609 if (pos
< 0 || pos
>= SCHARS (string
))
4610 args_out_of_range (string
, position
);
4613 window
= selected_window
;
4614 CHECK_LIVE_WINDOW (window
);
4615 w
= XWINDOW (window
);
4617 return font_at (-1, pos
, NULL
, w
, string
);
4621 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4622 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4623 The value is a number of glyphs drawn.
4624 Type C-l to recover what previously shown. */)
4625 (font_object
, string
)
4626 Lisp_Object font_object
, string
;
4628 Lisp_Object frame
= selected_frame
;
4629 FRAME_PTR f
= XFRAME (frame
);
4635 CHECK_FONT_GET_OBJECT (font_object
, font
);
4636 CHECK_STRING (string
);
4637 len
= SCHARS (string
);
4638 code
= alloca (sizeof (unsigned) * len
);
4639 for (i
= 0; i
< len
; i
++)
4641 Lisp_Object ch
= Faref (string
, make_number (i
));
4645 code
[i
] = font
->driver
->encode_char (font
, c
);
4646 if (code
[i
] == FONT_INVALID_CODE
)
4649 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4651 if (font
->driver
->prepare_face
)
4652 font
->driver
->prepare_face (f
, face
);
4653 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4654 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4655 if (font
->driver
->done_face
)
4656 font
->driver
->done_face (f
, face
);
4658 return make_number (len
);
4662 #endif /* FONT_DEBUG */
4664 #ifdef HAVE_WINDOW_SYSTEM
4666 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4667 doc
: /* Return information about a font named NAME on frame FRAME.
4668 If FRAME is omitted or nil, use the selected frame.
4669 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4670 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4672 OPENED-NAME is the name used for opening the font,
4673 FULL-NAME is the full name of the font,
4674 SIZE is the maximum bound width of the font,
4675 HEIGHT is the height of the font,
4676 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4677 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4678 how to compose characters.
4679 If the named font is not yet loaded, return nil. */)
4681 Lisp_Object name
, frame
;
4686 Lisp_Object font_object
;
4688 (*check_window_system_func
) ();
4691 CHECK_STRING (name
);
4693 frame
= selected_frame
;
4694 CHECK_LIVE_FRAME (frame
);
4699 int fontset
= fs_query_fontset (name
, 0);
4702 name
= fontset_ascii (fontset
);
4703 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4705 else if (FONT_OBJECT_P (name
))
4707 else if (FONT_ENTITY_P (name
))
4708 font_object
= font_open_entity (f
, name
, 0);
4711 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4712 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4714 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4716 if (NILP (font_object
))
4718 font
= XFONT_OBJECT (font_object
);
4720 info
= Fmake_vector (make_number (7), Qnil
);
4721 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4722 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4723 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4724 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4725 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4726 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4727 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4730 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4731 close it now. Perhaps, we should manage font-objects
4732 by `reference-count'. */
4733 font_close_object (f
, font_object
);
4740 #define BUILD_STYLE_TABLE(TBL) \
4741 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4744 build_style_table (entry
, nelement
)
4745 struct table_entry
*entry
;
4749 Lisp_Object table
, elt
;
4751 table
= Fmake_vector (make_number (nelement
), Qnil
);
4752 for (i
= 0; i
< nelement
; i
++)
4754 for (j
= 0; entry
[i
].names
[j
]; j
++);
4755 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4756 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4757 for (j
= 0; entry
[i
].names
[j
]; j
++)
4758 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4759 ASET (table
, i
, elt
);
4764 static Lisp_Object Vfont_log
;
4765 static int font_log_env_checked
;
4767 /* The deferred font-log data of the form [ACTION ARG RESULT].
4768 If ACTION is not nil, that is added to the log when font_add_log is
4769 called next time. At that time, ACTION is set back to nil. */
4770 static Lisp_Object Vfont_log_deferred
;
4772 /* Prepend the font-related logging data in Vfont_log if it is not
4773 `t'. ACTION describes a kind of font-related action (e.g. listing,
4774 opening), ARG is the argument for the action, and RESULT is the
4775 result of the action. */
4777 font_add_log (action
, arg
, result
)
4779 Lisp_Object arg
, result
;
4781 Lisp_Object tail
, val
;
4784 if (! font_log_env_checked
)
4786 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
4787 font_log_env_checked
= 1;
4789 if (EQ (Vfont_log
, Qt
))
4791 if (STRINGP (AREF (Vfont_log_deferred
, 0)))
4793 char *str
= (char *) SDATA (AREF (Vfont_log_deferred
, 0));
4795 ASET (Vfont_log_deferred
, 0, Qnil
);
4796 font_add_log (str
, AREF (Vfont_log_deferred
, 1),
4797 AREF (Vfont_log_deferred
, 2));
4802 Lisp_Object tail
, elt
;
4803 Lisp_Object equalstr
= build_string ("=");
4805 val
= Ffont_xlfd_name (arg
, Qt
);
4806 for (tail
= AREF (arg
, FONT_EXTRA_INDEX
); CONSP (tail
);
4810 if (EQ (XCAR (elt
), QCscript
))
4811 val
= concat3 (val
, SYMBOL_NAME (QCscript
),
4812 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4813 else if (EQ (XCAR (elt
), QClang
))
4814 val
= concat3 (val
, SYMBOL_NAME (QClang
),
4815 concat2 (equalstr
, SYMBOL_NAME (XCDR (elt
))));
4816 else if (EQ (XCAR (elt
), QCotf
) && CONSP (XCDR (elt
)))
4817 val
= concat3 (val
, SYMBOL_NAME (QCotf
),
4819 SYMBOL_NAME (XCAR (XCDR (elt
)))));
4825 val
= Ffont_xlfd_name (result
, Qt
);
4826 if (! FONT_SPEC_P (result
))
4827 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4828 build_string (":"), val
);
4831 else if (CONSP (result
))
4833 result
= Fcopy_sequence (result
);
4834 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4838 val
= Ffont_xlfd_name (val
, Qt
);
4839 XSETCAR (tail
, val
);
4842 else if (VECTORP (result
))
4844 result
= Fcopy_sequence (result
);
4845 for (i
= 0; i
< ASIZE (result
); i
++)
4847 val
= AREF (result
, i
);
4849 val
= Ffont_xlfd_name (val
, Qt
);
4850 ASET (result
, i
, val
);
4853 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4856 /* Record a font-related logging data to be added to Vfont_log when
4857 font_add_log is called next time. ACTION, ARG, RESULT are the same
4861 font_deferred_log (action
, arg
, result
)
4863 Lisp_Object arg
, result
;
4865 ASET (Vfont_log_deferred
, 0, build_string (action
));
4866 ASET (Vfont_log_deferred
, 1, arg
);
4867 ASET (Vfont_log_deferred
, 2, result
);
4870 extern void syms_of_ftfont
P_ (());
4871 extern void syms_of_xfont
P_ (());
4872 extern void syms_of_xftfont
P_ (());
4873 extern void syms_of_ftxfont
P_ (());
4874 extern void syms_of_bdffont
P_ (());
4875 extern void syms_of_w32font
P_ (());
4876 extern void syms_of_atmfont
P_ (());
4877 extern void syms_of_nsfont
P_ (());
4882 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
4883 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
4884 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
4885 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
4886 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
4887 /* Note that the other elements in sort_shift_bits are not used. */
4889 staticpro (&font_charset_alist
);
4890 font_charset_alist
= Qnil
;
4892 DEFSYM (Qfont_spec
, "font-spec");
4893 DEFSYM (Qfont_entity
, "font-entity");
4894 DEFSYM (Qfont_object
, "font-object");
4896 DEFSYM (Qopentype
, "opentype");
4898 DEFSYM (Qascii_0
, "ascii-0");
4899 DEFSYM (Qiso8859_1
, "iso8859-1");
4900 DEFSYM (Qiso10646_1
, "iso10646-1");
4901 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4902 DEFSYM (Qunicode_sip
, "unicode-sip");
4906 DEFSYM (QCotf
, ":otf");
4907 DEFSYM (QClang
, ":lang");
4908 DEFSYM (QCscript
, ":script");
4909 DEFSYM (QCantialias
, ":antialias");
4911 DEFSYM (QCfoundry
, ":foundry");
4912 DEFSYM (QCadstyle
, ":adstyle");
4913 DEFSYM (QCregistry
, ":registry");
4914 DEFSYM (QCspacing
, ":spacing");
4915 DEFSYM (QCdpi
, ":dpi");
4916 DEFSYM (QCscalable
, ":scalable");
4917 DEFSYM (QCavgwidth
, ":avgwidth");
4918 DEFSYM (QCfont_entity
, ":font-entity");
4919 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
4926 staticpro (&null_vector
);
4927 null_vector
= Fmake_vector (make_number (0), Qnil
);
4929 staticpro (&scratch_font_spec
);
4930 scratch_font_spec
= Ffont_spec (0, NULL
);
4931 staticpro (&scratch_font_prefer
);
4932 scratch_font_prefer
= Ffont_spec (0, NULL
);
4934 staticpro (&Vfont_log_deferred
);
4935 Vfont_log_deferred
= Fmake_vector (make_number (3), Qnil
);
4939 staticpro (&otf_list
);
4941 #endif /* HAVE_LIBOTF */
4945 defsubr (&Sfont_spec
);
4946 defsubr (&Sfont_get
);
4947 #ifdef HAVE_WINDOW_SYSTEM
4948 defsubr (&Sfont_face_attributes
);
4950 defsubr (&Sfont_put
);
4951 defsubr (&Slist_fonts
);
4952 defsubr (&Sfont_family_list
);
4953 defsubr (&Sfind_font
);
4954 defsubr (&Sfont_xlfd_name
);
4955 defsubr (&Sclear_font_cache
);
4956 defsubr (&Sfont_shape_gstring
);
4958 defsubr (&Sfont_drive_otf
);
4959 defsubr (&Sfont_otf_alternates
);
4963 defsubr (&Sopen_font
);
4964 defsubr (&Sclose_font
);
4965 defsubr (&Squery_font
);
4966 defsubr (&Sget_font_glyphs
);
4967 defsubr (&Sfont_match_p
);
4968 defsubr (&Sfont_at
);
4970 defsubr (&Sdraw_string
);
4972 #endif /* FONT_DEBUG */
4973 #ifdef HAVE_WINDOW_SYSTEM
4974 defsubr (&Sfont_info
);
4977 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
4979 Alist of fontname patterns vs the corresponding encoding and repertory info.
4980 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
4981 where ENCODING is a charset or a char-table,
4982 and REPERTORY is a charset, a char-table, or nil.
4984 If ENCODING and REPERTORY are the same, the element can have the form
4985 \(REGEXP . ENCODING).
4987 ENCODING is for converting a character to a glyph code of the font.
4988 If ENCODING is a charset, encoding a character by the charset gives
4989 the corresponding glyph code. If ENCODING is a char-table, looking up
4990 the table by a character gives the corresponding glyph code.
4992 REPERTORY specifies a repertory of characters supported by the font.
4993 If REPERTORY is a charset, all characters beloging to the charset are
4994 supported. If REPERTORY is a char-table, all characters who have a
4995 non-nil value in the table are supported. If REPERTORY is nil, Emacs
4996 gets the repertory information by an opened font and ENCODING. */);
4997 Vfont_encoding_alist
= Qnil
;
4999 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5000 doc
: /* Vector of valid font weight values.
5001 Each element has the form:
5002 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5003 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5004 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5006 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5007 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5008 See `font-weight-table' for the format of the vector. */);
5009 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5011 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5012 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5013 See `font-weight-table' for the format of the vector. */);
5014 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5016 staticpro (&font_style_table
);
5017 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5018 ASET (font_style_table
, 0, Vfont_weight_table
);
5019 ASET (font_style_table
, 1, Vfont_slant_table
);
5020 ASET (font_style_table
, 2, Vfont_width_table
);
5022 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5023 *Logging list of font related actions and results.
5024 The value t means to suppress the logging.
5025 The initial value is set to nil if the environment variable
5026 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5029 #ifdef HAVE_WINDOW_SYSTEM
5030 #ifdef HAVE_FREETYPE
5032 #ifdef HAVE_X_WINDOWS
5037 #endif /* HAVE_XFT */
5038 #endif /* HAVE_X_WINDOWS */
5039 #else /* not HAVE_FREETYPE */
5040 #ifdef HAVE_X_WINDOWS
5042 #endif /* HAVE_X_WINDOWS */
5043 #endif /* not HAVE_FREETYPE */
5046 #endif /* HAVE_BDFFONT */
5049 #endif /* WINDOWSNT */
5052 #endif /* HAVE_NS */
5053 #endif /* HAVE_WINDOW_SYSTEM */
5056 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5057 (do not change this comment) */