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
, 0));
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])
1362 props_beg
= family_end
= p
;
1367 int decimal
= 0, size_found
= 1;
1368 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1371 if (*q
!= '.' || decimal
)
1390 /* A fontconfig name with size and/or property data. */
1391 if (family_end
> name
)
1394 family
= font_intern_prop (name
, family_end
- name
, 1);
1395 ASET (font
, FONT_FAMILY_INDEX
, family
);
1399 double point_size
= strtod (size_beg
, &size_end
);
1400 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1401 if (*size_end
== ':' && size_end
[1])
1402 props_beg
= size_end
;
1406 /* Now parse ":KEY=VAL" patterns. */
1409 for (p
= props_beg
; *p
; p
= q
)
1411 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1414 /* Must be an enumerated value. */
1418 val
= font_intern_prop (p
, q
- p
, 1);
1420 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1422 if (PROP_MATCH ("light", 5)
1423 || PROP_MATCH ("medium", 6)
1424 || PROP_MATCH ("demibold", 8)
1425 || PROP_MATCH ("bold", 4)
1426 || PROP_MATCH ("black", 5))
1427 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1428 else if (PROP_MATCH ("roman", 5)
1429 || PROP_MATCH ("italic", 6)
1430 || PROP_MATCH ("oblique", 7))
1431 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1432 else if (PROP_MATCH ("charcell", 8))
1433 ASET (font
, FONT_SPACING_INDEX
,
1434 make_number (FONT_SPACING_CHARCELL
));
1435 else if (PROP_MATCH ("mono", 4))
1436 ASET (font
, FONT_SPACING_INDEX
,
1437 make_number (FONT_SPACING_MONO
));
1438 else if (PROP_MATCH ("proportional", 12))
1439 ASET (font
, FONT_SPACING_INDEX
,
1440 make_number (FONT_SPACING_PROPORTIONAL
));
1450 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1451 prop
= FONT_SIZE_INDEX
;
1454 key
= font_intern_prop (p
, q
- p
, 1);
1455 prop
= get_font_prop_index (key
);
1459 for (q
= p
; *q
&& *q
!= ':'; q
++);
1460 val
= font_intern_prop (p
, q
- p
, 0);
1462 if (prop
>= FONT_FOUNDRY_INDEX
1463 && prop
< FONT_EXTRA_INDEX
)
1464 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1466 Ffont_put (font
, key
, val
);
1474 /* Either a fontconfig-style name with no size and property
1475 data, or a GTK-style name. */
1477 int word_len
, prop_found
= 0;
1479 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1485 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1493 double point_size
= strtod (p
, &q
);
1494 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1499 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1500 if (*q
== '\\' && q
[1])
1504 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1506 if (PROP_MATCH ("Ultra-Light", 11))
1509 prop
= font_intern_prop ("ultra-light", 11, 1);
1510 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1512 else if (PROP_MATCH ("Light", 5))
1515 prop
= font_intern_prop ("light", 5, 1);
1516 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1518 else if (PROP_MATCH ("Semi-Bold", 9))
1521 prop
= font_intern_prop ("semi-bold", 9, 1);
1522 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1524 else if (PROP_MATCH ("Bold", 4))
1527 prop
= font_intern_prop ("bold", 4, 1);
1528 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1530 else if (PROP_MATCH ("Italic", 6))
1533 prop
= font_intern_prop ("italic", 4, 1);
1534 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1536 else if (PROP_MATCH ("Oblique", 7))
1539 prop
= font_intern_prop ("oblique", 7, 1);
1540 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1544 return -1; /* Unknown property in GTK-style font name. */
1553 family
= font_intern_prop (name
, family_end
- name
, 1);
1554 ASET (font
, FONT_FAMILY_INDEX
, family
);
1561 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1562 NAME (NBYTES length), and return the name length. If
1563 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1566 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1572 Lisp_Object family
, foundry
;
1573 Lisp_Object tail
, val
;
1578 Lisp_Object styles
[3];
1579 char *style_names
[3] = { "weight", "slant", "width" };
1582 family
= AREF (font
, FONT_FAMILY_INDEX
);
1583 if (! NILP (family
))
1585 if (SYMBOLP (family
))
1587 family
= SYMBOL_NAME (family
);
1588 len
+= SBYTES (family
);
1594 val
= AREF (font
, FONT_SIZE_INDEX
);
1597 if (XINT (val
) != 0)
1598 pixel_size
= XINT (val
);
1600 len
+= 21; /* for ":pixelsize=NUM" */
1602 else if (FLOATP (val
))
1605 point_size
= (int) XFLOAT_DATA (val
);
1606 len
+= 11; /* for "-NUM" */
1609 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1610 if (! NILP (foundry
))
1612 if (SYMBOLP (foundry
))
1614 foundry
= SYMBOL_NAME (foundry
);
1615 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1621 for (i
= 0; i
< 3; i
++)
1623 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1624 if (! NILP (styles
[i
]))
1625 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1626 SDATA (SYMBOL_NAME (styles
[i
])));
1629 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1630 len
+= sprintf (work
, ":dpi=%d", dpi
);
1631 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1632 len
+= strlen (":spacing=100");
1633 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1634 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1635 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1637 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1639 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1641 len
+= SBYTES (val
);
1642 else if (INTEGERP (val
))
1643 len
+= sprintf (work
, "%d", XINT (val
));
1644 else if (SYMBOLP (val
))
1645 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1651 if (! NILP (family
))
1652 p
+= sprintf (p
, "%s", SDATA (family
));
1656 p
+= sprintf (p
, "%d", point_size
);
1658 p
+= sprintf (p
, "-%d", point_size
);
1660 else if (pixel_size
> 0)
1661 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1662 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1663 p
+= sprintf (p
, ":foundry=%s",
1664 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1665 for (i
= 0; i
< 3; i
++)
1666 if (! NILP (styles
[i
]))
1667 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1668 SDATA (SYMBOL_NAME (styles
[i
])));
1669 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1670 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1671 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1672 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1673 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1675 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1676 p
+= sprintf (p
, ":scalable=true");
1678 p
+= sprintf (p
, ":scalable=false");
1683 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1684 NAME (NBYTES length), and return the name length. F is the frame
1685 on which the font is displayed; it is used to calculate the point
1689 font_unparse_gtkname (font
, f
, name
, nbytes
)
1697 Lisp_Object family
, weight
, slant
, size
;
1698 int point_size
= -1;
1700 family
= AREF (font
, FONT_FAMILY_INDEX
);
1701 if (! NILP (family
))
1703 if (! SYMBOLP (family
))
1705 family
= SYMBOL_NAME (family
);
1706 len
+= SBYTES (family
);
1709 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1710 if (EQ (weight
, Qnormal
))
1712 else if (! NILP (weight
))
1714 weight
= SYMBOL_NAME (weight
);
1715 len
+= SBYTES (weight
);
1718 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1719 if (EQ (slant
, Qnormal
))
1721 else if (! NILP (slant
))
1723 slant
= SYMBOL_NAME (slant
);
1724 len
+= SBYTES (slant
);
1727 size
= AREF (font
, FONT_SIZE_INDEX
);
1728 /* Convert pixel size to point size. */
1729 if (INTEGERP (size
))
1731 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1733 if (INTEGERP (font_dpi
))
1734 dpi
= XINT (font_dpi
);
1737 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1740 else if (FLOATP (size
))
1742 point_size
= (int) XFLOAT_DATA (size
);
1749 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1751 if (! NILP (weight
))
1754 p
+= sprintf (p
, " %s", SDATA (weight
));
1755 q
[1] = toupper (q
[1]);
1761 p
+= sprintf (p
, " %s", SDATA (slant
));
1762 q
[1] = toupper (q
[1]);
1766 p
+= sprintf (p
, " %d", point_size
);
1771 /* Parse NAME (null terminated) and store information in FONT
1772 (font-spec or font-entity). If NAME is successfully parsed, return
1773 0. Otherwise return -1. */
1776 font_parse_name (name
, font
)
1780 if (name
[0] == '-' || index (name
, '*'))
1781 return font_parse_xlfd (name
, font
);
1782 return font_parse_fcname (name
, font
);
1786 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1787 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1791 font_parse_family_registry (family
, registry
, font_spec
)
1792 Lisp_Object family
, registry
, font_spec
;
1798 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1800 CHECK_STRING (family
);
1801 len
= SBYTES (family
);
1802 p0
= (char *) SDATA (family
);
1803 p1
= index (p0
, '-');
1806 if ((*p0
!= '*' || p1
- p0
> 1)
1807 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1808 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1811 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1814 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1816 if (! NILP (registry
))
1818 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1819 CHECK_STRING (registry
);
1820 len
= SBYTES (registry
);
1821 p0
= (char *) SDATA (registry
);
1822 p1
= index (p0
, '-');
1825 if (SDATA (registry
)[len
- 1] == '*')
1826 registry
= concat2 (registry
, build_string ("-*"));
1828 registry
= concat2 (registry
, build_string ("*-*"));
1830 registry
= Fdowncase (registry
);
1831 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1836 /* This part (through the next ^L) is still experimental and not
1837 tested much. We may drastically change codes. */
1843 #define LGSTRING_HEADER_SIZE 6
1844 #define LGSTRING_GLYPH_SIZE 8
1847 check_gstring (gstring
)
1848 Lisp_Object gstring
;
1853 CHECK_VECTOR (gstring
);
1854 val
= AREF (gstring
, 0);
1856 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1858 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1859 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1860 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1861 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1862 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1863 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1864 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1865 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1866 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1867 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1868 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1870 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1872 val
= LGSTRING_GLYPH (gstring
, i
);
1874 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1876 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1878 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1879 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1880 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1881 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1882 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1883 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1884 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1885 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1887 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1889 if (ASIZE (val
) < 3)
1891 for (j
= 0; j
< 3; j
++)
1892 CHECK_NUMBER (AREF (val
, j
));
1897 error ("Invalid glyph-string format");
1902 check_otf_features (otf_features
)
1903 Lisp_Object otf_features
;
1907 CHECK_CONS (otf_features
);
1908 CHECK_SYMBOL (XCAR (otf_features
));
1909 otf_features
= XCDR (otf_features
);
1910 CHECK_CONS (otf_features
);
1911 CHECK_SYMBOL (XCAR (otf_features
));
1912 otf_features
= XCDR (otf_features
);
1913 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1915 CHECK_SYMBOL (Fcar (val
));
1916 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1917 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1919 otf_features
= XCDR (otf_features
);
1920 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1922 CHECK_SYMBOL (Fcar (val
));
1923 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1924 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1931 Lisp_Object otf_list
;
1934 otf_tag_symbol (tag
)
1939 OTF_tag_name (tag
, name
);
1940 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1947 Lisp_Object val
= Fassoc (file
, otf_list
);
1951 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1954 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1955 val
= make_save_value (otf
, 0);
1956 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1962 /* Return a list describing which scripts/languages FONT supports by
1963 which GSUB/GPOS features of OpenType tables. See the comment of
1964 (struct font_driver).otf_capability. */
1967 font_otf_capability (font
)
1971 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1974 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1977 for (i
= 0; i
< 2; i
++)
1979 OTF_GSUB_GPOS
*gsub_gpos
;
1980 Lisp_Object script_list
= Qnil
;
1983 if (OTF_get_features (otf
, i
== 0) < 0)
1985 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1986 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1988 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1989 Lisp_Object langsys_list
= Qnil
;
1990 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1993 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1995 OTF_LangSys
*langsys
;
1996 Lisp_Object feature_list
= Qnil
;
1997 Lisp_Object langsys_tag
;
2000 if (k
== script
->LangSysCount
)
2002 langsys
= &script
->DefaultLangSys
;
2007 langsys
= script
->LangSys
+ k
;
2009 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2011 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2013 OTF_Feature
*feature
2014 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2015 Lisp_Object feature_tag
2016 = otf_tag_symbol (feature
->FeatureTag
);
2018 feature_list
= Fcons (feature_tag
, feature_list
);
2020 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2023 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2028 XSETCAR (capability
, script_list
);
2030 XSETCDR (capability
, script_list
);
2036 /* Parse OTF features in SPEC and write a proper features spec string
2037 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2038 assured that the sufficient memory has already allocated for
2042 generate_otf_features (spec
, features
)
2052 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2058 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2063 else if (! asterisk
)
2065 val
= SYMBOL_NAME (val
);
2066 p
+= sprintf (p
, "%s", SDATA (val
));
2070 val
= SYMBOL_NAME (val
);
2071 p
+= sprintf (p
, "~%s", SDATA (val
));
2075 error ("OTF spec too long");
2079 font_otf_DeviceTable (device_table
)
2080 OTF_DeviceTable
*device_table
;
2082 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2084 return Fcons (make_number (len
),
2085 make_unibyte_string (device_table
->DeltaValue
, len
));
2089 font_otf_ValueRecord (value_format
, value_record
)
2091 OTF_ValueRecord
*value_record
;
2093 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2095 if (value_format
& OTF_XPlacement
)
2096 ASET (val
, 0, make_number (value_record
->XPlacement
));
2097 if (value_format
& OTF_YPlacement
)
2098 ASET (val
, 1, make_number (value_record
->YPlacement
));
2099 if (value_format
& OTF_XAdvance
)
2100 ASET (val
, 2, make_number (value_record
->XAdvance
));
2101 if (value_format
& OTF_YAdvance
)
2102 ASET (val
, 3, make_number (value_record
->YAdvance
));
2103 if (value_format
& OTF_XPlaDevice
)
2104 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2105 if (value_format
& OTF_YPlaDevice
)
2106 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2107 if (value_format
& OTF_XAdvDevice
)
2108 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2109 if (value_format
& OTF_YAdvDevice
)
2110 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2115 font_otf_Anchor (anchor
)
2120 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2121 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2122 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2123 if (anchor
->AnchorFormat
== 2)
2124 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2127 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2128 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2132 #endif /* HAVE_LIBOTF */
2135 /* G-string (glyph string) handler */
2137 /* G-string is a vector of the form [HEADER GLYPH ...].
2138 See the docstring of `font-make-gstring' for more detail. */
2141 font_prepare_composition (cmp
, f
)
2142 struct composition
*cmp
;
2146 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
2147 cmp
->hash_index
* 2);
2149 cmp
->font
= XFONT_OBJECT (LGSTRING_FONT (gstring
));
2150 cmp
->glyph_len
= LGSTRING_LENGTH (gstring
);
2151 cmp
->pixel_width
= LGSTRING_WIDTH (gstring
);
2152 cmp
->lbearing
= LGSTRING_LBEARING (gstring
);
2153 cmp
->rbearing
= LGSTRING_RBEARING (gstring
);
2154 cmp
->ascent
= LGSTRING_ASCENT (gstring
);
2155 cmp
->descent
= LGSTRING_DESCENT (gstring
);
2156 cmp
->width
= cmp
->pixel_width
/ FRAME_COLUMN_WIDTH (f
);
2157 if (cmp
->width
== 0)
2166 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2167 static int font_compare
P_ ((const void *, const void *));
2168 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
2169 Lisp_Object
, Lisp_Object
,
2172 /* We sort fonts by scoring each of them against a specified
2173 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2174 the value is, the closer the font is to the font-spec.
2176 The lowest 2 bits of the score is used for driver type. The font
2177 available by the most preferred font driver is 0.
2179 Each 7-bit in the higher 28 bits are used for numeric properties
2180 WEIGHT, SLANT, WIDTH, and SIZE. */
2182 /* How many bits to shift to store the difference value of each font
2183 property in a score. Note that flots for FONT_TYPE_INDEX and
2184 FONT_REGISTRY_INDEX are not used. */
2185 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2187 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2188 The return value indicates how different ENTITY is compared with
2191 ALTERNATE_FAMILIES, if non-nil, is a pre-calculated list of
2192 alternate family names for AREF (SPEC_PROP, FONT_FAMILY_INDEX). */
2195 font_score (entity
, spec_prop
)
2196 Lisp_Object entity
, *spec_prop
;
2201 /* Score three style numeric fields. Maximum difference is 127. */
2202 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2203 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2205 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2210 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2213 /* Score the size. Maximum difference is 127. */
2214 i
= FONT_SIZE_INDEX
;
2215 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
])
2216 && XINT (AREF (entity
, i
)) > 0)
2218 /* We use the higher 6-bit for the actual size difference. The
2219 lowest bit is set if the DPI is different. */
2220 int diff
= XINT (spec_prop
[i
]) - XINT (AREF (entity
, i
));
2225 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2226 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2228 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2235 /* The comparison function for qsort. */
2238 font_compare (d1
, d2
)
2239 const void *d1
, *d2
;
2241 return (*(unsigned *) d1
- *(unsigned *) d2
);
2245 /* The structure for elements being sorted by qsort. */
2246 struct font_sort_data
2253 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2254 If PREFER specifies a point-size, calculate the corresponding
2255 pixel-size from QCdpi property of PREFER or from the Y-resolution
2256 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
2257 get the font-entities in VEC.
2259 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2260 return the sorted VEC. */
2263 font_sort_entites (vec
, prefer
, frame
, spec
, best_only
)
2264 Lisp_Object vec
, prefer
, frame
, spec
;
2267 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2269 struct font_sort_data
*data
;
2270 unsigned best_score
;
2271 Lisp_Object best_entity
, driver_type
;
2273 struct frame
*f
= XFRAME (frame
);
2274 struct font_driver_list
*list
;
2279 return best_only
? AREF (vec
, 0) : vec
;
2281 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2282 prefer_prop
[i
] = AREF (prefer
, i
);
2286 /* A font driver may return a font that has a property value
2287 different from the value specified in SPEC if the driver
2288 thinks they are the same. That happens, for instance, such a
2289 generic family name as "serif" is specified. So, to ignore
2290 such a difference, for all properties specified in SPEC, set
2291 the corresponding properties in PREFER_PROP to nil. */
2292 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2293 if (! NILP (AREF (spec
, i
)))
2294 prefer_prop
[i
] = Qnil
;
2297 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2298 prefer_prop
[FONT_SIZE_INDEX
]
2299 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2301 /* Scoring and sorting. */
2302 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2303 best_score
= 0xFFFFFFFF;
2304 /* We are sure that the length of VEC > 1. */
2305 driver_type
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2306 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2307 driver_order
++, list
= list
->next
)
2308 if (EQ (driver_type
, list
->driver
->type
))
2310 best_entity
= data
[0].entity
= AREF (vec
, 0);
2311 best_score
= data
[0].score
2312 = font_score (data
[0].entity
, prefer_prop
) | driver_order
;
2313 for (i
= 0; i
< len
; i
++)
2315 if (!EQ (driver_type
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2316 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2317 driver_order
++, list
= list
->next
)
2318 if (EQ (driver_type
, list
->driver
->type
))
2320 data
[i
].entity
= AREF (vec
, i
);
2321 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
) | driver_order
;
2322 if (best_only
&& best_score
> data
[i
].score
)
2324 best_score
= data
[i
].score
;
2325 best_entity
= data
[i
].entity
;
2326 if (best_score
== 0)
2330 if (NILP (best_entity
))
2332 qsort (data
, len
, sizeof *data
, font_compare
);
2333 for (i
= 0; i
< len
; i
++)
2334 ASET (vec
, i
, data
[i
].entity
);
2340 font_add_log ("sort-by", prefer
, vec
);
2345 /* API of Font Service Layer. */
2347 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2348 sort_shift_bits. Finternal_set_font_selection_order calls this
2349 function with font_sort_order after setting up it. */
2352 font_update_sort_order (order
)
2357 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2359 int xlfd_idx
= order
[i
];
2361 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2362 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2363 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2364 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2365 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2366 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2368 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2373 /* Check if ENTITY matches with the font specification SPEC. */
2376 font_match_p (spec
, entity
)
2377 Lisp_Object spec
, entity
;
2379 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2380 Lisp_Object alternate_families
= Qnil
;
2383 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2384 prefer_prop
[i
] = AREF (spec
, i
);
2385 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2386 prefer_prop
[FONT_SIZE_INDEX
]
2387 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2388 if (! NILP (prefer_prop
[FONT_FAMILY_INDEX
]))
2391 = Fassoc_string (prefer_prop
[FONT_FAMILY_INDEX
],
2392 Vface_alternative_font_family_alist
, Qt
);
2393 if (CONSP (alternate_families
))
2394 alternate_families
= XCDR (alternate_families
);
2397 return (font_score (entity
, prefer_prop
) == 0);
2403 Each font backend has the callback function get_cache, and it
2404 returns a cons cell of which cdr part can be freely used for
2405 caching fonts. The cons cell may be shared by multiple frames
2406 and/or multiple font drivers. So, we arrange the cdr part as this:
2408 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2410 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2411 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2412 cons (FONT-SPEC FONT-ENTITY ...). */
2414 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2415 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2416 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2417 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2418 struct font_driver
*));
2421 font_prepare_cache (f
, driver
)
2423 struct font_driver
*driver
;
2425 Lisp_Object cache
, val
;
2427 cache
= driver
->get_cache (f
);
2429 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2433 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2434 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2438 val
= XCDR (XCAR (val
));
2439 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2445 font_finish_cache (f
, driver
)
2447 struct font_driver
*driver
;
2449 Lisp_Object cache
, val
, tmp
;
2452 cache
= driver
->get_cache (f
);
2454 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2455 cache
= val
, val
= XCDR (val
);
2456 font_assert (! NILP (val
));
2457 tmp
= XCDR (XCAR (val
));
2458 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2459 if (XINT (XCAR (tmp
)) == 0)
2461 font_clear_cache (f
, XCAR (val
), driver
);
2462 XSETCDR (cache
, XCDR (val
));
2468 font_get_cache (f
, driver
)
2470 struct font_driver
*driver
;
2472 Lisp_Object val
= driver
->get_cache (f
);
2473 Lisp_Object type
= driver
->type
;
2475 font_assert (CONSP (val
));
2476 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2477 font_assert (CONSP (val
));
2478 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2479 val
= XCDR (XCAR (val
));
2483 static int num_fonts
;
2486 font_clear_cache (f
, cache
, driver
)
2489 struct font_driver
*driver
;
2491 Lisp_Object tail
, elt
;
2493 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2494 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2497 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)) && VECTORP (XCDR (elt
)))
2499 Lisp_Object vec
= XCDR (elt
);
2502 for (i
= 0; i
< ASIZE (vec
); i
++)
2504 Lisp_Object entity
= AREF (vec
, i
);
2506 if (EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2508 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2510 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2512 Lisp_Object val
= XCAR (objlist
);
2513 struct font
*font
= XFONT_OBJECT (val
);
2515 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2517 font_assert (font
&& driver
== font
->driver
);
2518 driver
->close (f
, font
);
2522 if (driver
->free_entity
)
2523 driver
->free_entity (entity
);
2528 XSETCDR (cache
, Qnil
);
2532 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2535 font_delete_unmatched (list
, spec
, size
)
2536 Lisp_Object list
, spec
;
2539 Lisp_Object entity
, val
;
2540 enum font_property_index prop
;
2542 for (val
= Qnil
; CONSP (list
); list
= XCDR (list
))
2544 entity
= XCAR (list
);
2545 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2546 if (INTEGERP (AREF (spec
, prop
))
2547 && ((XINT (AREF (spec
, prop
)) >> 8)
2548 != (XINT (AREF (entity
, prop
)) >> 8)))
2549 prop
= FONT_SPEC_MAX
;
2550 if (prop
++ <= FONT_SIZE_INDEX
2552 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2554 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2557 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2558 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2559 prop
= FONT_SPEC_MAX
;
2561 if (prop
< FONT_SPEC_MAX
)
2562 val
= Fcons (entity
, val
);
2568 /* Return a vector of font-entities matching with SPEC on FRAME. */
2571 font_list_entities (frame
, spec
)
2572 Lisp_Object frame
, spec
;
2574 FRAME_PTR f
= XFRAME (frame
);
2575 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2576 Lisp_Object ftype
, val
;
2579 int need_filtering
= 0;
2582 font_assert (FONT_SPEC_P (spec
));
2584 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2585 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2586 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2587 size
= font_pixel_size (f
, spec
);
2591 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2592 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2593 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2594 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2596 ASET (scratch_font_spec
, i
, Qnil
);
2597 if (! NILP (AREF (spec
, i
)))
2599 if (i
== FONT_DPI_INDEX
)
2600 /* Skip FONT_SPACING_INDEX */
2603 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2604 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2606 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2610 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2612 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2614 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2616 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2617 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2624 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2625 copy
= Fcopy_font_spec (scratch_font_spec
);
2626 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2627 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2629 if (! NILP (val
) && need_filtering
)
2630 val
= font_delete_unmatched (val
, spec
, size
);
2635 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2636 font_add_log ("list", spec
, val
);
2641 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2642 nil, is an array of face's attributes, which specifies preferred
2643 font-related attributes. */
2646 font_matching_entity (f
, attrs
, spec
)
2648 Lisp_Object
*attrs
, spec
;
2650 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2651 Lisp_Object ftype
, size
, entity
;
2654 XSETFRAME (frame
, f
);
2655 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2656 size
= AREF (spec
, FONT_SIZE_INDEX
);
2658 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2660 for (; driver_list
; driver_list
= driver_list
->next
)
2662 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2664 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2667 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2668 entity
= assoc_no_quit (spec
, XCDR (cache
));
2670 entity
= XCDR (entity
);
2673 entity
= driver_list
->driver
->match (frame
, spec
);
2674 copy
= Fcopy_font_spec (spec
);
2675 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2676 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2678 if (! NILP (entity
))
2681 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2682 ASET (spec
, FONT_SIZE_INDEX
, size
);
2683 font_add_log ("match", spec
, entity
);
2688 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2689 opened font object. */
2692 font_open_entity (f
, entity
, pixel_size
)
2697 struct font_driver_list
*driver_list
;
2698 Lisp_Object objlist
, size
, val
, font_object
;
2700 int min_width
, height
;
2702 font_assert (FONT_ENTITY_P (entity
));
2703 size
= AREF (entity
, FONT_SIZE_INDEX
);
2704 if (XINT (size
) != 0)
2705 pixel_size
= XINT (size
);
2707 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2708 objlist
= XCDR (objlist
))
2709 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2710 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2711 return XCAR (objlist
);
2713 val
= AREF (entity
, FONT_TYPE_INDEX
);
2714 for (driver_list
= f
->font_driver_list
;
2715 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2716 driver_list
= driver_list
->next
);
2720 font_object
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2721 font_add_log ("open", entity
, font_object
);
2722 if (NILP (font_object
))
2724 ASET (entity
, FONT_OBJLIST_INDEX
,
2725 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2726 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
2729 font
= XFONT_OBJECT (font_object
);
2730 min_width
= (font
->min_width
? font
->min_width
2731 : font
->average_width
? font
->average_width
2732 : font
->space_width
? font
->space_width
2734 height
= (font
->height
? font
->height
: 1);
2735 #ifdef HAVE_WINDOW_SYSTEM
2736 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2737 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2739 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2740 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2741 fonts_changed_p
= 1;
2745 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2746 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2747 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2748 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2756 /* Close FONT_OBJECT that is opened on frame F. */
2759 font_close_object (f
, font_object
)
2761 Lisp_Object font_object
;
2763 struct font
*font
= XFONT_OBJECT (font_object
);
2765 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2766 /* Already closed. */
2768 font_add_log ("close", font_object
, Qnil
);
2769 font
->driver
->close (f
, font
);
2770 #ifdef HAVE_WINDOW_SYSTEM
2771 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2772 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2778 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2779 FONT is a font-entity and it must be opened to check. */
2782 font_has_char (f
, font
, c
)
2789 if (FONT_ENTITY_P (font
))
2791 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2792 struct font_driver_list
*driver_list
;
2794 for (driver_list
= f
->font_driver_list
;
2795 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2796 driver_list
= driver_list
->next
);
2799 if (! driver_list
->driver
->has_char
)
2801 return driver_list
->driver
->has_char (font
, c
);
2804 font_assert (FONT_OBJECT_P (font
));
2805 fontp
= XFONT_OBJECT (font
);
2806 if (fontp
->driver
->has_char
)
2808 int result
= fontp
->driver
->has_char (font
, c
);
2813 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2817 /* Return the glyph ID of FONT_OBJECT for character C. */
2820 font_encode_char (font_object
, c
)
2821 Lisp_Object font_object
;
2826 font_assert (FONT_OBJECT_P (font_object
));
2827 font
= XFONT_OBJECT (font_object
);
2828 return font
->driver
->encode_char (font
, c
);
2832 /* Return the name of FONT_OBJECT. */
2835 font_get_name (font_object
)
2836 Lisp_Object font_object
;
2838 font_assert (FONT_OBJECT_P (font_object
));
2839 return AREF (font_object
, FONT_NAME_INDEX
);
2843 /* Return the specification of FONT_OBJECT. */
2846 font_get_spec (font_object
)
2847 Lisp_Object font_object
;
2849 Lisp_Object spec
= font_make_spec ();
2852 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2853 ASET (spec
, i
, AREF (font_object
, i
));
2854 ASET (spec
, FONT_SIZE_INDEX
,
2855 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2860 font_spec_from_name (font_name
)
2861 Lisp_Object font_name
;
2863 Lisp_Object args
[2];
2866 args
[1] = font_name
;
2867 return Ffont_spec (2, args
);
2872 font_clear_prop (attrs
, prop
)
2874 enum font_property_index prop
;
2876 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2880 if (NILP (AREF (font
, prop
))
2881 && prop
!= FONT_FAMILY_INDEX
&& prop
!= FONT_FOUNDRY_INDEX
2882 && prop
!= FONT_SIZE_INDEX
)
2884 font
= Fcopy_font_spec (font
);
2885 ASET (font
, prop
, Qnil
);
2886 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
2888 if (prop
== FONT_FAMILY_INDEX
)
2889 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
2890 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
2891 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
2892 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
2893 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2894 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2895 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2897 else if (prop
== FONT_SIZE_INDEX
)
2899 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2900 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2901 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2903 attrs
[LFACE_FONT_INDEX
] = font
;
2907 font_update_lface (f
, attrs
)
2913 spec
= attrs
[LFACE_FONT_INDEX
];
2914 if (! FONT_SPEC_P (spec
))
2917 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
2918 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
2919 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2920 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
2921 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
2922 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
2923 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
2924 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);;
2925 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
2926 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
2927 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
2931 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2936 val
= Ffont_get (spec
, QCdpi
);
2939 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
2942 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2943 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
2944 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
2949 /* Return a font-entity satisfying SPEC and best matching with face's
2950 font related attributes in ATTRS. C, if not negative, is a
2951 character that the entity must support. */
2954 font_find_for_lface (f
, attrs
, spec
, c
)
2961 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
2962 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
2964 int i
, j
, k
, l
, result
;
2966 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
2967 if (NILP (registry
[0]))
2969 registry
[0] = Qiso8859_1
;
2970 registry
[1] = Qascii_0
;
2971 registry
[2] = null_vector
;
2974 registry
[1] = null_vector
;
2976 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
2978 struct charset
*encoding
, *repertory
;
2980 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
2981 &encoding
, &repertory
) < 0)
2985 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
2987 /* Any font of this registry support C. So, let's
2988 suppress the further checking. */
2991 else if (c
> encoding
->max_char
)
2995 work
= Fcopy_font_spec (spec
);
2996 XSETFRAME (frame
, f
);
2997 size
= AREF (spec
, FONT_SIZE_INDEX
);
2998 pixel_size
= font_pixel_size (f
, spec
);
2999 if (pixel_size
== 0)
3001 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3003 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3005 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3006 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3007 if (! NILP (foundry
[0]))
3008 foundry
[1] = null_vector
;
3009 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3011 foundry
[0] = font_intern_prop (SDATA (attrs
[LFACE_FOUNDRY_INDEX
]),
3012 SBYTES (attrs
[LFACE_FOUNDRY_INDEX
]), 1);
3014 foundry
[2] = null_vector
;
3017 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3019 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3020 if (! NILP (adstyle
[0]))
3021 adstyle
[1] = null_vector
;
3022 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3024 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3026 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3028 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3030 adstyle
[2] = null_vector
;
3033 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3036 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3039 val
= AREF (work
, FONT_FAMILY_INDEX
);
3040 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3041 val
= font_intern_prop (SDATA (attrs
[LFACE_FAMILY_INDEX
]),
3042 SBYTES (attrs
[LFACE_FAMILY_INDEX
]), 1);
3045 family
= alloca ((sizeof family
[0]) * 2);
3047 family
[1] = null_vector
; /* terminator. */
3052 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3054 if (! NILP (alters
))
3056 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3057 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3058 family
[i
] = XCAR (alters
);
3059 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3061 family
[i
] = null_vector
;
3065 family
= alloca ((sizeof family
[0]) * 3);
3068 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3070 family
[i
] = null_vector
;
3074 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3076 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3077 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3079 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3080 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3082 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3083 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3085 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3086 entities
= font_list_entities (frame
, work
);
3087 if (ASIZE (entities
) > 0)
3095 if (ASIZE (entities
) == 1)
3098 return AREF (entities
, 0);
3102 /* Sort fonts by properties specified in LFACE. */
3103 Lisp_Object prefer
= scratch_font_prefer
;
3105 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3106 ASET (prefer
, i
, AREF (work
, i
));
3107 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3109 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3111 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3112 if (NILP (AREF (prefer
, i
)))
3113 ASET (prefer
, i
, AREF (face_font
, i
));
3115 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3116 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3117 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3118 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3119 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3120 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3121 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3122 entities
= font_sort_entites (entities
, prefer
, frame
, work
, c
< 0);
3127 for (i
= 0; i
< ASIZE (entities
); i
++)
3131 val
= AREF (entities
, i
);
3134 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3135 if (! EQ (AREF (val
, j
), props
[j
]))
3137 if (j
> FONT_REGISTRY_INDEX
)
3140 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3141 props
[j
] = AREF (val
, j
);
3142 result
= font_has_char (f
, val
, c
);
3147 val
= font_open_for_lface (f
, val
, attrs
, spec
);
3150 result
= font_has_char (f
, val
, c
);
3151 font_close_object (f
, val
);
3153 return AREF (entities
, i
);
3160 font_open_for_lface (f
, entity
, attrs
, spec
)
3168 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3169 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3170 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3171 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3172 size
= font_pixel_size (f
, spec
);
3175 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3178 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3180 return font_open_entity (f
, entity
, size
);
3184 /* Find a font satisfying SPEC and best matching with face's
3185 attributes in ATTRS on FRAME, and return the opened
3189 font_load_for_lface (f
, attrs
, spec
)
3191 Lisp_Object
*attrs
, spec
;
3195 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3198 /* No font is listed for SPEC, but each font-backend may have
3199 the different criteria about "font matching". So, try
3201 entity
= font_matching_entity (f
, attrs
, spec
);
3205 return font_open_for_lface (f
, entity
, attrs
, spec
);
3209 /* Make FACE on frame F ready to use the font opened for FACE. */
3212 font_prepare_for_face (f
, face
)
3216 if (face
->font
->driver
->prepare_face
)
3217 face
->font
->driver
->prepare_face (f
, face
);
3221 /* Make FACE on frame F stop using the font opened for FACE. */
3224 font_done_for_face (f
, face
)
3228 if (face
->font
->driver
->done_face
)
3229 face
->font
->driver
->done_face (f
, face
);
3234 /* Open a font best matching with NAME on frame F. If no proper font
3235 is found, return Qnil. */
3238 font_open_by_name (f
, name
)
3242 Lisp_Object args
[2];
3243 Lisp_Object spec
, attrs
[LFACE_VECTOR_SIZE
];
3246 args
[1] = make_unibyte_string (name
, strlen (name
));
3247 spec
= Ffont_spec (2, args
);
3248 /* We set up the default font-related attributes of a face to prefer
3250 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3251 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3252 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3253 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3254 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3256 return font_load_for_lface (f
, attrs
, spec
);
3260 /* Register font-driver DRIVER. This function is used in two ways.
3262 The first is with frame F non-NULL. In this case, make DRIVER
3263 available (but not yet activated) on F. All frame creaters
3264 (e.g. Fx_create_frame) must call this function at least once with
3265 an available font-driver.
3267 The second is with frame F NULL. In this case, DRIVER is globally
3268 registered in the variable `font_driver_list'. All font-driver
3269 implementations must call this function in its syms_of_XXXX
3270 (e.g. syms_of_xfont). */
3273 register_font_driver (driver
, f
)
3274 struct font_driver
*driver
;
3277 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3278 struct font_driver_list
*prev
, *list
;
3280 if (f
&& ! driver
->draw
)
3281 error ("Unusable font driver for a frame: %s",
3282 SDATA (SYMBOL_NAME (driver
->type
)));
3284 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3285 if (EQ (list
->driver
->type
, driver
->type
))
3286 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3288 list
= malloc (sizeof (struct font_driver_list
));
3290 list
->driver
= driver
;
3295 f
->font_driver_list
= list
;
3297 font_driver_list
= list
;
3303 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3304 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3305 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3307 A caller must free all realized faces if any in advance. The
3308 return value is a list of font backends actually made used on
3312 font_update_drivers (f
, new_drivers
)
3314 Lisp_Object new_drivers
;
3316 Lisp_Object active_drivers
= Qnil
;
3317 struct font_driver
*driver
;
3318 struct font_driver_list
*list
;
3320 /* At first, turn off non-requested drivers, and turn on requested
3322 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3324 driver
= list
->driver
;
3325 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3330 if (driver
->end_for_frame
)
3331 driver
->end_for_frame (f
);
3332 font_finish_cache (f
, driver
);
3337 if (! driver
->start_for_frame
3338 || driver
->start_for_frame (f
) == 0)
3340 font_prepare_cache (f
, driver
);
3347 if (NILP (new_drivers
))
3350 if (! EQ (new_drivers
, Qt
))
3352 /* Re-order the driver list according to new_drivers. */
3353 struct font_driver_list
**list_table
, **next
;
3357 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3358 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3360 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3361 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3364 list_table
[i
++] = list
;
3366 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3368 list_table
[i
] = list
;
3369 list_table
[i
] = NULL
;
3371 next
= &f
->font_driver_list
;
3372 for (i
= 0; list_table
[i
]; i
++)
3374 *next
= list_table
[i
];
3375 next
= &(*next
)->next
;
3380 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3382 active_drivers
= nconc2 (active_drivers
,
3383 Fcons (list
->driver
->type
, Qnil
));
3384 return active_drivers
;
3388 font_put_frame_data (f
, driver
, data
)
3390 struct font_driver
*driver
;
3393 struct font_data_list
*list
, *prev
;
3395 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3396 prev
= list
, list
= list
->next
)
3397 if (list
->driver
== driver
)
3404 prev
->next
= list
->next
;
3406 f
->font_data_list
= list
->next
;
3414 list
= malloc (sizeof (struct font_data_list
));
3417 list
->driver
= driver
;
3418 list
->next
= f
->font_data_list
;
3419 f
->font_data_list
= list
;
3427 font_get_frame_data (f
, driver
)
3429 struct font_driver
*driver
;
3431 struct font_data_list
*list
;
3433 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3434 if (list
->driver
== driver
)
3442 /* Return the font used to draw character C by FACE at buffer position
3443 POS in window W. If STRING is non-nil, it is a string containing C
3444 at index POS. If C is negative, get C from the current buffer or
3448 font_at (c
, pos
, face
, w
, string
)
3457 Lisp_Object font_object
;
3463 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3466 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3468 c
= FETCH_CHAR (pos_byte
);
3471 c
= FETCH_BYTE (pos
);
3477 multibyte
= STRING_MULTIBYTE (string
);
3480 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3482 str
= SDATA (string
) + pos_byte
;
3483 c
= STRING_CHAR (str
, 0);
3486 c
= SDATA (string
)[pos
];
3490 f
= XFRAME (w
->frame
);
3491 if (! FRAME_WINDOW_P (f
))
3498 if (STRINGP (string
))
3499 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3500 DEFAULT_FACE_ID
, 0);
3502 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3504 face
= FACE_FROM_ID (f
, face_id
);
3508 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3509 face
= FACE_FROM_ID (f
, face_id
);
3514 XSETFONT (font_object
, face
->font
);
3519 /* Check how many characters after POS (at most to LIMIT) can be
3520 displayed by the same font. FACE is the face selected for the
3521 character as POS on frame F. STRING, if not nil, is the string to
3522 check instead of the current buffer.
3524 The return value is the position of the character that is displayed
3525 by the differnt font than that of the character as POS. */
3528 font_range (pos
, limit
, face
, f
, string
)
3529 EMACS_INT pos
, limit
;
3542 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3543 pos_byte
= CHAR_TO_BYTE (pos
);
3547 multibyte
= STRING_MULTIBYTE (string
);
3548 pos_byte
= string_char_to_byte (string
, pos
);
3552 /* All unibyte character are displayed by the same font. */
3560 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3562 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3563 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3564 face
= FACE_FROM_ID (f
, face_id
);
3571 else if (font
!= face
->font
)
3583 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3584 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3585 Return nil otherwise.
3586 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3587 which kind of font it is. It must be one of `font-spec', `font-entity',
3589 (object
, extra_type
)
3590 Lisp_Object object
, extra_type
;
3592 if (NILP (extra_type
))
3593 return (FONTP (object
) ? Qt
: Qnil
);
3594 if (EQ (extra_type
, Qfont_spec
))
3595 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3596 if (EQ (extra_type
, Qfont_entity
))
3597 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3598 if (EQ (extra_type
, Qfont_object
))
3599 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3600 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3603 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3604 doc
: /* Return a newly created font-spec with arguments as properties.
3606 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3607 valid font property name listed below:
3609 `:family', `:weight', `:slant', `:width'
3611 They are the same as face attributes of the same name. See
3612 `set-face-attribute'.
3616 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3620 VALUE must be a string or a symbol specifying the additional
3621 typographic style information of a font, e.g. ``sans''.
3625 VALUE must be a string or a symbol specifying the charset registry and
3626 encoding of a font, e.g. ``iso8859-1''.
3630 VALUE must be a non-negative integer or a floating point number
3631 specifying the font size. It specifies the font size in pixels
3632 (if VALUE is an integer), or in points (if VALUE is a float).
3636 VALUE must be a string of XLFD-style or fontconfig-style font name.
3637 usage: (font-spec ARGS ...) */)
3642 Lisp_Object spec
= font_make_spec ();
3645 for (i
= 0; i
< nargs
; i
+= 2)
3647 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3649 if (EQ (key
, QCname
))
3652 font_parse_name ((char *) SDATA (val
), spec
);
3653 font_put_extra (spec
, key
, val
);
3657 int idx
= get_font_prop_index (key
);
3661 val
= font_prop_validate (idx
, Qnil
, val
);
3662 if (idx
< FONT_EXTRA_INDEX
)
3663 ASET (spec
, idx
, val
);
3665 font_put_extra (spec
, key
, val
);
3668 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3674 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3675 doc
: /* Return a copy of FONT as a font-spec. */)
3679 Lisp_Object new_spec
, tail
, prev
, extra
;
3683 new_spec
= font_make_spec ();
3684 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3685 ASET (new_spec
, i
, AREF (font
, i
));
3686 extra
= Fcopy_sequence (AREF (font
, FONT_EXTRA_INDEX
));
3687 /* We must remove :font-entity property. */
3688 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3689 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3692 extra
= XCDR (extra
);
3694 XSETCDR (prev
, XCDR (tail
));
3697 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3701 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3702 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3703 Every specified properties in FROM override the corresponding
3704 properties in TO. */)
3706 Lisp_Object from
, to
;
3708 Lisp_Object extra
, tail
;
3713 to
= Fcopy_font_spec (to
);
3714 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3715 ASET (to
, i
, AREF (from
, i
));
3716 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3717 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3718 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3720 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3723 XSETCDR (slot
, XCDR (XCAR (tail
)));
3725 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3727 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3731 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3732 doc
: /* Return the value of FONT's property KEY.
3733 FONT is a font-spec, a font-entity, or a font-object. */)
3735 Lisp_Object font
, key
;
3742 idx
= get_font_prop_index (key
);
3743 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3744 return font_style_symbolic (font
, idx
, 0);
3745 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3746 return AREF (font
, idx
);
3747 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3750 #ifdef HAVE_WINDOW_SYSTEM
3752 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3753 doc
: /* Return a plist of face attributes generated by FONT.
3754 FONT is a font name, a font-spec, a font-entity, or a font-object.
3755 The return value is a list of the form
3757 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3759 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3760 compatible with `set-face-attribute'. Some of these key-attribute pairs
3761 may be omitted from the list if they are not specified by FONT.
3763 The optional argument FRAME specifies the frame that the face attributes
3764 are to be displayed on. If omitted, the selected frame is used. */)
3766 Lisp_Object font
, frame
;
3769 Lisp_Object plist
[10];
3774 frame
= selected_frame
;
3775 CHECK_LIVE_FRAME (frame
);
3780 int fontset
= fs_query_fontset (font
, 0);
3781 Lisp_Object name
= font
;
3783 font
= fontset_ascii (fontset
);
3784 font
= font_spec_from_name (name
);
3786 signal_error ("Invalid font name", name
);
3788 else if (! FONTP (font
))
3789 signal_error ("Invalid font object", font
);
3791 val
= AREF (font
, FONT_FAMILY_INDEX
);
3794 plist
[n
++] = QCfamily
;
3795 plist
[n
++] = SYMBOL_NAME (val
);
3798 val
= AREF (font
, FONT_SIZE_INDEX
);
3801 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
3802 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
3803 plist
[n
++] = QCheight
;
3804 plist
[n
++] = make_number (10 * PIXEL_TO_POINT (XINT (val
), dpi
));
3806 else if (FLOATP (val
))
3808 plist
[n
++] = QCheight
;
3809 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
3812 val
= FONT_WEIGHT_FOR_FACE (font
);
3815 plist
[n
++] = QCweight
;
3819 val
= FONT_SLANT_FOR_FACE (font
);
3822 plist
[n
++] = QCslant
;
3826 val
= FONT_WIDTH_FOR_FACE (font
);
3829 plist
[n
++] = QCwidth
;
3833 return Flist (n
, plist
);
3838 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3839 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
3840 (font_spec
, prop
, val
)
3841 Lisp_Object font_spec
, prop
, val
;
3845 CHECK_FONT_SPEC (font_spec
);
3846 idx
= get_font_prop_index (prop
);
3847 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3848 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
3850 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
3854 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3855 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3856 Optional 2nd argument FRAME specifies the target frame.
3857 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3858 Optional 4th argument PREFER, if non-nil, is a font-spec to
3859 control the order of the returned list. Fonts are sorted by
3860 how close they are to PREFER. */)
3861 (font_spec
, frame
, num
, prefer
)
3862 Lisp_Object font_spec
, frame
, num
, prefer
;
3864 Lisp_Object vec
, list
, tail
;
3868 frame
= selected_frame
;
3869 CHECK_LIVE_FRAME (frame
);
3870 CHECK_FONT_SPEC (font_spec
);
3878 if (! NILP (prefer
))
3879 CHECK_FONT_SPEC (prefer
);
3881 vec
= font_list_entities (frame
, font_spec
);
3886 return Fcons (AREF (vec
, 0), Qnil
);
3888 if (! NILP (prefer
))
3889 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
, 0);
3891 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3892 if (n
== 0 || n
> len
)
3894 for (i
= 1; i
< n
; i
++)
3896 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3898 XSETCDR (tail
, val
);
3904 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
3905 doc
: /* List available font families on the current frame.
3906 Optional argument FRAME, if non-nil, specifies the target frame. */)
3911 struct font_driver_list
*driver_list
;
3915 frame
= selected_frame
;
3916 CHECK_LIVE_FRAME (frame
);
3919 for (driver_list
= f
->font_driver_list
; driver_list
;
3920 driver_list
= driver_list
->next
)
3921 if (driver_list
->driver
->list_family
)
3923 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3929 Lisp_Object tail
= list
;
3931 for (; CONSP (val
); val
= XCDR (val
))
3932 if (NILP (Fmemq (XCAR (val
), tail
)))
3933 list
= Fcons (XCAR (val
), list
);
3939 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3940 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3941 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3943 Lisp_Object font_spec
, frame
;
3945 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3952 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
3953 doc
: /* Return XLFD name of FONT.
3954 FONT is a font-spec, font-entity, or font-object.
3955 If the name is too long for XLFD (maximum 255 chars), return nil.
3956 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
3957 the consecutive wildcards are folded to one. */)
3958 (font
, fold_wildcards
)
3959 Lisp_Object font
, fold_wildcards
;
3966 if (FONT_OBJECT_P (font
))
3968 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
3970 if (STRINGP (font_name
)
3971 && SDATA (font_name
)[0] == '-')
3973 if (NILP (fold_wildcards
))
3975 strcpy (name
, (char *) SDATA (font_name
));
3978 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
3980 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3983 if (! NILP (fold_wildcards
))
3985 char *p0
= name
, *p1
;
3987 while ((p1
= strstr (p0
, "-*-*")))
3989 strcpy (p1
, p1
+ 2);
3994 return build_string (name
);
3997 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3998 doc
: /* Clear font cache. */)
4001 Lisp_Object list
, frame
;
4003 FOR_EACH_FRAME (list
, frame
)
4005 FRAME_PTR f
= XFRAME (frame
);
4006 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4008 for (; driver_list
; driver_list
= driver_list
->next
)
4009 if (driver_list
->on
)
4011 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4016 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4018 font_assert (! NILP (val
));
4019 val
= XCDR (XCAR (val
));
4020 if (XINT (XCAR (val
)) == 0)
4022 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4023 XSETCDR (cache
, XCDR (val
));
4031 /* The following three functions are still experimental. */
4033 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
4034 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
4035 FONT-OBJECT may be nil if it is not yet known.
4037 G-string is sequence of glyphs of a specific font,
4038 and is a vector of this form:
4039 [ HEADER GLYPH ... ]
4040 HEADER is a vector of this form:
4041 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
4043 FONT-OBJECT is a font-object for all glyphs in the g-string,
4044 WIDTH thru DESCENT are the metrics (in pixels) of the whole G-string.
4045 GLYPH is a vector of this form:
4046 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
4047 [ [X-OFF Y-OFF WADJUST] | nil] ]
4049 FROM-IDX and TO-IDX are used internally and should not be touched.
4050 C is the character of the glyph.
4051 CODE is the glyph-code of C in FONT-OBJECT.
4052 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4053 X-OFF and Y-OFF are offests to the base position for the glyph.
4054 WADJUST is the adjustment to the normal width of the glyph. */)
4056 Lisp_Object font_object
, num
;
4058 Lisp_Object gstring
, g
;
4062 if (! NILP (font_object
))
4063 CHECK_FONT_OBJECT (font_object
);
4066 len
= XINT (num
) + 1;
4067 gstring
= Fmake_vector (make_number (len
), Qnil
);
4068 g
= Fmake_vector (make_number (6), Qnil
);
4069 ASET (g
, 0, font_object
);
4070 ASET (gstring
, 0, g
);
4071 for (i
= 1; i
< len
; i
++)
4072 ASET (gstring
, i
, Fmake_vector (make_number (10), Qnil
));
4076 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
4077 doc
: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
4078 START and END specify the region to extract characters.
4079 If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
4080 where to extract characters.
4081 FONT-OBJECT may be nil if GSTRING already contains one. */)
4082 (gstring
, font_object
, start
, end
, object
)
4083 Lisp_Object gstring
, font_object
, start
, end
, object
;
4089 CHECK_VECTOR (gstring
);
4090 if (NILP (font_object
))
4091 font_object
= LGSTRING_FONT (gstring
);
4092 font
= XFONT_OBJECT (font_object
);
4094 if (STRINGP (object
))
4096 const unsigned char *p
;
4098 CHECK_NATNUM (start
);
4100 if (XINT (start
) > XINT (end
)
4101 || XINT (end
) > ASIZE (object
)
4102 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
4103 args_out_of_range_3 (object
, start
, end
);
4105 len
= XINT (end
) - XINT (start
);
4106 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
4107 for (i
= 0; i
< len
; i
++)
4109 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4110 /* Shut up GCC warning in comparison with
4111 MOST_POSITIVE_FIXNUM below. */
4114 c
= STRING_CHAR_ADVANCE (p
);
4115 cod
= code
= font
->driver
->encode_char (font
, c
);
4116 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
4118 LGLYPH_SET_FROM (g
, i
);
4119 LGLYPH_SET_TO (g
, i
);
4120 LGLYPH_SET_CHAR (g
, c
);
4121 LGLYPH_SET_CODE (g
, code
);
4128 if (! NILP (object
))
4129 Fset_buffer (object
);
4130 validate_region (&start
, &end
);
4131 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
4132 args_out_of_range (start
, end
);
4133 len
= XINT (end
) - XINT (start
);
4135 pos_byte
= CHAR_TO_BYTE (pos
);
4136 for (i
= 0; i
< len
; i
++)
4138 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4139 /* Shut up GCC warning in comparison with
4140 MOST_POSITIVE_FIXNUM below. */
4143 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
4144 cod
= code
= font
->driver
->encode_char (font
, c
);
4145 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
4147 LGLYPH_SET_FROM (g
, i
);
4148 LGLYPH_SET_TO (g
, i
);
4149 LGLYPH_SET_CHAR (g
, c
);
4150 LGLYPH_SET_CODE (g
, code
);
4153 for (; i
< LGSTRING_LENGTH (gstring
); i
++)
4154 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
4158 DEFUN ("font-shape-text", Ffont_shape_text
, Sfont_shape_text
, 3, 4, 0,
4159 doc
: /* Shape text between FROM and TO by FONT-OBJECT.
4160 If optional 4th argument STRING is non-nil, it is a string to shape,
4161 and FROM and TO are indices to the string.
4162 The value is the end position of the text that can be shaped by
4164 (from
, to
, font_object
, string
)
4165 Lisp_Object from
, to
, font_object
, string
;
4168 struct font_metrics metrics
;
4169 EMACS_INT start
, end
;
4170 Lisp_Object gstring
, n
;
4173 if (! FONT_OBJECT_P (font_object
))
4175 font
= XFONT_OBJECT (font_object
);
4176 if (! font
->driver
->shape
)
4181 validate_region (&from
, &to
);
4182 start
= XFASTINT (from
);
4183 end
= XFASTINT (to
);
4184 modify_region (current_buffer
, start
, end
, 0);
4188 CHECK_STRING (string
);
4189 start
= XINT (from
);
4191 if (start
< 0 || start
> end
|| end
> SCHARS (string
))
4192 args_out_of_range_3 (string
, from
, to
);
4196 gstring
= Ffont_make_gstring (font_object
, make_number (len
));
4197 Ffont_fill_gstring (gstring
, font_object
, from
, to
, string
);
4199 /* Try at most three times with larger gstring each time. */
4200 for (i
= 0; i
< 3; i
++)
4202 Lisp_Object args
[2];
4204 n
= font
->driver
->shape (gstring
);
4208 args
[1] = Fmake_vector (make_number (len
), Qnil
);
4209 gstring
= Fvconcat (2, args
);
4211 if (! INTEGERP (n
) || XINT (n
) == 0)
4215 for (i
= 0; i
< len
;)
4218 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4219 EMACS_INT this_from
= LGLYPH_FROM (g
);
4220 EMACS_INT this_to
= LGLYPH_TO (g
) + 1;
4222 int need_composition
= 0;
4224 metrics
.lbearing
= LGLYPH_LBEARING (g
);
4225 metrics
.rbearing
= LGLYPH_RBEARING (g
);
4226 metrics
.ascent
= LGLYPH_ASCENT (g
);
4227 metrics
.descent
= LGLYPH_DESCENT (g
);
4228 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4230 metrics
.width
= LGLYPH_WIDTH (g
);
4231 if (LGLYPH_CHAR (g
) == 0 || metrics
.width
== 0)
4232 need_composition
= 1;
4236 metrics
.width
= LGLYPH_WADJUST (g
);
4237 metrics
.lbearing
+= LGLYPH_XOFF (g
);
4238 metrics
.rbearing
+= LGLYPH_XOFF (g
);
4239 metrics
.ascent
-= LGLYPH_YOFF (g
);
4240 metrics
.descent
+= LGLYPH_YOFF (g
);
4241 need_composition
= 1;
4243 for (j
= i
+ 1; j
< len
; j
++)
4247 g
= LGSTRING_GLYPH (gstring
, j
);
4248 if (this_from
!= LGLYPH_FROM (g
))
4250 need_composition
= 1;
4251 x
= metrics
.width
+ LGLYPH_LBEARING (g
) + LGLYPH_XOFF (g
);
4252 if (metrics
.lbearing
> x
)
4253 metrics
.lbearing
= x
;
4254 x
= metrics
.width
+ LGLYPH_RBEARING (g
) + LGLYPH_XOFF (g
);
4255 if (metrics
.rbearing
< x
)
4256 metrics
.rbearing
= x
;
4257 x
= LGLYPH_ASCENT (g
) - LGLYPH_YOFF (g
);
4258 if (metrics
.ascent
< x
)
4260 x
= LGLYPH_DESCENT (g
) - LGLYPH_YOFF (g
);
4261 if (metrics
.descent
< x
)
4262 metrics
.descent
= x
;
4263 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4264 metrics
.width
+= LGLYPH_WIDTH (g
);
4266 metrics
.width
+= LGLYPH_WADJUST (g
);
4269 if (need_composition
)
4271 gstr
= Ffont_make_gstring (font_object
, make_number (j
- i
));
4272 LGSTRING_SET_WIDTH (gstr
, metrics
.width
);
4273 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
4274 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
);
4275 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
4276 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
4277 for (k
= i
; i
< j
; i
++)
4279 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4281 LGLYPH_SET_FROM (g
, LGLYPH_FROM (g
) - this_from
);
4282 LGLYPH_SET_TO (g
, LGLYPH_TO (g
) - this_from
);
4283 LGSTRING_SET_GLYPH (gstr
, i
- k
, LGSTRING_GLYPH (gstring
, i
));
4285 from
= make_number (start
+ this_from
);
4286 to
= make_number (start
+ this_to
);
4288 Fcompose_region_internal (from
, to
, gstr
, Qnil
);
4290 Fcompose_string_internal (string
, from
, to
, gstr
, Qnil
);
4301 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4302 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4303 OTF-FEATURES specifies which features to apply in this format:
4304 (SCRIPT LANGSYS GSUB GPOS)
4306 SCRIPT is a symbol specifying a script tag of OpenType,
4307 LANGSYS is a symbol specifying a langsys tag of OpenType,
4308 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4310 If LANGYS is nil, the default langsys is selected.
4312 The features are applied in the order they appear in the list. The
4313 symbol `*' means to apply all available features not present in this
4314 list, and the remaining features are ignored. For instance, (vatu
4315 pstf * haln) is to apply vatu and pstf in this order, then to apply
4316 all available features other than vatu, pstf, and haln.
4318 The features are applied to the glyphs in the range FROM and TO of
4319 the glyph-string GSTRING-IN.
4321 If some feature is actually applicable, the resulting glyphs are
4322 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4323 this case, the value is the number of produced glyphs.
4325 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4328 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4329 produced in GSTRING-OUT, and the value is nil.
4331 See the documentation of `font-make-gstring' for the format of
4333 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4334 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4336 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4341 check_otf_features (otf_features
);
4342 CHECK_FONT_OBJECT (font_object
);
4343 font
= XFONT_OBJECT (font_object
);
4344 if (! font
->driver
->otf_drive
)
4345 error ("Font backend %s can't drive OpenType GSUB table",
4346 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4347 CHECK_CONS (otf_features
);
4348 CHECK_SYMBOL (XCAR (otf_features
));
4349 val
= XCDR (otf_features
);
4350 CHECK_SYMBOL (XCAR (val
));
4351 val
= XCDR (otf_features
);
4354 len
= check_gstring (gstring_in
);
4355 CHECK_VECTOR (gstring_out
);
4356 CHECK_NATNUM (from
);
4358 CHECK_NATNUM (index
);
4360 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4361 args_out_of_range_3 (from
, to
, make_number (len
));
4362 if (XINT (index
) >= ASIZE (gstring_out
))
4363 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4364 num
= font
->driver
->otf_drive (font
, otf_features
,
4365 gstring_in
, XINT (from
), XINT (to
),
4366 gstring_out
, XINT (index
), 0);
4369 return make_number (num
);
4372 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4374 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4375 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4377 (SCRIPT LANGSYS FEATURE ...)
4378 See the documentation of `font-drive-otf' for more detail.
4380 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4381 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4382 character code corresponding to the glyph or nil if there's no
4383 corresponding character. */)
4384 (font_object
, character
, otf_features
)
4385 Lisp_Object font_object
, character
, otf_features
;
4388 Lisp_Object gstring_in
, gstring_out
, g
;
4389 Lisp_Object alternates
;
4392 CHECK_FONT_GET_OBJECT (font_object
, font
);
4393 if (! font
->driver
->otf_drive
)
4394 error ("Font backend %s can't drive OpenType GSUB table",
4395 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4396 CHECK_CHARACTER (character
);
4397 CHECK_CONS (otf_features
);
4399 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4400 g
= LGSTRING_GLYPH (gstring_in
, 0);
4401 LGLYPH_SET_CHAR (g
, XINT (character
));
4402 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4403 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4404 gstring_out
, 0, 1)) < 0)
4405 gstring_out
= Ffont_make_gstring (font_object
,
4406 make_number (ASIZE (gstring_out
) * 2));
4408 for (i
= 0; i
< num
; i
++)
4410 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4411 int c
= LGLYPH_CHAR (g
);
4412 unsigned code
= LGLYPH_CODE (g
);
4414 alternates
= Fcons (Fcons (make_number (code
),
4415 c
> 0 ? make_number (c
) : Qnil
),
4418 return Fnreverse (alternates
);
4424 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4425 doc
: /* Open FONT-ENTITY. */)
4426 (font_entity
, size
, frame
)
4427 Lisp_Object font_entity
;
4433 CHECK_FONT_ENTITY (font_entity
);
4435 frame
= selected_frame
;
4436 CHECK_LIVE_FRAME (frame
);
4439 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4442 CHECK_NUMBER_OR_FLOAT (size
);
4444 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
4446 isize
= XINT (size
);
4450 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4453 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4454 doc
: /* Close FONT-OBJECT. */)
4455 (font_object
, frame
)
4456 Lisp_Object font_object
, frame
;
4458 CHECK_FONT_OBJECT (font_object
);
4460 frame
= selected_frame
;
4461 CHECK_LIVE_FRAME (frame
);
4462 font_close_object (XFRAME (frame
), font_object
);
4466 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4467 doc
: /* Return information about FONT-OBJECT.
4468 The value is a vector:
4469 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4472 NAME is a string of the font name (or nil if the font backend doesn't
4475 FILENAME is a string of the font file (or nil if the font backend
4476 doesn't provide a file name).
4478 PIXEL-SIZE is a pixel size by which the font is opened.
4480 SIZE is a maximum advance width of the font in pixels.
4482 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4485 CAPABILITY is a list whose first element is a symbol representing the
4486 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4487 remaining elements describe the details of the font capability.
4489 If the font is OpenType font, the form of the list is
4490 \(opentype GSUB GPOS)
4491 where GSUB shows which "GSUB" features the font supports, and GPOS
4492 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4493 lists of the format:
4494 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4496 If the font is not OpenType font, currently the length of the form is
4499 SCRIPT is a symbol representing OpenType script tag.
4501 LANGSYS is a symbol representing OpenType langsys tag, or nil
4502 representing the default langsys.
4504 FEATURE is a symbol representing OpenType feature tag.
4506 If the font is not OpenType font, CAPABILITY is nil. */)
4508 Lisp_Object font_object
;
4513 CHECK_FONT_GET_OBJECT (font_object
, font
);
4515 val
= Fmake_vector (make_number (9), Qnil
);
4516 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4517 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4518 ASET (val
, 2, make_number (font
->pixel_size
));
4519 ASET (val
, 3, make_number (font
->max_width
));
4520 ASET (val
, 4, make_number (font
->ascent
));
4521 ASET (val
, 5, make_number (font
->descent
));
4522 ASET (val
, 6, make_number (font
->space_width
));
4523 ASET (val
, 7, make_number (font
->average_width
));
4524 if (font
->driver
->otf_capability
)
4525 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4529 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4530 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4531 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4532 (font_object
, string
)
4533 Lisp_Object font_object
, string
;
4539 CHECK_FONT_GET_OBJECT (font_object
, font
);
4540 CHECK_STRING (string
);
4541 len
= SCHARS (string
);
4542 vec
= Fmake_vector (make_number (len
), Qnil
);
4543 for (i
= 0; i
< len
; i
++)
4545 Lisp_Object ch
= Faref (string
, make_number (i
));
4550 struct font_metrics metrics
;
4552 cod
= code
= font
->driver
->encode_char (font
, c
);
4553 if (code
== FONT_INVALID_CODE
)
4555 val
= Fmake_vector (make_number (6), Qnil
);
4556 if (cod
<= MOST_POSITIVE_FIXNUM
)
4557 ASET (val
, 0, make_number (code
));
4559 ASET (val
, 0, Fcons (make_number (code
>> 16),
4560 make_number (code
& 0xFFFF)));
4561 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4562 ASET (val
, 1, make_number (metrics
.lbearing
));
4563 ASET (val
, 2, make_number (metrics
.rbearing
));
4564 ASET (val
, 3, make_number (metrics
.width
));
4565 ASET (val
, 4, make_number (metrics
.ascent
));
4566 ASET (val
, 5, make_number (metrics
.descent
));
4572 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4573 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4574 FONT is a font-spec, font-entity, or font-object. */)
4576 Lisp_Object spec
, font
;
4578 CHECK_FONT_SPEC (spec
);
4581 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4584 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4585 doc
: /* Return a font-object for displaying a character at POSITION.
4586 Optional second arg WINDOW, if non-nil, is a window displaying
4587 the current buffer. It defaults to the currently selected window. */)
4588 (position
, window
, string
)
4589 Lisp_Object position
, window
, string
;
4596 CHECK_NUMBER_COERCE_MARKER (position
);
4597 pos
= XINT (position
);
4598 if (pos
< BEGV
|| pos
>= ZV
)
4599 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4603 CHECK_NUMBER (position
);
4604 CHECK_STRING (string
);
4605 pos
= XINT (position
);
4606 if (pos
< 0 || pos
>= SCHARS (string
))
4607 args_out_of_range (string
, position
);
4610 window
= selected_window
;
4611 CHECK_LIVE_WINDOW (window
);
4612 w
= XWINDOW (window
);
4614 return font_at (-1, pos
, NULL
, w
, string
);
4618 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4619 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4620 The value is a number of glyphs drawn.
4621 Type C-l to recover what previously shown. */)
4622 (font_object
, string
)
4623 Lisp_Object font_object
, string
;
4625 Lisp_Object frame
= selected_frame
;
4626 FRAME_PTR f
= XFRAME (frame
);
4632 CHECK_FONT_GET_OBJECT (font_object
, font
);
4633 CHECK_STRING (string
);
4634 len
= SCHARS (string
);
4635 code
= alloca (sizeof (unsigned) * len
);
4636 for (i
= 0; i
< len
; i
++)
4638 Lisp_Object ch
= Faref (string
, make_number (i
));
4642 code
[i
] = font
->driver
->encode_char (font
, c
);
4643 if (code
[i
] == FONT_INVALID_CODE
)
4646 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4648 if (font
->driver
->prepare_face
)
4649 font
->driver
->prepare_face (f
, face
);
4650 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4651 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4652 if (font
->driver
->done_face
)
4653 font
->driver
->done_face (f
, face
);
4655 return make_number (len
);
4659 #endif /* FONT_DEBUG */
4661 #ifdef HAVE_WINDOW_SYSTEM
4663 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4664 doc
: /* Return information about a font named NAME on frame FRAME.
4665 If FRAME is omitted or nil, use the selected frame.
4666 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4667 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4669 OPENED-NAME is the name used for opening the font,
4670 FULL-NAME is the full name of the font,
4671 SIZE is the maximum bound width of the font,
4672 HEIGHT is the height of the font,
4673 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4674 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4675 how to compose characters.
4676 If the named font is not yet loaded, return nil. */)
4678 Lisp_Object name
, frame
;
4683 Lisp_Object font_object
;
4685 (*check_window_system_func
) ();
4688 CHECK_STRING (name
);
4690 frame
= selected_frame
;
4691 CHECK_LIVE_FRAME (frame
);
4696 int fontset
= fs_query_fontset (name
, 0);
4699 name
= fontset_ascii (fontset
);
4700 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4702 else if (FONT_OBJECT_P (name
))
4704 else if (FONT_ENTITY_P (name
))
4705 font_object
= font_open_entity (f
, name
, 0);
4708 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4709 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4711 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4713 if (NILP (font_object
))
4715 font
= XFONT_OBJECT (font_object
);
4717 info
= Fmake_vector (make_number (7), Qnil
);
4718 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4719 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4720 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4721 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4722 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4723 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4724 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4727 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4728 close it now. Perhaps, we should manage font-objects
4729 by `reference-count'. */
4730 font_close_object (f
, font_object
);
4737 #define BUILD_STYLE_TABLE(TBL) \
4738 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4741 build_style_table (entry
, nelement
)
4742 struct table_entry
*entry
;
4746 Lisp_Object table
, elt
;
4748 table
= Fmake_vector (make_number (nelement
), Qnil
);
4749 for (i
= 0; i
< nelement
; i
++)
4751 for (j
= 0; entry
[i
].names
[j
]; j
++);
4752 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4753 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4754 for (j
= 0; entry
[i
].names
[j
]; j
++)
4755 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4756 ASET (table
, i
, elt
);
4761 static Lisp_Object Vfont_log
;
4762 static int font_log_env_checked
;
4765 font_add_log (action
, arg
, result
)
4767 Lisp_Object arg
, result
;
4769 Lisp_Object tail
, val
;
4772 if (! font_log_env_checked
)
4774 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
4775 font_log_env_checked
= 1;
4777 if (EQ (Vfont_log
, Qt
))
4780 arg
= Ffont_xlfd_name (arg
, Qt
);
4783 val
= Ffont_xlfd_name (result
, Qt
);
4784 if (! FONT_SPEC_P (result
))
4785 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4786 build_string (":"), val
);
4789 else if (CONSP (result
))
4791 result
= Fcopy_sequence (result
);
4792 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4796 val
= Ffont_xlfd_name (val
, Qt
);
4797 XSETCAR (tail
, val
);
4800 else if (VECTORP (result
))
4802 result
= Fcopy_sequence (result
);
4803 for (i
= 0; i
< ASIZE (result
); i
++)
4805 val
= AREF (result
, i
);
4807 val
= Ffont_xlfd_name (val
, Qt
);
4808 ASET (result
, i
, val
);
4811 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4814 extern void syms_of_ftfont
P_ (());
4815 extern void syms_of_xfont
P_ (());
4816 extern void syms_of_xftfont
P_ (());
4817 extern void syms_of_ftxfont
P_ (());
4818 extern void syms_of_bdffont
P_ (());
4819 extern void syms_of_w32font
P_ (());
4820 extern void syms_of_atmfont
P_ (());
4825 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
4826 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
4827 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
4828 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
4829 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
4830 /* Note that the other elements in sort_shift_bits are not used. */
4832 staticpro (&font_charset_alist
);
4833 font_charset_alist
= Qnil
;
4835 DEFSYM (Qfont_spec
, "font-spec");
4836 DEFSYM (Qfont_entity
, "font-entity");
4837 DEFSYM (Qfont_object
, "font-object");
4839 DEFSYM (Qopentype
, "opentype");
4841 DEFSYM (Qascii_0
, "ascii-0");
4842 DEFSYM (Qiso8859_1
, "iso8859-1");
4843 DEFSYM (Qiso10646_1
, "iso10646-1");
4844 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4845 DEFSYM (Qunicode_sip
, "unicode-sip");
4847 DEFSYM (QCotf
, ":otf");
4848 DEFSYM (QClang
, ":lang");
4849 DEFSYM (QCscript
, ":script");
4850 DEFSYM (QCantialias
, ":antialias");
4852 DEFSYM (QCfoundry
, ":foundry");
4853 DEFSYM (QCadstyle
, ":adstyle");
4854 DEFSYM (QCregistry
, ":registry");
4855 DEFSYM (QCspacing
, ":spacing");
4856 DEFSYM (QCdpi
, ":dpi");
4857 DEFSYM (QCscalable
, ":scalable");
4858 DEFSYM (QCavgwidth
, ":avgwidth");
4859 DEFSYM (QCfont_entity
, ":font-entity");
4860 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
4867 staticpro (&null_vector
);
4868 null_vector
= Fmake_vector (make_number (0), Qnil
);
4870 staticpro (&scratch_font_spec
);
4871 scratch_font_spec
= Ffont_spec (0, NULL
);
4872 staticpro (&scratch_font_prefer
);
4873 scratch_font_prefer
= Ffont_spec (0, NULL
);
4877 staticpro (&otf_list
);
4879 #endif /* HAVE_LIBOTF */
4883 defsubr (&Sfont_spec
);
4884 defsubr (&Sfont_get
);
4885 #ifdef HAVE_WINDOW_SYSTEM
4886 defsubr (&Sfont_face_attributes
);
4888 defsubr (&Sfont_put
);
4889 defsubr (&Slist_fonts
);
4890 defsubr (&Sfont_family_list
);
4891 defsubr (&Sfind_font
);
4892 defsubr (&Sfont_xlfd_name
);
4893 defsubr (&Sclear_font_cache
);
4894 defsubr (&Sfont_make_gstring
);
4895 defsubr (&Sfont_fill_gstring
);
4896 defsubr (&Sfont_shape_text
);
4898 defsubr (&Sfont_drive_otf
);
4899 defsubr (&Sfont_otf_alternates
);
4903 defsubr (&Sopen_font
);
4904 defsubr (&Sclose_font
);
4905 defsubr (&Squery_font
);
4906 defsubr (&Sget_font_glyphs
);
4907 defsubr (&Sfont_match_p
);
4908 defsubr (&Sfont_at
);
4910 defsubr (&Sdraw_string
);
4912 #endif /* FONT_DEBUG */
4913 #ifdef HAVE_WINDOW_SYSTEM
4914 defsubr (&Sfont_info
);
4917 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
4919 Alist of fontname patterns vs the corresponding encoding and repertory info.
4920 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
4921 where ENCODING is a charset or a char-table,
4922 and REPERTORY is a charset, a char-table, or nil.
4924 If ENCODING and REPERTORY are the same, the element can have the form
4925 \(REGEXP . ENCODING).
4927 ENCODING is for converting a character to a glyph code of the font.
4928 If ENCODING is a charset, encoding a character by the charset gives
4929 the corresponding glyph code. If ENCODING is a char-table, looking up
4930 the table by a character gives the corresponding glyph code.
4932 REPERTORY specifies a repertory of characters supported by the font.
4933 If REPERTORY is a charset, all characters beloging to the charset are
4934 supported. If REPERTORY is a char-table, all characters who have a
4935 non-nil value in the table are supported. If REPERTORY is nil, Emacs
4936 gets the repertory information by an opened font and ENCODING. */);
4937 Vfont_encoding_alist
= Qnil
;
4939 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
4940 doc
: /* Vector of valid font weight values.
4941 Each element has the form:
4942 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
4943 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
4944 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
4946 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
4947 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
4948 See `font-weight-table' for the format of the vector. */);
4949 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
4951 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
4952 doc
: /* Alist of font width symbols vs the corresponding numeric values.
4953 See `font-weight-table' for the format of the vector. */);
4954 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
4956 staticpro (&font_style_table
);
4957 font_style_table
= Fmake_vector (make_number (3), Qnil
);
4958 ASET (font_style_table
, 0, Vfont_weight_table
);
4959 ASET (font_style_table
, 1, Vfont_slant_table
);
4960 ASET (font_style_table
, 2, Vfont_width_table
);
4962 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
4963 *Logging list of font related actions and results.
4964 The value t means to suppress the logging.
4965 The initial value is set to nil if the environment variable
4966 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
4969 #ifdef HAVE_WINDOW_SYSTEM
4970 #ifdef HAVE_FREETYPE
4972 #ifdef HAVE_X_WINDOWS
4977 #endif /* HAVE_XFT */
4978 #endif /* HAVE_X_WINDOWS */
4979 #else /* not HAVE_FREETYPE */
4980 #ifdef HAVE_X_WINDOWS
4982 #endif /* HAVE_X_WINDOWS */
4983 #endif /* not HAVE_FREETYPE */
4986 #endif /* HAVE_BDFFONT */
4989 #endif /* WINDOWSNT */
4993 #endif /* HAVE_WINDOW_SYSTEM */
4996 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
4997 (do not change this comment) */