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
;
55 Lisp_Object Qopentype
;
57 /* Important character set strings. */
58 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
60 /* Special vector of zero length. This is repeatedly used by (struct
61 font_driver *)->list when a specified font is not found. */
62 static Lisp_Object null_vector
;
64 static Lisp_Object Vfont_weight_table
, Vfont_slant_table
, Vfont_width_table
;
66 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
67 static Lisp_Object font_style_table
;
69 /* Structure used for tables mapping weight, slant, and width numeric
70 values and their names. */
75 /* The first one is a valid name as a face attribute.
76 The second one (if any) is a typical name in XLFD field. */
81 /* Table of weight numeric values and their names. This table must be
82 sorted by numeric values in ascending order. */
84 static struct table_entry weight_table
[] =
87 { 20, { "ultra-light", "ultralight" }},
88 { 40, { "extra-light", "extralight" }},
90 { 75, { "semi-light", "semilight", "demilight", "book" }},
91 { 100, { "normal", "medium", "regular" }},
92 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
94 { 205, { "extra-bold", "extrabold" }},
95 { 210, { "ultra-bold", "ultrabold", "black" }}
98 /* Table of slant numeric values and their names. This table must be
99 sorted by numeric values in ascending order. */
101 static struct table_entry slant_table
[] =
103 { 0, { "reverse-oblique", "ro" }},
104 { 10, { "reverse-italic", "ri" }},
105 { 100, { "normal", "r" }},
106 { 200, { "italic" ,"i", "ot" }},
107 { 210, { "oblique", "o" }}
110 /* Table of width numeric values and their names. This table must be
111 sorted by numeric values in ascending order. */
113 static struct table_entry width_table
[] =
115 { 50, { "ultra-condensed", "ultracondensed" }},
116 { 63, { "extra-condensed", "extracondensed" }},
117 { 75, { "condensed", "compressed", "narrow" }},
118 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
119 { 100, { "normal", "medium", "regular" }},
120 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
121 { 125, { "expanded" }},
122 { 150, { "extra-expanded", "extraexpanded" }},
123 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
126 extern Lisp_Object Qnormal
;
128 /* Symbols representing keys of normal font properties. */
129 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
;
130 extern Lisp_Object QCheight
, QCsize
, QCname
;
132 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
;
133 /* Symbols representing keys of font extra info. */
134 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
135 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
136 /* Symbols representing values of font spacing property. */
137 Lisp_Object Qc
, Qm
, Qp
, Qd
;
139 Lisp_Object Vfont_encoding_alist
;
141 /* Alist of font registry symbol and the corresponding charsets
142 information. The information is retrieved from
143 Vfont_encoding_alist on demand.
145 Eash element has the form:
146 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
150 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
151 encodes a character code to a glyph code of a font, and
152 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
153 character is supported by a font.
155 The latter form means that the information for REGISTRY couldn't be
157 static Lisp_Object font_charset_alist
;
159 /* List of all font drivers. Each font-backend (XXXfont.c) calls
160 register_font_driver in syms_of_XXXfont to register its font-driver
162 static struct font_driver_list
*font_driver_list
;
166 /* Creaters of font-related Lisp object. */
171 Lisp_Object font_spec
;
172 struct font_spec
*spec
173 = ((struct font_spec
*)
174 allocate_pseudovector (VECSIZE (struct font_spec
),
175 FONT_SPEC_MAX
, PVEC_FONT
));
176 XSETFONT (font_spec
, spec
);
183 Lisp_Object font_entity
;
184 struct font_entity
*entity
185 = ((struct font_entity
*)
186 allocate_pseudovector (VECSIZE (struct font_entity
),
187 FONT_ENTITY_MAX
, PVEC_FONT
));
188 XSETFONT (font_entity
, entity
);
192 /* Create a font-object whose structure size is SIZE. If ENTITY is
193 not nil, copy properties from ENTITY to the font-object. If
194 PIXELSIZE is positive, set the `size' property to PIXELSIZE. */
196 font_make_object (size
, entity
, pixelsize
)
201 Lisp_Object font_object
;
203 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
206 XSETFONT (font_object
, font
);
210 for (i
= 1; i
< FONT_SPEC_MAX
; i
++)
211 font
->props
[i
] = AREF (entity
, i
);
212 if (! NILP (AREF (entity
, FONT_EXTRA_INDEX
)))
213 font
->props
[FONT_EXTRA_INDEX
]
214 = Fcopy_sequence (AREF (entity
, FONT_EXTRA_INDEX
));
217 font
->props
[FONT_SIZE_INDEX
] = make_number (pixelsize
);
223 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
224 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
225 static Lisp_Object font_matching_entity
P_ ((FRAME_PTR
, Lisp_Object
*,
228 /* Number of registered font drivers. */
229 static int num_font_drivers
;
232 /* Return a Lispy value of a font property value at STR and LEN bytes.
233 If STR is "*", it returns nil.
234 If FORCE_SYMBOL is zero and all characters in STR are digits, it
235 returns an integer. Otherwise, it returns a symbol interned from
239 font_intern_prop (str
, len
, force_symbol
)
248 if (len
== 1 && *str
== '*')
250 if (!force_symbol
&& len
>=1 && isdigit (*str
))
252 for (i
= 1; i
< len
; i
++)
253 if (! isdigit (str
[i
]))
256 return make_number (atoi (str
));
259 /* The following code is copied from the function intern (in lread.c). */
261 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
262 obarray
= check_obarray (obarray
);
263 tem
= oblookup (obarray
, str
, len
, len
);
266 return Fintern (make_unibyte_string (str
, len
), obarray
);
269 /* Return a pixel size of font-spec SPEC on frame F. */
272 font_pixel_size (f
, spec
)
276 #ifdef HAVE_WINDOW_SYSTEM
277 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
286 font_assert (FLOATP (size
));
287 point_size
= XFLOAT_DATA (size
);
288 val
= AREF (spec
, FONT_DPI_INDEX
);
293 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
301 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
302 font vector. If VAL is not valid (i.e. not registered in
303 font_style_table), return -1 if NOERROR is zero, and return a
304 proper index if NOERROR is nonzero. In that case, register VAL in
305 font_style_table if VAL is a symbol, and return a closest index if
306 VAL is an integer. */
309 font_style_to_value (prop
, val
, noerror
)
310 enum font_property_index prop
;
314 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
315 int len
= ASIZE (table
);
321 Lisp_Object args
[2], elt
;
323 /* At first try exact match. */
324 for (i
= 0; i
< len
; i
++)
325 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
326 if (EQ (val
, AREF (AREF (table
, i
), j
)))
327 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
328 | (i
<< 4) | (j
- 1));
329 /* Try also with case-folding match. */
330 s
= SDATA (SYMBOL_NAME (val
));
331 for (i
= 0; i
< len
; i
++)
332 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
334 elt
= AREF (AREF (table
, i
), j
);
335 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
336 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
337 | (i
<< 4) | (j
- 1));
343 elt
= Fmake_vector (make_number (2), make_number (255));
346 args
[1] = Fmake_vector (make_number (1), elt
);
347 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
348 return (255 << 8) | (i
<< 4);
353 int numeric
= XINT (val
);
355 for (i
= 0, last_n
= -1; i
< len
; i
++)
357 int n
= XINT (AREF (AREF (table
, i
), 0));
360 return (n
<< 8) | (i
<< 4);
365 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
366 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
372 return ((last_n
<< 8) | ((i
- 1) << 4));
377 font_style_symbolic (font
, prop
, for_face
)
379 enum font_property_index prop
;
382 Lisp_Object val
= AREF (font
, prop
);
383 Lisp_Object table
, elt
;
388 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
389 i
= XINT (val
) & 0xFF;
390 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
391 elt
= AREF (table
, ((i
>> 4) & 0xF));
392 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
393 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
396 extern Lisp_Object Vface_alternative_font_family_alist
;
398 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
401 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
402 FONTNAME. ENCODING is a charset symbol that specifies the encoding
403 of the font. REPERTORY is a charset symbol or nil. */
406 find_font_encoding (fontname
)
407 Lisp_Object fontname
;
409 Lisp_Object tail
, elt
;
411 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
415 && STRINGP (XCAR (elt
))
416 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
417 && (SYMBOLP (XCDR (elt
))
418 ? CHARSETP (XCDR (elt
))
419 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
422 /* We don't know the encoding of this font. Let's assume `ascii'. */
426 /* Return encoding charset and repertory charset for REGISTRY in
427 ENCODING and REPERTORY correspondingly. If correct information for
428 REGISTRY is available, return 0. Otherwise return -1. */
431 font_registry_charsets (registry
, encoding
, repertory
)
432 Lisp_Object registry
;
433 struct charset
**encoding
, **repertory
;
436 int encoding_id
, repertory_id
;
438 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
444 encoding_id
= XINT (XCAR (val
));
445 repertory_id
= XINT (XCDR (val
));
449 val
= find_font_encoding (SYMBOL_NAME (registry
));
450 if (SYMBOLP (val
) && CHARSETP (val
))
452 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
454 else if (CONSP (val
))
456 if (! CHARSETP (XCAR (val
)))
458 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
459 if (NILP (XCDR (val
)))
463 if (! CHARSETP (XCDR (val
)))
465 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
470 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
472 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
476 *encoding
= CHARSET_FROM_ID (encoding_id
);
478 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
483 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
488 /* Font property value validaters. See the comment of
489 font_property_table for the meaning of the arguments. */
491 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
492 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
493 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
494 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
495 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
496 static int get_font_prop_index
P_ ((Lisp_Object
));
499 font_prop_validate_symbol (prop
, val
)
500 Lisp_Object prop
, val
;
503 val
= Fintern (val
, Qnil
);
506 else if (EQ (prop
, QCregistry
))
507 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
513 font_prop_validate_style (style
, val
)
514 Lisp_Object style
, val
;
516 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
517 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
524 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
528 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
530 if ((n
& 0xF) + 1 >= ASIZE (elt
))
532 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
536 else if (SYMBOLP (val
))
538 int n
= font_style_to_value (prop
, val
, 0);
540 val
= n
>= 0 ? make_number (n
) : Qerror
;
548 font_prop_validate_non_neg (prop
, val
)
549 Lisp_Object prop
, val
;
551 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
556 font_prop_validate_spacing (prop
, val
)
557 Lisp_Object prop
, val
;
559 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
561 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
563 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
565 if (spacing
== 'c' || spacing
== 'C')
566 return make_number (FONT_SPACING_CHARCELL
);
567 if (spacing
== 'm' || spacing
== 'M')
568 return make_number (FONT_SPACING_MONO
);
569 if (spacing
== 'p' || spacing
== 'P')
570 return make_number (FONT_SPACING_PROPORTIONAL
);
571 if (spacing
== 'd' || spacing
== 'D')
572 return make_number (FONT_SPACING_DUAL
);
578 font_prop_validate_otf (prop
, val
)
579 Lisp_Object prop
, val
;
581 Lisp_Object tail
, tmp
;
584 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
585 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
586 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
589 if (! SYMBOLP (XCAR (val
)))
594 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
596 for (i
= 0; i
< 2; i
++)
603 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
604 if (! SYMBOLP (XCAR (tmp
)))
612 /* Structure of known font property keys and validater of the
616 /* Pointer to the key symbol. */
618 /* Function to validate PROP's value VAL, or NULL if any value is
619 ok. The value is VAL or its regularized value if VAL is valid,
620 and Qerror if not. */
621 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
622 } font_property_table
[] =
623 { { &QCtype
, font_prop_validate_symbol
},
624 { &QCfoundry
, font_prop_validate_symbol
},
625 { &QCfamily
, font_prop_validate_symbol
},
626 { &QCadstyle
, font_prop_validate_symbol
},
627 { &QCregistry
, font_prop_validate_symbol
},
628 { &QCweight
, font_prop_validate_style
},
629 { &QCslant
, font_prop_validate_style
},
630 { &QCwidth
, font_prop_validate_style
},
631 { &QCsize
, font_prop_validate_non_neg
},
632 { &QCdpi
, font_prop_validate_non_neg
},
633 { &QCspacing
, font_prop_validate_spacing
},
634 { &QCavgwidth
, font_prop_validate_non_neg
},
635 /* The order of the above entries must match with enum
636 font_property_index. */
637 { &QClang
, font_prop_validate_symbol
},
638 { &QCscript
, font_prop_validate_symbol
},
639 { &QCotf
, font_prop_validate_otf
}
642 /* Size (number of elements) of the above table. */
643 #define FONT_PROPERTY_TABLE_SIZE \
644 ((sizeof font_property_table) / (sizeof *font_property_table))
646 /* Return an index number of font property KEY or -1 if KEY is not an
647 already known property. */
650 get_font_prop_index (key
)
655 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
656 if (EQ (key
, *font_property_table
[i
].key
))
661 /* Validate the font property. The property key is specified by the
662 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
663 signal an error. The value is VAL or the regularized one. */
666 font_prop_validate (idx
, prop
, val
)
668 Lisp_Object prop
, val
;
670 Lisp_Object validated
;
675 prop
= *font_property_table
[idx
].key
;
678 idx
= get_font_prop_index (prop
);
682 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
683 if (EQ (validated
, Qerror
))
684 signal_error ("invalid font property", Fcons (prop
, val
));
689 /* Store VAL as a value of extra font property PROP in FONT while
690 keeping the sorting order. Don't check the validity of VAL. */
693 font_put_extra (font
, prop
, val
)
694 Lisp_Object font
, prop
, val
;
696 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
697 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
701 Lisp_Object prev
= Qnil
;
704 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
705 prev
= extra
, extra
= XCDR (extra
);
707 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
709 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
717 /* Font name parser and unparser */
719 static int parse_matrix
P_ ((char *));
720 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
721 static int font_parse_name
P_ ((char *, Lisp_Object
));
723 /* An enumerator for each field of an XLFD font name. */
724 enum xlfd_field_index
743 /* An enumerator for mask bit corresponding to each XLFD field. */
746 XLFD_FOUNDRY_MASK
= 0x0001,
747 XLFD_FAMILY_MASK
= 0x0002,
748 XLFD_WEIGHT_MASK
= 0x0004,
749 XLFD_SLANT_MASK
= 0x0008,
750 XLFD_SWIDTH_MASK
= 0x0010,
751 XLFD_ADSTYLE_MASK
= 0x0020,
752 XLFD_PIXEL_MASK
= 0x0040,
753 XLFD_POINT_MASK
= 0x0080,
754 XLFD_RESX_MASK
= 0x0100,
755 XLFD_RESY_MASK
= 0x0200,
756 XLFD_SPACING_MASK
= 0x0400,
757 XLFD_AVGWIDTH_MASK
= 0x0800,
758 XLFD_REGISTRY_MASK
= 0x1000,
759 XLFD_ENCODING_MASK
= 0x2000
763 /* Parse P pointing the pixel/point size field of the form
764 `[A B C D]' which specifies a transformation matrix:
770 by which all glyphs of the font are transformed. The spec says
771 that scalar value N for the pixel/point size is equivalent to:
772 A = N * resx/resy, B = C = 0, D = N.
774 Return the scalar value N if the form is valid. Otherwise return
785 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
788 matrix
[i
] = - strtod (p
+ 1, &end
);
790 matrix
[i
] = strtod (p
, &end
);
793 return (i
== 4 ? (int) matrix
[3] : -1);
796 /* Expand a wildcard field in FIELD (the first N fields are filled) to
797 multiple fields to fill in all 14 XLFD fields while restring a
798 field position by its contents. */
801 font_expand_wildcards (field
, n
)
802 Lisp_Object field
[XLFD_LAST_INDEX
];
806 Lisp_Object tmp
[XLFD_LAST_INDEX
];
807 /* Array of information about where this element can go. Nth
808 element is for Nth element of FIELD. */
810 /* Minimum possible field. */
812 /* Maxinum possible field. */
814 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
816 } range
[XLFD_LAST_INDEX
];
818 int range_from
, range_to
;
821 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
822 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
823 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
824 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
825 | XLFD_AVGWIDTH_MASK)
826 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
828 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
829 field. The value is shifted to left one bit by one in the
831 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
832 range_mask
= (range_mask
<< 1) | 1;
834 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
835 position-based retriction for FIELD[I]. */
836 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
837 i
++, range_from
++, range_to
++, range_mask
<<= 1)
839 Lisp_Object val
= field
[i
];
845 range
[i
].from
= range_from
;
846 range
[i
].to
= range_to
;
847 range
[i
].mask
= range_mask
;
851 /* The triplet FROM, TO, and MASK is a value-based
852 retriction for FIELD[I]. */
858 int numeric
= XINT (val
);
861 from
= to
= XLFD_ENCODING_INDEX
,
862 mask
= XLFD_ENCODING_MASK
;
863 else if (numeric
== 0)
864 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
865 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
866 else if (numeric
<= 48)
867 from
= to
= XLFD_PIXEL_INDEX
,
868 mask
= XLFD_PIXEL_MASK
;
870 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
871 mask
= XLFD_LARGENUM_MASK
;
873 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
874 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
875 mask
= XLFD_NULL_MASK
;
877 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
880 Lisp_Object name
= SYMBOL_NAME (val
);
882 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
883 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
884 mask
= XLFD_REGENC_MASK
;
886 from
= to
= XLFD_ENCODING_INDEX
,
887 mask
= XLFD_ENCODING_MASK
;
889 else if (range_from
<= XLFD_WEIGHT_INDEX
890 && range_to
>= XLFD_WEIGHT_INDEX
891 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
892 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
893 else if (range_from
<= XLFD_SLANT_INDEX
894 && range_to
>= XLFD_SLANT_INDEX
895 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
896 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
897 else if (range_from
<= XLFD_SWIDTH_INDEX
898 && range_to
>= XLFD_SWIDTH_INDEX
899 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
900 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
903 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
904 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
906 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
907 mask
= XLFD_SYMBOL_MASK
;
910 /* Merge position-based and value-based restrictions. */
912 while (from
< range_from
)
913 mask
&= ~(1 << from
++);
914 while (from
< 14 && ! (mask
& (1 << from
)))
916 while (to
> range_to
)
917 mask
&= ~(1 << to
--);
918 while (to
>= 0 && ! (mask
& (1 << to
)))
922 range
[i
].from
= from
;
924 range
[i
].mask
= mask
;
926 if (from
> range_from
|| to
< range_to
)
928 /* The range is narrowed by value-based restrictions.
929 Reflect it to the other fields. */
931 /* Following fields should be after FROM. */
933 /* Preceding fields should be before TO. */
934 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
936 /* Check FROM for non-wildcard field. */
937 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
939 while (range
[j
].from
< from
)
940 range
[j
].mask
&= ~(1 << range
[j
].from
++);
941 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
943 range
[j
].from
= from
;
946 from
= range
[j
].from
;
947 if (range
[j
].to
> to
)
949 while (range
[j
].to
> to
)
950 range
[j
].mask
&= ~(1 << range
[j
].to
--);
951 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
964 /* Decide all fileds from restrictions in RANGE. */
965 for (i
= j
= 0; i
< n
; i
++)
967 if (j
< range
[i
].from
)
969 if (i
== 0 || ! NILP (tmp
[i
- 1]))
970 /* None of TMP[X] corresponds to Jth field. */
972 for (; j
< range
[i
].from
; j
++)
977 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
979 for (; j
< XLFD_LAST_INDEX
; j
++)
981 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
982 field
[XLFD_ENCODING_INDEX
]
983 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
988 #ifdef ENABLE_CHECKING
989 /* Match a 14-field XLFD pattern against a full XLFD font name. */
991 font_match_xlfd (char *pattern
, char *name
)
993 while (*pattern
&& *name
)
995 if (*pattern
== *name
)
997 else if (*pattern
== '*')
998 if (*name
== pattern
[1])
1009 /* Make sure the font object matches the XLFD font name. */
1011 font_check_xlfd_parse (Lisp_Object font
, char *name
)
1013 char name_check
[256];
1014 font_unparse_xlfd (font
, 0, name_check
, 255);
1015 return font_match_xlfd (name_check
, name
);
1021 /* Parse NAME (null terminated) as XLFD and store information in FONT
1022 (font-spec or font-entity). Size property of FONT is set as
1024 specified XLFD fields FONT property
1025 --------------------- -------------
1026 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1027 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1028 POINT_SIZE POINT_SIZE/10 (Lisp float)
1030 If NAME is successfully parsed, return 0. Otherwise return -1.
1032 FONT is usually a font-spec, but when this function is called from
1033 X font backend driver, it is a font-entity. In that case, NAME is
1034 a fully specified XLFD. */
1037 font_parse_xlfd (name
, font
)
1041 int len
= strlen (name
);
1043 char *f
[XLFD_LAST_INDEX
+ 1];
1048 /* Maximum XLFD name length is 255. */
1050 /* Accept "*-.." as a fully specified XLFD. */
1051 if (name
[0] == '*' && name
[1] == '-')
1052 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1055 for (p
= name
+ i
; *p
; p
++)
1059 if (i
== XLFD_LAST_INDEX
)
1064 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1065 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1067 if (i
== XLFD_LAST_INDEX
)
1069 /* Fully specified XLFD. */
1072 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1073 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1074 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1075 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1077 val
= INTERN_FIELD_SYM (i
);
1080 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1082 ASET (font
, j
, make_number (n
));
1085 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1086 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1087 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1089 ASET (font
, FONT_REGISTRY_INDEX
,
1090 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1091 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1093 p
= f
[XLFD_PIXEL_INDEX
];
1094 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1095 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1098 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1100 ASET (font
, FONT_SIZE_INDEX
, val
);
1103 double point_size
= -1;
1105 font_assert (FONT_SPEC_P (font
));
1106 p
= f
[XLFD_POINT_INDEX
];
1108 point_size
= parse_matrix (p
);
1109 else if (isdigit (*p
))
1110 point_size
= atoi (p
), point_size
/= 10;
1111 if (point_size
>= 0)
1112 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1116 ASET (font
, FONT_DPI_INDEX
, INTERN_FIELD (XLFD_RESY_INDEX
));
1117 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1120 val
= font_prop_validate_spacing (QCspacing
, val
);
1121 if (! INTEGERP (val
))
1123 ASET (font
, FONT_SPACING_INDEX
, val
);
1125 p
= f
[XLFD_AVGWIDTH_INDEX
];
1128 ASET (font
, FONT_AVGWIDTH_INDEX
,
1129 font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0));
1133 int wild_card_found
= 0;
1134 Lisp_Object prop
[XLFD_LAST_INDEX
];
1136 if (FONT_ENTITY_P (font
))
1138 for (j
= 0; j
< i
; j
++)
1142 if (f
[j
][1] && f
[j
][1] != '-')
1145 wild_card_found
= 1;
1148 prop
[j
] = INTERN_FIELD (j
);
1150 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1152 if (! wild_card_found
)
1154 if (font_expand_wildcards (prop
, i
) < 0)
1157 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1158 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1159 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1160 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1161 if (! NILP (prop
[i
]))
1163 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1165 ASET (font
, j
, make_number (n
));
1167 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1168 val
= prop
[XLFD_REGISTRY_INDEX
];
1171 val
= prop
[XLFD_ENCODING_INDEX
];
1173 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1175 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1176 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1178 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1179 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1181 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1183 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1184 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1185 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1187 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1189 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1192 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1193 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1194 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1196 val
= font_prop_validate_spacing (QCspacing
,
1197 prop
[XLFD_SPACING_INDEX
]);
1198 if (! INTEGERP (val
))
1200 ASET (font
, FONT_SPACING_INDEX
, val
);
1202 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1203 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1209 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1210 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1211 0, use PIXEL_SIZE instead. */
1214 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1220 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1224 font_assert (FONTP (font
));
1226 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1229 if (i
== FONT_ADSTYLE_INDEX
)
1230 j
= XLFD_ADSTYLE_INDEX
;
1231 else if (i
== FONT_REGISTRY_INDEX
)
1232 j
= XLFD_REGISTRY_INDEX
;
1233 val
= AREF (font
, i
);
1236 if (j
== XLFD_REGISTRY_INDEX
)
1237 f
[j
] = "*-*", len
+= 4;
1239 f
[j
] = "*", len
+= 2;
1244 val
= SYMBOL_NAME (val
);
1245 if (j
== XLFD_REGISTRY_INDEX
1246 && ! strchr ((char *) SDATA (val
), '-'))
1248 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1249 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1251 f
[j
] = alloca (SBYTES (val
) + 3);
1252 sprintf (f
[j
], "%s-*", SDATA (val
));
1253 len
+= SBYTES (val
) + 3;
1257 f
[j
] = alloca (SBYTES (val
) + 4);
1258 sprintf (f
[j
], "%s*-*", SDATA (val
));
1259 len
+= SBYTES (val
) + 4;
1263 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1267 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1270 val
= font_style_symbolic (font
, i
, 0);
1272 f
[j
] = "*", len
+= 2;
1275 val
= SYMBOL_NAME (val
);
1276 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1280 val
= AREF (font
, FONT_SIZE_INDEX
);
1281 font_assert (NUMBERP (val
) || NILP (val
));
1289 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1290 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1293 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1295 else if (FLOATP (val
))
1297 i
= XFLOAT_DATA (val
) * 10;
1298 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1299 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1302 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1304 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1306 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1307 f
[XLFD_RESX_INDEX
] = alloca (22);
1308 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1312 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1313 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1315 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1317 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1318 : spacing
<= FONT_SPACING_DUAL
? "d"
1319 : spacing
<= FONT_SPACING_MONO
? "m"
1324 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1325 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1327 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1328 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
],
1329 "%d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1332 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1333 len
++; /* for terminating '\0'. */
1336 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1337 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1338 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1339 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1340 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1341 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1342 f
[XLFD_REGISTRY_INDEX
]);
1345 /* Parse NAME (null terminated) and store information in FONT
1346 (font-spec or font-entity). NAME is supplied in either the
1347 Fontconfig or GTK font name format. If NAME is successfully
1348 parsed, return 0. Otherwise return -1.
1350 The fontconfig format is
1352 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1356 FAMILY [PROPS...] [SIZE]
1358 This function tries to guess which format it is. */
1361 font_parse_fcname (name
, font
)
1366 char *size_beg
= NULL
, *size_end
= NULL
;
1367 char *props_beg
= NULL
, *family_end
= NULL
;
1368 int len
= strlen (name
);
1373 for (p
= name
; *p
; p
++)
1375 if (*p
== '\\' && p
[1])
1379 props_beg
= family_end
= p
;
1384 int decimal
= 0, size_found
= 1;
1385 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1388 if (*q
!= '.' || decimal
)
1407 /* A fontconfig name with size and/or property data. */
1408 if (family_end
> name
)
1411 family
= font_intern_prop (name
, family_end
- name
, 1);
1412 ASET (font
, FONT_FAMILY_INDEX
, family
);
1416 double point_size
= strtod (size_beg
, &size_end
);
1417 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1418 if (*size_end
== ':' && size_end
[1])
1419 props_beg
= size_end
;
1423 /* Now parse ":KEY=VAL" patterns. */
1426 for (p
= props_beg
; *p
; p
= q
)
1428 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1431 /* Must be an enumerated value. */
1435 val
= font_intern_prop (p
, q
- p
, 1);
1437 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1439 if (PROP_MATCH ("light", 5)
1440 || PROP_MATCH ("medium", 6)
1441 || PROP_MATCH ("demibold", 8)
1442 || PROP_MATCH ("bold", 4)
1443 || PROP_MATCH ("black", 5))
1444 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1445 else if (PROP_MATCH ("roman", 5)
1446 || PROP_MATCH ("italic", 6)
1447 || PROP_MATCH ("oblique", 7))
1448 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1449 else if (PROP_MATCH ("charcell", 8))
1450 ASET (font
, FONT_SPACING_INDEX
,
1451 make_number (FONT_SPACING_CHARCELL
));
1452 else if (PROP_MATCH ("mono", 4))
1453 ASET (font
, FONT_SPACING_INDEX
,
1454 make_number (FONT_SPACING_MONO
));
1455 else if (PROP_MATCH ("proportional", 12))
1456 ASET (font
, FONT_SPACING_INDEX
,
1457 make_number (FONT_SPACING_PROPORTIONAL
));
1466 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1467 prop
= FONT_SIZE_INDEX
;
1470 key
= font_intern_prop (p
, q
- p
, 1);
1471 prop
= get_font_prop_index (key
);
1475 for (q
= p
; *q
&& *q
!= ':'; q
++);
1476 val
= font_intern_prop (p
, q
- p
, 0);
1478 if (prop
>= FONT_FOUNDRY_INDEX
1479 && prop
< FONT_EXTRA_INDEX
)
1480 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1482 Ffont_put (font
, key
, val
);
1490 /* Either a fontconfig-style name with no size and property
1491 data, or a GTK-style name. */
1493 int word_len
, prop_found
= 0;
1495 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1501 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1509 double point_size
= strtod (p
, &q
);
1510 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1515 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1516 if (*q
== '\\' && q
[1])
1520 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1522 if (PROP_MATCH ("Ultra-Light", 11))
1525 prop
= font_intern_prop ("ultra-light", 11, 1);
1526 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1528 else if (PROP_MATCH ("Light", 5))
1531 prop
= font_intern_prop ("light", 5, 1);
1532 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1534 else if (PROP_MATCH ("Semi-Bold", 9))
1537 prop
= font_intern_prop ("semi-bold", 9, 1);
1538 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1540 else if (PROP_MATCH ("Bold", 4))
1543 prop
= font_intern_prop ("bold", 4, 1);
1544 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1546 else if (PROP_MATCH ("Italic", 6))
1549 prop
= font_intern_prop ("italic", 4, 1);
1550 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1552 else if (PROP_MATCH ("Oblique", 7))
1555 prop
= font_intern_prop ("oblique", 7, 1);
1556 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1560 return -1; /* Unknown property in GTK-style font name. */
1569 family
= font_intern_prop (name
, family_end
- name
, 1);
1570 ASET (font
, FONT_FAMILY_INDEX
, family
);
1577 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1578 NAME (NBYTES length), and return the name length. If
1579 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1582 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1588 Lisp_Object family
, foundry
;
1589 Lisp_Object tail
, val
;
1594 Lisp_Object styles
[3];
1595 char *style_names
[3] = { "weight", "slant", "width" };
1598 family
= AREF (font
, FONT_FAMILY_INDEX
);
1599 if (! NILP (family
))
1601 if (SYMBOLP (family
))
1603 family
= SYMBOL_NAME (family
);
1604 len
+= SBYTES (family
);
1610 val
= AREF (font
, FONT_SIZE_INDEX
);
1613 if (XINT (val
) != 0)
1614 pixel_size
= XINT (val
);
1616 len
+= 21; /* for ":pixelsize=NUM" */
1618 else if (FLOATP (val
))
1621 point_size
= (int) XFLOAT_DATA (val
);
1622 len
+= 11; /* for "-NUM" */
1625 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1626 if (! NILP (foundry
))
1628 if (SYMBOLP (foundry
))
1630 foundry
= SYMBOL_NAME (foundry
);
1631 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1637 for (i
= 0; i
< 3; i
++)
1639 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1640 if (! NILP (styles
[i
]))
1641 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1642 SDATA (SYMBOL_NAME (styles
[i
])));
1645 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1646 len
+= sprintf (work
, ":dpi=%d", dpi
);
1647 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1648 len
+= strlen (":spacing=100");
1649 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1650 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1651 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1653 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1655 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1657 len
+= SBYTES (val
);
1658 else if (INTEGERP (val
))
1659 len
+= sprintf (work
, "%d", XINT (val
));
1660 else if (SYMBOLP (val
))
1661 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1667 if (! NILP (family
))
1668 p
+= sprintf (p
, "%s", SDATA (family
));
1672 p
+= sprintf (p
, "%d", point_size
);
1674 p
+= sprintf (p
, "-%d", point_size
);
1676 else if (pixel_size
> 0)
1677 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1678 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1679 p
+= sprintf (p
, ":foundry=%s",
1680 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1681 for (i
= 0; i
< 3; i
++)
1682 if (! NILP (styles
[i
]))
1683 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1684 SDATA (SYMBOL_NAME (styles
[i
])));
1685 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1686 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1687 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1688 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1689 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1691 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1692 p
+= sprintf (p
, ":scalable=true");
1694 p
+= sprintf (p
, ":scalable=false");
1699 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1700 NAME (NBYTES length), and return the name length. F is the frame
1701 on which the font is displayed; it is used to calculate the point
1705 font_unparse_gtkname (font
, f
, name
, nbytes
)
1713 Lisp_Object family
, weight
, slant
, size
;
1714 int point_size
= -1;
1716 family
= AREF (font
, FONT_FAMILY_INDEX
);
1717 if (! NILP (family
))
1719 if (! SYMBOLP (family
))
1721 family
= SYMBOL_NAME (family
);
1722 len
+= SBYTES (family
);
1725 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1726 if (EQ (weight
, Qnormal
))
1728 else if (! NILP (weight
))
1730 weight
= SYMBOL_NAME (weight
);
1731 len
+= SBYTES (weight
);
1734 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1735 if (EQ (slant
, Qnormal
))
1737 else if (! NILP (slant
))
1739 slant
= SYMBOL_NAME (slant
);
1740 len
+= SBYTES (slant
);
1743 size
= AREF (font
, FONT_SIZE_INDEX
);
1744 /* Convert pixel size to point size. */
1745 if (INTEGERP (size
))
1747 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1749 if (INTEGERP (font_dpi
))
1750 dpi
= XINT (font_dpi
);
1753 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1756 else if (FLOATP (size
))
1758 point_size
= (int) XFLOAT_DATA (size
);
1765 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1767 if (! NILP (weight
))
1770 p
+= sprintf (p
, " %s", SDATA (weight
));
1771 q
[1] = toupper (q
[1]);
1777 p
+= sprintf (p
, " %s", SDATA (slant
));
1778 q
[1] = toupper (q
[1]);
1782 p
+= sprintf (p
, " %d", point_size
);
1787 /* Parse NAME (null terminated) and store information in FONT
1788 (font-spec or font-entity). If NAME is successfully parsed, return
1789 0. Otherwise return -1. */
1792 font_parse_name (name
, font
)
1796 if (name
[0] == '-' || index (name
, '*'))
1797 return font_parse_xlfd (name
, font
);
1798 return font_parse_fcname (name
, font
);
1802 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1803 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1807 font_parse_family_registry (family
, registry
, font_spec
)
1808 Lisp_Object family
, registry
, font_spec
;
1814 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1816 CHECK_STRING (family
);
1817 len
= SBYTES (family
);
1818 p0
= (char *) SDATA (family
);
1819 p1
= index (p0
, '-');
1822 if ((*p0
!= '*' || p1
- p0
> 1)
1823 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1824 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1827 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1830 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1832 if (! NILP (registry
))
1834 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1835 CHECK_STRING (registry
);
1836 len
= SBYTES (registry
);
1837 p0
= (char *) SDATA (registry
);
1838 p1
= index (p0
, '-');
1841 if (SDATA (registry
)[len
- 1] == '*')
1842 registry
= concat2 (registry
, build_string ("-*"));
1844 registry
= concat2 (registry
, build_string ("*-*"));
1846 registry
= Fdowncase (registry
);
1847 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1852 /* This part (through the next ^L) is still experimental and not
1853 tested much. We may drastically change codes. */
1859 #define LGSTRING_HEADER_SIZE 6
1860 #define LGSTRING_GLYPH_SIZE 8
1863 check_gstring (gstring
)
1864 Lisp_Object gstring
;
1869 CHECK_VECTOR (gstring
);
1870 val
= AREF (gstring
, 0);
1872 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1874 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1875 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1876 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1877 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1878 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1879 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1880 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1881 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1882 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1883 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1884 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1886 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1888 val
= LGSTRING_GLYPH (gstring
, i
);
1890 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1892 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1894 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1895 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1896 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1897 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1898 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1899 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1900 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1901 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1903 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1905 if (ASIZE (val
) < 3)
1907 for (j
= 0; j
< 3; j
++)
1908 CHECK_NUMBER (AREF (val
, j
));
1913 error ("Invalid glyph-string format");
1918 check_otf_features (otf_features
)
1919 Lisp_Object otf_features
;
1923 CHECK_CONS (otf_features
);
1924 CHECK_SYMBOL (XCAR (otf_features
));
1925 otf_features
= XCDR (otf_features
);
1926 CHECK_CONS (otf_features
);
1927 CHECK_SYMBOL (XCAR (otf_features
));
1928 otf_features
= XCDR (otf_features
);
1929 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1931 CHECK_SYMBOL (Fcar (val
));
1932 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1933 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1935 otf_features
= XCDR (otf_features
);
1936 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1938 CHECK_SYMBOL (Fcar (val
));
1939 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1940 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1947 Lisp_Object otf_list
;
1950 otf_tag_symbol (tag
)
1955 OTF_tag_name (tag
, name
);
1956 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1963 Lisp_Object val
= Fassoc (file
, otf_list
);
1967 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1970 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1971 val
= make_save_value (otf
, 0);
1972 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1978 /* Return a list describing which scripts/languages FONT supports by
1979 which GSUB/GPOS features of OpenType tables. See the comment of
1980 (struct font_driver).otf_capability. */
1983 font_otf_capability (font
)
1987 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1990 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1993 for (i
= 0; i
< 2; i
++)
1995 OTF_GSUB_GPOS
*gsub_gpos
;
1996 Lisp_Object script_list
= Qnil
;
1999 if (OTF_get_features (otf
, i
== 0) < 0)
2001 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2002 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2004 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2005 Lisp_Object langsys_list
= Qnil
;
2006 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2009 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2011 OTF_LangSys
*langsys
;
2012 Lisp_Object feature_list
= Qnil
;
2013 Lisp_Object langsys_tag
;
2016 if (k
== script
->LangSysCount
)
2018 langsys
= &script
->DefaultLangSys
;
2023 langsys
= script
->LangSys
+ k
;
2025 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2027 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2029 OTF_Feature
*feature
2030 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2031 Lisp_Object feature_tag
2032 = otf_tag_symbol (feature
->FeatureTag
);
2034 feature_list
= Fcons (feature_tag
, feature_list
);
2036 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2039 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2044 XSETCAR (capability
, script_list
);
2046 XSETCDR (capability
, script_list
);
2052 /* Parse OTF features in SPEC and write a proper features spec string
2053 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2054 assured that the sufficient memory has already allocated for
2058 generate_otf_features (spec
, features
)
2068 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2074 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2079 else if (! asterisk
)
2081 val
= SYMBOL_NAME (val
);
2082 p
+= sprintf (p
, "%s", SDATA (val
));
2086 val
= SYMBOL_NAME (val
);
2087 p
+= sprintf (p
, "~%s", SDATA (val
));
2091 error ("OTF spec too long");
2095 font_otf_DeviceTable (device_table
)
2096 OTF_DeviceTable
*device_table
;
2098 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2100 return Fcons (make_number (len
),
2101 make_unibyte_string (device_table
->DeltaValue
, len
));
2105 font_otf_ValueRecord (value_format
, value_record
)
2107 OTF_ValueRecord
*value_record
;
2109 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2111 if (value_format
& OTF_XPlacement
)
2112 ASET (val
, 0, make_number (value_record
->XPlacement
));
2113 if (value_format
& OTF_YPlacement
)
2114 ASET (val
, 1, make_number (value_record
->YPlacement
));
2115 if (value_format
& OTF_XAdvance
)
2116 ASET (val
, 2, make_number (value_record
->XAdvance
));
2117 if (value_format
& OTF_YAdvance
)
2118 ASET (val
, 3, make_number (value_record
->YAdvance
));
2119 if (value_format
& OTF_XPlaDevice
)
2120 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2121 if (value_format
& OTF_YPlaDevice
)
2122 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2123 if (value_format
& OTF_XAdvDevice
)
2124 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2125 if (value_format
& OTF_YAdvDevice
)
2126 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2131 font_otf_Anchor (anchor
)
2136 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2137 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2138 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2139 if (anchor
->AnchorFormat
== 2)
2140 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2143 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2144 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2148 #endif /* HAVE_LIBOTF */
2151 /* G-string (glyph string) handler */
2153 /* G-string is a vector of the form [HEADER GLYPH ...].
2154 See the docstring of `font-make-gstring' for more detail. */
2157 font_prepare_composition (cmp
, f
)
2158 struct composition
*cmp
;
2162 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
2163 cmp
->hash_index
* 2);
2165 cmp
->font
= XFONT_OBJECT (LGSTRING_FONT (gstring
));
2166 cmp
->glyph_len
= LGSTRING_LENGTH (gstring
);
2167 cmp
->pixel_width
= LGSTRING_WIDTH (gstring
);
2168 cmp
->lbearing
= LGSTRING_LBEARING (gstring
);
2169 cmp
->rbearing
= LGSTRING_RBEARING (gstring
);
2170 cmp
->ascent
= LGSTRING_ASCENT (gstring
);
2171 cmp
->descent
= LGSTRING_DESCENT (gstring
);
2172 cmp
->width
= cmp
->pixel_width
/ FRAME_COLUMN_WIDTH (f
);
2173 if (cmp
->width
== 0)
2182 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2183 static int font_compare
P_ ((const void *, const void *));
2184 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
2187 /* We sort fonts by scoring each of them against a specified
2188 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2189 the value is, the closer the font is to the font-spec.
2191 The lowest 2 bits of the score is used for driver type. The font
2192 available by the most preferred font driver is 0.
2194 Each 7-bit in the higher 28 bits are used for numeric properties
2195 WEIGHT, SLANT, WIDTH, and SIZE. */
2197 /* How many bits to shift to store the difference value of each font
2198 property in a score. Note that flots for FONT_TYPE_INDEX and
2199 FONT_REGISTRY_INDEX are not used. */
2200 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2202 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2203 The return value indicates how different ENTITY is compared with
2207 font_score (entity
, spec_prop
)
2208 Lisp_Object entity
, *spec_prop
;
2213 /* Score three style numeric fields. Maximum difference is 127. */
2214 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2215 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2217 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2222 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2225 /* Score the size. Maximum difference is 127. */
2226 i
= FONT_SIZE_INDEX
;
2227 if (! NILP (spec_prop
[i
]) && XINT (AREF (entity
, i
)) > 0)
2229 /* We use the higher 6-bit for the actual size difference. The
2230 lowest bit is set if the DPI is different. */
2231 int diff
= XINT (spec_prop
[i
]) - XINT (AREF (entity
, i
));
2236 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2237 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2239 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2246 /* The comparison function for qsort. */
2249 font_compare (d1
, d2
)
2250 const void *d1
, *d2
;
2252 return (*(unsigned *) d1
- *(unsigned *) d2
);
2256 /* The structure for elements being sorted by qsort. */
2257 struct font_sort_data
2264 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2265 If PREFER specifies a point-size, calculate the corresponding
2266 pixel-size from QCdpi property of PREFER or from the Y-resolution
2267 of FRAME before sorting.
2269 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2270 return the sorted VEC. */
2273 font_sort_entites (vec
, prefer
, frame
, best_only
)
2274 Lisp_Object vec
, prefer
, frame
;
2277 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2279 struct font_sort_data
*data
;
2280 unsigned best_score
;
2281 Lisp_Object best_entity
, driver_type
;
2283 struct frame
*f
= XFRAME (frame
);
2284 struct font_driver_list
*list
;
2289 return best_only
? AREF (vec
, 0) : vec
;
2291 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_DPI_INDEX
; i
++)
2292 prefer_prop
[i
] = AREF (prefer
, i
);
2293 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2294 prefer_prop
[FONT_SIZE_INDEX
]
2295 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2297 /* Scoring and sorting. */
2298 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2299 best_score
= 0xFFFFFFFF;
2300 /* We are sure that the length of VEC > 1. */
2301 driver_type
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2302 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2303 driver_order
++, list
= list
->next
)
2304 if (EQ (driver_type
, list
->driver
->type
))
2306 best_entity
= data
[0].entity
= AREF (vec
, 0);
2307 best_score
= data
[0].score
2308 = font_score (data
[0].entity
, prefer_prop
) | driver_order
;
2309 for (i
= 0; i
< len
; i
++)
2311 if (!EQ (driver_type
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2312 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2313 driver_order
++, list
= list
->next
)
2314 if (EQ (driver_type
, list
->driver
->type
))
2316 data
[i
].entity
= AREF (vec
, i
);
2317 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
) | driver_order
;
2318 if (best_only
&& best_score
> data
[i
].score
)
2320 best_score
= data
[i
].score
;
2321 best_entity
= data
[i
].entity
;
2322 if (best_score
== 0)
2328 qsort (data
, len
, sizeof *data
, font_compare
);
2329 for (i
= 0; i
< len
; i
++)
2330 ASET (vec
, i
, data
[i
].entity
);
2336 font_add_log ("sort-by", prefer
, vec
);
2341 /* API of Font Service Layer. */
2343 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2344 sort_shift_bits. Finternal_set_font_selection_order calls this
2345 function with font_sort_order after setting up it. */
2348 font_update_sort_order (order
)
2353 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2355 int xlfd_idx
= order
[i
];
2357 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2358 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2359 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2360 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2361 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2362 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2364 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2369 font_check_otf_features (script
, langsys
, features
, table
)
2370 Lisp_Object script
, langsys
, features
, table
;
2375 table
= assq_no_quit (script
, table
);
2378 table
= XCDR (table
);
2379 if (! NILP (langsys
))
2381 table
= assq_no_quit (langsys
, table
);
2387 val
= assq_no_quit (Qnil
, table
);
2389 table
= XCAR (table
);
2393 table
= XCDR (table
);
2394 for (negative
= 0; CONSP (features
); features
= XCDR (features
))
2396 if (NILP (XCAR (features
)))
2398 if (NILP (Fmemq (XCAR (features
), table
)) != negative
)
2404 /* Check if OTF_CAPABILITY satisfies SPEC (otf-spec). */
2407 font_check_otf (spec
, otf_capability
)
2409 Lisp_Object script
, langsys
= Qnil
, gsub
= Qnil
, gpos
= Qnil
;
2411 script
= XCAR (spec
);
2415 langsys
= XCAR (spec
);
2426 if (! NILP (gsub
) && ! font_check_otf_features (script
, langsys
, gsub
,
2427 XCAR (otf_capability
)))
2429 if (! NILP (gpos
) && ! font_check_otf_features (script
, langsys
, gpos
,
2430 XCDR (otf_capability
)))
2437 /* Check if FONT (font-entity or font-object) matches with the font
2438 specification SPEC. */
2441 font_match_p (spec
, font
)
2442 Lisp_Object spec
, font
;
2444 Lisp_Object prop
[FONT_SPEC_MAX
], *props
;
2445 Lisp_Object extra
, font_extra
;
2448 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2449 if (! NILP (AREF (spec
, i
))
2450 && ! NILP (AREF (font
, i
))
2451 && ! EQ (AREF (spec
, i
), AREF (font
, i
)))
2453 props
= XFONT_SPEC (spec
)->props
;
2454 if (FLOATP (props
[FONT_SIZE_INDEX
]))
2456 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2457 prop
[i
] = AREF (spec
, i
);
2458 prop
[FONT_SIZE_INDEX
]
2459 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2463 if (font_score (font
, props
) > 0)
2465 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
2466 font_extra
= AREF (font
, FONT_EXTRA_INDEX
);
2467 for (; CONSP (extra
); extra
= XCDR (extra
))
2469 Lisp_Object key
= XCAR (XCAR (extra
));
2470 Lisp_Object val
= XCDR (XCAR (extra
)), val2
;
2472 if (EQ (key
, QClang
))
2474 val2
= assq_no_quit (key
, font_extra
);
2483 if (NILP (Fmemq (val
, val2
)))
2488 ? NILP (Fmemq (val
, XCDR (val2
)))
2492 else if (EQ (key
, QCscript
))
2494 val2
= assq_no_quit (val
, Vscript_representative_chars
);
2496 for (val2
= XCDR (val2
); CONSP (val2
); val2
= XCDR (val2
))
2497 if (font_encode_char (font
, XINT (XCAR (val2
)))
2498 == FONT_INVALID_CODE
)
2501 else if (EQ (key
, QCotf
))
2505 if (! FONT_OBJECT_P (font
))
2507 fontp
= XFONT_OBJECT (font
);
2508 if (! fontp
->driver
->otf_capability
)
2510 val2
= fontp
->driver
->otf_capability (fontp
);
2511 if (NILP (val2
) || ! font_check_otf (val
, val2
))
2522 Each font backend has the callback function get_cache, and it
2523 returns a cons cell of which cdr part can be freely used for
2524 caching fonts. The cons cell may be shared by multiple frames
2525 and/or multiple font drivers. So, we arrange the cdr part as this:
2527 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2529 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2530 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2531 cons (FONT-SPEC FONT-ENTITY ...). */
2533 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2534 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2535 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2536 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2537 struct font_driver
*));
2540 font_prepare_cache (f
, driver
)
2542 struct font_driver
*driver
;
2544 Lisp_Object cache
, val
;
2546 cache
= driver
->get_cache (f
);
2548 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2552 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2553 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2557 val
= XCDR (XCAR (val
));
2558 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2564 font_finish_cache (f
, driver
)
2566 struct font_driver
*driver
;
2568 Lisp_Object cache
, val
, tmp
;
2571 cache
= driver
->get_cache (f
);
2573 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2574 cache
= val
, val
= XCDR (val
);
2575 font_assert (! NILP (val
));
2576 tmp
= XCDR (XCAR (val
));
2577 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2578 if (XINT (XCAR (tmp
)) == 0)
2580 font_clear_cache (f
, XCAR (val
), driver
);
2581 XSETCDR (cache
, XCDR (val
));
2587 font_get_cache (f
, driver
)
2589 struct font_driver
*driver
;
2591 Lisp_Object val
= driver
->get_cache (f
);
2592 Lisp_Object type
= driver
->type
;
2594 font_assert (CONSP (val
));
2595 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2596 font_assert (CONSP (val
));
2597 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2598 val
= XCDR (XCAR (val
));
2602 static int num_fonts
;
2605 font_clear_cache (f
, cache
, driver
)
2608 struct font_driver
*driver
;
2610 Lisp_Object tail
, elt
;
2612 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2613 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2616 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)) && VECTORP (XCDR (elt
)))
2618 Lisp_Object vec
= XCDR (elt
);
2621 for (i
= 0; i
< ASIZE (vec
); i
++)
2623 Lisp_Object entity
= AREF (vec
, i
);
2625 if (EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2627 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2629 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2631 Lisp_Object val
= XCAR (objlist
);
2632 struct font
*font
= XFONT_OBJECT (val
);
2634 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2636 font_assert (font
&& driver
== font
->driver
);
2637 driver
->close (f
, font
);
2641 if (driver
->free_entity
)
2642 driver
->free_entity (entity
);
2647 XSETCDR (cache
, Qnil
);
2651 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2654 font_delete_unmatched (list
, spec
, size
)
2655 Lisp_Object list
, spec
;
2658 Lisp_Object entity
, val
;
2659 enum font_property_index prop
;
2661 for (val
= Qnil
; CONSP (list
); list
= XCDR (list
))
2663 entity
= XCAR (list
);
2664 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2665 if (INTEGERP (AREF (spec
, prop
))
2666 && ((XINT (AREF (spec
, prop
)) >> 8)
2667 != (XINT (AREF (entity
, prop
)) >> 8)))
2668 prop
= FONT_SPEC_MAX
;
2669 if (prop
< FONT_SPEC_MAX
2671 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2673 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2676 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2677 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2678 prop
= FONT_SPEC_MAX
;
2680 if (prop
< FONT_SPEC_MAX
2681 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2682 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2683 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2684 prop
= FONT_SPEC_MAX
;
2685 if (prop
< FONT_SPEC_MAX
2686 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2687 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2688 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2689 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2690 prop
= FONT_SPEC_MAX
;
2691 if (prop
< FONT_SPEC_MAX
)
2692 val
= Fcons (entity
, val
);
2698 /* Return a vector of font-entities matching with SPEC on FRAME. */
2701 font_list_entities (frame
, spec
)
2702 Lisp_Object frame
, spec
;
2704 FRAME_PTR f
= XFRAME (frame
);
2705 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2706 Lisp_Object ftype
, val
;
2709 int need_filtering
= 0;
2712 font_assert (FONT_SPEC_P (spec
));
2714 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2715 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2716 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2717 size
= font_pixel_size (f
, spec
);
2721 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2722 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2723 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2724 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2726 ASET (scratch_font_spec
, i
, Qnil
);
2727 if (! NILP (AREF (spec
, i
)))
2729 if (i
== FONT_DPI_INDEX
)
2730 /* Skip FONT_SPACING_INDEX */
2733 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2734 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2736 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2740 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2742 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2744 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2746 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2747 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2754 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2755 copy
= Fcopy_font_spec (scratch_font_spec
);
2756 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2757 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2759 if (! NILP (val
) && need_filtering
)
2760 val
= font_delete_unmatched (val
, spec
, size
);
2765 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2766 font_add_log ("list", spec
, val
);
2771 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2772 nil, is an array of face's attributes, which specifies preferred
2773 font-related attributes. */
2776 font_matching_entity (f
, attrs
, spec
)
2778 Lisp_Object
*attrs
, spec
;
2780 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2781 Lisp_Object ftype
, size
, entity
;
2784 XSETFRAME (frame
, f
);
2785 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2786 size
= AREF (spec
, FONT_SIZE_INDEX
);
2788 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2790 for (; driver_list
; driver_list
= driver_list
->next
)
2792 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2794 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2797 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2798 entity
= assoc_no_quit (spec
, XCDR (cache
));
2800 entity
= XCDR (entity
);
2803 entity
= driver_list
->driver
->match (frame
, spec
);
2804 copy
= Fcopy_font_spec (spec
);
2805 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2806 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2808 if (! NILP (entity
))
2811 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2812 ASET (spec
, FONT_SIZE_INDEX
, size
);
2813 font_add_log ("match", spec
, entity
);
2818 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2819 opened font object. */
2822 font_open_entity (f
, entity
, pixel_size
)
2827 struct font_driver_list
*driver_list
;
2828 Lisp_Object objlist
, size
, val
, font_object
;
2830 int min_width
, height
;
2832 font_assert (FONT_ENTITY_P (entity
));
2833 size
= AREF (entity
, FONT_SIZE_INDEX
);
2834 if (XINT (size
) != 0)
2835 pixel_size
= XINT (size
);
2837 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2838 objlist
= XCDR (objlist
))
2839 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2840 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2841 return XCAR (objlist
);
2843 val
= AREF (entity
, FONT_TYPE_INDEX
);
2844 for (driver_list
= f
->font_driver_list
;
2845 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2846 driver_list
= driver_list
->next
);
2850 font_object
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2851 if (STRINGP (AREF (font_object
, FONT_FULLNAME_INDEX
))
2852 && STRINGP (Vvertical_centering_font_regexp
))
2853 XFONT_OBJECT (font_object
)->vertical_centering
2854 = (fast_string_match_ignore_case
2855 (Vvertical_centering_font_regexp
,
2856 (AREF (font_object
, FONT_FULLNAME_INDEX
))) >= 0);
2857 font_add_log ("open", entity
, font_object
);
2858 if (NILP (font_object
))
2860 ASET (entity
, FONT_OBJLIST_INDEX
,
2861 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2862 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
2865 font
= XFONT_OBJECT (font_object
);
2866 min_width
= (font
->min_width
? font
->min_width
2867 : font
->average_width
? font
->average_width
2868 : font
->space_width
? font
->space_width
2870 height
= (font
->height
? font
->height
: 1);
2871 #ifdef HAVE_WINDOW_SYSTEM
2872 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2873 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2875 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2876 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2877 fonts_changed_p
= 1;
2881 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2882 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2883 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2884 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2892 /* Close FONT_OBJECT that is opened on frame F. */
2895 font_close_object (f
, font_object
)
2897 Lisp_Object font_object
;
2899 struct font
*font
= XFONT_OBJECT (font_object
);
2901 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2902 /* Already closed. */
2904 font_add_log ("close", font_object
, Qnil
);
2905 font
->driver
->close (f
, font
);
2906 #ifdef HAVE_WINDOW_SYSTEM
2907 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2908 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2914 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2915 FONT is a font-entity and it must be opened to check. */
2918 font_has_char (f
, font
, c
)
2925 if (FONT_ENTITY_P (font
))
2927 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2928 struct font_driver_list
*driver_list
;
2930 for (driver_list
= f
->font_driver_list
;
2931 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2932 driver_list
= driver_list
->next
);
2935 if (! driver_list
->driver
->has_char
)
2937 return driver_list
->driver
->has_char (font
, c
);
2940 font_assert (FONT_OBJECT_P (font
));
2941 fontp
= XFONT_OBJECT (font
);
2942 if (fontp
->driver
->has_char
)
2944 int result
= fontp
->driver
->has_char (font
, c
);
2949 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2953 /* Return the glyph ID of FONT_OBJECT for character C. */
2956 font_encode_char (font_object
, c
)
2957 Lisp_Object font_object
;
2962 font_assert (FONT_OBJECT_P (font_object
));
2963 font
= XFONT_OBJECT (font_object
);
2964 return font
->driver
->encode_char (font
, c
);
2968 /* Return the name of FONT_OBJECT. */
2971 font_get_name (font_object
)
2972 Lisp_Object font_object
;
2974 font_assert (FONT_OBJECT_P (font_object
));
2975 return AREF (font_object
, FONT_NAME_INDEX
);
2979 /* Return the specification of FONT_OBJECT. */
2982 font_get_spec (font_object
)
2983 Lisp_Object font_object
;
2985 Lisp_Object spec
= font_make_spec ();
2988 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2989 ASET (spec
, i
, AREF (font_object
, i
));
2990 ASET (spec
, FONT_SIZE_INDEX
,
2991 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2996 font_spec_from_name (font_name
)
2997 Lisp_Object font_name
;
2999 Lisp_Object args
[2];
3002 args
[1] = font_name
;
3003 return Ffont_spec (2, args
);
3008 font_clear_prop (attrs
, prop
)
3010 enum font_property_index prop
;
3012 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3016 if (NILP (AREF (font
, prop
))
3017 && prop
!= FONT_FAMILY_INDEX
&& prop
!= FONT_FOUNDRY_INDEX
3018 && prop
!= FONT_SIZE_INDEX
)
3020 font
= Fcopy_font_spec (font
);
3021 ASET (font
, prop
, Qnil
);
3022 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3024 if (prop
== FONT_FAMILY_INDEX
)
3025 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3026 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3027 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3028 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3029 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3030 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3031 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3033 else if (prop
== FONT_SIZE_INDEX
)
3035 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3036 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3037 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3039 attrs
[LFACE_FONT_INDEX
] = font
;
3043 font_update_lface (f
, attrs
)
3049 spec
= attrs
[LFACE_FONT_INDEX
];
3050 if (! FONT_SPEC_P (spec
))
3053 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3054 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3055 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3056 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3057 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3058 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3059 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3060 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);;
3061 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3062 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3063 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3067 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3072 val
= Ffont_get (spec
, QCdpi
);
3075 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3078 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3079 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3080 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3085 /* Return a font-entity satisfying SPEC and best matching with face's
3086 font related attributes in ATTRS. C, if not negative, is a
3087 character that the entity must support. */
3090 font_find_for_lface (f
, attrs
, spec
, c
)
3097 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
3098 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3100 int i
, j
, k
, l
, result
;
3102 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3103 if (NILP (registry
[0]))
3105 registry
[0] = Qiso8859_1
;
3106 registry
[1] = Qascii_0
;
3107 registry
[2] = null_vector
;
3110 registry
[1] = null_vector
;
3112 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3114 struct charset
*encoding
, *repertory
;
3116 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3117 &encoding
, &repertory
) < 0)
3121 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3123 /* Any font of this registry support C. So, let's
3124 suppress the further checking. */
3127 else if (c
> encoding
->max_char
)
3131 work
= Fcopy_font_spec (spec
);
3132 XSETFRAME (frame
, f
);
3133 size
= AREF (spec
, FONT_SIZE_INDEX
);
3134 pixel_size
= font_pixel_size (f
, spec
);
3135 if (pixel_size
== 0)
3137 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3139 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3141 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3142 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3143 if (! NILP (foundry
[0]))
3144 foundry
[1] = null_vector
;
3145 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3147 foundry
[0] = font_intern_prop (SDATA (attrs
[LFACE_FOUNDRY_INDEX
]),
3148 SBYTES (attrs
[LFACE_FOUNDRY_INDEX
]), 1);
3150 foundry
[2] = null_vector
;
3153 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3155 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3156 if (! NILP (adstyle
[0]))
3157 adstyle
[1] = null_vector
;
3158 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3160 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3162 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3164 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3166 adstyle
[2] = null_vector
;
3169 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3172 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3175 val
= AREF (work
, FONT_FAMILY_INDEX
);
3176 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3177 val
= font_intern_prop (SDATA (attrs
[LFACE_FAMILY_INDEX
]),
3178 SBYTES (attrs
[LFACE_FAMILY_INDEX
]), 1);
3181 family
= alloca ((sizeof family
[0]) * 2);
3183 family
[1] = null_vector
; /* terminator. */
3188 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3190 if (! NILP (alters
))
3192 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3193 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3194 family
[i
] = XCAR (alters
);
3195 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3197 family
[i
] = null_vector
;
3201 family
= alloca ((sizeof family
[0]) * 3);
3204 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3206 family
[i
] = null_vector
;
3210 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3212 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3213 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3215 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3216 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3218 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3219 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3221 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3222 entities
= font_list_entities (frame
, work
);
3223 if (ASIZE (entities
) > 0)
3231 if (ASIZE (entities
) == 1)
3234 return AREF (entities
, 0);
3238 /* Sort fonts by properties specified in LFACE. */
3239 Lisp_Object prefer
= scratch_font_prefer
;
3241 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3242 ASET (prefer
, i
, AREF (work
, i
));
3243 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3245 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3247 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3248 if (NILP (AREF (prefer
, i
)))
3249 ASET (prefer
, i
, AREF (face_font
, i
));
3251 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3252 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3253 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3254 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3255 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3256 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3257 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3258 entities
= font_sort_entites (entities
, prefer
, frame
, c
< 0);
3263 for (i
= 0; i
< ASIZE (entities
); i
++)
3267 val
= AREF (entities
, i
);
3270 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3271 if (! EQ (AREF (val
, j
), props
[j
]))
3273 if (j
> FONT_REGISTRY_INDEX
)
3276 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3277 props
[j
] = AREF (val
, j
);
3278 result
= font_has_char (f
, val
, c
);
3283 val
= font_open_for_lface (f
, val
, attrs
, spec
);
3286 result
= font_has_char (f
, val
, c
);
3287 font_close_object (f
, val
);
3289 return AREF (entities
, i
);
3296 font_open_for_lface (f
, entity
, attrs
, spec
)
3304 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3305 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3306 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3307 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3308 size
= font_pixel_size (f
, spec
);
3311 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3314 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3316 return font_open_entity (f
, entity
, size
);
3320 /* Find a font satisfying SPEC and best matching with face's
3321 attributes in ATTRS on FRAME, and return the opened
3325 font_load_for_lface (f
, attrs
, spec
)
3327 Lisp_Object
*attrs
, spec
;
3331 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3334 /* No font is listed for SPEC, but each font-backend may have
3335 the different criteria about "font matching". So, try
3337 entity
= font_matching_entity (f
, attrs
, spec
);
3341 return font_open_for_lface (f
, entity
, attrs
, spec
);
3345 /* Make FACE on frame F ready to use the font opened for FACE. */
3348 font_prepare_for_face (f
, face
)
3352 if (face
->font
->driver
->prepare_face
)
3353 face
->font
->driver
->prepare_face (f
, face
);
3357 /* Make FACE on frame F stop using the font opened for FACE. */
3360 font_done_for_face (f
, face
)
3364 if (face
->font
->driver
->done_face
)
3365 face
->font
->driver
->done_face (f
, face
);
3370 /* Open a font best matching with NAME on frame F. If no proper font
3371 is found, return Qnil. */
3374 font_open_by_name (f
, name
)
3378 Lisp_Object args
[2];
3379 Lisp_Object spec
, attrs
[LFACE_VECTOR_SIZE
];
3382 args
[1] = make_unibyte_string (name
, strlen (name
));
3383 spec
= Ffont_spec (2, args
);
3384 /* We set up the default font-related attributes of a face to prefer
3386 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3387 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3388 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3389 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3390 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3392 return font_load_for_lface (f
, attrs
, spec
);
3396 /* Register font-driver DRIVER. This function is used in two ways.
3398 The first is with frame F non-NULL. In this case, make DRIVER
3399 available (but not yet activated) on F. All frame creaters
3400 (e.g. Fx_create_frame) must call this function at least once with
3401 an available font-driver.
3403 The second is with frame F NULL. In this case, DRIVER is globally
3404 registered in the variable `font_driver_list'. All font-driver
3405 implementations must call this function in its syms_of_XXXX
3406 (e.g. syms_of_xfont). */
3409 register_font_driver (driver
, f
)
3410 struct font_driver
*driver
;
3413 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3414 struct font_driver_list
*prev
, *list
;
3416 if (f
&& ! driver
->draw
)
3417 error ("Unusable font driver for a frame: %s",
3418 SDATA (SYMBOL_NAME (driver
->type
)));
3420 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3421 if (EQ (list
->driver
->type
, driver
->type
))
3422 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3424 list
= malloc (sizeof (struct font_driver_list
));
3426 list
->driver
= driver
;
3431 f
->font_driver_list
= list
;
3433 font_driver_list
= list
;
3439 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3440 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3441 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3443 A caller must free all realized faces if any in advance. The
3444 return value is a list of font backends actually made used on
3448 font_update_drivers (f
, new_drivers
)
3450 Lisp_Object new_drivers
;
3452 Lisp_Object active_drivers
= Qnil
;
3453 struct font_driver
*driver
;
3454 struct font_driver_list
*list
;
3456 /* At first, turn off non-requested drivers, and turn on requested
3458 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3460 driver
= list
->driver
;
3461 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3466 if (driver
->end_for_frame
)
3467 driver
->end_for_frame (f
);
3468 font_finish_cache (f
, driver
);
3473 if (! driver
->start_for_frame
3474 || driver
->start_for_frame (f
) == 0)
3476 font_prepare_cache (f
, driver
);
3483 if (NILP (new_drivers
))
3486 if (! EQ (new_drivers
, Qt
))
3488 /* Re-order the driver list according to new_drivers. */
3489 struct font_driver_list
**list_table
, **next
;
3493 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3494 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3496 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3497 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3500 list_table
[i
++] = list
;
3502 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3504 list_table
[i
] = list
;
3505 list_table
[i
] = NULL
;
3507 next
= &f
->font_driver_list
;
3508 for (i
= 0; list_table
[i
]; i
++)
3510 *next
= list_table
[i
];
3511 next
= &(*next
)->next
;
3516 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3518 active_drivers
= nconc2 (active_drivers
,
3519 Fcons (list
->driver
->type
, Qnil
));
3520 return active_drivers
;
3524 font_put_frame_data (f
, driver
, data
)
3526 struct font_driver
*driver
;
3529 struct font_data_list
*list
, *prev
;
3531 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3532 prev
= list
, list
= list
->next
)
3533 if (list
->driver
== driver
)
3540 prev
->next
= list
->next
;
3542 f
->font_data_list
= list
->next
;
3550 list
= malloc (sizeof (struct font_data_list
));
3553 list
->driver
= driver
;
3554 list
->next
= f
->font_data_list
;
3555 f
->font_data_list
= list
;
3563 font_get_frame_data (f
, driver
)
3565 struct font_driver
*driver
;
3567 struct font_data_list
*list
;
3569 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3570 if (list
->driver
== driver
)
3578 /* Return the font used to draw character C by FACE at buffer position
3579 POS in window W. If STRING is non-nil, it is a string containing C
3580 at index POS. If C is negative, get C from the current buffer or
3584 font_at (c
, pos
, face
, w
, string
)
3593 Lisp_Object font_object
;
3599 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3602 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3604 c
= FETCH_CHAR (pos_byte
);
3607 c
= FETCH_BYTE (pos
);
3613 multibyte
= STRING_MULTIBYTE (string
);
3616 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3618 str
= SDATA (string
) + pos_byte
;
3619 c
= STRING_CHAR (str
, 0);
3622 c
= SDATA (string
)[pos
];
3626 f
= XFRAME (w
->frame
);
3627 if (! FRAME_WINDOW_P (f
))
3634 if (STRINGP (string
))
3635 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3636 DEFAULT_FACE_ID
, 0);
3638 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3640 face
= FACE_FROM_ID (f
, face_id
);
3644 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3645 face
= FACE_FROM_ID (f
, face_id
);
3650 XSETFONT (font_object
, face
->font
);
3655 /* Check how many characters after POS (at most to LIMIT) can be
3656 displayed by the same font. FACE is the face selected for the
3657 character as POS on frame F. STRING, if not nil, is the string to
3658 check instead of the current buffer.
3660 The return value is the position of the character that is displayed
3661 by the differnt font than that of the character as POS. */
3664 font_range (pos
, limit
, face
, f
, string
)
3665 EMACS_INT pos
, limit
;
3678 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3679 pos_byte
= CHAR_TO_BYTE (pos
);
3683 multibyte
= STRING_MULTIBYTE (string
);
3684 pos_byte
= string_char_to_byte (string
, pos
);
3688 /* All unibyte character are displayed by the same font. */
3696 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3698 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3699 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3700 face
= FACE_FROM_ID (f
, face_id
);
3707 else if (font
!= face
->font
)
3719 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3720 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3721 Return nil otherwise.
3722 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3723 which kind of font it is. It must be one of `font-spec', `font-entity',
3725 (object
, extra_type
)
3726 Lisp_Object object
, extra_type
;
3728 if (NILP (extra_type
))
3729 return (FONTP (object
) ? Qt
: Qnil
);
3730 if (EQ (extra_type
, Qfont_spec
))
3731 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3732 if (EQ (extra_type
, Qfont_entity
))
3733 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3734 if (EQ (extra_type
, Qfont_object
))
3735 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3736 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3739 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3740 doc
: /* Return a newly created font-spec with arguments as properties.
3742 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3743 valid font property name listed below:
3745 `:family', `:weight', `:slant', `:width'
3747 They are the same as face attributes of the same name. See
3748 `set-face-attribute'.
3752 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3756 VALUE must be a string or a symbol specifying the additional
3757 typographic style information of a font, e.g. ``sans''.
3761 VALUE must be a string or a symbol specifying the charset registry and
3762 encoding of a font, e.g. ``iso8859-1''.
3766 VALUE must be a non-negative integer or a floating point number
3767 specifying the font size. It specifies the font size in pixels
3768 (if VALUE is an integer), or in points (if VALUE is a float).
3772 VALUE must be a string of XLFD-style or fontconfig-style font name.
3773 usage: (font-spec ARGS ...) */)
3778 Lisp_Object spec
= font_make_spec ();
3781 for (i
= 0; i
< nargs
; i
+= 2)
3783 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3785 if (EQ (key
, QCname
))
3788 font_parse_name ((char *) SDATA (val
), spec
);
3789 font_put_extra (spec
, key
, val
);
3793 int idx
= get_font_prop_index (key
);
3797 val
= font_prop_validate (idx
, Qnil
, val
);
3798 if (idx
< FONT_EXTRA_INDEX
)
3799 ASET (spec
, idx
, val
);
3801 font_put_extra (spec
, key
, val
);
3804 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3810 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3811 doc
: /* Return a copy of FONT as a font-spec. */)
3815 Lisp_Object new_spec
, tail
, prev
, extra
;
3819 new_spec
= font_make_spec ();
3820 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3821 ASET (new_spec
, i
, AREF (font
, i
));
3822 extra
= Fcopy_sequence (AREF (font
, FONT_EXTRA_INDEX
));
3823 /* We must remove :font-entity property. */
3824 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3825 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3828 extra
= XCDR (extra
);
3830 XSETCDR (prev
, XCDR (tail
));
3833 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3837 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3838 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3839 Every specified properties in FROM override the corresponding
3840 properties in TO. */)
3842 Lisp_Object from
, to
;
3844 Lisp_Object extra
, tail
;
3849 to
= Fcopy_font_spec (to
);
3850 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3851 ASET (to
, i
, AREF (from
, i
));
3852 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3853 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3854 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3856 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3859 XSETCDR (slot
, XCDR (XCAR (tail
)));
3861 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3863 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3867 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3868 doc
: /* Return the value of FONT's property KEY.
3869 FONT is a font-spec, a font-entity, or a font-object. */)
3871 Lisp_Object font
, key
;
3878 idx
= get_font_prop_index (key
);
3879 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3880 return font_style_symbolic (font
, idx
, 0);
3881 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3882 return AREF (font
, idx
);
3883 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3886 #ifdef HAVE_WINDOW_SYSTEM
3888 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3889 doc
: /* Return a plist of face attributes generated by FONT.
3890 FONT is a font name, a font-spec, a font-entity, or a font-object.
3891 The return value is a list of the form
3893 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3895 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3896 compatible with `set-face-attribute'. Some of these key-attribute pairs
3897 may be omitted from the list if they are not specified by FONT.
3899 The optional argument FRAME specifies the frame that the face attributes
3900 are to be displayed on. If omitted, the selected frame is used. */)
3902 Lisp_Object font
, frame
;
3905 Lisp_Object plist
[10];
3910 frame
= selected_frame
;
3911 CHECK_LIVE_FRAME (frame
);
3916 int fontset
= fs_query_fontset (font
, 0);
3917 Lisp_Object name
= font
;
3919 font
= fontset_ascii (fontset
);
3920 font
= font_spec_from_name (name
);
3922 signal_error ("Invalid font name", name
);
3924 else if (! FONTP (font
))
3925 signal_error ("Invalid font object", font
);
3927 val
= AREF (font
, FONT_FAMILY_INDEX
);
3930 plist
[n
++] = QCfamily
;
3931 plist
[n
++] = SYMBOL_NAME (val
);
3934 val
= AREF (font
, FONT_SIZE_INDEX
);
3937 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
3938 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
3939 plist
[n
++] = QCheight
;
3940 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
3942 else if (FLOATP (val
))
3944 plist
[n
++] = QCheight
;
3945 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
3948 val
= FONT_WEIGHT_FOR_FACE (font
);
3951 plist
[n
++] = QCweight
;
3955 val
= FONT_SLANT_FOR_FACE (font
);
3958 plist
[n
++] = QCslant
;
3962 val
= FONT_WIDTH_FOR_FACE (font
);
3965 plist
[n
++] = QCwidth
;
3969 return Flist (n
, plist
);
3974 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3975 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
3976 (font_spec
, prop
, val
)
3977 Lisp_Object font_spec
, prop
, val
;
3981 CHECK_FONT_SPEC (font_spec
);
3982 idx
= get_font_prop_index (prop
);
3983 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3984 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
3986 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
3990 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3991 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3992 Optional 2nd argument FRAME specifies the target frame.
3993 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3994 Optional 4th argument PREFER, if non-nil, is a font-spec to
3995 control the order of the returned list. Fonts are sorted by
3996 how close they are to PREFER. */)
3997 (font_spec
, frame
, num
, prefer
)
3998 Lisp_Object font_spec
, frame
, num
, prefer
;
4000 Lisp_Object vec
, list
, tail
;
4004 frame
= selected_frame
;
4005 CHECK_LIVE_FRAME (frame
);
4006 CHECK_FONT_SPEC (font_spec
);
4014 if (! NILP (prefer
))
4015 CHECK_FONT_SPEC (prefer
);
4017 vec
= font_list_entities (frame
, font_spec
);
4022 return Fcons (AREF (vec
, 0), Qnil
);
4024 if (! NILP (prefer
))
4025 vec
= font_sort_entites (vec
, prefer
, frame
, 0);
4027 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
4028 if (n
== 0 || n
> len
)
4030 for (i
= 1; i
< n
; i
++)
4032 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
4034 XSETCDR (tail
, val
);
4040 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4041 doc
: /* List available font families on the current frame.
4042 Optional argument FRAME, if non-nil, specifies the target frame. */)
4047 struct font_driver_list
*driver_list
;
4051 frame
= selected_frame
;
4052 CHECK_LIVE_FRAME (frame
);
4055 for (driver_list
= f
->font_driver_list
; driver_list
;
4056 driver_list
= driver_list
->next
)
4057 if (driver_list
->driver
->list_family
)
4059 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4065 Lisp_Object tail
= list
;
4067 for (; CONSP (val
); val
= XCDR (val
))
4068 if (NILP (Fmemq (XCAR (val
), tail
)))
4069 list
= Fcons (XCAR (val
), list
);
4075 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4076 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4077 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4079 Lisp_Object font_spec
, frame
;
4081 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4088 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4089 doc
: /* Return XLFD name of FONT.
4090 FONT is a font-spec, font-entity, or font-object.
4091 If the name is too long for XLFD (maximum 255 chars), return nil.
4092 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4093 the consecutive wildcards are folded to one. */)
4094 (font
, fold_wildcards
)
4095 Lisp_Object font
, fold_wildcards
;
4102 if (FONT_OBJECT_P (font
))
4104 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4106 if (STRINGP (font_name
)
4107 && SDATA (font_name
)[0] == '-')
4109 if (NILP (fold_wildcards
))
4111 strcpy (name
, (char *) SDATA (font_name
));
4114 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4116 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4119 if (! NILP (fold_wildcards
))
4121 char *p0
= name
, *p1
;
4123 while ((p1
= strstr (p0
, "-*-*")))
4125 strcpy (p1
, p1
+ 2);
4130 return build_string (name
);
4133 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4134 doc
: /* Clear font cache. */)
4137 Lisp_Object list
, frame
;
4139 FOR_EACH_FRAME (list
, frame
)
4141 FRAME_PTR f
= XFRAME (frame
);
4142 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4144 for (; driver_list
; driver_list
= driver_list
->next
)
4145 if (driver_list
->on
)
4147 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4152 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4154 font_assert (! NILP (val
));
4155 val
= XCDR (XCAR (val
));
4156 if (XINT (XCAR (val
)) == 0)
4158 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4159 XSETCDR (cache
, XCDR (val
));
4167 /* The following three functions are still experimental. */
4169 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
4170 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
4171 FONT-OBJECT may be nil if it is not yet known.
4173 G-string is sequence of glyphs of a specific font,
4174 and is a vector of this form:
4175 [ HEADER GLYPH ... ]
4176 HEADER is a vector of this form:
4177 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
4179 FONT-OBJECT is a font-object for all glyphs in the g-string,
4180 WIDTH thru DESCENT are the metrics (in pixels) of the whole G-string.
4181 GLYPH is a vector of this form:
4182 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
4183 [ [X-OFF Y-OFF WADJUST] | nil] ]
4185 FROM-IDX and TO-IDX are used internally and should not be touched.
4186 C is the character of the glyph.
4187 CODE is the glyph-code of C in FONT-OBJECT.
4188 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4189 X-OFF and Y-OFF are offests to the base position for the glyph.
4190 WADJUST is the adjustment to the normal width of the glyph. */)
4192 Lisp_Object font_object
, num
;
4194 Lisp_Object gstring
, g
;
4198 if (! NILP (font_object
))
4199 CHECK_FONT_OBJECT (font_object
);
4202 len
= XINT (num
) + 1;
4203 gstring
= Fmake_vector (make_number (len
), Qnil
);
4204 g
= Fmake_vector (make_number (6), Qnil
);
4205 ASET (g
, 0, font_object
);
4206 ASET (gstring
, 0, g
);
4207 for (i
= 1; i
< len
; i
++)
4208 ASET (gstring
, i
, Fmake_vector (make_number (10), Qnil
));
4212 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
4213 doc
: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
4214 START and END specify the region to extract characters.
4215 If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
4216 where to extract characters.
4217 FONT-OBJECT may be nil if GSTRING already contains one. */)
4218 (gstring
, font_object
, start
, end
, object
)
4219 Lisp_Object gstring
, font_object
, start
, end
, object
;
4225 CHECK_VECTOR (gstring
);
4226 if (NILP (font_object
))
4227 font_object
= LGSTRING_FONT (gstring
);
4228 font
= XFONT_OBJECT (font_object
);
4230 if (STRINGP (object
))
4232 const unsigned char *p
;
4234 CHECK_NATNUM (start
);
4236 if (XINT (start
) > XINT (end
)
4237 || XINT (end
) > ASIZE (object
)
4238 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
4239 args_out_of_range_3 (object
, start
, end
);
4241 len
= XINT (end
) - XINT (start
);
4242 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
4243 for (i
= 0; i
< len
; i
++)
4245 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4246 /* Shut up GCC warning in comparison with
4247 MOST_POSITIVE_FIXNUM below. */
4250 c
= STRING_CHAR_ADVANCE (p
);
4251 cod
= code
= font
->driver
->encode_char (font
, c
);
4252 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
4254 LGLYPH_SET_FROM (g
, i
);
4255 LGLYPH_SET_TO (g
, i
);
4256 LGLYPH_SET_CHAR (g
, c
);
4257 LGLYPH_SET_CODE (g
, code
);
4264 if (! NILP (object
))
4265 Fset_buffer (object
);
4266 validate_region (&start
, &end
);
4267 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
4268 args_out_of_range (start
, end
);
4269 len
= XINT (end
) - XINT (start
);
4271 pos_byte
= CHAR_TO_BYTE (pos
);
4272 for (i
= 0; i
< len
; i
++)
4274 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4275 /* Shut up GCC warning in comparison with
4276 MOST_POSITIVE_FIXNUM below. */
4279 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
4280 cod
= code
= font
->driver
->encode_char (font
, c
);
4281 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
4283 LGLYPH_SET_FROM (g
, i
);
4284 LGLYPH_SET_TO (g
, i
);
4285 LGLYPH_SET_CHAR (g
, c
);
4286 LGLYPH_SET_CODE (g
, code
);
4289 for (; i
< LGSTRING_LENGTH (gstring
); i
++)
4290 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
4294 DEFUN ("font-shape-text", Ffont_shape_text
, Sfont_shape_text
, 3, 4, 0,
4295 doc
: /* Shape text between FROM and TO by FONT-OBJECT.
4296 If optional 4th argument STRING is non-nil, it is a string to shape,
4297 and FROM and TO are indices to the string.
4298 The value is the end position of the text that can be shaped by
4300 (from
, to
, font_object
, string
)
4301 Lisp_Object from
, to
, font_object
, string
;
4304 struct font_metrics metrics
;
4305 EMACS_INT start
, end
;
4306 Lisp_Object gstring
, n
;
4309 if (! FONT_OBJECT_P (font_object
))
4311 font
= XFONT_OBJECT (font_object
);
4312 if (! font
->driver
->shape
)
4317 validate_region (&from
, &to
);
4318 start
= XFASTINT (from
);
4319 end
= XFASTINT (to
);
4320 modify_region (current_buffer
, start
, end
, 0);
4324 CHECK_STRING (string
);
4325 start
= XINT (from
);
4327 if (start
< 0 || start
> end
|| end
> SCHARS (string
))
4328 args_out_of_range_3 (string
, from
, to
);
4332 gstring
= Ffont_make_gstring (font_object
, make_number (len
));
4333 Ffont_fill_gstring (gstring
, font_object
, from
, to
, string
);
4335 /* Try at most three times with larger gstring each time. */
4336 for (i
= 0; i
< 3; i
++)
4338 Lisp_Object args
[2];
4340 n
= font
->driver
->shape (gstring
);
4344 args
[1] = Fmake_vector (make_number (len
), Qnil
);
4345 gstring
= Fvconcat (2, args
);
4347 if (! INTEGERP (n
) || XINT (n
) == 0)
4351 for (i
= 0; i
< len
;)
4354 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4355 EMACS_INT this_from
= LGLYPH_FROM (g
);
4356 EMACS_INT this_to
= LGLYPH_TO (g
) + 1;
4358 int need_composition
= 0;
4360 metrics
.lbearing
= LGLYPH_LBEARING (g
);
4361 metrics
.rbearing
= LGLYPH_RBEARING (g
);
4362 metrics
.ascent
= LGLYPH_ASCENT (g
);
4363 metrics
.descent
= LGLYPH_DESCENT (g
);
4364 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4366 metrics
.width
= LGLYPH_WIDTH (g
);
4367 if (LGLYPH_CHAR (g
) == 0 || metrics
.width
== 0)
4368 need_composition
= 1;
4372 metrics
.width
= LGLYPH_WADJUST (g
);
4373 metrics
.lbearing
+= LGLYPH_XOFF (g
);
4374 metrics
.rbearing
+= LGLYPH_XOFF (g
);
4375 metrics
.ascent
-= LGLYPH_YOFF (g
);
4376 metrics
.descent
+= LGLYPH_YOFF (g
);
4377 need_composition
= 1;
4379 for (j
= i
+ 1; j
< len
; j
++)
4383 g
= LGSTRING_GLYPH (gstring
, j
);
4384 if (this_from
!= LGLYPH_FROM (g
))
4386 need_composition
= 1;
4387 x
= metrics
.width
+ LGLYPH_LBEARING (g
) + LGLYPH_XOFF (g
);
4388 if (metrics
.lbearing
> x
)
4389 metrics
.lbearing
= x
;
4390 x
= metrics
.width
+ LGLYPH_RBEARING (g
) + LGLYPH_XOFF (g
);
4391 if (metrics
.rbearing
< x
)
4392 metrics
.rbearing
= x
;
4393 x
= LGLYPH_ASCENT (g
) - LGLYPH_YOFF (g
);
4394 if (metrics
.ascent
< x
)
4396 x
= LGLYPH_DESCENT (g
) - LGLYPH_YOFF (g
);
4397 if (metrics
.descent
< x
)
4398 metrics
.descent
= x
;
4399 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4400 metrics
.width
+= LGLYPH_WIDTH (g
);
4402 metrics
.width
+= LGLYPH_WADJUST (g
);
4405 if (need_composition
)
4407 gstr
= Ffont_make_gstring (font_object
, make_number (j
- i
));
4408 LGSTRING_SET_WIDTH (gstr
, metrics
.width
);
4409 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
4410 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
);
4411 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
4412 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
4413 for (k
= i
; i
< j
; i
++)
4415 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4417 LGLYPH_SET_FROM (g
, LGLYPH_FROM (g
) - this_from
);
4418 LGLYPH_SET_TO (g
, LGLYPH_TO (g
) - this_from
);
4419 LGSTRING_SET_GLYPH (gstr
, i
- k
, LGSTRING_GLYPH (gstring
, i
));
4421 from
= make_number (start
+ this_from
);
4422 to
= make_number (start
+ this_to
);
4424 Fcompose_region_internal (from
, to
, gstr
, Qnil
);
4426 Fcompose_string_internal (string
, from
, to
, gstr
, Qnil
);
4437 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4438 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4439 OTF-FEATURES specifies which features to apply in this format:
4440 (SCRIPT LANGSYS GSUB GPOS)
4442 SCRIPT is a symbol specifying a script tag of OpenType,
4443 LANGSYS is a symbol specifying a langsys tag of OpenType,
4444 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4446 If LANGYS is nil, the default langsys is selected.
4448 The features are applied in the order they appear in the list. The
4449 symbol `*' means to apply all available features not present in this
4450 list, and the remaining features are ignored. For instance, (vatu
4451 pstf * haln) is to apply vatu and pstf in this order, then to apply
4452 all available features other than vatu, pstf, and haln.
4454 The features are applied to the glyphs in the range FROM and TO of
4455 the glyph-string GSTRING-IN.
4457 If some feature is actually applicable, the resulting glyphs are
4458 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4459 this case, the value is the number of produced glyphs.
4461 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4464 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4465 produced in GSTRING-OUT, and the value is nil.
4467 See the documentation of `font-make-gstring' for the format of
4469 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4470 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4472 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4477 check_otf_features (otf_features
);
4478 CHECK_FONT_OBJECT (font_object
);
4479 font
= XFONT_OBJECT (font_object
);
4480 if (! font
->driver
->otf_drive
)
4481 error ("Font backend %s can't drive OpenType GSUB table",
4482 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4483 CHECK_CONS (otf_features
);
4484 CHECK_SYMBOL (XCAR (otf_features
));
4485 val
= XCDR (otf_features
);
4486 CHECK_SYMBOL (XCAR (val
));
4487 val
= XCDR (otf_features
);
4490 len
= check_gstring (gstring_in
);
4491 CHECK_VECTOR (gstring_out
);
4492 CHECK_NATNUM (from
);
4494 CHECK_NATNUM (index
);
4496 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4497 args_out_of_range_3 (from
, to
, make_number (len
));
4498 if (XINT (index
) >= ASIZE (gstring_out
))
4499 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4500 num
= font
->driver
->otf_drive (font
, otf_features
,
4501 gstring_in
, XINT (from
), XINT (to
),
4502 gstring_out
, XINT (index
), 0);
4505 return make_number (num
);
4508 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4510 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4511 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4513 (SCRIPT LANGSYS FEATURE ...)
4514 See the documentation of `font-drive-otf' for more detail.
4516 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4517 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4518 character code corresponding to the glyph or nil if there's no
4519 corresponding character. */)
4520 (font_object
, character
, otf_features
)
4521 Lisp_Object font_object
, character
, otf_features
;
4524 Lisp_Object gstring_in
, gstring_out
, g
;
4525 Lisp_Object alternates
;
4528 CHECK_FONT_GET_OBJECT (font_object
, font
);
4529 if (! font
->driver
->otf_drive
)
4530 error ("Font backend %s can't drive OpenType GSUB table",
4531 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4532 CHECK_CHARACTER (character
);
4533 CHECK_CONS (otf_features
);
4535 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4536 g
= LGSTRING_GLYPH (gstring_in
, 0);
4537 LGLYPH_SET_CHAR (g
, XINT (character
));
4538 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4539 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4540 gstring_out
, 0, 1)) < 0)
4541 gstring_out
= Ffont_make_gstring (font_object
,
4542 make_number (ASIZE (gstring_out
) * 2));
4544 for (i
= 0; i
< num
; i
++)
4546 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4547 int c
= LGLYPH_CHAR (g
);
4548 unsigned code
= LGLYPH_CODE (g
);
4550 alternates
= Fcons (Fcons (make_number (code
),
4551 c
> 0 ? make_number (c
) : Qnil
),
4554 return Fnreverse (alternates
);
4560 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4561 doc
: /* Open FONT-ENTITY. */)
4562 (font_entity
, size
, frame
)
4563 Lisp_Object font_entity
;
4569 CHECK_FONT_ENTITY (font_entity
);
4571 frame
= selected_frame
;
4572 CHECK_LIVE_FRAME (frame
);
4575 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4578 CHECK_NUMBER_OR_FLOAT (size
);
4580 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
4582 isize
= XINT (size
);
4586 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4589 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4590 doc
: /* Close FONT-OBJECT. */)
4591 (font_object
, frame
)
4592 Lisp_Object font_object
, frame
;
4594 CHECK_FONT_OBJECT (font_object
);
4596 frame
= selected_frame
;
4597 CHECK_LIVE_FRAME (frame
);
4598 font_close_object (XFRAME (frame
), font_object
);
4602 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4603 doc
: /* Return information about FONT-OBJECT.
4604 The value is a vector:
4605 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4608 NAME is a string of the font name (or nil if the font backend doesn't
4611 FILENAME is a string of the font file (or nil if the font backend
4612 doesn't provide a file name).
4614 PIXEL-SIZE is a pixel size by which the font is opened.
4616 SIZE is a maximum advance width of the font in pixels.
4618 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4621 CAPABILITY is a list whose first element is a symbol representing the
4622 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4623 remaining elements describe the details of the font capability.
4625 If the font is OpenType font, the form of the list is
4626 \(opentype GSUB GPOS)
4627 where GSUB shows which "GSUB" features the font supports, and GPOS
4628 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4629 lists of the format:
4630 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4632 If the font is not OpenType font, currently the length of the form is
4635 SCRIPT is a symbol representing OpenType script tag.
4637 LANGSYS is a symbol representing OpenType langsys tag, or nil
4638 representing the default langsys.
4640 FEATURE is a symbol representing OpenType feature tag.
4642 If the font is not OpenType font, CAPABILITY is nil. */)
4644 Lisp_Object font_object
;
4649 CHECK_FONT_GET_OBJECT (font_object
, font
);
4651 val
= Fmake_vector (make_number (9), Qnil
);
4652 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4653 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4654 ASET (val
, 2, make_number (font
->pixel_size
));
4655 ASET (val
, 3, make_number (font
->max_width
));
4656 ASET (val
, 4, make_number (font
->ascent
));
4657 ASET (val
, 5, make_number (font
->descent
));
4658 ASET (val
, 6, make_number (font
->space_width
));
4659 ASET (val
, 7, make_number (font
->average_width
));
4660 if (font
->driver
->otf_capability
)
4661 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4665 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4666 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4667 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4668 (font_object
, string
)
4669 Lisp_Object font_object
, string
;
4675 CHECK_FONT_GET_OBJECT (font_object
, font
);
4676 CHECK_STRING (string
);
4677 len
= SCHARS (string
);
4678 vec
= Fmake_vector (make_number (len
), Qnil
);
4679 for (i
= 0; i
< len
; i
++)
4681 Lisp_Object ch
= Faref (string
, make_number (i
));
4686 struct font_metrics metrics
;
4688 cod
= code
= font
->driver
->encode_char (font
, c
);
4689 if (code
== FONT_INVALID_CODE
)
4691 val
= Fmake_vector (make_number (6), Qnil
);
4692 if (cod
<= MOST_POSITIVE_FIXNUM
)
4693 ASET (val
, 0, make_number (code
));
4695 ASET (val
, 0, Fcons (make_number (code
>> 16),
4696 make_number (code
& 0xFFFF)));
4697 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4698 ASET (val
, 1, make_number (metrics
.lbearing
));
4699 ASET (val
, 2, make_number (metrics
.rbearing
));
4700 ASET (val
, 3, make_number (metrics
.width
));
4701 ASET (val
, 4, make_number (metrics
.ascent
));
4702 ASET (val
, 5, make_number (metrics
.descent
));
4708 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4709 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4710 FONT is a font-spec, font-entity, or font-object. */)
4712 Lisp_Object spec
, font
;
4714 CHECK_FONT_SPEC (spec
);
4717 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4720 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4721 doc
: /* Return a font-object for displaying a character at POSITION.
4722 Optional second arg WINDOW, if non-nil, is a window displaying
4723 the current buffer. It defaults to the currently selected window. */)
4724 (position
, window
, string
)
4725 Lisp_Object position
, window
, string
;
4732 CHECK_NUMBER_COERCE_MARKER (position
);
4733 pos
= XINT (position
);
4734 if (pos
< BEGV
|| pos
>= ZV
)
4735 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4739 CHECK_NUMBER (position
);
4740 CHECK_STRING (string
);
4741 pos
= XINT (position
);
4742 if (pos
< 0 || pos
>= SCHARS (string
))
4743 args_out_of_range (string
, position
);
4746 window
= selected_window
;
4747 CHECK_LIVE_WINDOW (window
);
4748 w
= XWINDOW (window
);
4750 return font_at (-1, pos
, NULL
, w
, string
);
4754 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4755 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4756 The value is a number of glyphs drawn.
4757 Type C-l to recover what previously shown. */)
4758 (font_object
, string
)
4759 Lisp_Object font_object
, string
;
4761 Lisp_Object frame
= selected_frame
;
4762 FRAME_PTR f
= XFRAME (frame
);
4768 CHECK_FONT_GET_OBJECT (font_object
, font
);
4769 CHECK_STRING (string
);
4770 len
= SCHARS (string
);
4771 code
= alloca (sizeof (unsigned) * len
);
4772 for (i
= 0; i
< len
; i
++)
4774 Lisp_Object ch
= Faref (string
, make_number (i
));
4778 code
[i
] = font
->driver
->encode_char (font
, c
);
4779 if (code
[i
] == FONT_INVALID_CODE
)
4782 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4784 if (font
->driver
->prepare_face
)
4785 font
->driver
->prepare_face (f
, face
);
4786 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4787 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4788 if (font
->driver
->done_face
)
4789 font
->driver
->done_face (f
, face
);
4791 return make_number (len
);
4795 #endif /* FONT_DEBUG */
4797 #ifdef HAVE_WINDOW_SYSTEM
4799 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4800 doc
: /* Return information about a font named NAME on frame FRAME.
4801 If FRAME is omitted or nil, use the selected frame.
4802 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4803 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4805 OPENED-NAME is the name used for opening the font,
4806 FULL-NAME is the full name of the font,
4807 SIZE is the maximum bound width of the font,
4808 HEIGHT is the height of the font,
4809 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4810 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4811 how to compose characters.
4812 If the named font is not yet loaded, return nil. */)
4814 Lisp_Object name
, frame
;
4819 Lisp_Object font_object
;
4821 (*check_window_system_func
) ();
4824 CHECK_STRING (name
);
4826 frame
= selected_frame
;
4827 CHECK_LIVE_FRAME (frame
);
4832 int fontset
= fs_query_fontset (name
, 0);
4835 name
= fontset_ascii (fontset
);
4836 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4838 else if (FONT_OBJECT_P (name
))
4840 else if (FONT_ENTITY_P (name
))
4841 font_object
= font_open_entity (f
, name
, 0);
4844 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4845 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4847 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4849 if (NILP (font_object
))
4851 font
= XFONT_OBJECT (font_object
);
4853 info
= Fmake_vector (make_number (7), Qnil
);
4854 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4855 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4856 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4857 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4858 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4859 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4860 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4863 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4864 close it now. Perhaps, we should manage font-objects
4865 by `reference-count'. */
4866 font_close_object (f
, font_object
);
4873 #define BUILD_STYLE_TABLE(TBL) \
4874 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4877 build_style_table (entry
, nelement
)
4878 struct table_entry
*entry
;
4882 Lisp_Object table
, elt
;
4884 table
= Fmake_vector (make_number (nelement
), Qnil
);
4885 for (i
= 0; i
< nelement
; i
++)
4887 for (j
= 0; entry
[i
].names
[j
]; j
++);
4888 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4889 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4890 for (j
= 0; entry
[i
].names
[j
]; j
++)
4891 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4892 ASET (table
, i
, elt
);
4897 static Lisp_Object Vfont_log
;
4898 static int font_log_env_checked
;
4901 font_add_log (action
, arg
, result
)
4903 Lisp_Object arg
, result
;
4905 Lisp_Object tail
, val
;
4908 if (! font_log_env_checked
)
4910 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
4911 font_log_env_checked
= 1;
4913 if (EQ (Vfont_log
, Qt
))
4916 arg
= Ffont_xlfd_name (arg
, Qt
);
4919 val
= Ffont_xlfd_name (result
, Qt
);
4920 if (! FONT_SPEC_P (result
))
4921 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4922 build_string (":"), val
);
4925 else if (CONSP (result
))
4927 result
= Fcopy_sequence (result
);
4928 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4932 val
= Ffont_xlfd_name (val
, Qt
);
4933 XSETCAR (tail
, val
);
4936 else if (VECTORP (result
))
4938 result
= Fcopy_sequence (result
);
4939 for (i
= 0; i
< ASIZE (result
); i
++)
4941 val
= AREF (result
, i
);
4943 val
= Ffont_xlfd_name (val
, Qt
);
4944 ASET (result
, i
, val
);
4947 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4950 extern void syms_of_ftfont
P_ (());
4951 extern void syms_of_xfont
P_ (());
4952 extern void syms_of_xftfont
P_ (());
4953 extern void syms_of_ftxfont
P_ (());
4954 extern void syms_of_bdffont
P_ (());
4955 extern void syms_of_w32font
P_ (());
4956 extern void syms_of_atmfont
P_ (());
4961 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
4962 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
4963 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
4964 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
4965 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
4966 /* Note that the other elements in sort_shift_bits are not used. */
4968 staticpro (&font_charset_alist
);
4969 font_charset_alist
= Qnil
;
4971 DEFSYM (Qfont_spec
, "font-spec");
4972 DEFSYM (Qfont_entity
, "font-entity");
4973 DEFSYM (Qfont_object
, "font-object");
4975 DEFSYM (Qopentype
, "opentype");
4977 DEFSYM (Qascii_0
, "ascii-0");
4978 DEFSYM (Qiso8859_1
, "iso8859-1");
4979 DEFSYM (Qiso10646_1
, "iso10646-1");
4980 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4981 DEFSYM (Qunicode_sip
, "unicode-sip");
4983 DEFSYM (QCotf
, ":otf");
4984 DEFSYM (QClang
, ":lang");
4985 DEFSYM (QCscript
, ":script");
4986 DEFSYM (QCantialias
, ":antialias");
4988 DEFSYM (QCfoundry
, ":foundry");
4989 DEFSYM (QCadstyle
, ":adstyle");
4990 DEFSYM (QCregistry
, ":registry");
4991 DEFSYM (QCspacing
, ":spacing");
4992 DEFSYM (QCdpi
, ":dpi");
4993 DEFSYM (QCscalable
, ":scalable");
4994 DEFSYM (QCavgwidth
, ":avgwidth");
4995 DEFSYM (QCfont_entity
, ":font-entity");
4996 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
5003 staticpro (&null_vector
);
5004 null_vector
= Fmake_vector (make_number (0), Qnil
);
5006 staticpro (&scratch_font_spec
);
5007 scratch_font_spec
= Ffont_spec (0, NULL
);
5008 staticpro (&scratch_font_prefer
);
5009 scratch_font_prefer
= Ffont_spec (0, NULL
);
5013 staticpro (&otf_list
);
5015 #endif /* HAVE_LIBOTF */
5019 defsubr (&Sfont_spec
);
5020 defsubr (&Sfont_get
);
5021 #ifdef HAVE_WINDOW_SYSTEM
5022 defsubr (&Sfont_face_attributes
);
5024 defsubr (&Sfont_put
);
5025 defsubr (&Slist_fonts
);
5026 defsubr (&Sfont_family_list
);
5027 defsubr (&Sfind_font
);
5028 defsubr (&Sfont_xlfd_name
);
5029 defsubr (&Sclear_font_cache
);
5030 defsubr (&Sfont_make_gstring
);
5031 defsubr (&Sfont_fill_gstring
);
5032 defsubr (&Sfont_shape_text
);
5034 defsubr (&Sfont_drive_otf
);
5035 defsubr (&Sfont_otf_alternates
);
5039 defsubr (&Sopen_font
);
5040 defsubr (&Sclose_font
);
5041 defsubr (&Squery_font
);
5042 defsubr (&Sget_font_glyphs
);
5043 defsubr (&Sfont_match_p
);
5044 defsubr (&Sfont_at
);
5046 defsubr (&Sdraw_string
);
5048 #endif /* FONT_DEBUG */
5049 #ifdef HAVE_WINDOW_SYSTEM
5050 defsubr (&Sfont_info
);
5053 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5055 Alist of fontname patterns vs the corresponding encoding and repertory info.
5056 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5057 where ENCODING is a charset or a char-table,
5058 and REPERTORY is a charset, a char-table, or nil.
5060 If ENCODING and REPERTORY are the same, the element can have the form
5061 \(REGEXP . ENCODING).
5063 ENCODING is for converting a character to a glyph code of the font.
5064 If ENCODING is a charset, encoding a character by the charset gives
5065 the corresponding glyph code. If ENCODING is a char-table, looking up
5066 the table by a character gives the corresponding glyph code.
5068 REPERTORY specifies a repertory of characters supported by the font.
5069 If REPERTORY is a charset, all characters beloging to the charset are
5070 supported. If REPERTORY is a char-table, all characters who have a
5071 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5072 gets the repertory information by an opened font and ENCODING. */);
5073 Vfont_encoding_alist
= Qnil
;
5075 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5076 doc
: /* Vector of valid font weight values.
5077 Each element has the form:
5078 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5079 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5080 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5082 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5083 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5084 See `font-weight-table' for the format of the vector. */);
5085 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5087 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5088 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5089 See `font-weight-table' for the format of the vector. */);
5090 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5092 staticpro (&font_style_table
);
5093 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5094 ASET (font_style_table
, 0, Vfont_weight_table
);
5095 ASET (font_style_table
, 1, Vfont_slant_table
);
5096 ASET (font_style_table
, 2, Vfont_width_table
);
5098 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5099 *Logging list of font related actions and results.
5100 The value t means to suppress the logging.
5101 The initial value is set to nil if the environment variable
5102 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5105 #ifdef HAVE_WINDOW_SYSTEM
5106 #ifdef HAVE_FREETYPE
5108 #ifdef HAVE_X_WINDOWS
5113 #endif /* HAVE_XFT */
5114 #endif /* HAVE_X_WINDOWS */
5115 #else /* not HAVE_FREETYPE */
5116 #ifdef HAVE_X_WINDOWS
5118 #endif /* HAVE_X_WINDOWS */
5119 #endif /* not HAVE_FREETYPE */
5122 #endif /* HAVE_BDFFONT */
5125 #endif /* WINDOWSNT */
5129 #endif /* HAVE_WINDOW_SYSTEM */
5132 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5133 (do not change this comment) */