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 (Lisp_Object spec
, Lisp_Object 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 font_add_log ("open", entity
, font_object
);
2852 if (NILP (font_object
))
2854 ASET (entity
, FONT_OBJLIST_INDEX
,
2855 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2856 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
2859 font
= XFONT_OBJECT (font_object
);
2860 min_width
= (font
->min_width
? font
->min_width
2861 : font
->average_width
? font
->average_width
2862 : font
->space_width
? font
->space_width
2864 height
= (font
->height
? font
->height
: 1);
2865 #ifdef HAVE_WINDOW_SYSTEM
2866 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2867 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2869 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2870 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2871 fonts_changed_p
= 1;
2875 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2876 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2877 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2878 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2886 /* Close FONT_OBJECT that is opened on frame F. */
2889 font_close_object (f
, font_object
)
2891 Lisp_Object font_object
;
2893 struct font
*font
= XFONT_OBJECT (font_object
);
2895 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2896 /* Already closed. */
2898 font_add_log ("close", font_object
, Qnil
);
2899 font
->driver
->close (f
, font
);
2900 #ifdef HAVE_WINDOW_SYSTEM
2901 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2902 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2908 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2909 FONT is a font-entity and it must be opened to check. */
2912 font_has_char (f
, font
, c
)
2919 if (FONT_ENTITY_P (font
))
2921 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2922 struct font_driver_list
*driver_list
;
2924 for (driver_list
= f
->font_driver_list
;
2925 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2926 driver_list
= driver_list
->next
);
2929 if (! driver_list
->driver
->has_char
)
2931 return driver_list
->driver
->has_char (font
, c
);
2934 font_assert (FONT_OBJECT_P (font
));
2935 fontp
= XFONT_OBJECT (font
);
2936 if (fontp
->driver
->has_char
)
2938 int result
= fontp
->driver
->has_char (font
, c
);
2943 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2947 /* Return the glyph ID of FONT_OBJECT for character C. */
2950 font_encode_char (font_object
, c
)
2951 Lisp_Object font_object
;
2956 font_assert (FONT_OBJECT_P (font_object
));
2957 font
= XFONT_OBJECT (font_object
);
2958 return font
->driver
->encode_char (font
, c
);
2962 /* Return the name of FONT_OBJECT. */
2965 font_get_name (font_object
)
2966 Lisp_Object font_object
;
2968 font_assert (FONT_OBJECT_P (font_object
));
2969 return AREF (font_object
, FONT_NAME_INDEX
);
2973 /* Return the specification of FONT_OBJECT. */
2976 font_get_spec (font_object
)
2977 Lisp_Object font_object
;
2979 Lisp_Object spec
= font_make_spec ();
2982 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2983 ASET (spec
, i
, AREF (font_object
, i
));
2984 ASET (spec
, FONT_SIZE_INDEX
,
2985 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2990 font_spec_from_name (font_name
)
2991 Lisp_Object font_name
;
2993 Lisp_Object args
[2];
2996 args
[1] = font_name
;
2997 return Ffont_spec (2, args
);
3002 font_clear_prop (attrs
, prop
)
3004 enum font_property_index prop
;
3006 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
3010 if (NILP (AREF (font
, prop
))
3011 && prop
!= FONT_FAMILY_INDEX
&& prop
!= FONT_FOUNDRY_INDEX
3012 && prop
!= FONT_SIZE_INDEX
)
3014 font
= Fcopy_font_spec (font
);
3015 ASET (font
, prop
, Qnil
);
3016 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
3018 if (prop
== FONT_FAMILY_INDEX
)
3019 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
3020 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
3021 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
3022 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
3023 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3024 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3025 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3027 else if (prop
== FONT_SIZE_INDEX
)
3029 ASET (font
, FONT_DPI_INDEX
, Qnil
);
3030 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
3031 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
3033 attrs
[LFACE_FONT_INDEX
] = font
;
3037 font_update_lface (f
, attrs
)
3043 spec
= attrs
[LFACE_FONT_INDEX
];
3044 if (! FONT_SPEC_P (spec
))
3047 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
3048 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
3049 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3050 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
3051 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
3052 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
3053 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
3054 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);;
3055 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
3056 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
3057 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3061 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
3066 val
= Ffont_get (spec
, QCdpi
);
3069 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
3072 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
3073 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3074 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3079 /* Return a font-entity satisfying SPEC and best matching with face's
3080 font related attributes in ATTRS. C, if not negative, is a
3081 character that the entity must support. */
3084 font_find_for_lface (f
, attrs
, spec
, c
)
3091 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
3092 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
3094 int i
, j
, k
, l
, result
;
3096 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3097 if (NILP (registry
[0]))
3099 registry
[0] = Qiso8859_1
;
3100 registry
[1] = Qascii_0
;
3101 registry
[2] = null_vector
;
3104 registry
[1] = null_vector
;
3106 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3108 struct charset
*encoding
, *repertory
;
3110 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3111 &encoding
, &repertory
) < 0)
3115 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3117 /* Any font of this registry support C. So, let's
3118 suppress the further checking. */
3121 else if (c
> encoding
->max_char
)
3125 work
= Fcopy_font_spec (spec
);
3126 XSETFRAME (frame
, f
);
3127 size
= AREF (spec
, FONT_SIZE_INDEX
);
3128 pixel_size
= font_pixel_size (f
, spec
);
3129 if (pixel_size
== 0)
3131 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3133 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3135 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3136 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3137 if (! NILP (foundry
[0]))
3138 foundry
[1] = null_vector
;
3139 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3141 foundry
[0] = font_intern_prop (SDATA (attrs
[LFACE_FOUNDRY_INDEX
]),
3142 SBYTES (attrs
[LFACE_FOUNDRY_INDEX
]), 1);
3144 foundry
[2] = null_vector
;
3147 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3149 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3150 if (! NILP (adstyle
[0]))
3151 adstyle
[1] = null_vector
;
3152 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3154 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3156 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3158 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3160 adstyle
[2] = null_vector
;
3163 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3166 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3169 val
= AREF (work
, FONT_FAMILY_INDEX
);
3170 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3171 val
= font_intern_prop (SDATA (attrs
[LFACE_FAMILY_INDEX
]),
3172 SBYTES (attrs
[LFACE_FAMILY_INDEX
]), 1);
3175 family
= alloca ((sizeof family
[0]) * 2);
3177 family
[1] = null_vector
; /* terminator. */
3182 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3184 if (! NILP (alters
))
3186 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3187 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3188 family
[i
] = XCAR (alters
);
3189 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3191 family
[i
] = null_vector
;
3195 family
= alloca ((sizeof family
[0]) * 3);
3198 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3200 family
[i
] = null_vector
;
3204 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3206 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3207 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3209 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3210 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3212 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3213 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3215 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3216 entities
= font_list_entities (frame
, work
);
3217 if (ASIZE (entities
) > 0)
3225 if (ASIZE (entities
) == 1)
3228 return AREF (entities
, 0);
3232 /* Sort fonts by properties specified in LFACE. */
3233 Lisp_Object prefer
= scratch_font_prefer
;
3235 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3236 ASET (prefer
, i
, AREF (work
, i
));
3237 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3239 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3241 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3242 if (NILP (AREF (prefer
, i
)))
3243 ASET (prefer
, i
, AREF (face_font
, i
));
3245 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3246 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3247 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3248 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3249 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3250 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3251 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3252 entities
= font_sort_entites (entities
, prefer
, frame
, c
< 0);
3257 for (i
= 0; i
< ASIZE (entities
); i
++)
3261 val
= AREF (entities
, i
);
3264 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3265 if (! EQ (AREF (val
, j
), props
[j
]))
3267 if (j
> FONT_REGISTRY_INDEX
)
3270 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3271 props
[j
] = AREF (val
, j
);
3272 result
= font_has_char (f
, val
, c
);
3277 val
= font_open_for_lface (f
, val
, attrs
, spec
);
3280 result
= font_has_char (f
, val
, c
);
3281 font_close_object (f
, val
);
3283 return AREF (entities
, i
);
3290 font_open_for_lface (f
, entity
, attrs
, spec
)
3298 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3299 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3300 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3301 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3302 size
= font_pixel_size (f
, spec
);
3305 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3308 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3310 return font_open_entity (f
, entity
, size
);
3314 /* Find a font satisfying SPEC and best matching with face's
3315 attributes in ATTRS on FRAME, and return the opened
3319 font_load_for_lface (f
, attrs
, spec
)
3321 Lisp_Object
*attrs
, spec
;
3325 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3328 /* No font is listed for SPEC, but each font-backend may have
3329 the different criteria about "font matching". So, try
3331 entity
= font_matching_entity (f
, attrs
, spec
);
3335 return font_open_for_lface (f
, entity
, attrs
, spec
);
3339 /* Make FACE on frame F ready to use the font opened for FACE. */
3342 font_prepare_for_face (f
, face
)
3346 if (face
->font
->driver
->prepare_face
)
3347 face
->font
->driver
->prepare_face (f
, face
);
3351 /* Make FACE on frame F stop using the font opened for FACE. */
3354 font_done_for_face (f
, face
)
3358 if (face
->font
->driver
->done_face
)
3359 face
->font
->driver
->done_face (f
, face
);
3364 /* Open a font best matching with NAME on frame F. If no proper font
3365 is found, return Qnil. */
3368 font_open_by_name (f
, name
)
3372 Lisp_Object args
[2];
3373 Lisp_Object spec
, attrs
[LFACE_VECTOR_SIZE
];
3376 args
[1] = make_unibyte_string (name
, strlen (name
));
3377 spec
= Ffont_spec (2, args
);
3378 /* We set up the default font-related attributes of a face to prefer
3380 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3381 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3382 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3383 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3384 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3386 return font_load_for_lface (f
, attrs
, spec
);
3390 /* Register font-driver DRIVER. This function is used in two ways.
3392 The first is with frame F non-NULL. In this case, make DRIVER
3393 available (but not yet activated) on F. All frame creaters
3394 (e.g. Fx_create_frame) must call this function at least once with
3395 an available font-driver.
3397 The second is with frame F NULL. In this case, DRIVER is globally
3398 registered in the variable `font_driver_list'. All font-driver
3399 implementations must call this function in its syms_of_XXXX
3400 (e.g. syms_of_xfont). */
3403 register_font_driver (driver
, f
)
3404 struct font_driver
*driver
;
3407 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3408 struct font_driver_list
*prev
, *list
;
3410 if (f
&& ! driver
->draw
)
3411 error ("Unusable font driver for a frame: %s",
3412 SDATA (SYMBOL_NAME (driver
->type
)));
3414 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3415 if (EQ (list
->driver
->type
, driver
->type
))
3416 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3418 list
= malloc (sizeof (struct font_driver_list
));
3420 list
->driver
= driver
;
3425 f
->font_driver_list
= list
;
3427 font_driver_list
= list
;
3433 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3434 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3435 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3437 A caller must free all realized faces if any in advance. The
3438 return value is a list of font backends actually made used on
3442 font_update_drivers (f
, new_drivers
)
3444 Lisp_Object new_drivers
;
3446 Lisp_Object active_drivers
= Qnil
;
3447 struct font_driver
*driver
;
3448 struct font_driver_list
*list
;
3450 /* At first, turn off non-requested drivers, and turn on requested
3452 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3454 driver
= list
->driver
;
3455 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3460 if (driver
->end_for_frame
)
3461 driver
->end_for_frame (f
);
3462 font_finish_cache (f
, driver
);
3467 if (! driver
->start_for_frame
3468 || driver
->start_for_frame (f
) == 0)
3470 font_prepare_cache (f
, driver
);
3477 if (NILP (new_drivers
))
3480 if (! EQ (new_drivers
, Qt
))
3482 /* Re-order the driver list according to new_drivers. */
3483 struct font_driver_list
**list_table
, **next
;
3487 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3488 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3490 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3491 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3494 list_table
[i
++] = list
;
3496 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3498 list_table
[i
] = list
;
3499 list_table
[i
] = NULL
;
3501 next
= &f
->font_driver_list
;
3502 for (i
= 0; list_table
[i
]; i
++)
3504 *next
= list_table
[i
];
3505 next
= &(*next
)->next
;
3510 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3512 active_drivers
= nconc2 (active_drivers
,
3513 Fcons (list
->driver
->type
, Qnil
));
3514 return active_drivers
;
3518 font_put_frame_data (f
, driver
, data
)
3520 struct font_driver
*driver
;
3523 struct font_data_list
*list
, *prev
;
3525 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3526 prev
= list
, list
= list
->next
)
3527 if (list
->driver
== driver
)
3534 prev
->next
= list
->next
;
3536 f
->font_data_list
= list
->next
;
3544 list
= malloc (sizeof (struct font_data_list
));
3547 list
->driver
= driver
;
3548 list
->next
= f
->font_data_list
;
3549 f
->font_data_list
= list
;
3557 font_get_frame_data (f
, driver
)
3559 struct font_driver
*driver
;
3561 struct font_data_list
*list
;
3563 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3564 if (list
->driver
== driver
)
3572 /* Return the font used to draw character C by FACE at buffer position
3573 POS in window W. If STRING is non-nil, it is a string containing C
3574 at index POS. If C is negative, get C from the current buffer or
3578 font_at (c
, pos
, face
, w
, string
)
3587 Lisp_Object font_object
;
3593 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3596 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3598 c
= FETCH_CHAR (pos_byte
);
3601 c
= FETCH_BYTE (pos
);
3607 multibyte
= STRING_MULTIBYTE (string
);
3610 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3612 str
= SDATA (string
) + pos_byte
;
3613 c
= STRING_CHAR (str
, 0);
3616 c
= SDATA (string
)[pos
];
3620 f
= XFRAME (w
->frame
);
3621 if (! FRAME_WINDOW_P (f
))
3628 if (STRINGP (string
))
3629 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3630 DEFAULT_FACE_ID
, 0);
3632 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3634 face
= FACE_FROM_ID (f
, face_id
);
3638 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3639 face
= FACE_FROM_ID (f
, face_id
);
3644 XSETFONT (font_object
, face
->font
);
3649 /* Check how many characters after POS (at most to LIMIT) can be
3650 displayed by the same font. FACE is the face selected for the
3651 character as POS on frame F. STRING, if not nil, is the string to
3652 check instead of the current buffer.
3654 The return value is the position of the character that is displayed
3655 by the differnt font than that of the character as POS. */
3658 font_range (pos
, limit
, face
, f
, string
)
3659 EMACS_INT pos
, limit
;
3672 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3673 pos_byte
= CHAR_TO_BYTE (pos
);
3677 multibyte
= STRING_MULTIBYTE (string
);
3678 pos_byte
= string_char_to_byte (string
, pos
);
3682 /* All unibyte character are displayed by the same font. */
3690 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3692 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3693 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3694 face
= FACE_FROM_ID (f
, face_id
);
3701 else if (font
!= face
->font
)
3713 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3714 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3715 Return nil otherwise.
3716 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3717 which kind of font it is. It must be one of `font-spec', `font-entity',
3719 (object
, extra_type
)
3720 Lisp_Object object
, extra_type
;
3722 if (NILP (extra_type
))
3723 return (FONTP (object
) ? Qt
: Qnil
);
3724 if (EQ (extra_type
, Qfont_spec
))
3725 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3726 if (EQ (extra_type
, Qfont_entity
))
3727 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3728 if (EQ (extra_type
, Qfont_object
))
3729 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3730 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3733 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3734 doc
: /* Return a newly created font-spec with arguments as properties.
3736 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3737 valid font property name listed below:
3739 `:family', `:weight', `:slant', `:width'
3741 They are the same as face attributes of the same name. See
3742 `set-face-attribute'.
3746 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3750 VALUE must be a string or a symbol specifying the additional
3751 typographic style information of a font, e.g. ``sans''.
3755 VALUE must be a string or a symbol specifying the charset registry and
3756 encoding of a font, e.g. ``iso8859-1''.
3760 VALUE must be a non-negative integer or a floating point number
3761 specifying the font size. It specifies the font size in pixels
3762 (if VALUE is an integer), or in points (if VALUE is a float).
3766 VALUE must be a string of XLFD-style or fontconfig-style font name.
3767 usage: (font-spec ARGS ...) */)
3772 Lisp_Object spec
= font_make_spec ();
3775 for (i
= 0; i
< nargs
; i
+= 2)
3777 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3779 if (EQ (key
, QCname
))
3782 font_parse_name ((char *) SDATA (val
), spec
);
3783 font_put_extra (spec
, key
, val
);
3787 int idx
= get_font_prop_index (key
);
3791 val
= font_prop_validate (idx
, Qnil
, val
);
3792 if (idx
< FONT_EXTRA_INDEX
)
3793 ASET (spec
, idx
, val
);
3795 font_put_extra (spec
, key
, val
);
3798 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3804 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3805 doc
: /* Return a copy of FONT as a font-spec. */)
3809 Lisp_Object new_spec
, tail
, prev
, extra
;
3813 new_spec
= font_make_spec ();
3814 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3815 ASET (new_spec
, i
, AREF (font
, i
));
3816 extra
= Fcopy_sequence (AREF (font
, FONT_EXTRA_INDEX
));
3817 /* We must remove :font-entity property. */
3818 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3819 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3822 extra
= XCDR (extra
);
3824 XSETCDR (prev
, XCDR (tail
));
3827 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3831 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3832 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3833 Every specified properties in FROM override the corresponding
3834 properties in TO. */)
3836 Lisp_Object from
, to
;
3838 Lisp_Object extra
, tail
;
3843 to
= Fcopy_font_spec (to
);
3844 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3845 ASET (to
, i
, AREF (from
, i
));
3846 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3847 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3848 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3850 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3853 XSETCDR (slot
, XCDR (XCAR (tail
)));
3855 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3857 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3861 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3862 doc
: /* Return the value of FONT's property KEY.
3863 FONT is a font-spec, a font-entity, or a font-object. */)
3865 Lisp_Object font
, key
;
3872 idx
= get_font_prop_index (key
);
3873 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3874 return font_style_symbolic (font
, idx
, 0);
3875 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3876 return AREF (font
, idx
);
3877 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3880 #ifdef HAVE_WINDOW_SYSTEM
3882 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3883 doc
: /* Return a plist of face attributes generated by FONT.
3884 FONT is a font name, a font-spec, a font-entity, or a font-object.
3885 The return value is a list of the form
3887 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3889 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3890 compatible with `set-face-attribute'. Some of these key-attribute pairs
3891 may be omitted from the list if they are not specified by FONT.
3893 The optional argument FRAME specifies the frame that the face attributes
3894 are to be displayed on. If omitted, the selected frame is used. */)
3896 Lisp_Object font
, frame
;
3899 Lisp_Object plist
[10];
3904 frame
= selected_frame
;
3905 CHECK_LIVE_FRAME (frame
);
3910 int fontset
= fs_query_fontset (font
, 0);
3911 Lisp_Object name
= font
;
3913 font
= fontset_ascii (fontset
);
3914 font
= font_spec_from_name (name
);
3916 signal_error ("Invalid font name", name
);
3918 else if (! FONTP (font
))
3919 signal_error ("Invalid font object", font
);
3921 val
= AREF (font
, FONT_FAMILY_INDEX
);
3924 plist
[n
++] = QCfamily
;
3925 plist
[n
++] = SYMBOL_NAME (val
);
3928 val
= AREF (font
, FONT_SIZE_INDEX
);
3931 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
3932 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
3933 plist
[n
++] = QCheight
;
3934 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
3936 else if (FLOATP (val
))
3938 plist
[n
++] = QCheight
;
3939 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
3942 val
= FONT_WEIGHT_FOR_FACE (font
);
3945 plist
[n
++] = QCweight
;
3949 val
= FONT_SLANT_FOR_FACE (font
);
3952 plist
[n
++] = QCslant
;
3956 val
= FONT_WIDTH_FOR_FACE (font
);
3959 plist
[n
++] = QCwidth
;
3963 return Flist (n
, plist
);
3968 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3969 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
3970 (font_spec
, prop
, val
)
3971 Lisp_Object font_spec
, prop
, val
;
3975 CHECK_FONT_SPEC (font_spec
);
3976 idx
= get_font_prop_index (prop
);
3977 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3978 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
3980 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
3984 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3985 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3986 Optional 2nd argument FRAME specifies the target frame.
3987 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3988 Optional 4th argument PREFER, if non-nil, is a font-spec to
3989 control the order of the returned list. Fonts are sorted by
3990 how close they are to PREFER. */)
3991 (font_spec
, frame
, num
, prefer
)
3992 Lisp_Object font_spec
, frame
, num
, prefer
;
3994 Lisp_Object vec
, list
, tail
;
3998 frame
= selected_frame
;
3999 CHECK_LIVE_FRAME (frame
);
4000 CHECK_FONT_SPEC (font_spec
);
4008 if (! NILP (prefer
))
4009 CHECK_FONT_SPEC (prefer
);
4011 vec
= font_list_entities (frame
, font_spec
);
4016 return Fcons (AREF (vec
, 0), Qnil
);
4018 if (! NILP (prefer
))
4019 vec
= font_sort_entites (vec
, prefer
, frame
, 0);
4021 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
4022 if (n
== 0 || n
> len
)
4024 for (i
= 1; i
< n
; i
++)
4026 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
4028 XSETCDR (tail
, val
);
4034 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
4035 doc
: /* List available font families on the current frame.
4036 Optional argument FRAME, if non-nil, specifies the target frame. */)
4041 struct font_driver_list
*driver_list
;
4045 frame
= selected_frame
;
4046 CHECK_LIVE_FRAME (frame
);
4049 for (driver_list
= f
->font_driver_list
; driver_list
;
4050 driver_list
= driver_list
->next
)
4051 if (driver_list
->driver
->list_family
)
4053 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
4059 Lisp_Object tail
= list
;
4061 for (; CONSP (val
); val
= XCDR (val
))
4062 if (NILP (Fmemq (XCAR (val
), tail
)))
4063 list
= Fcons (XCAR (val
), list
);
4069 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
4070 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
4071 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
4073 Lisp_Object font_spec
, frame
;
4075 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
4082 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
4083 doc
: /* Return XLFD name of FONT.
4084 FONT is a font-spec, font-entity, or font-object.
4085 If the name is too long for XLFD (maximum 255 chars), return nil.
4086 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
4087 the consecutive wildcards are folded to one. */)
4088 (font
, fold_wildcards
)
4089 Lisp_Object font
, fold_wildcards
;
4096 if (FONT_OBJECT_P (font
))
4098 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
4100 if (STRINGP (font_name
)
4101 && SDATA (font_name
)[0] == '-')
4103 if (NILP (fold_wildcards
))
4105 strcpy (name
, (char *) SDATA (font_name
));
4108 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
4110 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
4113 if (! NILP (fold_wildcards
))
4115 char *p0
= name
, *p1
;
4117 while ((p1
= strstr (p0
, "-*-*")))
4119 strcpy (p1
, p1
+ 2);
4124 return build_string (name
);
4127 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4128 doc
: /* Clear font cache. */)
4131 Lisp_Object list
, frame
;
4133 FOR_EACH_FRAME (list
, frame
)
4135 FRAME_PTR f
= XFRAME (frame
);
4136 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4138 for (; driver_list
; driver_list
= driver_list
->next
)
4139 if (driver_list
->on
)
4141 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4146 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4148 font_assert (! NILP (val
));
4149 val
= XCDR (XCAR (val
));
4150 if (XINT (XCAR (val
)) == 0)
4152 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4153 XSETCDR (cache
, XCDR (val
));
4161 /* The following three functions are still experimental. */
4163 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
4164 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
4165 FONT-OBJECT may be nil if it is not yet known.
4167 G-string is sequence of glyphs of a specific font,
4168 and is a vector of this form:
4169 [ HEADER GLYPH ... ]
4170 HEADER is a vector of this form:
4171 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
4173 FONT-OBJECT is a font-object for all glyphs in the g-string,
4174 WIDTH thru DESCENT are the metrics (in pixels) of the whole G-string.
4175 GLYPH is a vector of this form:
4176 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
4177 [ [X-OFF Y-OFF WADJUST] | nil] ]
4179 FROM-IDX and TO-IDX are used internally and should not be touched.
4180 C is the character of the glyph.
4181 CODE is the glyph-code of C in FONT-OBJECT.
4182 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4183 X-OFF and Y-OFF are offests to the base position for the glyph.
4184 WADJUST is the adjustment to the normal width of the glyph. */)
4186 Lisp_Object font_object
, num
;
4188 Lisp_Object gstring
, g
;
4192 if (! NILP (font_object
))
4193 CHECK_FONT_OBJECT (font_object
);
4196 len
= XINT (num
) + 1;
4197 gstring
= Fmake_vector (make_number (len
), Qnil
);
4198 g
= Fmake_vector (make_number (6), Qnil
);
4199 ASET (g
, 0, font_object
);
4200 ASET (gstring
, 0, g
);
4201 for (i
= 1; i
< len
; i
++)
4202 ASET (gstring
, i
, Fmake_vector (make_number (10), Qnil
));
4206 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
4207 doc
: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
4208 START and END specify the region to extract characters.
4209 If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
4210 where to extract characters.
4211 FONT-OBJECT may be nil if GSTRING already contains one. */)
4212 (gstring
, font_object
, start
, end
, object
)
4213 Lisp_Object gstring
, font_object
, start
, end
, object
;
4219 CHECK_VECTOR (gstring
);
4220 if (NILP (font_object
))
4221 font_object
= LGSTRING_FONT (gstring
);
4222 font
= XFONT_OBJECT (font_object
);
4224 if (STRINGP (object
))
4226 const unsigned char *p
;
4228 CHECK_NATNUM (start
);
4230 if (XINT (start
) > XINT (end
)
4231 || XINT (end
) > ASIZE (object
)
4232 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
4233 args_out_of_range_3 (object
, start
, end
);
4235 len
= XINT (end
) - XINT (start
);
4236 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
4237 for (i
= 0; i
< len
; i
++)
4239 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4240 /* Shut up GCC warning in comparison with
4241 MOST_POSITIVE_FIXNUM below. */
4244 c
= STRING_CHAR_ADVANCE (p
);
4245 cod
= code
= font
->driver
->encode_char (font
, c
);
4246 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
4248 LGLYPH_SET_FROM (g
, i
);
4249 LGLYPH_SET_TO (g
, i
);
4250 LGLYPH_SET_CHAR (g
, c
);
4251 LGLYPH_SET_CODE (g
, code
);
4258 if (! NILP (object
))
4259 Fset_buffer (object
);
4260 validate_region (&start
, &end
);
4261 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
4262 args_out_of_range (start
, end
);
4263 len
= XINT (end
) - XINT (start
);
4265 pos_byte
= CHAR_TO_BYTE (pos
);
4266 for (i
= 0; i
< len
; i
++)
4268 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4269 /* Shut up GCC warning in comparison with
4270 MOST_POSITIVE_FIXNUM below. */
4273 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
4274 cod
= code
= font
->driver
->encode_char (font
, c
);
4275 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
4277 LGLYPH_SET_FROM (g
, i
);
4278 LGLYPH_SET_TO (g
, i
);
4279 LGLYPH_SET_CHAR (g
, c
);
4280 LGLYPH_SET_CODE (g
, code
);
4283 for (; i
< LGSTRING_LENGTH (gstring
); i
++)
4284 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
4288 DEFUN ("font-shape-text", Ffont_shape_text
, Sfont_shape_text
, 3, 4, 0,
4289 doc
: /* Shape text between FROM and TO by FONT-OBJECT.
4290 If optional 4th argument STRING is non-nil, it is a string to shape,
4291 and FROM and TO are indices to the string.
4292 The value is the end position of the text that can be shaped by
4294 (from
, to
, font_object
, string
)
4295 Lisp_Object from
, to
, font_object
, string
;
4298 struct font_metrics metrics
;
4299 EMACS_INT start
, end
;
4300 Lisp_Object gstring
, n
;
4303 if (! FONT_OBJECT_P (font_object
))
4305 font
= XFONT_OBJECT (font_object
);
4306 if (! font
->driver
->shape
)
4311 validate_region (&from
, &to
);
4312 start
= XFASTINT (from
);
4313 end
= XFASTINT (to
);
4314 modify_region (current_buffer
, start
, end
, 0);
4318 CHECK_STRING (string
);
4319 start
= XINT (from
);
4321 if (start
< 0 || start
> end
|| end
> SCHARS (string
))
4322 args_out_of_range_3 (string
, from
, to
);
4326 gstring
= Ffont_make_gstring (font_object
, make_number (len
));
4327 Ffont_fill_gstring (gstring
, font_object
, from
, to
, string
);
4329 /* Try at most three times with larger gstring each time. */
4330 for (i
= 0; i
< 3; i
++)
4332 Lisp_Object args
[2];
4334 n
= font
->driver
->shape (gstring
);
4338 args
[1] = Fmake_vector (make_number (len
), Qnil
);
4339 gstring
= Fvconcat (2, args
);
4341 if (! INTEGERP (n
) || XINT (n
) == 0)
4345 for (i
= 0; i
< len
;)
4348 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4349 EMACS_INT this_from
= LGLYPH_FROM (g
);
4350 EMACS_INT this_to
= LGLYPH_TO (g
) + 1;
4352 int need_composition
= 0;
4354 metrics
.lbearing
= LGLYPH_LBEARING (g
);
4355 metrics
.rbearing
= LGLYPH_RBEARING (g
);
4356 metrics
.ascent
= LGLYPH_ASCENT (g
);
4357 metrics
.descent
= LGLYPH_DESCENT (g
);
4358 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4360 metrics
.width
= LGLYPH_WIDTH (g
);
4361 if (LGLYPH_CHAR (g
) == 0 || metrics
.width
== 0)
4362 need_composition
= 1;
4366 metrics
.width
= LGLYPH_WADJUST (g
);
4367 metrics
.lbearing
+= LGLYPH_XOFF (g
);
4368 metrics
.rbearing
+= LGLYPH_XOFF (g
);
4369 metrics
.ascent
-= LGLYPH_YOFF (g
);
4370 metrics
.descent
+= LGLYPH_YOFF (g
);
4371 need_composition
= 1;
4373 for (j
= i
+ 1; j
< len
; j
++)
4377 g
= LGSTRING_GLYPH (gstring
, j
);
4378 if (this_from
!= LGLYPH_FROM (g
))
4380 need_composition
= 1;
4381 x
= metrics
.width
+ LGLYPH_LBEARING (g
) + LGLYPH_XOFF (g
);
4382 if (metrics
.lbearing
> x
)
4383 metrics
.lbearing
= x
;
4384 x
= metrics
.width
+ LGLYPH_RBEARING (g
) + LGLYPH_XOFF (g
);
4385 if (metrics
.rbearing
< x
)
4386 metrics
.rbearing
= x
;
4387 x
= LGLYPH_ASCENT (g
) - LGLYPH_YOFF (g
);
4388 if (metrics
.ascent
< x
)
4390 x
= LGLYPH_DESCENT (g
) - LGLYPH_YOFF (g
);
4391 if (metrics
.descent
< x
)
4392 metrics
.descent
= x
;
4393 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4394 metrics
.width
+= LGLYPH_WIDTH (g
);
4396 metrics
.width
+= LGLYPH_WADJUST (g
);
4399 if (need_composition
)
4401 gstr
= Ffont_make_gstring (font_object
, make_number (j
- i
));
4402 LGSTRING_SET_WIDTH (gstr
, metrics
.width
);
4403 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
4404 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
);
4405 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
4406 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
4407 for (k
= i
; i
< j
; i
++)
4409 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4411 LGLYPH_SET_FROM (g
, LGLYPH_FROM (g
) - this_from
);
4412 LGLYPH_SET_TO (g
, LGLYPH_TO (g
) - this_from
);
4413 LGSTRING_SET_GLYPH (gstr
, i
- k
, LGSTRING_GLYPH (gstring
, i
));
4415 from
= make_number (start
+ this_from
);
4416 to
= make_number (start
+ this_to
);
4418 Fcompose_region_internal (from
, to
, gstr
, Qnil
);
4420 Fcompose_string_internal (string
, from
, to
, gstr
, Qnil
);
4431 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4432 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4433 OTF-FEATURES specifies which features to apply in this format:
4434 (SCRIPT LANGSYS GSUB GPOS)
4436 SCRIPT is a symbol specifying a script tag of OpenType,
4437 LANGSYS is a symbol specifying a langsys tag of OpenType,
4438 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4440 If LANGYS is nil, the default langsys is selected.
4442 The features are applied in the order they appear in the list. The
4443 symbol `*' means to apply all available features not present in this
4444 list, and the remaining features are ignored. For instance, (vatu
4445 pstf * haln) is to apply vatu and pstf in this order, then to apply
4446 all available features other than vatu, pstf, and haln.
4448 The features are applied to the glyphs in the range FROM and TO of
4449 the glyph-string GSTRING-IN.
4451 If some feature is actually applicable, the resulting glyphs are
4452 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4453 this case, the value is the number of produced glyphs.
4455 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4458 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4459 produced in GSTRING-OUT, and the value is nil.
4461 See the documentation of `font-make-gstring' for the format of
4463 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4464 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4466 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4471 check_otf_features (otf_features
);
4472 CHECK_FONT_OBJECT (font_object
);
4473 font
= XFONT_OBJECT (font_object
);
4474 if (! font
->driver
->otf_drive
)
4475 error ("Font backend %s can't drive OpenType GSUB table",
4476 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4477 CHECK_CONS (otf_features
);
4478 CHECK_SYMBOL (XCAR (otf_features
));
4479 val
= XCDR (otf_features
);
4480 CHECK_SYMBOL (XCAR (val
));
4481 val
= XCDR (otf_features
);
4484 len
= check_gstring (gstring_in
);
4485 CHECK_VECTOR (gstring_out
);
4486 CHECK_NATNUM (from
);
4488 CHECK_NATNUM (index
);
4490 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4491 args_out_of_range_3 (from
, to
, make_number (len
));
4492 if (XINT (index
) >= ASIZE (gstring_out
))
4493 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4494 num
= font
->driver
->otf_drive (font
, otf_features
,
4495 gstring_in
, XINT (from
), XINT (to
),
4496 gstring_out
, XINT (index
), 0);
4499 return make_number (num
);
4502 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4504 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4505 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4507 (SCRIPT LANGSYS FEATURE ...)
4508 See the documentation of `font-drive-otf' for more detail.
4510 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4511 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4512 character code corresponding to the glyph or nil if there's no
4513 corresponding character. */)
4514 (font_object
, character
, otf_features
)
4515 Lisp_Object font_object
, character
, otf_features
;
4518 Lisp_Object gstring_in
, gstring_out
, g
;
4519 Lisp_Object alternates
;
4522 CHECK_FONT_GET_OBJECT (font_object
, font
);
4523 if (! font
->driver
->otf_drive
)
4524 error ("Font backend %s can't drive OpenType GSUB table",
4525 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4526 CHECK_CHARACTER (character
);
4527 CHECK_CONS (otf_features
);
4529 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4530 g
= LGSTRING_GLYPH (gstring_in
, 0);
4531 LGLYPH_SET_CHAR (g
, XINT (character
));
4532 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4533 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4534 gstring_out
, 0, 1)) < 0)
4535 gstring_out
= Ffont_make_gstring (font_object
,
4536 make_number (ASIZE (gstring_out
) * 2));
4538 for (i
= 0; i
< num
; i
++)
4540 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4541 int c
= LGLYPH_CHAR (g
);
4542 unsigned code
= LGLYPH_CODE (g
);
4544 alternates
= Fcons (Fcons (make_number (code
),
4545 c
> 0 ? make_number (c
) : Qnil
),
4548 return Fnreverse (alternates
);
4554 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4555 doc
: /* Open FONT-ENTITY. */)
4556 (font_entity
, size
, frame
)
4557 Lisp_Object font_entity
;
4563 CHECK_FONT_ENTITY (font_entity
);
4565 frame
= selected_frame
;
4566 CHECK_LIVE_FRAME (frame
);
4569 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4572 CHECK_NUMBER_OR_FLOAT (size
);
4574 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
4576 isize
= XINT (size
);
4580 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4583 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4584 doc
: /* Close FONT-OBJECT. */)
4585 (font_object
, frame
)
4586 Lisp_Object font_object
, frame
;
4588 CHECK_FONT_OBJECT (font_object
);
4590 frame
= selected_frame
;
4591 CHECK_LIVE_FRAME (frame
);
4592 font_close_object (XFRAME (frame
), font_object
);
4596 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4597 doc
: /* Return information about FONT-OBJECT.
4598 The value is a vector:
4599 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4602 NAME is a string of the font name (or nil if the font backend doesn't
4605 FILENAME is a string of the font file (or nil if the font backend
4606 doesn't provide a file name).
4608 PIXEL-SIZE is a pixel size by which the font is opened.
4610 SIZE is a maximum advance width of the font in pixels.
4612 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4615 CAPABILITY is a list whose first element is a symbol representing the
4616 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4617 remaining elements describe the details of the font capability.
4619 If the font is OpenType font, the form of the list is
4620 \(opentype GSUB GPOS)
4621 where GSUB shows which "GSUB" features the font supports, and GPOS
4622 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4623 lists of the format:
4624 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4626 If the font is not OpenType font, currently the length of the form is
4629 SCRIPT is a symbol representing OpenType script tag.
4631 LANGSYS is a symbol representing OpenType langsys tag, or nil
4632 representing the default langsys.
4634 FEATURE is a symbol representing OpenType feature tag.
4636 If the font is not OpenType font, CAPABILITY is nil. */)
4638 Lisp_Object font_object
;
4643 CHECK_FONT_GET_OBJECT (font_object
, font
);
4645 val
= Fmake_vector (make_number (9), Qnil
);
4646 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4647 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4648 ASET (val
, 2, make_number (font
->pixel_size
));
4649 ASET (val
, 3, make_number (font
->max_width
));
4650 ASET (val
, 4, make_number (font
->ascent
));
4651 ASET (val
, 5, make_number (font
->descent
));
4652 ASET (val
, 6, make_number (font
->space_width
));
4653 ASET (val
, 7, make_number (font
->average_width
));
4654 if (font
->driver
->otf_capability
)
4655 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4659 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4660 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4661 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4662 (font_object
, string
)
4663 Lisp_Object font_object
, string
;
4669 CHECK_FONT_GET_OBJECT (font_object
, font
);
4670 CHECK_STRING (string
);
4671 len
= SCHARS (string
);
4672 vec
= Fmake_vector (make_number (len
), Qnil
);
4673 for (i
= 0; i
< len
; i
++)
4675 Lisp_Object ch
= Faref (string
, make_number (i
));
4680 struct font_metrics metrics
;
4682 cod
= code
= font
->driver
->encode_char (font
, c
);
4683 if (code
== FONT_INVALID_CODE
)
4685 val
= Fmake_vector (make_number (6), Qnil
);
4686 if (cod
<= MOST_POSITIVE_FIXNUM
)
4687 ASET (val
, 0, make_number (code
));
4689 ASET (val
, 0, Fcons (make_number (code
>> 16),
4690 make_number (code
& 0xFFFF)));
4691 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4692 ASET (val
, 1, make_number (metrics
.lbearing
));
4693 ASET (val
, 2, make_number (metrics
.rbearing
));
4694 ASET (val
, 3, make_number (metrics
.width
));
4695 ASET (val
, 4, make_number (metrics
.ascent
));
4696 ASET (val
, 5, make_number (metrics
.descent
));
4702 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4703 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4704 FONT is a font-spec, font-entity, or font-object. */)
4706 Lisp_Object spec
, font
;
4708 CHECK_FONT_SPEC (spec
);
4711 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4714 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4715 doc
: /* Return a font-object for displaying a character at POSITION.
4716 Optional second arg WINDOW, if non-nil, is a window displaying
4717 the current buffer. It defaults to the currently selected window. */)
4718 (position
, window
, string
)
4719 Lisp_Object position
, window
, string
;
4726 CHECK_NUMBER_COERCE_MARKER (position
);
4727 pos
= XINT (position
);
4728 if (pos
< BEGV
|| pos
>= ZV
)
4729 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4733 CHECK_NUMBER (position
);
4734 CHECK_STRING (string
);
4735 pos
= XINT (position
);
4736 if (pos
< 0 || pos
>= SCHARS (string
))
4737 args_out_of_range (string
, position
);
4740 window
= selected_window
;
4741 CHECK_LIVE_WINDOW (window
);
4742 w
= XWINDOW (window
);
4744 return font_at (-1, pos
, NULL
, w
, string
);
4748 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4749 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4750 The value is a number of glyphs drawn.
4751 Type C-l to recover what previously shown. */)
4752 (font_object
, string
)
4753 Lisp_Object font_object
, string
;
4755 Lisp_Object frame
= selected_frame
;
4756 FRAME_PTR f
= XFRAME (frame
);
4762 CHECK_FONT_GET_OBJECT (font_object
, font
);
4763 CHECK_STRING (string
);
4764 len
= SCHARS (string
);
4765 code
= alloca (sizeof (unsigned) * len
);
4766 for (i
= 0; i
< len
; i
++)
4768 Lisp_Object ch
= Faref (string
, make_number (i
));
4772 code
[i
] = font
->driver
->encode_char (font
, c
);
4773 if (code
[i
] == FONT_INVALID_CODE
)
4776 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4778 if (font
->driver
->prepare_face
)
4779 font
->driver
->prepare_face (f
, face
);
4780 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4781 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4782 if (font
->driver
->done_face
)
4783 font
->driver
->done_face (f
, face
);
4785 return make_number (len
);
4789 #endif /* FONT_DEBUG */
4791 #ifdef HAVE_WINDOW_SYSTEM
4793 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4794 doc
: /* Return information about a font named NAME on frame FRAME.
4795 If FRAME is omitted or nil, use the selected frame.
4796 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4797 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4799 OPENED-NAME is the name used for opening the font,
4800 FULL-NAME is the full name of the font,
4801 SIZE is the maximum bound width of the font,
4802 HEIGHT is the height of the font,
4803 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4804 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4805 how to compose characters.
4806 If the named font is not yet loaded, return nil. */)
4808 Lisp_Object name
, frame
;
4813 Lisp_Object font_object
;
4815 (*check_window_system_func
) ();
4818 CHECK_STRING (name
);
4820 frame
= selected_frame
;
4821 CHECK_LIVE_FRAME (frame
);
4826 int fontset
= fs_query_fontset (name
, 0);
4829 name
= fontset_ascii (fontset
);
4830 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4832 else if (FONT_OBJECT_P (name
))
4834 else if (FONT_ENTITY_P (name
))
4835 font_object
= font_open_entity (f
, name
, 0);
4838 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4839 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4841 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4843 if (NILP (font_object
))
4845 font
= XFONT_OBJECT (font_object
);
4847 info
= Fmake_vector (make_number (7), Qnil
);
4848 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4849 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4850 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4851 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4852 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4853 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4854 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4857 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4858 close it now. Perhaps, we should manage font-objects
4859 by `reference-count'. */
4860 font_close_object (f
, font_object
);
4867 #define BUILD_STYLE_TABLE(TBL) \
4868 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4871 build_style_table (entry
, nelement
)
4872 struct table_entry
*entry
;
4876 Lisp_Object table
, elt
;
4878 table
= Fmake_vector (make_number (nelement
), Qnil
);
4879 for (i
= 0; i
< nelement
; i
++)
4881 for (j
= 0; entry
[i
].names
[j
]; j
++);
4882 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4883 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4884 for (j
= 0; entry
[i
].names
[j
]; j
++)
4885 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4886 ASET (table
, i
, elt
);
4891 static Lisp_Object Vfont_log
;
4892 static int font_log_env_checked
;
4895 font_add_log (action
, arg
, result
)
4897 Lisp_Object arg
, result
;
4899 Lisp_Object tail
, val
;
4902 if (! font_log_env_checked
)
4904 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
4905 font_log_env_checked
= 1;
4907 if (EQ (Vfont_log
, Qt
))
4910 arg
= Ffont_xlfd_name (arg
, Qt
);
4913 val
= Ffont_xlfd_name (result
, Qt
);
4914 if (! FONT_SPEC_P (result
))
4915 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4916 build_string (":"), val
);
4919 else if (CONSP (result
))
4921 result
= Fcopy_sequence (result
);
4922 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4926 val
= Ffont_xlfd_name (val
, Qt
);
4927 XSETCAR (tail
, val
);
4930 else if (VECTORP (result
))
4932 result
= Fcopy_sequence (result
);
4933 for (i
= 0; i
< ASIZE (result
); i
++)
4935 val
= AREF (result
, i
);
4937 val
= Ffont_xlfd_name (val
, Qt
);
4938 ASET (result
, i
, val
);
4941 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4944 extern void syms_of_ftfont
P_ (());
4945 extern void syms_of_xfont
P_ (());
4946 extern void syms_of_xftfont
P_ (());
4947 extern void syms_of_ftxfont
P_ (());
4948 extern void syms_of_bdffont
P_ (());
4949 extern void syms_of_w32font
P_ (());
4950 extern void syms_of_atmfont
P_ (());
4955 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
4956 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
4957 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
4958 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
4959 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
4960 /* Note that the other elements in sort_shift_bits are not used. */
4962 staticpro (&font_charset_alist
);
4963 font_charset_alist
= Qnil
;
4965 DEFSYM (Qfont_spec
, "font-spec");
4966 DEFSYM (Qfont_entity
, "font-entity");
4967 DEFSYM (Qfont_object
, "font-object");
4969 DEFSYM (Qopentype
, "opentype");
4971 DEFSYM (Qascii_0
, "ascii-0");
4972 DEFSYM (Qiso8859_1
, "iso8859-1");
4973 DEFSYM (Qiso10646_1
, "iso10646-1");
4974 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4975 DEFSYM (Qunicode_sip
, "unicode-sip");
4977 DEFSYM (QCotf
, ":otf");
4978 DEFSYM (QClang
, ":lang");
4979 DEFSYM (QCscript
, ":script");
4980 DEFSYM (QCantialias
, ":antialias");
4982 DEFSYM (QCfoundry
, ":foundry");
4983 DEFSYM (QCadstyle
, ":adstyle");
4984 DEFSYM (QCregistry
, ":registry");
4985 DEFSYM (QCspacing
, ":spacing");
4986 DEFSYM (QCdpi
, ":dpi");
4987 DEFSYM (QCscalable
, ":scalable");
4988 DEFSYM (QCavgwidth
, ":avgwidth");
4989 DEFSYM (QCfont_entity
, ":font-entity");
4990 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
4997 staticpro (&null_vector
);
4998 null_vector
= Fmake_vector (make_number (0), Qnil
);
5000 staticpro (&scratch_font_spec
);
5001 scratch_font_spec
= Ffont_spec (0, NULL
);
5002 staticpro (&scratch_font_prefer
);
5003 scratch_font_prefer
= Ffont_spec (0, NULL
);
5007 staticpro (&otf_list
);
5009 #endif /* HAVE_LIBOTF */
5013 defsubr (&Sfont_spec
);
5014 defsubr (&Sfont_get
);
5015 #ifdef HAVE_WINDOW_SYSTEM
5016 defsubr (&Sfont_face_attributes
);
5018 defsubr (&Sfont_put
);
5019 defsubr (&Slist_fonts
);
5020 defsubr (&Sfont_family_list
);
5021 defsubr (&Sfind_font
);
5022 defsubr (&Sfont_xlfd_name
);
5023 defsubr (&Sclear_font_cache
);
5024 defsubr (&Sfont_make_gstring
);
5025 defsubr (&Sfont_fill_gstring
);
5026 defsubr (&Sfont_shape_text
);
5028 defsubr (&Sfont_drive_otf
);
5029 defsubr (&Sfont_otf_alternates
);
5033 defsubr (&Sopen_font
);
5034 defsubr (&Sclose_font
);
5035 defsubr (&Squery_font
);
5036 defsubr (&Sget_font_glyphs
);
5037 defsubr (&Sfont_match_p
);
5038 defsubr (&Sfont_at
);
5040 defsubr (&Sdraw_string
);
5042 #endif /* FONT_DEBUG */
5043 #ifdef HAVE_WINDOW_SYSTEM
5044 defsubr (&Sfont_info
);
5047 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
5049 Alist of fontname patterns vs the corresponding encoding and repertory info.
5050 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
5051 where ENCODING is a charset or a char-table,
5052 and REPERTORY is a charset, a char-table, or nil.
5054 If ENCODING and REPERTORY are the same, the element can have the form
5055 \(REGEXP . ENCODING).
5057 ENCODING is for converting a character to a glyph code of the font.
5058 If ENCODING is a charset, encoding a character by the charset gives
5059 the corresponding glyph code. If ENCODING is a char-table, looking up
5060 the table by a character gives the corresponding glyph code.
5062 REPERTORY specifies a repertory of characters supported by the font.
5063 If REPERTORY is a charset, all characters beloging to the charset are
5064 supported. If REPERTORY is a char-table, all characters who have a
5065 non-nil value in the table are supported. If REPERTORY is nil, Emacs
5066 gets the repertory information by an opened font and ENCODING. */);
5067 Vfont_encoding_alist
= Qnil
;
5069 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
5070 doc
: /* Vector of valid font weight values.
5071 Each element has the form:
5072 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
5073 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
5074 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
5076 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
5077 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
5078 See `font-weight-table' for the format of the vector. */);
5079 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
5081 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
5082 doc
: /* Alist of font width symbols vs the corresponding numeric values.
5083 See `font-weight-table' for the format of the vector. */);
5084 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
5086 staticpro (&font_style_table
);
5087 font_style_table
= Fmake_vector (make_number (3), Qnil
);
5088 ASET (font_style_table
, 0, Vfont_weight_table
);
5089 ASET (font_style_table
, 1, Vfont_slant_table
);
5090 ASET (font_style_table
, 2, Vfont_width_table
);
5092 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
5093 *Logging list of font related actions and results.
5094 The value t means to suppress the logging.
5095 The initial value is set to nil if the environment variable
5096 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
5099 #ifdef HAVE_WINDOW_SYSTEM
5100 #ifdef HAVE_FREETYPE
5102 #ifdef HAVE_X_WINDOWS
5107 #endif /* HAVE_XFT */
5108 #endif /* HAVE_X_WINDOWS */
5109 #else /* not HAVE_FREETYPE */
5110 #ifdef HAVE_X_WINDOWS
5112 #endif /* HAVE_X_WINDOWS */
5113 #endif /* not HAVE_FREETYPE */
5116 #endif /* HAVE_BDFFONT */
5119 #endif /* WINDOWSNT */
5123 #endif /* HAVE_WINDOW_SYSTEM */
5126 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
5127 (do not change this comment) */