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
);
193 font_make_object (size
)
196 Lisp_Object font_object
;
198 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
199 XSETFONT (font_object
, font
);
206 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
207 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
208 static Lisp_Object font_matching_entity
P_ ((FRAME_PTR
, Lisp_Object
*,
211 /* Number of registered font drivers. */
212 static int num_font_drivers
;
215 /* Return a Lispy value of a font property value at STR and LEN bytes.
216 If STR is "*", it returns nil.
217 If FORCE_SYMBOL is zero and all characters in STR are digits, it
218 returns an integer. Otherwise, it returns a symbol interned from
222 font_intern_prop (str
, len
, force_symbol
)
231 if (len
== 1 && *str
== '*')
233 if (!force_symbol
&& len
>=1 && isdigit (*str
))
235 for (i
= 1; i
< len
; i
++)
236 if (! isdigit (str
[i
]))
239 return make_number (atoi (str
));
242 /* The following code is copied from the function intern (in lread.c). */
244 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
245 obarray
= check_obarray (obarray
);
246 tem
= oblookup (obarray
, str
, len
, len
);
249 return Fintern (make_unibyte_string (str
, len
), obarray
);
252 /* Return a pixel size of font-spec SPEC on frame F. */
255 font_pixel_size (f
, spec
)
259 #ifdef HAVE_WINDOW_SYSTEM
260 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
269 font_assert (FLOATP (size
));
270 point_size
= XFLOAT_DATA (size
);
271 val
= AREF (spec
, FONT_DPI_INDEX
);
276 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
284 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
285 font vector. If VAL is not valid (i.e. not registered in
286 font_style_table), return -1 if NOERROR is zero, and return a
287 proper index if NOERROR is nonzero. In that case, register VAL in
288 font_style_table if VAL is a symbol, and return a closest index if
289 VAL is an integer. */
292 font_style_to_value (prop
, val
, noerror
)
293 enum font_property_index prop
;
297 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
298 int len
= ASIZE (table
);
304 Lisp_Object args
[2], elt
;
306 /* At first try exact match. */
307 for (i
= 0; i
< len
; i
++)
308 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
309 if (EQ (val
, AREF (AREF (table
, i
), j
)))
310 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
311 | (i
<< 4) | (j
- 1));
312 /* Try also with case-folding match. */
313 s
= SDATA (SYMBOL_NAME (val
));
314 for (i
= 0; i
< len
; i
++)
315 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
317 elt
= AREF (AREF (table
, i
), j
);
318 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
319 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
320 | (i
<< 4) | (j
- 1));
326 elt
= Fmake_vector (make_number (2), make_number (255));
329 args
[1] = Fmake_vector (make_number (1), elt
);
330 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
331 return (255 << 8) | (i
<< 4);
336 int numeric
= XINT (val
);
338 for (i
= 0, last_n
= -1; i
< len
; i
++)
340 int n
= XINT (AREF (AREF (table
, i
), 0));
343 return (n
<< 8) | (i
<< 4);
348 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
349 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
355 return ((last_n
<< 8) | ((i
- 1) << 4));
360 font_style_symbolic (font
, prop
, for_face
)
362 enum font_property_index prop
;
365 Lisp_Object val
= AREF (font
, prop
);
366 Lisp_Object table
, elt
;
371 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
372 i
= XINT (val
) & 0xFF;
373 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
374 elt
= AREF (table
, ((i
>> 4) & 0xF));
375 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
376 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
379 extern Lisp_Object Vface_alternative_font_family_alist
;
381 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
384 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
385 FONTNAME. ENCODING is a charset symbol that specifies the encoding
386 of the font. REPERTORY is a charset symbol or nil. */
389 find_font_encoding (fontname
)
390 Lisp_Object fontname
;
392 Lisp_Object tail
, elt
;
394 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
398 && STRINGP (XCAR (elt
))
399 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
400 && (SYMBOLP (XCDR (elt
))
401 ? CHARSETP (XCDR (elt
))
402 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
405 /* We don't know the encoding of this font. Let's assume `ascii'. */
409 /* Return encoding charset and repertory charset for REGISTRY in
410 ENCODING and REPERTORY correspondingly. If correct information for
411 REGISTRY is available, return 0. Otherwise return -1. */
414 font_registry_charsets (registry
, encoding
, repertory
)
415 Lisp_Object registry
;
416 struct charset
**encoding
, **repertory
;
419 int encoding_id
, repertory_id
;
421 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
427 encoding_id
= XINT (XCAR (val
));
428 repertory_id
= XINT (XCDR (val
));
432 val
= find_font_encoding (SYMBOL_NAME (registry
));
433 if (SYMBOLP (val
) && CHARSETP (val
))
435 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
437 else if (CONSP (val
))
439 if (! CHARSETP (XCAR (val
)))
441 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
442 if (NILP (XCDR (val
)))
446 if (! CHARSETP (XCDR (val
)))
448 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
453 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
455 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
459 *encoding
= CHARSET_FROM_ID (encoding_id
);
461 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
466 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
471 /* Font property value validaters. See the comment of
472 font_property_table for the meaning of the arguments. */
474 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
475 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
476 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
477 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
478 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
479 static int get_font_prop_index
P_ ((Lisp_Object
));
482 font_prop_validate_symbol (prop
, val
)
483 Lisp_Object prop
, val
;
486 val
= Fintern (val
, Qnil
);
489 else if (EQ (prop
, QCregistry
))
490 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
496 font_prop_validate_style (style
, val
)
497 Lisp_Object style
, val
;
499 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
500 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
507 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
511 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
513 if ((n
& 0xF) + 1 >= ASIZE (elt
))
515 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
519 else if (SYMBOLP (val
))
521 int n
= font_style_to_value (prop
, val
, 0);
523 val
= n
>= 0 ? make_number (n
) : Qerror
;
531 font_prop_validate_non_neg (prop
, val
)
532 Lisp_Object prop
, val
;
534 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
539 font_prop_validate_spacing (prop
, val
)
540 Lisp_Object prop
, val
;
542 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
544 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
546 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
548 if (spacing
== 'c' || spacing
== 'C')
549 return make_number (FONT_SPACING_CHARCELL
);
550 if (spacing
== 'm' || spacing
== 'M')
551 return make_number (FONT_SPACING_MONO
);
552 if (spacing
== 'p' || spacing
== 'P')
553 return make_number (FONT_SPACING_PROPORTIONAL
);
554 if (spacing
== 'd' || spacing
== 'D')
555 return make_number (FONT_SPACING_DUAL
);
561 font_prop_validate_otf (prop
, val
)
562 Lisp_Object prop
, val
;
564 Lisp_Object tail
, tmp
;
567 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
568 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
569 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
572 if (! SYMBOLP (XCAR (val
)))
577 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
579 for (i
= 0; i
< 2; i
++)
586 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
587 if (! SYMBOLP (XCAR (tmp
)))
595 /* Structure of known font property keys and validater of the
599 /* Pointer to the key symbol. */
601 /* Function to validate PROP's value VAL, or NULL if any value is
602 ok. The value is VAL or its regularized value if VAL is valid,
603 and Qerror if not. */
604 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
605 } font_property_table
[] =
606 { { &QCtype
, font_prop_validate_symbol
},
607 { &QCfoundry
, font_prop_validate_symbol
},
608 { &QCfamily
, font_prop_validate_symbol
},
609 { &QCadstyle
, font_prop_validate_symbol
},
610 { &QCregistry
, font_prop_validate_symbol
},
611 { &QCweight
, font_prop_validate_style
},
612 { &QCslant
, font_prop_validate_style
},
613 { &QCwidth
, font_prop_validate_style
},
614 { &QCsize
, font_prop_validate_non_neg
},
615 { &QCdpi
, font_prop_validate_non_neg
},
616 { &QCspacing
, font_prop_validate_spacing
},
617 { &QCavgwidth
, font_prop_validate_non_neg
},
618 /* The order of the above entries must match with enum
619 font_property_index. */
620 { &QClang
, font_prop_validate_symbol
},
621 { &QCscript
, font_prop_validate_symbol
},
622 { &QCotf
, font_prop_validate_otf
}
625 /* Size (number of elements) of the above table. */
626 #define FONT_PROPERTY_TABLE_SIZE \
627 ((sizeof font_property_table) / (sizeof *font_property_table))
629 /* Return an index number of font property KEY or -1 if KEY is not an
630 already known property. */
633 get_font_prop_index (key
)
638 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
639 if (EQ (key
, *font_property_table
[i
].key
))
644 /* Validate the font property. The property key is specified by the
645 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
646 signal an error. The value is VAL or the regularized one. */
649 font_prop_validate (idx
, prop
, val
)
651 Lisp_Object prop
, val
;
653 Lisp_Object validated
;
658 prop
= *font_property_table
[idx
].key
;
661 idx
= get_font_prop_index (prop
);
665 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
666 if (EQ (validated
, Qerror
))
667 signal_error ("invalid font property", Fcons (prop
, val
));
672 /* Store VAL as a value of extra font property PROP in FONT while
673 keeping the sorting order. Don't check the validity of VAL. */
676 font_put_extra (font
, prop
, val
)
677 Lisp_Object font
, prop
, val
;
679 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
680 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
684 Lisp_Object prev
= Qnil
;
687 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
688 prev
= extra
, extra
= XCDR (extra
);
690 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
692 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
700 /* Font name parser and unparser */
702 static int parse_matrix
P_ ((char *));
703 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
704 static int font_parse_name
P_ ((char *, Lisp_Object
));
706 /* An enumerator for each field of an XLFD font name. */
707 enum xlfd_field_index
726 /* An enumerator for mask bit corresponding to each XLFD field. */
729 XLFD_FOUNDRY_MASK
= 0x0001,
730 XLFD_FAMILY_MASK
= 0x0002,
731 XLFD_WEIGHT_MASK
= 0x0004,
732 XLFD_SLANT_MASK
= 0x0008,
733 XLFD_SWIDTH_MASK
= 0x0010,
734 XLFD_ADSTYLE_MASK
= 0x0020,
735 XLFD_PIXEL_MASK
= 0x0040,
736 XLFD_POINT_MASK
= 0x0080,
737 XLFD_RESX_MASK
= 0x0100,
738 XLFD_RESY_MASK
= 0x0200,
739 XLFD_SPACING_MASK
= 0x0400,
740 XLFD_AVGWIDTH_MASK
= 0x0800,
741 XLFD_REGISTRY_MASK
= 0x1000,
742 XLFD_ENCODING_MASK
= 0x2000
746 /* Parse P pointing the pixel/point size field of the form
747 `[A B C D]' which specifies a transformation matrix:
753 by which all glyphs of the font are transformed. The spec says
754 that scalar value N for the pixel/point size is equivalent to:
755 A = N * resx/resy, B = C = 0, D = N.
757 Return the scalar value N if the form is valid. Otherwise return
768 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
771 matrix
[i
] = - strtod (p
+ 1, &end
);
773 matrix
[i
] = strtod (p
, &end
);
776 return (i
== 4 ? (int) matrix
[3] : -1);
779 /* Expand a wildcard field in FIELD (the first N fields are filled) to
780 multiple fields to fill in all 14 XLFD fields while restring a
781 field position by its contents. */
784 font_expand_wildcards (field
, n
)
785 Lisp_Object field
[XLFD_LAST_INDEX
];
789 Lisp_Object tmp
[XLFD_LAST_INDEX
];
790 /* Array of information about where this element can go. Nth
791 element is for Nth element of FIELD. */
793 /* Minimum possible field. */
795 /* Maxinum possible field. */
797 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
799 } range
[XLFD_LAST_INDEX
];
801 int range_from
, range_to
;
804 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
805 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
806 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
807 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
808 | XLFD_AVGWIDTH_MASK)
809 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
811 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
812 field. The value is shifted to left one bit by one in the
814 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
815 range_mask
= (range_mask
<< 1) | 1;
817 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
818 position-based retriction for FIELD[I]. */
819 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
820 i
++, range_from
++, range_to
++, range_mask
<<= 1)
822 Lisp_Object val
= field
[i
];
828 range
[i
].from
= range_from
;
829 range
[i
].to
= range_to
;
830 range
[i
].mask
= range_mask
;
834 /* The triplet FROM, TO, and MASK is a value-based
835 retriction for FIELD[I]. */
841 int numeric
= XINT (val
);
844 from
= to
= XLFD_ENCODING_INDEX
,
845 mask
= XLFD_ENCODING_MASK
;
846 else if (numeric
== 0)
847 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
848 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
849 else if (numeric
<= 48)
850 from
= to
= XLFD_PIXEL_INDEX
,
851 mask
= XLFD_PIXEL_MASK
;
853 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
854 mask
= XLFD_LARGENUM_MASK
;
856 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
857 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
858 mask
= XLFD_NULL_MASK
;
860 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
863 Lisp_Object name
= SYMBOL_NAME (val
);
865 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
866 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
867 mask
= XLFD_REGENC_MASK
;
869 from
= to
= XLFD_ENCODING_INDEX
,
870 mask
= XLFD_ENCODING_MASK
;
872 else if (range_from
<= XLFD_WEIGHT_INDEX
873 && range_to
>= XLFD_WEIGHT_INDEX
874 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
875 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
876 else if (range_from
<= XLFD_SLANT_INDEX
877 && range_to
>= XLFD_SLANT_INDEX
878 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
879 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
880 else if (range_from
<= XLFD_SWIDTH_INDEX
881 && range_to
>= XLFD_SWIDTH_INDEX
882 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
883 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
886 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
887 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
889 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
890 mask
= XLFD_SYMBOL_MASK
;
893 /* Merge position-based and value-based restrictions. */
895 while (from
< range_from
)
896 mask
&= ~(1 << from
++);
897 while (from
< 14 && ! (mask
& (1 << from
)))
899 while (to
> range_to
)
900 mask
&= ~(1 << to
--);
901 while (to
>= 0 && ! (mask
& (1 << to
)))
905 range
[i
].from
= from
;
907 range
[i
].mask
= mask
;
909 if (from
> range_from
|| to
< range_to
)
911 /* The range is narrowed by value-based restrictions.
912 Reflect it to the other fields. */
914 /* Following fields should be after FROM. */
916 /* Preceding fields should be before TO. */
917 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
919 /* Check FROM for non-wildcard field. */
920 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
922 while (range
[j
].from
< from
)
923 range
[j
].mask
&= ~(1 << range
[j
].from
++);
924 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
926 range
[j
].from
= from
;
929 from
= range
[j
].from
;
930 if (range
[j
].to
> to
)
932 while (range
[j
].to
> to
)
933 range
[j
].mask
&= ~(1 << range
[j
].to
--);
934 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
947 /* Decide all fileds from restrictions in RANGE. */
948 for (i
= j
= 0; i
< n
; i
++)
950 if (j
< range
[i
].from
)
952 if (i
== 0 || ! NILP (tmp
[i
- 1]))
953 /* None of TMP[X] corresponds to Jth field. */
955 for (; j
< range
[i
].from
; j
++)
960 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
962 for (; j
< XLFD_LAST_INDEX
; j
++)
964 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
965 field
[XLFD_ENCODING_INDEX
]
966 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
971 #ifdef ENABLE_CHECKING
972 /* Match a 14-field XLFD pattern against a full XLFD font name. */
974 font_match_xlfd (char *pattern
, char *name
)
976 while (*pattern
&& *name
)
978 if (*pattern
== *name
)
980 else if (*pattern
== '*')
981 if (*name
== pattern
[1])
992 /* Make sure the font object matches the XLFD font name. */
994 font_check_xlfd_parse (Lisp_Object font
, char *name
)
996 char name_check
[256];
997 font_unparse_xlfd (font
, 0, name_check
, 255);
998 return font_match_xlfd (name_check
, name
);
1004 /* Parse NAME (null terminated) as XLFD and store information in FONT
1005 (font-spec or font-entity). Size property of FONT is set as
1007 specified XLFD fields FONT property
1008 --------------------- -------------
1009 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1010 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1011 POINT_SIZE POINT_SIZE/10 (Lisp float)
1013 If NAME is successfully parsed, return 0. Otherwise return -1.
1015 FONT is usually a font-spec, but when this function is called from
1016 X font backend driver, it is a font-entity. In that case, NAME is
1017 a fully specified XLFD. */
1020 font_parse_xlfd (name
, font
)
1024 int len
= strlen (name
);
1026 char *f
[XLFD_LAST_INDEX
+ 1];
1031 /* Maximum XLFD name length is 255. */
1033 /* Accept "*-.." as a fully specified XLFD. */
1034 if (name
[0] == '*' && name
[1] == '-')
1035 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1038 for (p
= name
+ i
; *p
; p
++)
1042 if (i
== XLFD_LAST_INDEX
)
1047 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1048 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1050 if (i
== XLFD_LAST_INDEX
)
1052 /* Fully specified XLFD. */
1055 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1056 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1057 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1058 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1060 val
= INTERN_FIELD_SYM (i
);
1063 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1065 ASET (font
, j
, make_number (n
));
1068 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1069 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1070 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1072 ASET (font
, FONT_REGISTRY_INDEX
,
1073 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1074 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1076 p
= f
[XLFD_PIXEL_INDEX
];
1077 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1078 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1081 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1083 ASET (font
, FONT_SIZE_INDEX
, val
);
1086 double point_size
= -1;
1088 font_assert (FONT_SPEC_P (font
));
1089 p
= f
[XLFD_POINT_INDEX
];
1091 point_size
= parse_matrix (p
);
1092 else if (isdigit (*p
))
1093 point_size
= atoi (p
), point_size
/= 10;
1094 if (point_size
>= 0)
1095 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1099 ASET (font
, FONT_DPI_INDEX
, INTERN_FIELD (XLFD_RESY_INDEX
));
1100 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1103 val
= font_prop_validate_spacing (QCspacing
, val
);
1104 if (! INTEGERP (val
))
1106 ASET (font
, FONT_SPACING_INDEX
, val
);
1108 p
= f
[XLFD_AVGWIDTH_INDEX
];
1111 ASET (font
, FONT_AVGWIDTH_INDEX
,
1112 font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 1));
1116 int wild_card_found
= 0;
1117 Lisp_Object prop
[XLFD_LAST_INDEX
];
1119 if (FONT_ENTITY_P (font
))
1121 for (j
= 0; j
< i
; j
++)
1125 if (f
[j
][1] && f
[j
][1] != '-')
1128 wild_card_found
= 1;
1131 prop
[j
] = INTERN_FIELD (j
);
1133 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1135 if (! wild_card_found
)
1137 if (font_expand_wildcards (prop
, i
) < 0)
1140 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1141 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1142 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1143 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1144 if (! NILP (prop
[i
]))
1146 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1148 ASET (font
, j
, make_number (n
));
1150 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1151 val
= prop
[XLFD_REGISTRY_INDEX
];
1154 val
= prop
[XLFD_ENCODING_INDEX
];
1156 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1158 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1159 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1161 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1162 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1164 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1166 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1167 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1168 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1170 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1172 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1175 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1176 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1177 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1179 val
= font_prop_validate_spacing (QCspacing
,
1180 prop
[XLFD_SPACING_INDEX
]);
1181 if (! INTEGERP (val
))
1183 ASET (font
, FONT_SPACING_INDEX
, val
);
1185 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1186 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1192 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1193 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1194 0, use PIXEL_SIZE instead. */
1197 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1203 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1207 font_assert (FONTP (font
));
1209 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1212 if (i
== FONT_ADSTYLE_INDEX
)
1213 j
= XLFD_ADSTYLE_INDEX
;
1214 else if (i
== FONT_REGISTRY_INDEX
)
1215 j
= XLFD_REGISTRY_INDEX
;
1216 val
= AREF (font
, i
);
1219 if (j
== XLFD_REGISTRY_INDEX
)
1220 f
[j
] = "*-*", len
+= 4;
1222 f
[j
] = "*", len
+= 2;
1227 val
= SYMBOL_NAME (val
);
1228 if (j
== XLFD_REGISTRY_INDEX
1229 && ! strchr ((char *) SDATA (val
), '-'))
1231 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1232 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1234 f
[j
] = alloca (SBYTES (val
) + 3);
1235 sprintf (f
[j
], "%s-*", SDATA (val
));
1236 len
+= SBYTES (val
) + 3;
1240 f
[j
] = alloca (SBYTES (val
) + 4);
1241 sprintf (f
[j
], "%s*-*", SDATA (val
));
1242 len
+= SBYTES (val
) + 4;
1246 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1250 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1253 val
= font_style_symbolic (font
, i
, 0);
1255 f
[j
] = "*", len
+= 2;
1258 val
= SYMBOL_NAME (val
);
1259 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1263 val
= AREF (font
, FONT_SIZE_INDEX
);
1264 font_assert (NUMBERP (val
) || NILP (val
));
1272 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1273 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1276 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1278 else if (FLOATP (val
))
1280 i
= XFLOAT_DATA (val
) * 10;
1281 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1282 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1285 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1287 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1289 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1290 f
[XLFD_RESX_INDEX
] = alloca (22);
1291 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1295 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1296 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1298 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1300 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1301 : spacing
<= FONT_SPACING_DUAL
? "d"
1302 : spacing
<= FONT_SPACING_MONO
? "m"
1307 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1308 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1310 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1311 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
],
1312 "%d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1315 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1316 len
++; /* for terminating '\0'. */
1319 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1320 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1321 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1322 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1323 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1324 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1325 f
[XLFD_REGISTRY_INDEX
]);
1328 /* Parse NAME (null terminated) and store information in FONT
1329 (font-spec or font-entity). NAME is supplied in either the
1330 Fontconfig or GTK font name format. If NAME is successfully
1331 parsed, return 0. Otherwise return -1.
1333 The fontconfig format is
1335 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1339 FAMILY [PROPS...] [SIZE]
1341 This function tries to guess which format it is. */
1344 font_parse_fcname (name
, font
)
1349 char *size_beg
= NULL
, *size_end
= NULL
;
1350 char *props_beg
= NULL
, *family_end
= NULL
;
1351 int len
= strlen (name
);
1356 for (p
= name
; *p
; p
++)
1358 if (*p
== '\\' && p
[1])
1368 int decimal
= 0, size_found
= 1;
1369 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1372 if (*q
!= '.' || decimal
)
1391 /* A fontconfig name with size and/or property data. */
1392 if (family_end
> name
)
1395 family
= font_intern_prop (name
, family_end
- name
, 1);
1396 ASET (font
, FONT_FAMILY_INDEX
, family
);
1400 double point_size
= strtod (size_beg
, &size_end
);
1401 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1402 if (*size_end
== ':' && size_end
[1])
1403 props_beg
= size_end
+ 1;
1407 /* Now parse ":KEY=VAL" patterns. Store known keys and values in
1408 extra, copy unknown ones to COPY. It is stored in extra slot by
1409 the key QCfc_unknown_spec. */
1412 name
= copy
= alloca (name
+ len
- props_beg
);
1422 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1426 /* Must be an enumerated value. */
1427 val
= font_intern_prop (p
, q
- p
, 1);
1429 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1431 if (PROP_MATCH ("light", 5)
1432 || PROP_MATCH ("medium", 6)
1433 || PROP_MATCH ("demibold", 8)
1434 || PROP_MATCH ("bold", 4)
1435 || PROP_MATCH ("black", 5))
1436 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1437 else if (PROP_MATCH ("roman", 5)
1438 || PROP_MATCH ("italic", 6)
1439 || PROP_MATCH ("oblique", 7))
1440 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1441 else if (PROP_MATCH ("charcell", 8))
1442 ASET (font
, FONT_SPACING_INDEX
,
1443 make_number (FONT_SPACING_CHARCELL
));
1444 else if (PROP_MATCH ("mono", 4))
1445 ASET (font
, FONT_SPACING_INDEX
,
1446 make_number (FONT_SPACING_MONO
));
1447 else if (PROP_MATCH ("proportional", 12))
1448 ASET (font
, FONT_SPACING_INDEX
,
1449 make_number (FONT_SPACING_PROPORTIONAL
));
1453 bcopy (p
, copy
, word_len
);
1458 else /* KEY=VAL pairs */
1463 if (word_len
== 9 && memcmp (p
, "pixelsize=", 10) == 0)
1464 prop
= FONT_SIZE_INDEX
;
1467 key
= font_intern_prop (p
, q
- p
, 1);
1468 prop
= get_font_prop_index (key
);
1471 for (q
= p
; *q
&& *q
!= ':'; q
++);
1473 val
= font_intern_prop (p
, q
- p
, 0);
1476 if (prop
>= FONT_FOUNDRY_INDEX
1477 && prop
< FONT_EXTRA_INDEX
)
1479 font_prop_validate (prop
, Qnil
, val
));
1481 Ffont_put (font
, key
, val
);
1483 bcopy (keyhead
, copy
, q
- keyhead
);
1484 copy
+= q
- keyhead
;
1490 font_put_extra (font
, QCfc_unknown_spec
,
1491 make_unibyte_string (name
, copy
- name
));
1496 /* Either a fontconfig-style name with no size and property
1497 data, or a GTK-style name. */
1499 int word_len
, prop_found
= 0;
1501 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1507 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1515 double point_size
= strtod (p
, &q
);
1516 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1521 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1522 if (*q
== '\\' && q
[1])
1526 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1528 if (PROP_MATCH ("Ultra-Light", 11))
1531 prop
= font_intern_prop ("ultra-light", 11, 1);
1532 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1534 else if (PROP_MATCH ("Light", 5))
1537 prop
= font_intern_prop ("light", 5, 1);
1538 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1540 else if (PROP_MATCH ("Semi-Bold", 9))
1543 prop
= font_intern_prop ("semi-bold", 9, 1);
1544 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1546 else if (PROP_MATCH ("Bold", 4))
1549 prop
= font_intern_prop ("bold", 4, 1);
1550 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1552 else if (PROP_MATCH ("Italic", 6))
1555 prop
= font_intern_prop ("italic", 4, 1);
1556 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1558 else if (PROP_MATCH ("Oblique", 7))
1561 prop
= font_intern_prop ("oblique", 7, 1);
1562 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1566 return -1; /* Unknown property in GTK-style font name. */
1575 family
= font_intern_prop (name
, family_end
- name
, 1);
1576 ASET (font
, FONT_FAMILY_INDEX
, family
);
1583 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1584 NAME (NBYTES length), and return the name length. If
1585 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1588 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1594 Lisp_Object family
, foundry
;
1595 Lisp_Object tail
, val
;
1600 Lisp_Object styles
[3];
1601 char *style_names
[3] = { "weight", "slant", "width" };
1604 family
= AREF (font
, FONT_FAMILY_INDEX
);
1605 if (! NILP (family
))
1607 if (SYMBOLP (family
))
1609 family
= SYMBOL_NAME (family
);
1610 len
+= SBYTES (family
);
1616 val
= AREF (font
, FONT_SIZE_INDEX
);
1619 if (XINT (val
) != 0)
1620 pixel_size
= XINT (val
);
1622 len
+= 21; /* for ":pixelsize=NUM" */
1624 else if (FLOATP (val
))
1627 point_size
= (int) XFLOAT_DATA (val
);
1628 len
+= 11; /* for "-NUM" */
1631 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1632 if (! NILP (foundry
))
1634 if (SYMBOLP (foundry
))
1636 foundry
= SYMBOL_NAME (foundry
);
1637 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1643 for (i
= 0; i
< 3; i
++)
1645 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1646 if (! NILP (styles
[i
]))
1647 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1648 SDATA (SYMBOL_NAME (styles
[i
])));
1651 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1652 len
+= sprintf (work
, ":dpi=%d", dpi
);
1653 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1654 len
+= strlen (":spacing=100");
1655 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1656 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1657 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1659 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1661 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1663 len
+= SBYTES (val
);
1664 else if (INTEGERP (val
))
1665 len
+= sprintf (work
, "%d", XINT (val
));
1666 else if (SYMBOLP (val
))
1667 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1673 if (! NILP (family
))
1674 p
+= sprintf (p
, "%s", SDATA (family
));
1678 p
+= sprintf (p
, "%d", point_size
);
1680 p
+= sprintf (p
, "-%d", point_size
);
1682 else if (pixel_size
> 0)
1683 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1684 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1685 p
+= sprintf (p
, ":foundry=%s",
1686 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1687 for (i
= 0; i
< 3; i
++)
1688 if (! NILP (styles
[i
]))
1689 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1690 SDATA (SYMBOL_NAME (styles
[i
])));
1691 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1692 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1693 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1694 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1695 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1697 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1698 p
+= sprintf (p
, ":scalable=true");
1700 p
+= sprintf (p
, ":scalable=false");
1705 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1706 NAME (NBYTES length), and return the name length. F is the frame
1707 on which the font is displayed; it is used to calculate the point
1711 font_unparse_gtkname (font
, f
, name
, nbytes
)
1719 Lisp_Object family
, weight
, slant
, size
;
1720 int point_size
= -1;
1722 family
= AREF (font
, FONT_FAMILY_INDEX
);
1723 if (! NILP (family
))
1725 if (! SYMBOLP (family
))
1727 family
= SYMBOL_NAME (family
);
1728 len
+= SBYTES (family
);
1731 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1732 if (weight
== Qnormal
)
1734 else if (! NILP (weight
))
1736 weight
= SYMBOL_NAME (weight
);
1737 len
+= SBYTES (weight
);
1740 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1741 if (slant
== Qnormal
)
1743 else if (! NILP (slant
))
1745 slant
= SYMBOL_NAME (slant
);
1746 len
+= SBYTES (slant
);
1749 size
= AREF (font
, FONT_SIZE_INDEX
);
1750 /* Convert pixel size to point size. */
1751 if (INTEGERP (size
))
1753 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1755 if (INTEGERP (font_dpi
))
1756 dpi
= XINT (font_dpi
);
1759 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1762 else if (FLOATP (size
))
1764 point_size
= (int) XFLOAT_DATA (size
);
1771 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1773 if (! NILP (weight
))
1776 p
+= sprintf (p
, " %s", SDATA (weight
));
1777 q
[1] = toupper (q
[1]);
1783 p
+= sprintf (p
, " %s", SDATA (slant
));
1784 q
[1] = toupper (q
[1]);
1788 p
+= sprintf (p
, " %d", point_size
);
1793 /* Parse NAME (null terminated) and store information in FONT
1794 (font-spec or font-entity). If NAME is successfully parsed, return
1795 0. Otherwise return -1. */
1798 font_parse_name (name
, font
)
1802 if (name
[0] == '-' || index (name
, '*'))
1803 return font_parse_xlfd (name
, font
);
1804 return font_parse_fcname (name
, font
);
1808 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1809 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1813 font_parse_family_registry (family
, registry
, font_spec
)
1814 Lisp_Object family
, registry
, font_spec
;
1820 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1822 CHECK_STRING (family
);
1823 len
= SBYTES (family
);
1824 p0
= (char *) SDATA (family
);
1825 p1
= index (p0
, '-');
1828 if ((*p0
!= '*' || p1
- p0
> 1)
1829 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1830 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1833 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1836 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1838 if (! NILP (registry
))
1840 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1841 CHECK_STRING (registry
);
1842 len
= SBYTES (registry
);
1843 p0
= (char *) SDATA (registry
);
1844 p1
= index (p0
, '-');
1847 if (SDATA (registry
)[len
- 1] == '*')
1848 registry
= concat2 (registry
, build_string ("-*"));
1850 registry
= concat2 (registry
, build_string ("*-*"));
1852 registry
= Fdowncase (registry
);
1853 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1858 /* This part (through the next ^L) is still experimental and not
1859 tested much. We may drastically change codes. */
1865 #define LGSTRING_HEADER_SIZE 6
1866 #define LGSTRING_GLYPH_SIZE 8
1869 check_gstring (gstring
)
1870 Lisp_Object gstring
;
1875 CHECK_VECTOR (gstring
);
1876 val
= AREF (gstring
, 0);
1878 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1880 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1881 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1882 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1883 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1884 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1885 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1886 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1887 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1888 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1889 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1890 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1892 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1894 val
= LGSTRING_GLYPH (gstring
, i
);
1896 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1898 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1900 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1901 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1902 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1903 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1904 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1905 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1906 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1907 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1909 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1911 if (ASIZE (val
) < 3)
1913 for (j
= 0; j
< 3; j
++)
1914 CHECK_NUMBER (AREF (val
, j
));
1919 error ("Invalid glyph-string format");
1924 check_otf_features (otf_features
)
1925 Lisp_Object otf_features
;
1929 CHECK_CONS (otf_features
);
1930 CHECK_SYMBOL (XCAR (otf_features
));
1931 otf_features
= XCDR (otf_features
);
1932 CHECK_CONS (otf_features
);
1933 CHECK_SYMBOL (XCAR (otf_features
));
1934 otf_features
= XCDR (otf_features
);
1935 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1937 CHECK_SYMBOL (Fcar (val
));
1938 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1939 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1941 otf_features
= XCDR (otf_features
);
1942 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1944 CHECK_SYMBOL (Fcar (val
));
1945 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1946 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1953 Lisp_Object otf_list
;
1956 otf_tag_symbol (tag
)
1961 OTF_tag_name (tag
, name
);
1962 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1969 Lisp_Object val
= Fassoc (file
, otf_list
);
1973 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1976 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1977 val
= make_save_value (otf
, 0);
1978 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1984 /* Return a list describing which scripts/languages FONT supports by
1985 which GSUB/GPOS features of OpenType tables. See the comment of
1986 (struct font_driver).otf_capability. */
1989 font_otf_capability (font
)
1993 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1996 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1999 for (i
= 0; i
< 2; i
++)
2001 OTF_GSUB_GPOS
*gsub_gpos
;
2002 Lisp_Object script_list
= Qnil
;
2005 if (OTF_get_features (otf
, i
== 0) < 0)
2007 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2008 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2010 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2011 Lisp_Object langsys_list
= Qnil
;
2012 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2015 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2017 OTF_LangSys
*langsys
;
2018 Lisp_Object feature_list
= Qnil
;
2019 Lisp_Object langsys_tag
;
2022 if (k
== script
->LangSysCount
)
2024 langsys
= &script
->DefaultLangSys
;
2029 langsys
= script
->LangSys
+ k
;
2031 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2033 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2035 OTF_Feature
*feature
2036 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2037 Lisp_Object feature_tag
2038 = otf_tag_symbol (feature
->FeatureTag
);
2040 feature_list
= Fcons (feature_tag
, feature_list
);
2042 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2045 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2050 XSETCAR (capability
, script_list
);
2052 XSETCDR (capability
, script_list
);
2058 /* Parse OTF features in SPEC and write a proper features spec string
2059 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2060 assured that the sufficient memory has already allocated for
2064 generate_otf_features (spec
, features
)
2074 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2080 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2085 else if (! asterisk
)
2087 val
= SYMBOL_NAME (val
);
2088 p
+= sprintf (p
, "%s", SDATA (val
));
2092 val
= SYMBOL_NAME (val
);
2093 p
+= sprintf (p
, "~%s", SDATA (val
));
2097 error ("OTF spec too long");
2101 font_otf_DeviceTable (device_table
)
2102 OTF_DeviceTable
*device_table
;
2104 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2106 return Fcons (make_number (len
),
2107 make_unibyte_string (device_table
->DeltaValue
, len
));
2111 font_otf_ValueRecord (value_format
, value_record
)
2113 OTF_ValueRecord
*value_record
;
2115 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2117 if (value_format
& OTF_XPlacement
)
2118 ASET (val
, 0, make_number (value_record
->XPlacement
));
2119 if (value_format
& OTF_YPlacement
)
2120 ASET (val
, 1, make_number (value_record
->YPlacement
));
2121 if (value_format
& OTF_XAdvance
)
2122 ASET (val
, 2, make_number (value_record
->XAdvance
));
2123 if (value_format
& OTF_YAdvance
)
2124 ASET (val
, 3, make_number (value_record
->YAdvance
));
2125 if (value_format
& OTF_XPlaDevice
)
2126 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2127 if (value_format
& OTF_YPlaDevice
)
2128 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2129 if (value_format
& OTF_XAdvDevice
)
2130 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2131 if (value_format
& OTF_YAdvDevice
)
2132 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2137 font_otf_Anchor (anchor
)
2142 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2143 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2144 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2145 if (anchor
->AnchorFormat
== 2)
2146 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2149 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2150 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2154 #endif /* HAVE_LIBOTF */
2157 /* G-string (glyph string) handler */
2159 /* G-string is a vector of the form [HEADER GLYPH ...].
2160 See the docstring of `font-make-gstring' for more detail. */
2163 font_prepare_composition (cmp
, f
)
2164 struct composition
*cmp
;
2168 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
2169 cmp
->hash_index
* 2);
2171 cmp
->font
= XFONT_OBJECT (LGSTRING_FONT (gstring
));
2172 cmp
->glyph_len
= LGSTRING_LENGTH (gstring
);
2173 cmp
->pixel_width
= LGSTRING_WIDTH (gstring
);
2174 cmp
->lbearing
= LGSTRING_LBEARING (gstring
);
2175 cmp
->rbearing
= LGSTRING_RBEARING (gstring
);
2176 cmp
->ascent
= LGSTRING_ASCENT (gstring
);
2177 cmp
->descent
= LGSTRING_DESCENT (gstring
);
2178 cmp
->width
= cmp
->pixel_width
/ FRAME_COLUMN_WIDTH (f
);
2179 if (cmp
->width
== 0)
2188 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2189 static int font_compare
P_ ((const void *, const void *));
2190 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
2191 Lisp_Object
, Lisp_Object
,
2194 /* We sort fonts by scoring each of them against a specified
2195 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2196 the value is, the closer the font is to the font-spec.
2198 The lowest 2 bits of the score is used for driver type. The font
2199 available by the most preferred font driver is 0.
2201 Each 7-bit in the higher 28 bits are used for numeric properties
2202 WEIGHT, SLANT, WIDTH, and SIZE. */
2204 /* How many bits to shift to store the difference value of each font
2205 property in a score. Note that flots for FONT_TYPE_INDEX and
2206 FONT_REGISTRY_INDEX are not used. */
2207 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2209 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2210 The return value indicates how different ENTITY is compared with
2213 ALTERNATE_FAMILIES, if non-nil, is a pre-calculated list of
2214 alternate family names for AREF (SPEC_PROP, FONT_FAMILY_INDEX). */
2217 font_score (entity
, spec_prop
)
2218 Lisp_Object entity
, *spec_prop
;
2223 /* Score three style numeric fields. Maximum difference is 127. */
2224 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2225 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2227 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2232 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2235 /* Score the size. Maximum difference is 127. */
2236 i
= FONT_SIZE_INDEX
;
2237 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
])
2238 && XINT (AREF (entity
, i
)) > 0)
2240 /* We use the higher 6-bit for the actual size difference. The
2241 lowest bit is set if the DPI is different. */
2242 int diff
= XINT (spec_prop
[i
]) - XINT (AREF (entity
, i
));
2247 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2248 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2250 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2257 /* The comparison function for qsort. */
2260 font_compare (d1
, d2
)
2261 const void *d1
, *d2
;
2263 return (*(unsigned *) d1
- *(unsigned *) d2
);
2267 /* The structure for elements being sorted by qsort. */
2268 struct font_sort_data
2275 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2276 If PREFER specifies a point-size, calculate the corresponding
2277 pixel-size from QCdpi property of PREFER or from the Y-resolution
2278 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
2279 get the font-entities in VEC.
2281 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2282 return the sorted VEC. */
2285 font_sort_entites (vec
, prefer
, frame
, spec
, best_only
)
2286 Lisp_Object vec
, prefer
, frame
, spec
;
2289 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2291 struct font_sort_data
*data
;
2292 unsigned best_score
;
2293 Lisp_Object best_entity
, driver_type
;
2295 struct frame
*f
= XFRAME (frame
);
2296 struct font_driver_list
*list
;
2301 return best_only
? AREF (vec
, 0) : vec
;
2303 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2304 prefer_prop
[i
] = AREF (prefer
, i
);
2308 /* A font driver may return a font that has a property value
2309 different from the value specified in SPEC if the driver
2310 thinks they are the same. That happens, for instance, such a
2311 generic family name as "serif" is specified. So, to ignore
2312 such a difference, for all properties specified in SPEC, set
2313 the corresponding properties in PREFER_PROP to nil. */
2314 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2315 if (! NILP (AREF (spec
, i
)))
2316 prefer_prop
[i
] = Qnil
;
2319 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2320 prefer_prop
[FONT_SIZE_INDEX
]
2321 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2323 /* Scoring and sorting. */
2324 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2325 best_score
= 0xFFFFFFFF;
2326 /* We are sure that the length of VEC > 1. */
2327 driver_type
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2328 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2329 driver_order
++, list
= list
->next
)
2330 if (EQ (driver_type
, list
->driver
->type
))
2332 best_entity
= data
[0].entity
= AREF (vec
, 0);
2333 best_score
= data
[0].score
2334 = font_score (data
[0].entity
, prefer_prop
) | driver_order
;
2335 for (i
= 0; i
< len
; i
++)
2337 if (!EQ (driver_type
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2338 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2339 driver_order
++, list
= list
->next
)
2340 if (EQ (driver_type
, list
->driver
->type
))
2342 data
[i
].entity
= AREF (vec
, i
);
2343 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
) | driver_order
;
2344 if (best_only
&& best_score
> data
[i
].score
)
2346 best_score
= data
[i
].score
;
2347 best_entity
= data
[i
].entity
;
2348 if (best_score
== 0)
2352 if (NILP (best_entity
))
2354 qsort (data
, len
, sizeof *data
, font_compare
);
2355 for (i
= 0; i
< len
; i
++)
2356 ASET (vec
, i
, data
[i
].entity
);
2362 font_add_log ("sort-by", prefer
, vec
);
2367 /* API of Font Service Layer. */
2369 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2370 sort_shift_bits. Finternal_set_font_selection_order calls this
2371 function with font_sort_order after setting up it. */
2374 font_update_sort_order (order
)
2379 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2381 int xlfd_idx
= order
[i
];
2383 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2384 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2385 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2386 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2387 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2388 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2390 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2395 /* Check if ENTITY matches with the font specification SPEC. */
2398 font_match_p (spec
, entity
)
2399 Lisp_Object spec
, entity
;
2401 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2402 Lisp_Object alternate_families
= Qnil
;
2405 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2406 prefer_prop
[i
] = AREF (spec
, i
);
2407 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2408 prefer_prop
[FONT_SIZE_INDEX
]
2409 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2410 if (! NILP (prefer_prop
[FONT_FAMILY_INDEX
]))
2413 = Fassoc_string (prefer_prop
[FONT_FAMILY_INDEX
],
2414 Vface_alternative_font_family_alist
, Qt
);
2415 if (CONSP (alternate_families
))
2416 alternate_families
= XCDR (alternate_families
);
2419 return (font_score (entity
, prefer_prop
) == 0);
2425 Each font backend has the callback function get_cache, and it
2426 returns a cons cell of which cdr part can be freely used for
2427 caching fonts. The cons cell may be shared by multiple frames
2428 and/or multiple font drivers. So, we arrange the cdr part as this:
2430 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2432 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2433 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2434 cons (FONT-SPEC FONT-ENTITY ...). */
2436 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2437 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2438 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2439 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2440 struct font_driver
*));
2443 font_prepare_cache (f
, driver
)
2445 struct font_driver
*driver
;
2447 Lisp_Object cache
, val
;
2449 cache
= driver
->get_cache (f
);
2451 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2455 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2456 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2460 val
= XCDR (XCAR (val
));
2461 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2467 font_finish_cache (f
, driver
)
2469 struct font_driver
*driver
;
2471 Lisp_Object cache
, val
, tmp
;
2474 cache
= driver
->get_cache (f
);
2476 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2477 cache
= val
, val
= XCDR (val
);
2478 font_assert (! NILP (val
));
2479 tmp
= XCDR (XCAR (val
));
2480 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2481 if (XINT (XCAR (tmp
)) == 0)
2483 font_clear_cache (f
, XCAR (val
), driver
);
2484 XSETCDR (cache
, XCDR (val
));
2490 font_get_cache (f
, driver
)
2492 struct font_driver
*driver
;
2494 Lisp_Object val
= driver
->get_cache (f
);
2495 Lisp_Object type
= driver
->type
;
2497 font_assert (CONSP (val
));
2498 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2499 font_assert (CONSP (val
));
2500 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2501 val
= XCDR (XCAR (val
));
2505 static int num_fonts
;
2508 font_clear_cache (f
, cache
, driver
)
2511 struct font_driver
*driver
;
2513 Lisp_Object tail
, elt
;
2515 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2516 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2519 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)) && VECTORP (XCDR (elt
)))
2521 Lisp_Object vec
= XCDR (elt
);
2524 for (i
= 0; i
< ASIZE (vec
); i
++)
2526 Lisp_Object entity
= AREF (vec
, i
);
2528 if (EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2530 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2532 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2534 Lisp_Object val
= XCAR (objlist
);
2535 struct font
*font
= XFONT_OBJECT (val
);
2537 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2539 font_assert (font
&& driver
== font
->driver
);
2540 driver
->close (f
, font
);
2544 if (driver
->free_entity
)
2545 driver
->free_entity (entity
);
2550 XSETCDR (cache
, Qnil
);
2554 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2557 font_delete_unmatched (list
, spec
, size
)
2558 Lisp_Object list
, spec
;
2561 Lisp_Object entity
, val
;
2562 enum font_property_index prop
;
2564 for (val
= Qnil
; CONSP (list
); list
= XCDR (list
))
2566 entity
= XCAR (list
);
2567 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2568 if (INTEGERP (AREF (spec
, prop
))
2569 && ((XINT (AREF (spec
, prop
)) >> 8)
2570 != (XINT (AREF (entity
, prop
)) >> 8)))
2571 prop
= FONT_SPEC_MAX
;
2572 if (prop
++ <= FONT_SIZE_INDEX
2574 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2576 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2579 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2580 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2581 prop
= FONT_SPEC_MAX
;
2583 if (prop
< FONT_SPEC_MAX
)
2584 val
= Fcons (entity
, val
);
2590 /* Return a vector of font-entities matching with SPEC on FRAME. */
2593 font_list_entities (frame
, spec
)
2594 Lisp_Object frame
, spec
;
2596 FRAME_PTR f
= XFRAME (frame
);
2597 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2598 Lisp_Object ftype
, val
;
2601 int need_filtering
= 0;
2604 font_assert (FONT_SPEC_P (spec
));
2606 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2607 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2608 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2609 size
= font_pixel_size (f
, spec
);
2613 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2614 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2615 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2616 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2618 ASET (scratch_font_spec
, i
, Qnil
);
2619 if (! NILP (AREF (spec
, i
)))
2621 if (i
== FONT_DPI_INDEX
)
2622 /* Skip FONT_SPACING_INDEX */
2625 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2626 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2628 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2632 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2634 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2636 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2638 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2639 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2646 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2647 copy
= Fcopy_font_spec (scratch_font_spec
);
2648 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2649 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2651 if (! NILP (val
) && need_filtering
)
2652 val
= font_delete_unmatched (val
, spec
, size
);
2657 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2658 font_add_log ("list", spec
, val
);
2663 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2664 nil, is an array of face's attributes, which specifies preferred
2665 font-related attributes. */
2668 font_matching_entity (f
, attrs
, spec
)
2670 Lisp_Object
*attrs
, spec
;
2672 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2673 Lisp_Object ftype
, size
, entity
;
2676 XSETFRAME (frame
, f
);
2677 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2678 size
= AREF (spec
, FONT_SIZE_INDEX
);
2680 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2682 for (; driver_list
; driver_list
= driver_list
->next
)
2684 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2686 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2689 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2690 entity
= assoc_no_quit (spec
, XCDR (cache
));
2692 entity
= XCDR (entity
);
2695 entity
= driver_list
->driver
->match (frame
, spec
);
2696 copy
= Fcopy_font_spec (spec
);
2697 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2698 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2700 if (! NILP (entity
))
2703 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2704 ASET (spec
, FONT_SIZE_INDEX
, size
);
2705 font_add_log ("match", spec
, entity
);
2710 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2711 opened font object. */
2714 font_open_entity (f
, entity
, pixel_size
)
2719 struct font_driver_list
*driver_list
;
2720 Lisp_Object objlist
, size
, val
, font_object
;
2724 font_assert (FONT_ENTITY_P (entity
));
2725 size
= AREF (entity
, FONT_SIZE_INDEX
);
2726 if (XINT (size
) != 0)
2727 pixel_size
= XINT (size
);
2729 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2730 objlist
= XCDR (objlist
))
2731 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2732 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2733 return XCAR (objlist
);
2735 val
= AREF (entity
, FONT_TYPE_INDEX
);
2736 for (driver_list
= f
->font_driver_list
;
2737 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2738 driver_list
= driver_list
->next
);
2742 font_object
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2743 font_add_log ("open", entity
, font_object
);
2744 if (NILP (font_object
))
2746 ASET (entity
, FONT_OBJLIST_INDEX
,
2747 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2748 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
2751 font
= XFONT_OBJECT (font_object
);
2752 min_width
= (font
->min_width
? font
->min_width
2753 : font
->average_width
? font
->average_width
2754 : font
->space_width
? font
->space_width
2756 #ifdef HAVE_WINDOW_SYSTEM
2757 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2758 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2760 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2761 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
;
2762 fonts_changed_p
= 1;
2766 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2767 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2768 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > font
->height
)
2769 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
, fonts_changed_p
= 1;
2777 /* Close FONT_OBJECT that is opened on frame F. */
2780 font_close_object (f
, font_object
)
2782 Lisp_Object font_object
;
2784 struct font
*font
= XFONT_OBJECT (font_object
);
2786 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2787 /* Already closed. */
2789 font_add_log ("close", font_object
, Qnil
);
2790 font
->driver
->close (f
, font
);
2791 #ifdef HAVE_WINDOW_SYSTEM
2792 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2793 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2799 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2800 FONT is a font-entity and it must be opened to check. */
2803 font_has_char (f
, font
, c
)
2810 if (FONT_ENTITY_P (font
))
2812 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2813 struct font_driver_list
*driver_list
;
2815 for (driver_list
= f
->font_driver_list
;
2816 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2817 driver_list
= driver_list
->next
);
2820 if (! driver_list
->driver
->has_char
)
2822 return driver_list
->driver
->has_char (font
, c
);
2825 font_assert (FONT_OBJECT_P (font
));
2826 fontp
= XFONT_OBJECT (font
);
2827 if (fontp
->driver
->has_char
)
2829 int result
= fontp
->driver
->has_char (font
, c
);
2834 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2838 /* Return the glyph ID of FONT_OBJECT for character C. */
2841 font_encode_char (font_object
, c
)
2842 Lisp_Object font_object
;
2847 font_assert (FONT_OBJECT_P (font_object
));
2848 font
= XFONT_OBJECT (font_object
);
2849 return font
->driver
->encode_char (font
, c
);
2853 /* Return the name of FONT_OBJECT. */
2856 font_get_name (font_object
)
2857 Lisp_Object font_object
;
2859 font_assert (FONT_OBJECT_P (font_object
));
2860 return AREF (font_object
, FONT_NAME_INDEX
);
2864 /* Return the specification of FONT_OBJECT. */
2867 font_get_spec (font_object
)
2868 Lisp_Object font_object
;
2870 Lisp_Object spec
= font_make_spec ();
2873 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2874 ASET (spec
, i
, AREF (font_object
, i
));
2875 ASET (spec
, FONT_SIZE_INDEX
,
2876 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2881 font_spec_from_name (font_name
)
2882 Lisp_Object font_name
;
2884 Lisp_Object args
[2];
2887 args
[1] = font_name
;
2888 return Ffont_spec (2, args
);
2893 font_clear_prop (attrs
, prop
)
2895 enum font_property_index prop
;
2897 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2901 if (NILP (AREF (font
, prop
))
2902 && prop
!= FONT_FAMILY_INDEX
&& prop
!= FONT_FOUNDRY_INDEX
2903 && prop
!= FONT_SIZE_INDEX
)
2905 font
= Fcopy_font_spec (font
);
2906 ASET (font
, prop
, Qnil
);
2907 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
2909 if (prop
== FONT_FAMILY_INDEX
)
2910 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
2911 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
2912 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
2913 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
2914 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2915 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2916 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2918 else if (prop
== FONT_SIZE_INDEX
)
2920 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2921 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2922 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2924 attrs
[LFACE_FONT_INDEX
] = font
;
2928 font_update_lface (f
, attrs
)
2934 spec
= attrs
[LFACE_FONT_INDEX
];
2935 if (! FONT_SPEC_P (spec
))
2938 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
2939 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
2940 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2941 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
2942 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
2943 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
2944 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
2945 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);;
2946 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
2947 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
2948 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
2952 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2957 val
= Ffont_get (spec
, QCdpi
);
2960 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
2963 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2964 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
2965 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
2970 /* Return a font-entity satisfying SPEC and best matching with face's
2971 font related attributes in ATTRS. C, if not negative, is a
2972 character that the entity must support. */
2975 font_find_for_lface (f
, attrs
, spec
, c
)
2982 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
2983 Lisp_Object size
, foundry
[3], *family
, registry
[3];
2985 int i
, j
, k
, result
;
2987 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
2988 if (NILP (registry
[0]))
2990 registry
[0] = Qiso8859_1
;
2991 registry
[1] = Qascii_0
;
2992 registry
[2] = null_vector
;
2995 registry
[1] = null_vector
;
2997 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
2999 struct charset
*encoding
, *repertory
;
3001 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3002 &encoding
, &repertory
) < 0)
3006 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3008 /* Any font of this registry support C. So, let's
3009 suppress the further checking. */
3012 else if (c
> encoding
->max_char
)
3016 work
= Fcopy_font_spec (spec
);
3017 XSETFRAME (frame
, f
);
3018 size
= AREF (spec
, FONT_SIZE_INDEX
);
3019 pixel_size
= font_pixel_size (f
, spec
);
3020 if (pixel_size
== 0)
3022 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3024 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3026 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3027 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3028 if (! NILP (foundry
[0]))
3029 foundry
[1] = null_vector
;
3030 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3032 foundry
[0] = font_intern_prop (SDATA (attrs
[LFACE_FOUNDRY_INDEX
]),
3033 SBYTES (attrs
[LFACE_FOUNDRY_INDEX
]), 1);
3035 foundry
[2] = null_vector
;
3038 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3040 val
= AREF (work
, FONT_FAMILY_INDEX
);
3041 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3042 val
= font_intern_prop (SDATA (attrs
[LFACE_FAMILY_INDEX
]),
3043 SBYTES (attrs
[LFACE_FAMILY_INDEX
]), 1);
3046 family
= alloca ((sizeof family
[0]) * 2);
3048 family
[1] = null_vector
; /* terminator. */
3053 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3055 if (! NILP (alters
))
3057 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3058 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3059 family
[i
] = XCAR (alters
);
3060 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3062 family
[i
] = null_vector
;
3066 family
= alloca ((sizeof family
[0]) * 3);
3069 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3071 family
[i
] = null_vector
;
3075 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3077 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3078 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3080 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3081 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3083 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3084 entities
= font_list_entities (frame
, work
);
3085 if (ASIZE (entities
) > 0)
3092 if (ASIZE (entities
) == 1)
3095 return AREF (entities
, 0);
3099 /* Sort fonts by properties specified in LFACE. */
3100 Lisp_Object prefer
= scratch_font_prefer
;
3102 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3103 ASET (prefer
, i
, AREF (work
, i
));
3104 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3106 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3108 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3109 if (NILP (AREF (prefer
, i
)))
3110 ASET (prefer
, i
, AREF (face_font
, i
));
3112 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3113 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3114 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3115 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3116 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3117 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3118 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3119 entities
= font_sort_entites (entities
, prefer
, frame
, work
, c
< 0);
3124 for (i
= 0; i
< ASIZE (entities
); i
++)
3128 val
= AREF (entities
, i
);
3131 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3132 if (! EQ (AREF (val
, j
), props
[j
]))
3134 if (j
> FONT_REGISTRY_INDEX
)
3137 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3138 props
[j
] = AREF (val
, j
);
3139 result
= font_has_char (f
, val
, c
);
3144 val
= font_open_for_lface (f
, val
, attrs
, spec
);
3147 result
= font_has_char (f
, val
, c
);
3148 font_close_object (f
, val
);
3150 return AREF (entities
, i
);
3157 font_open_for_lface (f
, entity
, attrs
, spec
)
3165 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3166 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3167 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3168 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3169 size
= font_pixel_size (f
, spec
);
3172 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3175 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3177 return font_open_entity (f
, entity
, size
);
3181 /* Find a font satisfying SPEC and best matching with face's
3182 attributes in ATTRS on FRAME, and return the opened
3186 font_load_for_lface (f
, attrs
, spec
)
3188 Lisp_Object
*attrs
, spec
;
3192 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3195 /* No font is listed for SPEC, but each font-backend may have
3196 the different criteria about "font matching". So, try
3198 entity
= font_matching_entity (f
, attrs
, spec
);
3202 return font_open_for_lface (f
, entity
, attrs
, spec
);
3206 /* Make FACE on frame F ready to use the font opened for FACE. */
3209 font_prepare_for_face (f
, face
)
3213 if (face
->font
->driver
->prepare_face
)
3214 face
->font
->driver
->prepare_face (f
, face
);
3218 /* Make FACE on frame F stop using the font opened for FACE. */
3221 font_done_for_face (f
, face
)
3225 if (face
->font
->driver
->done_face
)
3226 face
->font
->driver
->done_face (f
, face
);
3231 /* Open a font best matching with NAME on frame F. If no proper font
3232 is found, return Qnil. */
3235 font_open_by_name (f
, name
)
3239 Lisp_Object args
[2];
3240 Lisp_Object spec
, attrs
[LFACE_VECTOR_SIZE
];
3243 args
[1] = make_unibyte_string (name
, strlen (name
));
3244 spec
= Ffont_spec (2, args
);
3245 /* We set up the default font-related attributes of a face to prefer
3247 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3248 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3249 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3250 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3251 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3253 return font_load_for_lface (f
, attrs
, spec
);
3257 /* Register font-driver DRIVER. This function is used in two ways.
3259 The first is with frame F non-NULL. In this case, make DRIVER
3260 available (but not yet activated) on F. All frame creaters
3261 (e.g. Fx_create_frame) must call this function at least once with
3262 an available font-driver.
3264 The second is with frame F NULL. In this case, DRIVER is globally
3265 registered in the variable `font_driver_list'. All font-driver
3266 implementations must call this function in its syms_of_XXXX
3267 (e.g. syms_of_xfont). */
3270 register_font_driver (driver
, f
)
3271 struct font_driver
*driver
;
3274 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3275 struct font_driver_list
*prev
, *list
;
3277 if (f
&& ! driver
->draw
)
3278 error ("Unusable font driver for a frame: %s",
3279 SDATA (SYMBOL_NAME (driver
->type
)));
3281 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3282 if (EQ (list
->driver
->type
, driver
->type
))
3283 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3285 list
= malloc (sizeof (struct font_driver_list
));
3287 list
->driver
= driver
;
3292 f
->font_driver_list
= list
;
3294 font_driver_list
= list
;
3300 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3301 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3302 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3304 A caller must free all realized faces if any in advance. The
3305 return value is a list of font backends actually made used on
3309 font_update_drivers (f
, new_drivers
)
3311 Lisp_Object new_drivers
;
3313 Lisp_Object active_drivers
= Qnil
;
3314 struct font_driver
*driver
;
3315 struct font_driver_list
*list
;
3317 /* At first, turn off non-requested drivers, and turn on requested
3319 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3321 driver
= list
->driver
;
3322 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3327 if (driver
->end_for_frame
)
3328 driver
->end_for_frame (f
);
3329 font_finish_cache (f
, driver
);
3334 if (! driver
->start_for_frame
3335 || driver
->start_for_frame (f
) == 0)
3337 font_prepare_cache (f
, driver
);
3344 if (NILP (new_drivers
))
3347 if (! EQ (new_drivers
, Qt
))
3349 /* Re-order the driver list according to new_drivers. */
3350 struct font_driver_list
**list_table
, **next
;
3354 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3355 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3357 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3358 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3361 list_table
[i
++] = list
;
3363 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3365 list_table
[i
] = list
;
3366 list_table
[i
] = NULL
;
3368 next
= &f
->font_driver_list
;
3369 for (i
= 0; list_table
[i
]; i
++)
3371 *next
= list_table
[i
];
3372 next
= &(*next
)->next
;
3377 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3379 active_drivers
= nconc2 (active_drivers
,
3380 Fcons (list
->driver
->type
, Qnil
));
3381 return active_drivers
;
3385 font_put_frame_data (f
, driver
, data
)
3387 struct font_driver
*driver
;
3390 struct font_data_list
*list
, *prev
;
3392 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3393 prev
= list
, list
= list
->next
)
3394 if (list
->driver
== driver
)
3401 prev
->next
= list
->next
;
3403 f
->font_data_list
= list
->next
;
3411 list
= malloc (sizeof (struct font_data_list
));
3414 list
->driver
= driver
;
3415 list
->next
= f
->font_data_list
;
3416 f
->font_data_list
= list
;
3424 font_get_frame_data (f
, driver
)
3426 struct font_driver
*driver
;
3428 struct font_data_list
*list
;
3430 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3431 if (list
->driver
== driver
)
3439 /* Return the font used to draw character C by FACE at buffer position
3440 POS in window W. If STRING is non-nil, it is a string containing C
3441 at index POS. If C is negative, get C from the current buffer or
3445 font_at (c
, pos
, face
, w
, string
)
3454 Lisp_Object font_object
;
3460 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3463 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3465 c
= FETCH_CHAR (pos_byte
);
3468 c
= FETCH_BYTE (pos
);
3474 multibyte
= STRING_MULTIBYTE (string
);
3477 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3479 str
= SDATA (string
) + pos_byte
;
3480 c
= STRING_CHAR (str
, 0);
3483 c
= SDATA (string
)[pos
];
3487 f
= XFRAME (w
->frame
);
3488 if (! FRAME_WINDOW_P (f
))
3495 if (STRINGP (string
))
3496 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3497 DEFAULT_FACE_ID
, 0);
3499 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3501 face
= FACE_FROM_ID (f
, face_id
);
3505 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3506 face
= FACE_FROM_ID (f
, face_id
);
3511 XSETFONT (font_object
, face
->font
);
3516 /* Check how many characters after POS (at most to LIMIT) can be
3517 displayed by the same font. FACE is the face selected for the
3518 character as POS on frame F. STRING, if not nil, is the string to
3519 check instead of the current buffer.
3521 The return value is the position of the character that is displayed
3522 by the differnt font than that of the character as POS. */
3525 font_range (pos
, limit
, face
, f
, string
)
3526 EMACS_INT pos
, limit
;
3539 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3540 pos_byte
= CHAR_TO_BYTE (pos
);
3544 multibyte
= STRING_MULTIBYTE (string
);
3545 pos_byte
= string_char_to_byte (string
, pos
);
3549 /* All unibyte character are displayed by the same font. */
3557 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3559 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3560 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3561 face
= FACE_FROM_ID (f
, face_id
);
3568 else if (font
!= face
->font
)
3580 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3581 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3582 Return nil otherwise.
3583 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3584 which kind of font it is. It must be one of `font-spec', `font-entity',
3586 (object
, extra_type
)
3587 Lisp_Object object
, extra_type
;
3589 if (NILP (extra_type
))
3590 return (FONTP (object
) ? Qt
: Qnil
);
3591 if (EQ (extra_type
, Qfont_spec
))
3592 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3593 if (EQ (extra_type
, Qfont_entity
))
3594 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3595 if (EQ (extra_type
, Qfont_object
))
3596 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3597 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3600 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3601 doc
: /* Return a newly created font-spec with arguments as properties.
3603 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3604 valid font property name listed below:
3606 `:family', `:weight', `:slant', `:width'
3608 They are the same as face attributes of the same name. See
3609 `set-face-attribute'.
3613 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3617 VALUE must be a string or a symbol specifying the additional
3618 typographic style information of a font, e.g. ``sans''.
3622 VALUE must be a string or a symbol specifying the charset registry and
3623 encoding of a font, e.g. ``iso8859-1''.
3627 VALUE must be a non-negative integer or a floating point number
3628 specifying the font size. It specifies the font size in pixels
3629 (if VALUE is an integer), or in points (if VALUE is a float).
3630 usage: (font-spec ARGS ...)
3634 VALUE must be a string of XLFD-style or fontconfig-style font name. */)
3639 Lisp_Object spec
= font_make_spec ();
3642 for (i
= 0; i
< nargs
; i
+= 2)
3644 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3646 if (EQ (key
, QCname
))
3649 font_parse_name ((char *) SDATA (val
), spec
);
3650 font_put_extra (spec
, key
, val
);
3654 int idx
= get_font_prop_index (key
);
3658 val
= font_prop_validate (idx
, Qnil
, val
);
3659 if (idx
< FONT_EXTRA_INDEX
)
3660 ASET (spec
, idx
, val
);
3662 font_put_extra (spec
, key
, val
);
3665 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3671 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3672 doc
: /* Return a copy of FONT as a font-spec. */)
3676 Lisp_Object new_spec
, tail
, extra
;
3680 new_spec
= font_make_spec ();
3681 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3682 ASET (new_spec
, i
, AREF (font
, i
));
3684 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3686 if (! EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3687 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3689 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3693 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3694 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3695 Every specified properties in FROM override the corresponding
3696 properties in TO. */)
3698 Lisp_Object from
, to
;
3700 Lisp_Object extra
, tail
;
3705 to
= Fcopy_font_spec (to
);
3706 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3707 ASET (to
, i
, AREF (from
, i
));
3708 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3709 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3710 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3712 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3715 XSETCDR (slot
, XCDR (XCAR (tail
)));
3717 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3719 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3723 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3724 doc
: /* Return the value of FONT's property KEY.
3725 FONT is a font-spec, a font-entity, or a font-object. */)
3727 Lisp_Object font
, key
;
3734 idx
= get_font_prop_index (key
);
3735 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3736 return font_style_symbolic (font
, idx
, 0);
3737 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3738 return AREF (font
, idx
);
3739 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3742 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3743 doc
: /* Return a plist of face attributes generated by FONT.
3744 FONT is a font name, a font-spec, a font-entity, or a font-object.
3745 The return value is a list of the form
3747 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3749 where FAMILY, FOUNDRY, HEIGHT, WEIGHT, SLANT, and WIDTH are face
3750 attribute values compatible with `set-face-attribute'.
3752 The optional argument FRAME specifies the frame that the face
3753 attributes are to be displayed on. If omitted, the selected frame is
3756 Lisp_Object font
, frame
;
3759 Lisp_Object plist
[10];
3763 frame
= selected_frame
;
3764 CHECK_LIVE_FRAME (frame
);
3769 int fontset
= fs_query_fontset (font
, 0);
3770 Lisp_Object name
= font
;
3772 font
= fontset_ascii (fontset
);
3773 font
= font_spec_from_name (name
);
3775 signal_error ("Invalid font name", name
);
3777 else if (! FONTP (font
))
3778 signal_error ("Invalid font object", font
);
3780 plist
[0] = QCfamily
;
3781 val
= AREF (font
, FONT_FAMILY_INDEX
);
3782 plist
[1] = NILP (val
) ? Qnil
: SYMBOL_NAME (val
);
3784 plist
[2] = QCheight
;
3785 val
= AREF (font
, FONT_SIZE_INDEX
);
3788 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
3789 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
3790 plist
[3] = make_number (10 * PIXEL_TO_POINT (XINT (val
), dpi
));
3792 else if (FLOATP (val
))
3793 plist
[3] = make_number (10 * (int) XFLOAT_DATA (val
));
3797 plist
[4] = QCweight
;
3798 val
= FONT_WEIGHT_FOR_FACE (font
);
3799 plist
[5] = NILP (val
) ? Qnormal
: val
;
3802 val
= FONT_SLANT_FOR_FACE (font
);
3803 plist
[7] = NILP (val
) ? Qnormal
: val
;
3806 val
= FONT_WIDTH_FOR_FACE (font
);
3807 plist
[9] = NILP (val
) ? Qnormal
: val
;
3809 return Flist (10, plist
);
3812 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3813 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
3814 (font_spec
, prop
, val
)
3815 Lisp_Object font_spec
, prop
, val
;
3819 CHECK_FONT_SPEC (font_spec
);
3820 idx
= get_font_prop_index (prop
);
3821 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3822 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
3824 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
3828 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3829 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3830 Optional 2nd argument FRAME specifies the target frame.
3831 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3832 Optional 4th argument PREFER, if non-nil, is a font-spec to
3833 control the order of the returned list. Fonts are sorted by
3834 how close they are to PREFER. */)
3835 (font_spec
, frame
, num
, prefer
)
3836 Lisp_Object font_spec
, frame
, num
, prefer
;
3838 Lisp_Object vec
, list
, tail
;
3842 frame
= selected_frame
;
3843 CHECK_LIVE_FRAME (frame
);
3844 CHECK_FONT_SPEC (font_spec
);
3852 if (! NILP (prefer
))
3853 CHECK_FONT_SPEC (prefer
);
3855 vec
= font_list_entities (frame
, font_spec
);
3860 return Fcons (AREF (vec
, 0), Qnil
);
3862 if (! NILP (prefer
))
3863 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
, 0);
3865 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3866 if (n
== 0 || n
> len
)
3868 for (i
= 1; i
< n
; i
++)
3870 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3872 XSETCDR (tail
, val
);
3878 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
3879 doc
: /* List available font families on the current frame.
3880 Optional argument FRAME, if non-nil, specifies the target frame. */)
3885 struct font_driver_list
*driver_list
;
3889 frame
= selected_frame
;
3890 CHECK_LIVE_FRAME (frame
);
3893 for (driver_list
= f
->font_driver_list
; driver_list
;
3894 driver_list
= driver_list
->next
)
3895 if (driver_list
->driver
->list_family
)
3897 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3903 Lisp_Object tail
= list
;
3905 for (; CONSP (val
); val
= XCDR (val
))
3906 if (NILP (Fmemq (XCAR (val
), tail
)))
3907 list
= Fcons (XCAR (val
), list
);
3913 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3914 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3915 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3917 Lisp_Object font_spec
, frame
;
3919 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3926 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
3927 doc
: /* Return XLFD name of FONT.
3928 FONT is a font-spec, font-entity, or font-object.
3929 If the name is too long for XLFD (maximum 255 chars), return nil.
3930 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
3931 the consecutive wildcards are folded to one. */)
3932 (font
, fold_wildcards
)
3933 Lisp_Object font
, fold_wildcards
;
3940 if (FONT_OBJECT_P (font
))
3942 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
3944 if (STRINGP (font_name
)
3945 && SDATA (font_name
)[0] == '-')
3947 if (NILP (fold_wildcards
))
3949 strcpy (name
, (char *) SDATA (font_name
));
3952 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
3954 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3957 if (! NILP (fold_wildcards
))
3959 char *p0
= name
, *p1
;
3961 while ((p1
= strstr (p0
, "-*-*")))
3963 strcpy (p1
, p1
+ 2);
3968 return build_string (name
);
3971 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3972 doc
: /* Clear font cache. */)
3975 Lisp_Object list
, frame
;
3977 FOR_EACH_FRAME (list
, frame
)
3979 FRAME_PTR f
= XFRAME (frame
);
3980 struct font_driver_list
*driver_list
= f
->font_driver_list
;
3982 for (; driver_list
; driver_list
= driver_list
->next
)
3983 if (driver_list
->on
)
3985 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
3990 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
3992 font_assert (! NILP (val
));
3993 val
= XCDR (XCAR (val
));
3994 if (XINT (XCAR (val
)) == 0)
3996 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
3997 XSETCDR (cache
, XCDR (val
));
4005 /* The following three functions are still experimental. */
4007 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
4008 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
4009 FONT-OBJECT may be nil if it is not yet known.
4011 G-string is sequence of glyphs of a specific font,
4012 and is a vector of this form:
4013 [ HEADER GLYPH ... ]
4014 HEADER is a vector of this form:
4015 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
4017 FONT-OBJECT is a font-object for all glyphs in the g-string,
4018 WIDTH thru DESCENT are the metrics (in pixels) of the whole G-string.
4019 GLYPH is a vector of this form:
4020 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
4021 [ [X-OFF Y-OFF WADJUST] | nil] ]
4023 FROM-IDX and TO-IDX are used internally and should not be touched.
4024 C is the character of the glyph.
4025 CODE is the glyph-code of C in FONT-OBJECT.
4026 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4027 X-OFF and Y-OFF are offests to the base position for the glyph.
4028 WADJUST is the adjustment to the normal width of the glyph. */)
4030 Lisp_Object font_object
, num
;
4032 Lisp_Object gstring
, g
;
4036 if (! NILP (font_object
))
4037 CHECK_FONT_OBJECT (font_object
);
4040 len
= XINT (num
) + 1;
4041 gstring
= Fmake_vector (make_number (len
), Qnil
);
4042 g
= Fmake_vector (make_number (6), Qnil
);
4043 ASET (g
, 0, font_object
);
4044 ASET (gstring
, 0, g
);
4045 for (i
= 1; i
< len
; i
++)
4046 ASET (gstring
, i
, Fmake_vector (make_number (10), Qnil
));
4050 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
4051 doc
: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
4052 START and END specify the region to extract characters.
4053 If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
4054 where to extract characters.
4055 FONT-OBJECT may be nil if GSTRING already contains one. */)
4056 (gstring
, font_object
, start
, end
, object
)
4057 Lisp_Object gstring
, font_object
, start
, end
, object
;
4063 CHECK_VECTOR (gstring
);
4064 if (NILP (font_object
))
4065 font_object
= LGSTRING_FONT (gstring
);
4066 font
= XFONT_OBJECT (font_object
);
4068 if (STRINGP (object
))
4070 const unsigned char *p
;
4072 CHECK_NATNUM (start
);
4074 if (XINT (start
) > XINT (end
)
4075 || XINT (end
) > ASIZE (object
)
4076 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
4077 args_out_of_range_3 (object
, start
, end
);
4079 len
= XINT (end
) - XINT (start
);
4080 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
4081 for (i
= 0; i
< len
; i
++)
4083 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4084 /* Shut up GCC warning in comparison with
4085 MOST_POSITIVE_FIXNUM below. */
4088 c
= STRING_CHAR_ADVANCE (p
);
4089 cod
= code
= font
->driver
->encode_char (font
, c
);
4090 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
4092 LGLYPH_SET_FROM (g
, i
);
4093 LGLYPH_SET_TO (g
, i
);
4094 LGLYPH_SET_CHAR (g
, c
);
4095 LGLYPH_SET_CODE (g
, code
);
4102 if (! NILP (object
))
4103 Fset_buffer (object
);
4104 validate_region (&start
, &end
);
4105 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
4106 args_out_of_range (start
, end
);
4107 len
= XINT (end
) - XINT (start
);
4109 pos_byte
= CHAR_TO_BYTE (pos
);
4110 for (i
= 0; i
< len
; i
++)
4112 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4113 /* Shut up GCC warning in comparison with
4114 MOST_POSITIVE_FIXNUM below. */
4117 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
4118 cod
= code
= font
->driver
->encode_char (font
, c
);
4119 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
4121 LGLYPH_SET_FROM (g
, i
);
4122 LGLYPH_SET_TO (g
, i
);
4123 LGLYPH_SET_CHAR (g
, c
);
4124 LGLYPH_SET_CODE (g
, code
);
4127 for (; i
< LGSTRING_LENGTH (gstring
); i
++)
4128 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
4132 DEFUN ("font-shape-text", Ffont_shape_text
, Sfont_shape_text
, 3, 4, 0,
4133 doc
: /* Shape text between FROM and TO by FONT-OBJECT.
4134 If optional 4th argument STRING is non-nil, it is a string to shape,
4135 and FROM and TO are indices to the string.
4136 The value is the end position of the text that can be shaped by
4138 (from
, to
, font_object
, string
)
4139 Lisp_Object from
, to
, font_object
, string
;
4142 struct font_metrics metrics
;
4143 EMACS_INT start
, end
;
4144 Lisp_Object gstring
, n
;
4147 if (! FONT_OBJECT_P (font_object
))
4149 font
= XFONT_OBJECT (font_object
);
4150 if (! font
->driver
->shape
)
4155 validate_region (&from
, &to
);
4156 start
= XFASTINT (from
);
4157 end
= XFASTINT (to
);
4158 modify_region (current_buffer
, start
, end
, 0);
4162 CHECK_STRING (string
);
4163 start
= XINT (from
);
4165 if (start
< 0 || start
> end
|| end
> SCHARS (string
))
4166 args_out_of_range_3 (string
, from
, to
);
4170 gstring
= Ffont_make_gstring (font_object
, make_number (len
));
4171 Ffont_fill_gstring (gstring
, font_object
, from
, to
, string
);
4173 /* Try at most three times with larger gstring each time. */
4174 for (i
= 0; i
< 3; i
++)
4176 Lisp_Object args
[2];
4178 n
= font
->driver
->shape (gstring
);
4182 args
[1] = Fmake_vector (make_number (len
), Qnil
);
4183 gstring
= Fvconcat (2, args
);
4185 if (! INTEGERP (n
) || XINT (n
) == 0)
4189 for (i
= 0; i
< len
;)
4192 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4193 EMACS_INT this_from
= LGLYPH_FROM (g
);
4194 EMACS_INT this_to
= LGLYPH_TO (g
) + 1;
4196 int need_composition
= 0;
4198 metrics
.lbearing
= LGLYPH_LBEARING (g
);
4199 metrics
.rbearing
= LGLYPH_RBEARING (g
);
4200 metrics
.ascent
= LGLYPH_ASCENT (g
);
4201 metrics
.descent
= LGLYPH_DESCENT (g
);
4202 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4204 metrics
.width
= LGLYPH_WIDTH (g
);
4205 if (LGLYPH_CHAR (g
) == 0 || metrics
.width
== 0)
4206 need_composition
= 1;
4210 metrics
.width
= LGLYPH_WADJUST (g
);
4211 metrics
.lbearing
+= LGLYPH_XOFF (g
);
4212 metrics
.rbearing
+= LGLYPH_XOFF (g
);
4213 metrics
.ascent
-= LGLYPH_YOFF (g
);
4214 metrics
.descent
+= LGLYPH_YOFF (g
);
4215 need_composition
= 1;
4217 for (j
= i
+ 1; j
< len
; j
++)
4221 g
= LGSTRING_GLYPH (gstring
, j
);
4222 if (this_from
!= LGLYPH_FROM (g
))
4224 need_composition
= 1;
4225 x
= metrics
.width
+ LGLYPH_LBEARING (g
) + LGLYPH_XOFF (g
);
4226 if (metrics
.lbearing
> x
)
4227 metrics
.lbearing
= x
;
4228 x
= metrics
.width
+ LGLYPH_RBEARING (g
) + LGLYPH_XOFF (g
);
4229 if (metrics
.rbearing
< x
)
4230 metrics
.rbearing
= x
;
4231 x
= LGLYPH_ASCENT (g
) - LGLYPH_YOFF (g
);
4232 if (metrics
.ascent
< x
)
4234 x
= LGLYPH_DESCENT (g
) - LGLYPH_YOFF (g
);
4235 if (metrics
.descent
< x
)
4236 metrics
.descent
= x
;
4237 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4238 metrics
.width
+= LGLYPH_WIDTH (g
);
4240 metrics
.width
+= LGLYPH_WADJUST (g
);
4243 if (need_composition
)
4245 gstr
= Ffont_make_gstring (font_object
, make_number (j
- i
));
4246 LGSTRING_SET_WIDTH (gstr
, metrics
.width
);
4247 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
4248 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
);
4249 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
4250 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
4251 for (k
= i
; i
< j
; i
++)
4253 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4255 LGLYPH_SET_FROM (g
, LGLYPH_FROM (g
) - this_from
);
4256 LGLYPH_SET_TO (g
, LGLYPH_TO (g
) - this_from
);
4257 LGSTRING_SET_GLYPH (gstr
, i
- k
, LGSTRING_GLYPH (gstring
, i
));
4259 from
= make_number (start
+ this_from
);
4260 to
= make_number (start
+ this_to
);
4262 Fcompose_region_internal (from
, to
, gstr
, Qnil
);
4264 Fcompose_string_internal (string
, from
, to
, gstr
, Qnil
);
4275 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4276 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4277 OTF-FEATURES specifies which features to apply in this format:
4278 (SCRIPT LANGSYS GSUB GPOS)
4280 SCRIPT is a symbol specifying a script tag of OpenType,
4281 LANGSYS is a symbol specifying a langsys tag of OpenType,
4282 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4284 If LANGYS is nil, the default langsys is selected.
4286 The features are applied in the order they appear in the list. The
4287 symbol `*' means to apply all available features not present in this
4288 list, and the remaining features are ignored. For instance, (vatu
4289 pstf * haln) is to apply vatu and pstf in this order, then to apply
4290 all available features other than vatu, pstf, and haln.
4292 The features are applied to the glyphs in the range FROM and TO of
4293 the glyph-string GSTRING-IN.
4295 If some feature is actually applicable, the resulting glyphs are
4296 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4297 this case, the value is the number of produced glyphs.
4299 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4302 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4303 produced in GSTRING-OUT, and the value is nil.
4305 See the documentation of `font-make-gstring' for the format of
4307 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4308 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4310 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4315 check_otf_features (otf_features
);
4316 CHECK_FONT_OBJECT (font_object
);
4317 font
= XFONT_OBJECT (font_object
);
4318 if (! font
->driver
->otf_drive
)
4319 error ("Font backend %s can't drive OpenType GSUB table",
4320 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4321 CHECK_CONS (otf_features
);
4322 CHECK_SYMBOL (XCAR (otf_features
));
4323 val
= XCDR (otf_features
);
4324 CHECK_SYMBOL (XCAR (val
));
4325 val
= XCDR (otf_features
);
4328 len
= check_gstring (gstring_in
);
4329 CHECK_VECTOR (gstring_out
);
4330 CHECK_NATNUM (from
);
4332 CHECK_NATNUM (index
);
4334 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4335 args_out_of_range_3 (from
, to
, make_number (len
));
4336 if (XINT (index
) >= ASIZE (gstring_out
))
4337 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4338 num
= font
->driver
->otf_drive (font
, otf_features
,
4339 gstring_in
, XINT (from
), XINT (to
),
4340 gstring_out
, XINT (index
), 0);
4343 return make_number (num
);
4346 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4348 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4349 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4351 (SCRIPT LANGSYS FEATURE ...)
4352 See the documentation of `font-drive-otf' for more detail.
4354 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4355 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4356 character code corresponding to the glyph or nil if there's no
4357 corresponding character. */)
4358 (font_object
, character
, otf_features
)
4359 Lisp_Object font_object
, character
, otf_features
;
4362 Lisp_Object gstring_in
, gstring_out
, g
;
4363 Lisp_Object alternates
;
4366 CHECK_FONT_GET_OBJECT (font_object
, font
);
4367 if (! font
->driver
->otf_drive
)
4368 error ("Font backend %s can't drive OpenType GSUB table",
4369 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4370 CHECK_CHARACTER (character
);
4371 CHECK_CONS (otf_features
);
4373 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4374 g
= LGSTRING_GLYPH (gstring_in
, 0);
4375 LGLYPH_SET_CHAR (g
, XINT (character
));
4376 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4377 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4378 gstring_out
, 0, 1)) < 0)
4379 gstring_out
= Ffont_make_gstring (font_object
,
4380 make_number (ASIZE (gstring_out
) * 2));
4382 for (i
= 0; i
< num
; i
++)
4384 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4385 int c
= LGLYPH_CHAR (g
);
4386 unsigned code
= LGLYPH_CODE (g
);
4388 alternates
= Fcons (Fcons (make_number (code
),
4389 c
> 0 ? make_number (c
) : Qnil
),
4392 return Fnreverse (alternates
);
4398 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4399 doc
: /* Open FONT-ENTITY. */)
4400 (font_entity
, size
, frame
)
4401 Lisp_Object font_entity
;
4407 CHECK_FONT_ENTITY (font_entity
);
4409 frame
= selected_frame
;
4410 CHECK_LIVE_FRAME (frame
);
4413 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4416 CHECK_NUMBER_OR_FLOAT (size
);
4418 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
4420 isize
= XINT (size
);
4424 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4427 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4428 doc
: /* Close FONT-OBJECT. */)
4429 (font_object
, frame
)
4430 Lisp_Object font_object
, frame
;
4432 CHECK_FONT_OBJECT (font_object
);
4434 frame
= selected_frame
;
4435 CHECK_LIVE_FRAME (frame
);
4436 font_close_object (XFRAME (frame
), font_object
);
4440 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4441 doc
: /* Return information about FONT-OBJECT.
4442 The value is a vector:
4443 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4446 NAME is a string of the font name (or nil if the font backend doesn't
4449 FILENAME is a string of the font file (or nil if the font backend
4450 doesn't provide a file name).
4452 PIXEL-SIZE is a pixel size by which the font is opened.
4454 SIZE is a maximum advance width of the font in pixels.
4456 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4459 CAPABILITY is a list whose first element is a symbol representing the
4460 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4461 remaining elements describe the details of the font capability.
4463 If the font is OpenType font, the form of the list is
4464 \(opentype GSUB GPOS)
4465 where GSUB shows which "GSUB" features the font supports, and GPOS
4466 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4467 lists of the format:
4468 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4470 If the font is not OpenType font, currently the length of the form is
4473 SCRIPT is a symbol representing OpenType script tag.
4475 LANGSYS is a symbol representing OpenType langsys tag, or nil
4476 representing the default langsys.
4478 FEATURE is a symbol representing OpenType feature tag.
4480 If the font is not OpenType font, CAPABILITY is nil. */)
4482 Lisp_Object font_object
;
4487 CHECK_FONT_GET_OBJECT (font_object
, font
);
4489 val
= Fmake_vector (make_number (9), Qnil
);
4490 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4491 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4492 ASET (val
, 2, make_number (font
->pixel_size
));
4493 ASET (val
, 3, make_number (font
->max_width
));
4494 ASET (val
, 4, make_number (font
->ascent
));
4495 ASET (val
, 5, make_number (font
->descent
));
4496 ASET (val
, 6, make_number (font
->space_width
));
4497 ASET (val
, 7, make_number (font
->average_width
));
4498 if (font
->driver
->otf_capability
)
4499 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4503 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4504 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4505 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4506 (font_object
, string
)
4507 Lisp_Object font_object
, string
;
4513 CHECK_FONT_GET_OBJECT (font_object
, font
);
4514 CHECK_STRING (string
);
4515 len
= SCHARS (string
);
4516 vec
= Fmake_vector (make_number (len
), Qnil
);
4517 for (i
= 0; i
< len
; i
++)
4519 Lisp_Object ch
= Faref (string
, make_number (i
));
4524 struct font_metrics metrics
;
4526 cod
= code
= font
->driver
->encode_char (font
, c
);
4527 if (code
== FONT_INVALID_CODE
)
4529 val
= Fmake_vector (make_number (6), Qnil
);
4530 if (cod
<= MOST_POSITIVE_FIXNUM
)
4531 ASET (val
, 0, make_number (code
));
4533 ASET (val
, 0, Fcons (make_number (code
>> 16),
4534 make_number (code
& 0xFFFF)));
4535 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4536 ASET (val
, 1, make_number (metrics
.lbearing
));
4537 ASET (val
, 2, make_number (metrics
.rbearing
));
4538 ASET (val
, 3, make_number (metrics
.width
));
4539 ASET (val
, 4, make_number (metrics
.ascent
));
4540 ASET (val
, 5, make_number (metrics
.descent
));
4546 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4547 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4548 FONT is a font-spec, font-entity, or font-object. */)
4550 Lisp_Object spec
, font
;
4552 CHECK_FONT_SPEC (spec
);
4555 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4558 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4559 doc
: /* Return a font-object for displaying a character at POSITION.
4560 Optional second arg WINDOW, if non-nil, is a window displaying
4561 the current buffer. It defaults to the currently selected window. */)
4562 (position
, window
, string
)
4563 Lisp_Object position
, window
, string
;
4570 CHECK_NUMBER_COERCE_MARKER (position
);
4571 pos
= XINT (position
);
4572 if (pos
< BEGV
|| pos
>= ZV
)
4573 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4577 CHECK_NUMBER (position
);
4578 CHECK_STRING (string
);
4579 pos
= XINT (position
);
4580 if (pos
< 0 || pos
>= SCHARS (string
))
4581 args_out_of_range (string
, position
);
4584 window
= selected_window
;
4585 CHECK_LIVE_WINDOW (window
);
4586 w
= XWINDOW (window
);
4588 return font_at (-1, pos
, NULL
, w
, string
);
4592 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4593 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4594 The value is a number of glyphs drawn.
4595 Type C-l to recover what previously shown. */)
4596 (font_object
, string
)
4597 Lisp_Object font_object
, string
;
4599 Lisp_Object frame
= selected_frame
;
4600 FRAME_PTR f
= XFRAME (frame
);
4606 CHECK_FONT_GET_OBJECT (font_object
, font
);
4607 CHECK_STRING (string
);
4608 len
= SCHARS (string
);
4609 code
= alloca (sizeof (unsigned) * len
);
4610 for (i
= 0; i
< len
; i
++)
4612 Lisp_Object ch
= Faref (string
, make_number (i
));
4616 code
[i
] = font
->driver
->encode_char (font
, c
);
4617 if (code
[i
] == FONT_INVALID_CODE
)
4620 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4622 if (font
->driver
->prepare_face
)
4623 font
->driver
->prepare_face (f
, face
);
4624 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4625 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4626 if (font
->driver
->done_face
)
4627 font
->driver
->done_face (f
, face
);
4629 return make_number (len
);
4633 #endif /* FONT_DEBUG */
4635 #ifdef HAVE_WINDOW_SYSTEM
4637 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4638 doc
: /* Return information about a font named NAME on frame FRAME.
4639 If FRAME is omitted or nil, use the selected frame.
4640 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4641 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4643 OPENED-NAME is the name used for opening the font,
4644 FULL-NAME is the full name of the font,
4645 SIZE is the maximum bound width of the font,
4646 HEIGHT is the height of the font,
4647 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4648 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4649 how to compose characters.
4650 If the named font is not yet loaded, return nil. */)
4652 Lisp_Object name
, frame
;
4657 Lisp_Object font_object
;
4659 (*check_window_system_func
) ();
4662 CHECK_STRING (name
);
4664 frame
= selected_frame
;
4665 CHECK_LIVE_FRAME (frame
);
4670 int fontset
= fs_query_fontset (name
, 0);
4673 name
= fontset_ascii (fontset
);
4674 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4676 else if (FONT_OBJECT_P (name
))
4678 else if (FONT_ENTITY_P (name
))
4679 font_object
= font_open_entity (f
, name
, 0);
4682 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4683 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4685 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4687 if (NILP (font_object
))
4689 font
= XFONT_OBJECT (font_object
);
4691 info
= Fmake_vector (make_number (7), Qnil
);
4692 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4693 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4694 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4695 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4696 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4697 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4698 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4701 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4702 close it now. Perhaps, we should manage font-objects
4703 by `reference-count'. */
4704 font_close_object (f
, font_object
);
4711 #define BUILD_STYLE_TABLE(TBL) \
4712 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4715 build_style_table (entry
, nelement
)
4716 struct table_entry
*entry
;
4720 Lisp_Object table
, elt
;
4722 table
= Fmake_vector (make_number (nelement
), Qnil
);
4723 for (i
= 0; i
< nelement
; i
++)
4725 for (j
= 0; entry
[i
].names
[j
]; j
++);
4726 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4727 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4728 for (j
= 0; entry
[i
].names
[j
]; j
++)
4729 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4730 ASET (table
, i
, elt
);
4735 static Lisp_Object Vfont_log
;
4736 static int font_log_env_checked
;
4739 font_add_log (action
, arg
, result
)
4741 Lisp_Object arg
, result
;
4743 Lisp_Object tail
, val
;
4746 if (! font_log_env_checked
)
4748 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
4749 font_log_env_checked
= 1;
4751 if (EQ (Vfont_log
, Qt
))
4754 arg
= Ffont_xlfd_name (arg
, Qt
);
4756 result
= Ffont_xlfd_name (result
, Qt
);
4757 else if (CONSP (result
))
4759 result
= Fcopy_sequence (result
);
4760 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4764 val
= Ffont_xlfd_name (val
, Qt
);
4765 XSETCAR (tail
, val
);
4768 else if (VECTORP (result
))
4770 result
= Fcopy_sequence (result
);
4771 for (i
= 0; i
< ASIZE (result
); i
++)
4773 val
= AREF (result
, i
);
4775 val
= Ffont_xlfd_name (val
, Qt
);
4776 ASET (result
, i
, val
);
4779 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4782 extern void syms_of_ftfont
P_ (());
4783 extern void syms_of_xfont
P_ (());
4784 extern void syms_of_xftfont
P_ (());
4785 extern void syms_of_ftxfont
P_ (());
4786 extern void syms_of_bdffont
P_ (());
4787 extern void syms_of_w32font
P_ (());
4788 extern void syms_of_atmfont
P_ (());
4793 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
4794 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
4795 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
4796 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
4797 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
4798 /* Note that the other elements in sort_shift_bits are not used. */
4800 staticpro (&font_charset_alist
);
4801 font_charset_alist
= Qnil
;
4803 DEFSYM (Qfont_spec
, "font-spec");
4804 DEFSYM (Qfont_entity
, "font-entity");
4805 DEFSYM (Qfont_object
, "font-object");
4807 DEFSYM (Qopentype
, "opentype");
4809 DEFSYM (Qascii_0
, "ascii-0");
4810 DEFSYM (Qiso8859_1
, "iso8859-1");
4811 DEFSYM (Qiso10646_1
, "iso10646-1");
4812 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4813 DEFSYM (Qunicode_sip
, "unicode-sip");
4815 DEFSYM (QCotf
, ":otf");
4816 DEFSYM (QClang
, ":lang");
4817 DEFSYM (QCscript
, ":script");
4818 DEFSYM (QCantialias
, ":antialias");
4820 DEFSYM (QCfoundry
, ":foundry");
4821 DEFSYM (QCadstyle
, ":adstyle");
4822 DEFSYM (QCregistry
, ":registry");
4823 DEFSYM (QCspacing
, ":spacing");
4824 DEFSYM (QCdpi
, ":dpi");
4825 DEFSYM (QCscalable
, ":scalable");
4826 DEFSYM (QCavgwidth
, ":avgwidth");
4827 DEFSYM (QCfont_entity
, ":font-entity");
4828 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
4835 staticpro (&null_vector
);
4836 null_vector
= Fmake_vector (make_number (0), Qnil
);
4838 staticpro (&scratch_font_spec
);
4839 scratch_font_spec
= Ffont_spec (0, NULL
);
4840 staticpro (&scratch_font_prefer
);
4841 scratch_font_prefer
= Ffont_spec (0, NULL
);
4845 staticpro (&otf_list
);
4847 #endif /* HAVE_LIBOTF */
4851 defsubr (&Sfont_spec
);
4852 defsubr (&Sfont_get
);
4853 defsubr (&Sfont_face_attributes
);
4854 defsubr (&Sfont_put
);
4855 defsubr (&Slist_fonts
);
4856 defsubr (&Sfont_family_list
);
4857 defsubr (&Sfind_font
);
4858 defsubr (&Sfont_xlfd_name
);
4859 defsubr (&Sclear_font_cache
);
4860 defsubr (&Sfont_make_gstring
);
4861 defsubr (&Sfont_fill_gstring
);
4862 defsubr (&Sfont_shape_text
);
4864 defsubr (&Sfont_drive_otf
);
4865 defsubr (&Sfont_otf_alternates
);
4869 defsubr (&Sopen_font
);
4870 defsubr (&Sclose_font
);
4871 defsubr (&Squery_font
);
4872 defsubr (&Sget_font_glyphs
);
4873 defsubr (&Sfont_match_p
);
4874 defsubr (&Sfont_at
);
4876 defsubr (&Sdraw_string
);
4878 #endif /* FONT_DEBUG */
4879 #ifdef HAVE_WINDOW_SYSTEM
4880 defsubr (&Sfont_info
);
4883 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
4885 Alist of fontname patterns vs the corresponding encoding and repertory info.
4886 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
4887 where ENCODING is a charset or a char-table,
4888 and REPERTORY is a charset, a char-table, or nil.
4890 If ENCODING and REPERTORY are the same, the element can have the form
4891 \(REGEXP . ENCODING).
4893 ENCODING is for converting a character to a glyph code of the font.
4894 If ENCODING is a charset, encoding a character by the charset gives
4895 the corresponding glyph code. If ENCODING is a char-table, looking up
4896 the table by a character gives the corresponding glyph code.
4898 REPERTORY specifies a repertory of characters supported by the font.
4899 If REPERTORY is a charset, all characters beloging to the charset are
4900 supported. If REPERTORY is a char-table, all characters who have a
4901 non-nil value in the table are supported. If REPERTORY is nil, Emacs
4902 gets the repertory information by an opened font and ENCODING. */);
4903 Vfont_encoding_alist
= Qnil
;
4905 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
4906 doc
: /* Vector of valid font weight values.
4907 Each element has the form:
4908 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
4909 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
4910 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
4912 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
4913 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
4914 See `font-weight-table' for the format of the vector. */);
4915 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
4917 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
4918 doc
: /* Alist of font width symbols vs the corresponding numeric values.
4919 See `font-weight-table' for the format of the vector. */);
4920 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
4922 staticpro (&font_style_table
);
4923 font_style_table
= Fmake_vector (make_number (3), Qnil
);
4924 ASET (font_style_table
, 0, Vfont_weight_table
);
4925 ASET (font_style_table
, 1, Vfont_slant_table
);
4926 ASET (font_style_table
, 2, Vfont_width_table
);
4928 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
4929 *Logging list of font related actions and results.
4930 The value t means to suppress the logging.
4931 The initial value is set to nil if the environment variable
4932 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
4935 #ifdef HAVE_WINDOW_SYSTEM
4936 #ifdef HAVE_FREETYPE
4938 #ifdef HAVE_X_WINDOWS
4943 #endif /* HAVE_XFT */
4944 #endif /* HAVE_X_WINDOWS */
4945 #else /* not HAVE_FREETYPE */
4946 #ifdef HAVE_X_WINDOWS
4948 #endif /* HAVE_X_WINDOWS */
4949 #endif /* not HAVE_FREETYPE */
4952 #endif /* HAVE_BDFFONT */
4955 #endif /* WINDOWSNT */
4959 #endif /* HAVE_WINDOW_SYSTEM */
4962 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
4963 (do not change this comment) */