1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
3 Copyright (C) 2006, 2007, 2008
4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H13PRO009
7 This file is part of GNU Emacs.
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
34 #include "dispextern.h"
36 #include "character.h"
37 #include "composite.h"
43 #endif /* HAVE_X_WINDOWS */
47 #endif /* HAVE_NTGUI */
53 Lisp_Object Qfont_spec
, Qfont_entity
, Qfont_object
;
55 Lisp_Object Qopentype
;
57 /* Important character set strings. */
58 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
60 /* Special vector of zero length. This is repeatedly used by (struct
61 font_driver *)->list when a specified font is not found. */
62 static Lisp_Object null_vector
;
64 static Lisp_Object Vfont_weight_table
, Vfont_slant_table
, Vfont_width_table
;
66 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
67 static Lisp_Object font_style_table
;
69 /* Structure used for tables mapping weight, slant, and width numeric
70 values and their names. */
75 /* The first one is a valid name as a face attribute.
76 The second one (if any) is a typical name in XLFD field. */
81 /* Table of weight numeric values and their names. This table must be
82 sorted by numeric values in ascending order. */
84 static struct table_entry weight_table
[] =
87 { 20, { "ultra-light", "ultralight" }},
88 { 40, { "extra-light", "extralight" }},
90 { 75, { "semi-light", "semilight", "demilight", "book" }},
91 { 100, { "normal", "medium", "regular" }},
92 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
94 { 205, { "extra-bold", "extrabold" }},
95 { 210, { "ultra-bold", "ultrabold", "black" }}
98 /* Table of slant numeric values and their names. This table must be
99 sorted by numeric values in ascending order. */
101 static struct table_entry slant_table
[] =
103 { 0, { "reverse-oblique", "ro" }},
104 { 10, { "reverse-italic", "ri" }},
105 { 100, { "normal", "r" }},
106 { 200, { "italic" ,"i", "ot" }},
107 { 210, { "oblique", "o" }}
110 /* Table of width numeric values and their names. This table must be
111 sorted by numeric values in ascending order. */
113 static struct table_entry width_table
[] =
115 { 50, { "ultra-condensed", "ultracondensed" }},
116 { 63, { "extra-condensed", "extracondensed" }},
117 { 75, { "condensed", "compressed", "narrow" }},
118 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
119 { 100, { "normal", "medium", "regular" }},
120 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
121 { 125, { "expanded" }},
122 { 150, { "extra-expanded", "extraexpanded" }},
123 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
126 extern Lisp_Object Qnormal
;
128 /* Symbols representing keys of normal font properties. */
129 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
;
130 extern Lisp_Object QCheight
, QCsize
, QCname
;
132 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
;
133 /* Symbols representing keys of font extra info. */
134 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
135 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
136 /* Symbols representing values of font spacing property. */
137 Lisp_Object Qc
, Qm
, Qp
, Qd
;
139 Lisp_Object Vfont_encoding_alist
;
141 /* Alist of font registry symbol and the corresponding charsets
142 information. The information is retrieved from
143 Vfont_encoding_alist on demand.
145 Eash element has the form:
146 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
150 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
151 encodes a character code to a glyph code of a font, and
152 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
153 character is supported by a font.
155 The latter form means that the information for REGISTRY couldn't be
157 static Lisp_Object font_charset_alist
;
159 /* List of all font drivers. Each font-backend (XXXfont.c) calls
160 register_font_driver in syms_of_XXXfont to register its font-driver
162 static struct font_driver_list
*font_driver_list
;
166 /* Creaters of font-related Lisp object. */
171 Lisp_Object font_spec
;
172 struct font_spec
*spec
173 = ((struct font_spec
*)
174 allocate_pseudovector (VECSIZE (struct font_spec
),
175 FONT_SPEC_MAX
, PVEC_FONT
));
176 XSETFONT (font_spec
, spec
);
183 Lisp_Object font_entity
;
184 struct font_entity
*entity
185 = ((struct font_entity
*)
186 allocate_pseudovector (VECSIZE (struct font_entity
),
187 FONT_ENTITY_MAX
, PVEC_FONT
));
188 XSETFONT (font_entity
, entity
);
193 font_make_object (size
)
196 Lisp_Object font_object
;
198 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
199 XSETFONT (font_object
, font
);
206 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
207 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
208 static Lisp_Object font_matching_entity
P_ ((FRAME_PTR
, Lisp_Object
*,
211 /* Number of registered font drivers. */
212 static int num_font_drivers
;
215 /* Return a Lispy value of a font property value at STR and LEN bytes.
216 If STR is "*", it returns nil.
217 If FORCE_SYMBOL is zero and all characters in STR are digits, it
218 returns an integer. Otherwise, it returns a symbol interned from
222 font_intern_prop (str
, len
, force_symbol
)
231 if (len
== 1 && *str
== '*')
233 if (!force_symbol
&& len
>=1 && isdigit (*str
))
235 for (i
= 1; i
< len
; i
++)
236 if (! isdigit (str
[i
]))
239 return make_number (atoi (str
));
242 /* The following code is copied from the function intern (in lread.c). */
244 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
245 obarray
= check_obarray (obarray
);
246 tem
= oblookup (obarray
, str
, len
, len
);
249 return Fintern (make_unibyte_string (str
, len
), obarray
);
252 /* Return a pixel size of font-spec SPEC on frame F. */
255 font_pixel_size (f
, spec
)
259 #ifdef HAVE_WINDOW_SYSTEM
260 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
269 font_assert (FLOATP (size
));
270 point_size
= XFLOAT_DATA (size
);
271 val
= AREF (spec
, FONT_DPI_INDEX
);
276 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
284 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
285 font vector. If VAL is not valid (i.e. not registered in
286 font_style_table), return -1 if NOERROR is zero, and return a
287 proper index if NOERROR is nonzero. In that case, register VAL in
288 font_style_table if VAL is a symbol, and return a closest index if
289 VAL is an integer. */
292 font_style_to_value (prop
, val
, noerror
)
293 enum font_property_index prop
;
297 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
298 int len
= ASIZE (table
);
304 Lisp_Object args
[2], elt
;
306 /* At first try exact match. */
307 for (i
= 0; i
< len
; i
++)
308 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
309 if (EQ (val
, AREF (AREF (table
, i
), j
)))
310 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
311 | (i
<< 4) | (j
- 1));
312 /* Try also with case-folding match. */
313 s
= SDATA (SYMBOL_NAME (val
));
314 for (i
= 0; i
< len
; i
++)
315 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
317 elt
= AREF (AREF (table
, i
), j
);
318 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
319 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
320 | (i
<< 4) | (j
- 1));
326 elt
= Fmake_vector (make_number (2), make_number (255));
329 args
[1] = Fmake_vector (make_number (1), elt
);
330 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
331 return (255 << 8) | (i
<< 4);
336 int numeric
= XINT (val
);
338 for (i
= 0, last_n
= -1; i
< len
; i
++)
340 int n
= XINT (AREF (AREF (table
, i
), 0));
343 return (n
<< 8) | (i
<< 4);
348 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
349 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
355 return ((last_n
<< 8) | ((i
- 1) << 4));
360 font_style_symbolic (font
, prop
, for_face
)
362 enum font_property_index prop
;
365 Lisp_Object val
= AREF (font
, prop
);
366 Lisp_Object table
, elt
;
371 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
372 i
= XINT (val
) & 0xFF;
373 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
374 elt
= AREF (table
, ((i
>> 4) & 0xF));
375 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
376 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
379 extern Lisp_Object Vface_alternative_font_family_alist
;
381 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
384 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
385 FONTNAME. ENCODING is a charset symbol that specifies the encoding
386 of the font. REPERTORY is a charset symbol or nil. */
389 find_font_encoding (fontname
)
390 Lisp_Object fontname
;
392 Lisp_Object tail
, elt
;
394 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
398 && STRINGP (XCAR (elt
))
399 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
400 && (SYMBOLP (XCDR (elt
))
401 ? CHARSETP (XCDR (elt
))
402 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
405 /* We don't know the encoding of this font. Let's assume `ascii'. */
409 /* Return encoding charset and repertory charset for REGISTRY in
410 ENCODING and REPERTORY correspondingly. If correct information for
411 REGISTRY is available, return 0. Otherwise return -1. */
414 font_registry_charsets (registry
, encoding
, repertory
)
415 Lisp_Object registry
;
416 struct charset
**encoding
, **repertory
;
419 int encoding_id
, repertory_id
;
421 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
427 encoding_id
= XINT (XCAR (val
));
428 repertory_id
= XINT (XCDR (val
));
432 val
= find_font_encoding (SYMBOL_NAME (registry
));
433 if (SYMBOLP (val
) && CHARSETP (val
))
435 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
437 else if (CONSP (val
))
439 if (! CHARSETP (XCAR (val
)))
441 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
442 if (NILP (XCDR (val
)))
446 if (! CHARSETP (XCDR (val
)))
448 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
453 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
455 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
459 *encoding
= CHARSET_FROM_ID (encoding_id
);
461 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
466 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
471 /* Font property value validaters. See the comment of
472 font_property_table for the meaning of the arguments. */
474 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
475 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
476 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
477 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
478 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
479 static int get_font_prop_index
P_ ((Lisp_Object
));
482 font_prop_validate_symbol (prop
, val
)
483 Lisp_Object prop
, val
;
486 val
= Fintern (val
, Qnil
);
489 else if (EQ (prop
, QCregistry
))
490 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
496 font_prop_validate_style (style
, val
)
497 Lisp_Object style
, val
;
499 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
500 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
507 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
511 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
513 if ((n
& 0xF) + 1 >= ASIZE (elt
))
515 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
519 else if (SYMBOLP (val
))
521 int n
= font_style_to_value (prop
, val
, 0);
523 val
= n
>= 0 ? make_number (n
) : Qerror
;
531 font_prop_validate_non_neg (prop
, val
)
532 Lisp_Object prop
, val
;
534 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
539 font_prop_validate_spacing (prop
, val
)
540 Lisp_Object prop
, val
;
542 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
544 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
546 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
548 if (spacing
== 'c' || spacing
== 'C')
549 return make_number (FONT_SPACING_CHARCELL
);
550 if (spacing
== 'm' || spacing
== 'M')
551 return make_number (FONT_SPACING_MONO
);
552 if (spacing
== 'p' || spacing
== 'P')
553 return make_number (FONT_SPACING_PROPORTIONAL
);
554 if (spacing
== 'd' || spacing
== 'D')
555 return make_number (FONT_SPACING_DUAL
);
561 font_prop_validate_otf (prop
, val
)
562 Lisp_Object prop
, val
;
564 Lisp_Object tail
, tmp
;
567 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
568 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
569 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
572 if (! SYMBOLP (XCAR (val
)))
577 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
579 for (i
= 0; i
< 2; i
++)
586 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
587 if (! SYMBOLP (XCAR (tmp
)))
595 /* Structure of known font property keys and validater of the
599 /* Pointer to the key symbol. */
601 /* Function to validate PROP's value VAL, or NULL if any value is
602 ok. The value is VAL or its regularized value if VAL is valid,
603 and Qerror if not. */
604 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
605 } font_property_table
[] =
606 { { &QCtype
, font_prop_validate_symbol
},
607 { &QCfoundry
, font_prop_validate_symbol
},
608 { &QCfamily
, font_prop_validate_symbol
},
609 { &QCadstyle
, font_prop_validate_symbol
},
610 { &QCregistry
, font_prop_validate_symbol
},
611 { &QCweight
, font_prop_validate_style
},
612 { &QCslant
, font_prop_validate_style
},
613 { &QCwidth
, font_prop_validate_style
},
614 { &QCsize
, font_prop_validate_non_neg
},
615 { &QCdpi
, font_prop_validate_non_neg
},
616 { &QCspacing
, font_prop_validate_spacing
},
617 { &QCavgwidth
, font_prop_validate_non_neg
},
618 /* The order of the above entries must match with enum
619 font_property_index. */
620 { &QClang
, font_prop_validate_symbol
},
621 { &QCscript
, font_prop_validate_symbol
},
622 { &QCotf
, font_prop_validate_otf
}
625 /* Size (number of elements) of the above table. */
626 #define FONT_PROPERTY_TABLE_SIZE \
627 ((sizeof font_property_table) / (sizeof *font_property_table))
629 /* Return an index number of font property KEY or -1 if KEY is not an
630 already known property. */
633 get_font_prop_index (key
)
638 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
639 if (EQ (key
, *font_property_table
[i
].key
))
644 /* Validate the font property. The property key is specified by the
645 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
646 signal an error. The value is VAL or the regularized one. */
649 font_prop_validate (idx
, prop
, val
)
651 Lisp_Object prop
, val
;
653 Lisp_Object validated
;
658 prop
= *font_property_table
[idx
].key
;
661 idx
= get_font_prop_index (prop
);
665 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
666 if (EQ (validated
, Qerror
))
667 signal_error ("invalid font property", Fcons (prop
, val
));
672 /* Store VAL as a value of extra font property PROP in FONT while
673 keeping the sorting order. Don't check the validity of VAL. */
676 font_put_extra (font
, prop
, val
)
677 Lisp_Object font
, prop
, val
;
679 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
680 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
684 Lisp_Object prev
= Qnil
;
687 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
688 prev
= extra
, extra
= XCDR (extra
);
690 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
692 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
700 /* Font name parser and unparser */
702 static int parse_matrix
P_ ((char *));
703 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
704 static int font_parse_name
P_ ((char *, Lisp_Object
));
706 /* An enumerator for each field of an XLFD font name. */
707 enum xlfd_field_index
726 /* An enumerator for mask bit corresponding to each XLFD field. */
729 XLFD_FOUNDRY_MASK
= 0x0001,
730 XLFD_FAMILY_MASK
= 0x0002,
731 XLFD_WEIGHT_MASK
= 0x0004,
732 XLFD_SLANT_MASK
= 0x0008,
733 XLFD_SWIDTH_MASK
= 0x0010,
734 XLFD_ADSTYLE_MASK
= 0x0020,
735 XLFD_PIXEL_MASK
= 0x0040,
736 XLFD_POINT_MASK
= 0x0080,
737 XLFD_RESX_MASK
= 0x0100,
738 XLFD_RESY_MASK
= 0x0200,
739 XLFD_SPACING_MASK
= 0x0400,
740 XLFD_AVGWIDTH_MASK
= 0x0800,
741 XLFD_REGISTRY_MASK
= 0x1000,
742 XLFD_ENCODING_MASK
= 0x2000
746 /* Parse P pointing the pixel/point size field of the form
747 `[A B C D]' which specifies a transformation matrix:
753 by which all glyphs of the font are transformed. The spec says
754 that scalar value N for the pixel/point size is equivalent to:
755 A = N * resx/resy, B = C = 0, D = N.
757 Return the scalar value N if the form is valid. Otherwise return
768 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
771 matrix
[i
] = - strtod (p
+ 1, &end
);
773 matrix
[i
] = strtod (p
, &end
);
776 return (i
== 4 ? (int) matrix
[3] : -1);
779 /* Expand a wildcard field in FIELD (the first N fields are filled) to
780 multiple fields to fill in all 14 XLFD fields while restring a
781 field position by its contents. */
784 font_expand_wildcards (field
, n
)
785 Lisp_Object field
[XLFD_LAST_INDEX
];
789 Lisp_Object tmp
[XLFD_LAST_INDEX
];
790 /* Array of information about where this element can go. Nth
791 element is for Nth element of FIELD. */
793 /* Minimum possible field. */
795 /* Maxinum possible field. */
797 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
799 } range
[XLFD_LAST_INDEX
];
801 int range_from
, range_to
;
804 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
805 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
806 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
807 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
808 | XLFD_AVGWIDTH_MASK)
809 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
811 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
812 field. The value is shifted to left one bit by one in the
814 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
815 range_mask
= (range_mask
<< 1) | 1;
817 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
818 position-based retriction for FIELD[I]. */
819 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
820 i
++, range_from
++, range_to
++, range_mask
<<= 1)
822 Lisp_Object val
= field
[i
];
828 range
[i
].from
= range_from
;
829 range
[i
].to
= range_to
;
830 range
[i
].mask
= range_mask
;
834 /* The triplet FROM, TO, and MASK is a value-based
835 retriction for FIELD[I]. */
841 int numeric
= XINT (val
);
844 from
= to
= XLFD_ENCODING_INDEX
,
845 mask
= XLFD_ENCODING_MASK
;
846 else if (numeric
== 0)
847 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
848 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
849 else if (numeric
<= 48)
850 from
= to
= XLFD_PIXEL_INDEX
,
851 mask
= XLFD_PIXEL_MASK
;
853 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
854 mask
= XLFD_LARGENUM_MASK
;
856 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
857 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
858 mask
= XLFD_NULL_MASK
;
860 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
863 Lisp_Object name
= SYMBOL_NAME (val
);
865 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
866 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
867 mask
= XLFD_REGENC_MASK
;
869 from
= to
= XLFD_ENCODING_INDEX
,
870 mask
= XLFD_ENCODING_MASK
;
872 else if (range_from
<= XLFD_WEIGHT_INDEX
873 && range_to
>= XLFD_WEIGHT_INDEX
874 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
875 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
876 else if (range_from
<= XLFD_SLANT_INDEX
877 && range_to
>= XLFD_SLANT_INDEX
878 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
879 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
880 else if (range_from
<= XLFD_SWIDTH_INDEX
881 && range_to
>= XLFD_SWIDTH_INDEX
882 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
883 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
886 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
887 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
889 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
890 mask
= XLFD_SYMBOL_MASK
;
893 /* Merge position-based and value-based restrictions. */
895 while (from
< range_from
)
896 mask
&= ~(1 << from
++);
897 while (from
< 14 && ! (mask
& (1 << from
)))
899 while (to
> range_to
)
900 mask
&= ~(1 << to
--);
901 while (to
>= 0 && ! (mask
& (1 << to
)))
905 range
[i
].from
= from
;
907 range
[i
].mask
= mask
;
909 if (from
> range_from
|| to
< range_to
)
911 /* The range is narrowed by value-based restrictions.
912 Reflect it to the other fields. */
914 /* Following fields should be after FROM. */
916 /* Preceding fields should be before TO. */
917 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
919 /* Check FROM for non-wildcard field. */
920 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
922 while (range
[j
].from
< from
)
923 range
[j
].mask
&= ~(1 << range
[j
].from
++);
924 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
926 range
[j
].from
= from
;
929 from
= range
[j
].from
;
930 if (range
[j
].to
> to
)
932 while (range
[j
].to
> to
)
933 range
[j
].mask
&= ~(1 << range
[j
].to
--);
934 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
947 /* Decide all fileds from restrictions in RANGE. */
948 for (i
= j
= 0; i
< n
; i
++)
950 if (j
< range
[i
].from
)
952 if (i
== 0 || ! NILP (tmp
[i
- 1]))
953 /* None of TMP[X] corresponds to Jth field. */
955 for (; j
< range
[i
].from
; j
++)
960 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
962 for (; j
< XLFD_LAST_INDEX
; j
++)
964 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
965 field
[XLFD_ENCODING_INDEX
]
966 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
971 #ifdef ENABLE_CHECKING
972 /* Match a 14-field XLFD pattern against a full XLFD font name. */
974 font_match_xlfd (char *pattern
, char *name
)
976 while (*pattern
&& *name
)
978 if (*pattern
== *name
)
980 else if (*pattern
== '*')
981 if (*name
== pattern
[1])
992 /* Make sure the font object matches the XLFD font name. */
994 font_check_xlfd_parse (Lisp_Object font
, char *name
)
996 char name_check
[256];
997 font_unparse_xlfd (font
, 0, name_check
, 255);
998 return font_match_xlfd (name_check
, name
);
1004 /* Parse NAME (null terminated) as XLFD and store information in FONT
1005 (font-spec or font-entity). Size property of FONT is set as
1007 specified XLFD fields FONT property
1008 --------------------- -------------
1009 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1010 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1011 POINT_SIZE POINT_SIZE/10 (Lisp float)
1013 If NAME is successfully parsed, return 0. Otherwise return -1.
1015 FONT is usually a font-spec, but when this function is called from
1016 X font backend driver, it is a font-entity. In that case, NAME is
1017 a fully specified XLFD. */
1020 font_parse_xlfd (name
, font
)
1024 int len
= strlen (name
);
1026 char *f
[XLFD_LAST_INDEX
+ 1];
1031 /* Maximum XLFD name length is 255. */
1033 /* Accept "*-.." as a fully specified XLFD. */
1034 if (name
[0] == '*' && name
[1] == '-')
1035 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1038 for (p
= name
+ i
; *p
; p
++)
1042 if (i
== XLFD_LAST_INDEX
)
1047 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1048 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1050 if (i
== XLFD_LAST_INDEX
)
1052 /* Fully specified XLFD. */
1055 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1056 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1057 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1058 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1060 val
= INTERN_FIELD_SYM (i
);
1063 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1065 ASET (font
, j
, make_number (n
));
1068 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1069 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1070 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1072 ASET (font
, FONT_REGISTRY_INDEX
,
1073 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1074 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1076 p
= f
[XLFD_PIXEL_INDEX
];
1077 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1078 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1081 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1083 ASET (font
, FONT_SIZE_INDEX
, val
);
1086 double point_size
= -1;
1088 font_assert (FONT_SPEC_P (font
));
1089 p
= f
[XLFD_POINT_INDEX
];
1091 point_size
= parse_matrix (p
);
1092 else if (isdigit (*p
))
1093 point_size
= atoi (p
), point_size
/= 10;
1094 if (point_size
>= 0)
1095 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1099 ASET (font
, FONT_DPI_INDEX
, INTERN_FIELD (XLFD_RESY_INDEX
));
1100 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1103 val
= font_prop_validate_spacing (QCspacing
, val
);
1104 if (! INTEGERP (val
))
1106 ASET (font
, FONT_SPACING_INDEX
, val
);
1108 p
= f
[XLFD_AVGWIDTH_INDEX
];
1111 ASET (font
, FONT_AVGWIDTH_INDEX
,
1112 font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 1));
1116 int wild_card_found
= 0;
1117 Lisp_Object prop
[XLFD_LAST_INDEX
];
1119 if (FONT_ENTITY_P (font
))
1121 for (j
= 0; j
< i
; j
++)
1125 if (f
[j
][1] && f
[j
][1] != '-')
1128 wild_card_found
= 1;
1131 prop
[j
] = INTERN_FIELD (j
);
1133 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1135 if (! wild_card_found
)
1137 if (font_expand_wildcards (prop
, i
) < 0)
1140 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1141 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1142 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1143 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1144 if (! NILP (prop
[i
]))
1146 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1148 ASET (font
, j
, make_number (n
));
1150 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1151 val
= prop
[XLFD_REGISTRY_INDEX
];
1154 val
= prop
[XLFD_ENCODING_INDEX
];
1156 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1158 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1159 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1161 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1162 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1164 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1166 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1167 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1168 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1170 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1172 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1175 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1176 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1177 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1179 val
= font_prop_validate_spacing (QCspacing
,
1180 prop
[XLFD_SPACING_INDEX
]);
1181 if (! INTEGERP (val
))
1183 ASET (font
, FONT_SPACING_INDEX
, val
);
1185 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1186 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1192 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1193 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1194 0, use PIXEL_SIZE instead. */
1197 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1203 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1207 font_assert (FONTP (font
));
1209 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1212 if (i
== FONT_ADSTYLE_INDEX
)
1213 j
= XLFD_ADSTYLE_INDEX
;
1214 else if (i
== FONT_REGISTRY_INDEX
)
1215 j
= XLFD_REGISTRY_INDEX
;
1216 val
= AREF (font
, i
);
1219 if (j
== XLFD_REGISTRY_INDEX
)
1220 f
[j
] = "*-*", len
+= 4;
1222 f
[j
] = "*", len
+= 2;
1227 val
= SYMBOL_NAME (val
);
1228 if (j
== XLFD_REGISTRY_INDEX
1229 && ! strchr ((char *) SDATA (val
), '-'))
1231 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1232 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1234 f
[j
] = alloca (SBYTES (val
) + 3);
1235 sprintf (f
[j
], "%s-*", SDATA (val
));
1236 len
+= SBYTES (val
) + 3;
1240 f
[j
] = alloca (SBYTES (val
) + 4);
1241 sprintf (f
[j
], "%s*-*", SDATA (val
));
1242 len
+= SBYTES (val
) + 4;
1246 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1250 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1253 val
= font_style_symbolic (font
, i
, 0);
1255 f
[j
] = "*", len
+= 2;
1258 val
= SYMBOL_NAME (val
);
1259 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1263 val
= AREF (font
, FONT_SIZE_INDEX
);
1264 font_assert (NUMBERP (val
) || NILP (val
));
1272 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1273 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1276 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1278 else if (FLOATP (val
))
1280 i
= XFLOAT_DATA (val
) * 10;
1281 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1282 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1285 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1287 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1289 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1290 f
[XLFD_RESX_INDEX
] = alloca (22);
1291 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1295 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1296 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1298 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1300 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1301 : spacing
<= FONT_SPACING_DUAL
? "d"
1302 : spacing
<= FONT_SPACING_MONO
? "m"
1307 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1308 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1310 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1311 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
],
1312 "%d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1315 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1316 len
++; /* for terminating '\0'. */
1319 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1320 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1321 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1322 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1323 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1324 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1325 f
[XLFD_REGISTRY_INDEX
]);
1328 /* Parse NAME (null terminated) and store information in FONT
1329 (font-spec or font-entity). NAME is supplied in either the
1330 Fontconfig or GTK font name format. If NAME is successfully
1331 parsed, return 0. Otherwise return -1.
1333 The fontconfig format is
1335 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1339 FAMILY [PROPS...] [SIZE]
1341 This function tries to guess which format it is. */
1344 font_parse_fcname (name
, font
)
1349 char *size_beg
= NULL
, *size_end
= NULL
;
1350 char *props_beg
= NULL
, *family_end
= NULL
;
1351 int len
= strlen (name
);
1356 for (p
= name
; *p
; p
++)
1358 if (*p
== '\\' && p
[1])
1368 int decimal
= 0, size_found
= 1;
1369 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1372 if (*q
!= '.' || decimal
)
1391 /* A fontconfig name with size and/or property data. */
1392 if (family_end
> name
)
1395 family
= font_intern_prop (name
, family_end
- name
, 1);
1396 ASET (font
, FONT_FAMILY_INDEX
, family
);
1400 double point_size
= strtod (size_beg
, &size_end
);
1401 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1402 if (*size_end
== ':' && size_end
[1])
1403 props_beg
= size_end
+ 1;
1407 /* Now parse ":KEY=VAL" patterns. Store known keys and values in
1408 extra, copy unknown ones to COPY. It is stored in extra slot by
1409 the key QCfc_unknown_spec. */
1410 char *copy_start
, *copy
;
1412 copy_start
= copy
= alloca (name
+ len
- props_beg
);
1422 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1426 /* Must be an enumerated value. */
1427 val
= font_intern_prop (p
, q
- p
, 1);
1429 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1431 if (PROP_MATCH ("light", 5)
1432 || PROP_MATCH ("medium", 6)
1433 || PROP_MATCH ("demibold", 8)
1434 || PROP_MATCH ("bold", 4)
1435 || PROP_MATCH ("black", 5))
1436 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1437 else if (PROP_MATCH ("roman", 5)
1438 || PROP_MATCH ("italic", 6)
1439 || PROP_MATCH ("oblique", 7))
1440 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1441 else if (PROP_MATCH ("charcell", 8))
1442 ASET (font
, FONT_SPACING_INDEX
,
1443 make_number (FONT_SPACING_CHARCELL
));
1444 else if (PROP_MATCH ("mono", 4))
1445 ASET (font
, FONT_SPACING_INDEX
,
1446 make_number (FONT_SPACING_MONO
));
1447 else if (PROP_MATCH ("proportional", 12))
1448 ASET (font
, FONT_SPACING_INDEX
,
1449 make_number (FONT_SPACING_PROPORTIONAL
));
1453 bcopy (p
, copy
, word_len
);
1458 else /* KEY=VAL pairs */
1463 if (word_len
== 9 && memcmp (p
, "pixelsize=", 10) == 0)
1464 prop
= FONT_SIZE_INDEX
;
1467 key
= font_intern_prop (p
, q
- p
, 1);
1468 prop
= get_font_prop_index (key
);
1472 for (q
= p
; *q
&& *q
!= ':'; q
++);
1473 val
= font_intern_prop (p
, q
- p
, 0);
1477 if (prop
>= FONT_FOUNDRY_INDEX
1478 && prop
< FONT_EXTRA_INDEX
)
1480 font_prop_validate (prop
, Qnil
, val
));
1482 Ffont_put (font
, key
, val
);
1485 if (copy_start
!= copy
)
1487 bcopy (keyhead
, copy
, q
- keyhead
);
1488 copy
+= q
- keyhead
;
1494 if (copy_start
!= copy
)
1495 font_put_extra (font
, QCfc_unknown_spec
,
1496 make_unibyte_string (copy_start
, copy
- copy_start
));
1501 /* Either a fontconfig-style name with no size and property
1502 data, or a GTK-style name. */
1504 int word_len
, prop_found
= 0;
1506 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1512 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1520 double point_size
= strtod (p
, &q
);
1521 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1526 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1527 if (*q
== '\\' && q
[1])
1531 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1533 if (PROP_MATCH ("Ultra-Light", 11))
1536 prop
= font_intern_prop ("ultra-light", 11, 1);
1537 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1539 else if (PROP_MATCH ("Light", 5))
1542 prop
= font_intern_prop ("light", 5, 1);
1543 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1545 else if (PROP_MATCH ("Semi-Bold", 9))
1548 prop
= font_intern_prop ("semi-bold", 9, 1);
1549 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1551 else if (PROP_MATCH ("Bold", 4))
1554 prop
= font_intern_prop ("bold", 4, 1);
1555 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1557 else if (PROP_MATCH ("Italic", 6))
1560 prop
= font_intern_prop ("italic", 4, 1);
1561 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1563 else if (PROP_MATCH ("Oblique", 7))
1566 prop
= font_intern_prop ("oblique", 7, 1);
1567 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1571 return -1; /* Unknown property in GTK-style font name. */
1580 family
= font_intern_prop (name
, family_end
- name
, 1);
1581 ASET (font
, FONT_FAMILY_INDEX
, family
);
1588 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1589 NAME (NBYTES length), and return the name length. If
1590 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1593 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1599 Lisp_Object family
, foundry
;
1600 Lisp_Object tail
, val
;
1605 Lisp_Object styles
[3];
1606 char *style_names
[3] = { "weight", "slant", "width" };
1609 family
= AREF (font
, FONT_FAMILY_INDEX
);
1610 if (! NILP (family
))
1612 if (SYMBOLP (family
))
1614 family
= SYMBOL_NAME (family
);
1615 len
+= SBYTES (family
);
1621 val
= AREF (font
, FONT_SIZE_INDEX
);
1624 if (XINT (val
) != 0)
1625 pixel_size
= XINT (val
);
1627 len
+= 21; /* for ":pixelsize=NUM" */
1629 else if (FLOATP (val
))
1632 point_size
= (int) XFLOAT_DATA (val
);
1633 len
+= 11; /* for "-NUM" */
1636 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1637 if (! NILP (foundry
))
1639 if (SYMBOLP (foundry
))
1641 foundry
= SYMBOL_NAME (foundry
);
1642 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1648 for (i
= 0; i
< 3; i
++)
1650 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1651 if (! NILP (styles
[i
]))
1652 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1653 SDATA (SYMBOL_NAME (styles
[i
])));
1656 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1657 len
+= sprintf (work
, ":dpi=%d", dpi
);
1658 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1659 len
+= strlen (":spacing=100");
1660 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1661 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1662 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1664 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1666 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1668 len
+= SBYTES (val
);
1669 else if (INTEGERP (val
))
1670 len
+= sprintf (work
, "%d", XINT (val
));
1671 else if (SYMBOLP (val
))
1672 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1678 if (! NILP (family
))
1679 p
+= sprintf (p
, "%s", SDATA (family
));
1683 p
+= sprintf (p
, "%d", point_size
);
1685 p
+= sprintf (p
, "-%d", point_size
);
1687 else if (pixel_size
> 0)
1688 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1689 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1690 p
+= sprintf (p
, ":foundry=%s",
1691 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1692 for (i
= 0; i
< 3; i
++)
1693 if (! NILP (styles
[i
]))
1694 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1695 SDATA (SYMBOL_NAME (styles
[i
])));
1696 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1697 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1698 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1699 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1700 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1702 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1703 p
+= sprintf (p
, ":scalable=true");
1705 p
+= sprintf (p
, ":scalable=false");
1710 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1711 NAME (NBYTES length), and return the name length. F is the frame
1712 on which the font is displayed; it is used to calculate the point
1716 font_unparse_gtkname (font
, f
, name
, nbytes
)
1724 Lisp_Object family
, weight
, slant
, size
;
1725 int point_size
= -1;
1727 family
= AREF (font
, FONT_FAMILY_INDEX
);
1728 if (! NILP (family
))
1730 if (! SYMBOLP (family
))
1732 family
= SYMBOL_NAME (family
);
1733 len
+= SBYTES (family
);
1736 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1737 if (weight
== Qnormal
)
1739 else if (! NILP (weight
))
1741 weight
= SYMBOL_NAME (weight
);
1742 len
+= SBYTES (weight
);
1745 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1746 if (slant
== Qnormal
)
1748 else if (! NILP (slant
))
1750 slant
= SYMBOL_NAME (slant
);
1751 len
+= SBYTES (slant
);
1754 size
= AREF (font
, FONT_SIZE_INDEX
);
1755 /* Convert pixel size to point size. */
1756 if (INTEGERP (size
))
1758 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1760 if (INTEGERP (font_dpi
))
1761 dpi
= XINT (font_dpi
);
1764 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1767 else if (FLOATP (size
))
1769 point_size
= (int) XFLOAT_DATA (size
);
1776 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1778 if (! NILP (weight
))
1781 p
+= sprintf (p
, " %s", SDATA (weight
));
1782 q
[1] = toupper (q
[1]);
1788 p
+= sprintf (p
, " %s", SDATA (slant
));
1789 q
[1] = toupper (q
[1]);
1793 p
+= sprintf (p
, " %d", point_size
);
1798 /* Parse NAME (null terminated) and store information in FONT
1799 (font-spec or font-entity). If NAME is successfully parsed, return
1800 0. Otherwise return -1. */
1803 font_parse_name (name
, font
)
1807 if (name
[0] == '-' || index (name
, '*'))
1808 return font_parse_xlfd (name
, font
);
1809 return font_parse_fcname (name
, font
);
1813 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1814 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1818 font_parse_family_registry (family
, registry
, font_spec
)
1819 Lisp_Object family
, registry
, font_spec
;
1825 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1827 CHECK_STRING (family
);
1828 len
= SBYTES (family
);
1829 p0
= (char *) SDATA (family
);
1830 p1
= index (p0
, '-');
1833 if ((*p0
!= '*' || p1
- p0
> 1)
1834 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1835 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1838 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1841 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1843 if (! NILP (registry
))
1845 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1846 CHECK_STRING (registry
);
1847 len
= SBYTES (registry
);
1848 p0
= (char *) SDATA (registry
);
1849 p1
= index (p0
, '-');
1852 if (SDATA (registry
)[len
- 1] == '*')
1853 registry
= concat2 (registry
, build_string ("-*"));
1855 registry
= concat2 (registry
, build_string ("*-*"));
1857 registry
= Fdowncase (registry
);
1858 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1863 /* This part (through the next ^L) is still experimental and not
1864 tested much. We may drastically change codes. */
1870 #define LGSTRING_HEADER_SIZE 6
1871 #define LGSTRING_GLYPH_SIZE 8
1874 check_gstring (gstring
)
1875 Lisp_Object gstring
;
1880 CHECK_VECTOR (gstring
);
1881 val
= AREF (gstring
, 0);
1883 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1885 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1886 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1887 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1888 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1889 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1890 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1891 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1892 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1893 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1894 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1895 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1897 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1899 val
= LGSTRING_GLYPH (gstring
, i
);
1901 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1903 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1905 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1906 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1907 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1908 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1909 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1910 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1911 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1912 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1914 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1916 if (ASIZE (val
) < 3)
1918 for (j
= 0; j
< 3; j
++)
1919 CHECK_NUMBER (AREF (val
, j
));
1924 error ("Invalid glyph-string format");
1929 check_otf_features (otf_features
)
1930 Lisp_Object otf_features
;
1934 CHECK_CONS (otf_features
);
1935 CHECK_SYMBOL (XCAR (otf_features
));
1936 otf_features
= XCDR (otf_features
);
1937 CHECK_CONS (otf_features
);
1938 CHECK_SYMBOL (XCAR (otf_features
));
1939 otf_features
= XCDR (otf_features
);
1940 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1942 CHECK_SYMBOL (Fcar (val
));
1943 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1944 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1946 otf_features
= XCDR (otf_features
);
1947 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1949 CHECK_SYMBOL (Fcar (val
));
1950 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1951 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1958 Lisp_Object otf_list
;
1961 otf_tag_symbol (tag
)
1966 OTF_tag_name (tag
, name
);
1967 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1974 Lisp_Object val
= Fassoc (file
, otf_list
);
1978 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1981 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1982 val
= make_save_value (otf
, 0);
1983 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1989 /* Return a list describing which scripts/languages FONT supports by
1990 which GSUB/GPOS features of OpenType tables. See the comment of
1991 (struct font_driver).otf_capability. */
1994 font_otf_capability (font
)
1998 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
2001 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
2004 for (i
= 0; i
< 2; i
++)
2006 OTF_GSUB_GPOS
*gsub_gpos
;
2007 Lisp_Object script_list
= Qnil
;
2010 if (OTF_get_features (otf
, i
== 0) < 0)
2012 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2013 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2015 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2016 Lisp_Object langsys_list
= Qnil
;
2017 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2020 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2022 OTF_LangSys
*langsys
;
2023 Lisp_Object feature_list
= Qnil
;
2024 Lisp_Object langsys_tag
;
2027 if (k
== script
->LangSysCount
)
2029 langsys
= &script
->DefaultLangSys
;
2034 langsys
= script
->LangSys
+ k
;
2036 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2038 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2040 OTF_Feature
*feature
2041 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2042 Lisp_Object feature_tag
2043 = otf_tag_symbol (feature
->FeatureTag
);
2045 feature_list
= Fcons (feature_tag
, feature_list
);
2047 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2050 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2055 XSETCAR (capability
, script_list
);
2057 XSETCDR (capability
, script_list
);
2063 /* Parse OTF features in SPEC and write a proper features spec string
2064 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2065 assured that the sufficient memory has already allocated for
2069 generate_otf_features (spec
, features
)
2079 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2085 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2090 else if (! asterisk
)
2092 val
= SYMBOL_NAME (val
);
2093 p
+= sprintf (p
, "%s", SDATA (val
));
2097 val
= SYMBOL_NAME (val
);
2098 p
+= sprintf (p
, "~%s", SDATA (val
));
2102 error ("OTF spec too long");
2106 font_otf_DeviceTable (device_table
)
2107 OTF_DeviceTable
*device_table
;
2109 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2111 return Fcons (make_number (len
),
2112 make_unibyte_string (device_table
->DeltaValue
, len
));
2116 font_otf_ValueRecord (value_format
, value_record
)
2118 OTF_ValueRecord
*value_record
;
2120 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2122 if (value_format
& OTF_XPlacement
)
2123 ASET (val
, 0, make_number (value_record
->XPlacement
));
2124 if (value_format
& OTF_YPlacement
)
2125 ASET (val
, 1, make_number (value_record
->YPlacement
));
2126 if (value_format
& OTF_XAdvance
)
2127 ASET (val
, 2, make_number (value_record
->XAdvance
));
2128 if (value_format
& OTF_YAdvance
)
2129 ASET (val
, 3, make_number (value_record
->YAdvance
));
2130 if (value_format
& OTF_XPlaDevice
)
2131 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2132 if (value_format
& OTF_YPlaDevice
)
2133 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2134 if (value_format
& OTF_XAdvDevice
)
2135 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2136 if (value_format
& OTF_YAdvDevice
)
2137 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2142 font_otf_Anchor (anchor
)
2147 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2148 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2149 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2150 if (anchor
->AnchorFormat
== 2)
2151 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2154 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2155 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2159 #endif /* HAVE_LIBOTF */
2162 /* G-string (glyph string) handler */
2164 /* G-string is a vector of the form [HEADER GLYPH ...].
2165 See the docstring of `font-make-gstring' for more detail. */
2168 font_prepare_composition (cmp
, f
)
2169 struct composition
*cmp
;
2173 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
2174 cmp
->hash_index
* 2);
2176 cmp
->font
= XFONT_OBJECT (LGSTRING_FONT (gstring
));
2177 cmp
->glyph_len
= LGSTRING_LENGTH (gstring
);
2178 cmp
->pixel_width
= LGSTRING_WIDTH (gstring
);
2179 cmp
->lbearing
= LGSTRING_LBEARING (gstring
);
2180 cmp
->rbearing
= LGSTRING_RBEARING (gstring
);
2181 cmp
->ascent
= LGSTRING_ASCENT (gstring
);
2182 cmp
->descent
= LGSTRING_DESCENT (gstring
);
2183 cmp
->width
= cmp
->pixel_width
/ FRAME_COLUMN_WIDTH (f
);
2184 if (cmp
->width
== 0)
2193 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2194 static int font_compare
P_ ((const void *, const void *));
2195 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
2196 Lisp_Object
, Lisp_Object
,
2199 /* We sort fonts by scoring each of them against a specified
2200 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2201 the value is, the closer the font is to the font-spec.
2203 The lowest 2 bits of the score is used for driver type. The font
2204 available by the most preferred font driver is 0.
2206 Each 7-bit in the higher 28 bits are used for numeric properties
2207 WEIGHT, SLANT, WIDTH, and SIZE. */
2209 /* How many bits to shift to store the difference value of each font
2210 property in a score. Note that flots for FONT_TYPE_INDEX and
2211 FONT_REGISTRY_INDEX are not used. */
2212 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2214 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2215 The return value indicates how different ENTITY is compared with
2218 ALTERNATE_FAMILIES, if non-nil, is a pre-calculated list of
2219 alternate family names for AREF (SPEC_PROP, FONT_FAMILY_INDEX). */
2222 font_score (entity
, spec_prop
)
2223 Lisp_Object entity
, *spec_prop
;
2228 /* Score three style numeric fields. Maximum difference is 127. */
2229 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2230 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2232 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2237 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2240 /* Score the size. Maximum difference is 127. */
2241 i
= FONT_SIZE_INDEX
;
2242 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
])
2243 && XINT (AREF (entity
, i
)) > 0)
2245 /* We use the higher 6-bit for the actual size difference. The
2246 lowest bit is set if the DPI is different. */
2247 int diff
= XINT (spec_prop
[i
]) - XINT (AREF (entity
, i
));
2252 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2253 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2255 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2262 /* The comparison function for qsort. */
2265 font_compare (d1
, d2
)
2266 const void *d1
, *d2
;
2268 return (*(unsigned *) d1
- *(unsigned *) d2
);
2272 /* The structure for elements being sorted by qsort. */
2273 struct font_sort_data
2280 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2281 If PREFER specifies a point-size, calculate the corresponding
2282 pixel-size from QCdpi property of PREFER or from the Y-resolution
2283 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
2284 get the font-entities in VEC.
2286 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2287 return the sorted VEC. */
2290 font_sort_entites (vec
, prefer
, frame
, spec
, best_only
)
2291 Lisp_Object vec
, prefer
, frame
, spec
;
2294 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2296 struct font_sort_data
*data
;
2297 unsigned best_score
;
2298 Lisp_Object best_entity
, driver_type
;
2300 struct frame
*f
= XFRAME (frame
);
2301 struct font_driver_list
*list
;
2306 return best_only
? AREF (vec
, 0) : vec
;
2308 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2309 prefer_prop
[i
] = AREF (prefer
, i
);
2313 /* A font driver may return a font that has a property value
2314 different from the value specified in SPEC if the driver
2315 thinks they are the same. That happens, for instance, such a
2316 generic family name as "serif" is specified. So, to ignore
2317 such a difference, for all properties specified in SPEC, set
2318 the corresponding properties in PREFER_PROP to nil. */
2319 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2320 if (! NILP (AREF (spec
, i
)))
2321 prefer_prop
[i
] = Qnil
;
2324 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2325 prefer_prop
[FONT_SIZE_INDEX
]
2326 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2328 /* Scoring and sorting. */
2329 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2330 best_score
= 0xFFFFFFFF;
2331 /* We are sure that the length of VEC > 1. */
2332 driver_type
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2333 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2334 driver_order
++, list
= list
->next
)
2335 if (EQ (driver_type
, list
->driver
->type
))
2337 best_entity
= data
[0].entity
= AREF (vec
, 0);
2338 best_score
= data
[0].score
2339 = font_score (data
[0].entity
, prefer_prop
) | driver_order
;
2340 for (i
= 0; i
< len
; i
++)
2342 if (!EQ (driver_type
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2343 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2344 driver_order
++, list
= list
->next
)
2345 if (EQ (driver_type
, list
->driver
->type
))
2347 data
[i
].entity
= AREF (vec
, i
);
2348 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
) | driver_order
;
2349 if (best_only
&& best_score
> data
[i
].score
)
2351 best_score
= data
[i
].score
;
2352 best_entity
= data
[i
].entity
;
2353 if (best_score
== 0)
2357 if (NILP (best_entity
))
2359 qsort (data
, len
, sizeof *data
, font_compare
);
2360 for (i
= 0; i
< len
; i
++)
2361 ASET (vec
, i
, data
[i
].entity
);
2367 font_add_log ("sort-by", prefer
, vec
);
2372 /* API of Font Service Layer. */
2374 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2375 sort_shift_bits. Finternal_set_font_selection_order calls this
2376 function with font_sort_order after setting up it. */
2379 font_update_sort_order (order
)
2384 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2386 int xlfd_idx
= order
[i
];
2388 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2389 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2390 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2391 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2392 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2393 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2395 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2400 /* Check if ENTITY matches with the font specification SPEC. */
2403 font_match_p (spec
, entity
)
2404 Lisp_Object spec
, entity
;
2406 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2407 Lisp_Object alternate_families
= Qnil
;
2410 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2411 prefer_prop
[i
] = AREF (spec
, i
);
2412 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2413 prefer_prop
[FONT_SIZE_INDEX
]
2414 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2415 if (! NILP (prefer_prop
[FONT_FAMILY_INDEX
]))
2418 = Fassoc_string (prefer_prop
[FONT_FAMILY_INDEX
],
2419 Vface_alternative_font_family_alist
, Qt
);
2420 if (CONSP (alternate_families
))
2421 alternate_families
= XCDR (alternate_families
);
2424 return (font_score (entity
, prefer_prop
) == 0);
2430 Each font backend has the callback function get_cache, and it
2431 returns a cons cell of which cdr part can be freely used for
2432 caching fonts. The cons cell may be shared by multiple frames
2433 and/or multiple font drivers. So, we arrange the cdr part as this:
2435 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2437 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2438 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2439 cons (FONT-SPEC FONT-ENTITY ...). */
2441 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2442 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2443 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2444 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2445 struct font_driver
*));
2448 font_prepare_cache (f
, driver
)
2450 struct font_driver
*driver
;
2452 Lisp_Object cache
, val
;
2454 cache
= driver
->get_cache (f
);
2456 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2460 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2461 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2465 val
= XCDR (XCAR (val
));
2466 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2472 font_finish_cache (f
, driver
)
2474 struct font_driver
*driver
;
2476 Lisp_Object cache
, val
, tmp
;
2479 cache
= driver
->get_cache (f
);
2481 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2482 cache
= val
, val
= XCDR (val
);
2483 font_assert (! NILP (val
));
2484 tmp
= XCDR (XCAR (val
));
2485 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2486 if (XINT (XCAR (tmp
)) == 0)
2488 font_clear_cache (f
, XCAR (val
), driver
);
2489 XSETCDR (cache
, XCDR (val
));
2495 font_get_cache (f
, driver
)
2497 struct font_driver
*driver
;
2499 Lisp_Object val
= driver
->get_cache (f
);
2500 Lisp_Object type
= driver
->type
;
2502 font_assert (CONSP (val
));
2503 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2504 font_assert (CONSP (val
));
2505 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2506 val
= XCDR (XCAR (val
));
2510 static int num_fonts
;
2513 font_clear_cache (f
, cache
, driver
)
2516 struct font_driver
*driver
;
2518 Lisp_Object tail
, elt
;
2520 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2521 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2524 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)) && VECTORP (XCDR (elt
)))
2526 Lisp_Object vec
= XCDR (elt
);
2529 for (i
= 0; i
< ASIZE (vec
); i
++)
2531 Lisp_Object entity
= AREF (vec
, i
);
2533 if (EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2535 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2537 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2539 Lisp_Object val
= XCAR (objlist
);
2540 struct font
*font
= XFONT_OBJECT (val
);
2542 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2544 font_assert (font
&& driver
== font
->driver
);
2545 driver
->close (f
, font
);
2549 if (driver
->free_entity
)
2550 driver
->free_entity (entity
);
2555 XSETCDR (cache
, Qnil
);
2559 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2562 font_delete_unmatched (list
, spec
, size
)
2563 Lisp_Object list
, spec
;
2566 Lisp_Object entity
, val
;
2567 enum font_property_index prop
;
2569 for (val
= Qnil
; CONSP (list
); list
= XCDR (list
))
2571 entity
= XCAR (list
);
2572 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2573 if (INTEGERP (AREF (spec
, prop
))
2574 && ((XINT (AREF (spec
, prop
)) >> 8)
2575 != (XINT (AREF (entity
, prop
)) >> 8)))
2576 prop
= FONT_SPEC_MAX
;
2577 if (prop
++ <= FONT_SIZE_INDEX
2579 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2581 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2584 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2585 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2586 prop
= FONT_SPEC_MAX
;
2588 if (prop
< FONT_SPEC_MAX
)
2589 val
= Fcons (entity
, val
);
2595 /* Return a vector of font-entities matching with SPEC on FRAME. */
2598 font_list_entities (frame
, spec
)
2599 Lisp_Object frame
, spec
;
2601 FRAME_PTR f
= XFRAME (frame
);
2602 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2603 Lisp_Object ftype
, val
;
2606 int need_filtering
= 0;
2609 font_assert (FONT_SPEC_P (spec
));
2611 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2612 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2613 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2614 size
= font_pixel_size (f
, spec
);
2618 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2619 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2620 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2621 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2623 ASET (scratch_font_spec
, i
, Qnil
);
2624 if (! NILP (AREF (spec
, i
)))
2626 if (i
== FONT_DPI_INDEX
)
2627 /* Skip FONT_SPACING_INDEX */
2630 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2631 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2633 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2637 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2639 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2641 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2643 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2644 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2651 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2652 copy
= Fcopy_font_spec (scratch_font_spec
);
2653 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2654 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2656 if (! NILP (val
) && need_filtering
)
2657 val
= font_delete_unmatched (val
, spec
, size
);
2662 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2663 font_add_log ("list", spec
, val
);
2668 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2669 nil, is an array of face's attributes, which specifies preferred
2670 font-related attributes. */
2673 font_matching_entity (f
, attrs
, spec
)
2675 Lisp_Object
*attrs
, spec
;
2677 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2678 Lisp_Object ftype
, size
, entity
;
2681 XSETFRAME (frame
, f
);
2682 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2683 size
= AREF (spec
, FONT_SIZE_INDEX
);
2685 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2687 for (; driver_list
; driver_list
= driver_list
->next
)
2689 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2691 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2694 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2695 entity
= assoc_no_quit (spec
, XCDR (cache
));
2697 entity
= XCDR (entity
);
2700 entity
= driver_list
->driver
->match (frame
, spec
);
2701 copy
= Fcopy_font_spec (spec
);
2702 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2703 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2705 if (! NILP (entity
))
2708 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2709 ASET (spec
, FONT_SIZE_INDEX
, size
);
2710 font_add_log ("match", spec
, entity
);
2715 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2716 opened font object. */
2719 font_open_entity (f
, entity
, pixel_size
)
2724 struct font_driver_list
*driver_list
;
2725 Lisp_Object objlist
, size
, val
, font_object
;
2729 font_assert (FONT_ENTITY_P (entity
));
2730 size
= AREF (entity
, FONT_SIZE_INDEX
);
2731 if (XINT (size
) != 0)
2732 pixel_size
= XINT (size
);
2734 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2735 objlist
= XCDR (objlist
))
2736 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2737 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2738 return XCAR (objlist
);
2740 val
= AREF (entity
, FONT_TYPE_INDEX
);
2741 for (driver_list
= f
->font_driver_list
;
2742 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2743 driver_list
= driver_list
->next
);
2747 font_object
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2748 font_add_log ("open", entity
, font_object
);
2749 if (NILP (font_object
))
2751 ASET (entity
, FONT_OBJLIST_INDEX
,
2752 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2753 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
2756 font
= XFONT_OBJECT (font_object
);
2757 min_width
= (font
->min_width
? font
->min_width
2758 : font
->average_width
? font
->average_width
2759 : font
->space_width
? font
->space_width
2761 #ifdef HAVE_WINDOW_SYSTEM
2762 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2763 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2765 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2766 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
;
2767 fonts_changed_p
= 1;
2771 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2772 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2773 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > font
->height
)
2774 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
, fonts_changed_p
= 1;
2782 /* Close FONT_OBJECT that is opened on frame F. */
2785 font_close_object (f
, font_object
)
2787 Lisp_Object font_object
;
2789 struct font
*font
= XFONT_OBJECT (font_object
);
2791 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2792 /* Already closed. */
2794 font_add_log ("close", font_object
, Qnil
);
2795 font
->driver
->close (f
, font
);
2796 #ifdef HAVE_WINDOW_SYSTEM
2797 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2798 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2804 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2805 FONT is a font-entity and it must be opened to check. */
2808 font_has_char (f
, font
, c
)
2815 if (FONT_ENTITY_P (font
))
2817 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2818 struct font_driver_list
*driver_list
;
2820 for (driver_list
= f
->font_driver_list
;
2821 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2822 driver_list
= driver_list
->next
);
2825 if (! driver_list
->driver
->has_char
)
2827 return driver_list
->driver
->has_char (font
, c
);
2830 font_assert (FONT_OBJECT_P (font
));
2831 fontp
= XFONT_OBJECT (font
);
2832 if (fontp
->driver
->has_char
)
2834 int result
= fontp
->driver
->has_char (font
, c
);
2839 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2843 /* Return the glyph ID of FONT_OBJECT for character C. */
2846 font_encode_char (font_object
, c
)
2847 Lisp_Object font_object
;
2852 font_assert (FONT_OBJECT_P (font_object
));
2853 font
= XFONT_OBJECT (font_object
);
2854 return font
->driver
->encode_char (font
, c
);
2858 /* Return the name of FONT_OBJECT. */
2861 font_get_name (font_object
)
2862 Lisp_Object font_object
;
2864 font_assert (FONT_OBJECT_P (font_object
));
2865 return AREF (font_object
, FONT_NAME_INDEX
);
2869 /* Return the specification of FONT_OBJECT. */
2872 font_get_spec (font_object
)
2873 Lisp_Object font_object
;
2875 Lisp_Object spec
= font_make_spec ();
2878 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2879 ASET (spec
, i
, AREF (font_object
, i
));
2880 ASET (spec
, FONT_SIZE_INDEX
,
2881 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2886 font_spec_from_name (font_name
)
2887 Lisp_Object font_name
;
2889 Lisp_Object args
[2];
2892 args
[1] = font_name
;
2893 return Ffont_spec (2, args
);
2898 font_clear_prop (attrs
, prop
)
2900 enum font_property_index prop
;
2902 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2906 if (NILP (AREF (font
, prop
))
2907 && prop
!= FONT_FAMILY_INDEX
&& prop
!= FONT_FOUNDRY_INDEX
2908 && prop
!= FONT_SIZE_INDEX
)
2910 font
= Fcopy_font_spec (font
);
2911 ASET (font
, prop
, Qnil
);
2912 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
2914 if (prop
== FONT_FAMILY_INDEX
)
2915 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
2916 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
2917 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
2918 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
2919 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2920 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2921 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2923 else if (prop
== FONT_SIZE_INDEX
)
2925 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2926 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2927 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2929 attrs
[LFACE_FONT_INDEX
] = font
;
2933 font_update_lface (f
, attrs
)
2939 spec
= attrs
[LFACE_FONT_INDEX
];
2940 if (! FONT_SPEC_P (spec
))
2943 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
2944 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
2945 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2946 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
2947 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
2948 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
2949 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
2950 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);;
2951 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
2952 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
2953 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
2957 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2962 val
= Ffont_get (spec
, QCdpi
);
2965 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
2968 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2969 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
2970 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
2975 /* Return a font-entity satisfying SPEC and best matching with face's
2976 font related attributes in ATTRS. C, if not negative, is a
2977 character that the entity must support. */
2980 font_find_for_lface (f
, attrs
, spec
, c
)
2987 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
2988 Lisp_Object size
, foundry
[3], *family
, registry
[3];
2990 int i
, j
, k
, result
;
2992 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
2993 if (NILP (registry
[0]))
2995 registry
[0] = Qiso8859_1
;
2996 registry
[1] = Qascii_0
;
2997 registry
[2] = null_vector
;
3000 registry
[1] = null_vector
;
3002 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3004 struct charset
*encoding
, *repertory
;
3006 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3007 &encoding
, &repertory
) < 0)
3011 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3013 /* Any font of this registry support C. So, let's
3014 suppress the further checking. */
3017 else if (c
> encoding
->max_char
)
3021 work
= Fcopy_font_spec (spec
);
3022 XSETFRAME (frame
, f
);
3023 size
= AREF (spec
, FONT_SIZE_INDEX
);
3024 pixel_size
= font_pixel_size (f
, spec
);
3025 if (pixel_size
== 0)
3027 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3029 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3031 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3032 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3033 if (! NILP (foundry
[0]))
3034 foundry
[1] = null_vector
;
3035 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3037 foundry
[0] = font_intern_prop (SDATA (attrs
[LFACE_FOUNDRY_INDEX
]),
3038 SBYTES (attrs
[LFACE_FOUNDRY_INDEX
]), 1);
3040 foundry
[2] = null_vector
;
3043 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3045 val
= AREF (work
, FONT_FAMILY_INDEX
);
3046 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3047 val
= font_intern_prop (SDATA (attrs
[LFACE_FAMILY_INDEX
]),
3048 SBYTES (attrs
[LFACE_FAMILY_INDEX
]), 1);
3051 family
= alloca ((sizeof family
[0]) * 2);
3053 family
[1] = null_vector
; /* terminator. */
3058 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3060 if (! NILP (alters
))
3062 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3063 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3064 family
[i
] = XCAR (alters
);
3065 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3067 family
[i
] = null_vector
;
3071 family
= alloca ((sizeof family
[0]) * 3);
3074 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3076 family
[i
] = null_vector
;
3080 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3082 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3083 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3085 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3086 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3088 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3089 entities
= font_list_entities (frame
, work
);
3090 if (ASIZE (entities
) > 0)
3097 if (ASIZE (entities
) == 1)
3100 return AREF (entities
, 0);
3104 /* Sort fonts by properties specified in LFACE. */
3105 Lisp_Object prefer
= scratch_font_prefer
;
3107 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3108 ASET (prefer
, i
, AREF (work
, i
));
3109 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3111 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3113 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3114 if (NILP (AREF (prefer
, i
)))
3115 ASET (prefer
, i
, AREF (face_font
, i
));
3117 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3118 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3119 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3120 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3121 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3122 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3123 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3124 entities
= font_sort_entites (entities
, prefer
, frame
, work
, c
< 0);
3129 for (i
= 0; i
< ASIZE (entities
); i
++)
3133 val
= AREF (entities
, i
);
3136 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3137 if (! EQ (AREF (val
, j
), props
[j
]))
3139 if (j
> FONT_REGISTRY_INDEX
)
3142 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3143 props
[j
] = AREF (val
, j
);
3144 result
= font_has_char (f
, val
, c
);
3149 val
= font_open_for_lface (f
, val
, attrs
, spec
);
3152 result
= font_has_char (f
, val
, c
);
3153 font_close_object (f
, val
);
3155 return AREF (entities
, i
);
3162 font_open_for_lface (f
, entity
, attrs
, spec
)
3170 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3171 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3172 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3173 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3174 size
= font_pixel_size (f
, spec
);
3177 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3180 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3182 return font_open_entity (f
, entity
, size
);
3186 /* Find a font satisfying SPEC and best matching with face's
3187 attributes in ATTRS on FRAME, and return the opened
3191 font_load_for_lface (f
, attrs
, spec
)
3193 Lisp_Object
*attrs
, spec
;
3197 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3200 /* No font is listed for SPEC, but each font-backend may have
3201 the different criteria about "font matching". So, try
3203 entity
= font_matching_entity (f
, attrs
, spec
);
3207 return font_open_for_lface (f
, entity
, attrs
, spec
);
3211 /* Make FACE on frame F ready to use the font opened for FACE. */
3214 font_prepare_for_face (f
, face
)
3218 if (face
->font
->driver
->prepare_face
)
3219 face
->font
->driver
->prepare_face (f
, face
);
3223 /* Make FACE on frame F stop using the font opened for FACE. */
3226 font_done_for_face (f
, face
)
3230 if (face
->font
->driver
->done_face
)
3231 face
->font
->driver
->done_face (f
, face
);
3236 /* Open a font best matching with NAME on frame F. If no proper font
3237 is found, return Qnil. */
3240 font_open_by_name (f
, name
)
3244 Lisp_Object args
[2];
3245 Lisp_Object spec
, attrs
[LFACE_VECTOR_SIZE
];
3248 args
[1] = make_unibyte_string (name
, strlen (name
));
3249 spec
= Ffont_spec (2, args
);
3250 /* We set up the default font-related attributes of a face to prefer
3252 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3253 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3254 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3255 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3256 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3258 return font_load_for_lface (f
, attrs
, spec
);
3262 /* Register font-driver DRIVER. This function is used in two ways.
3264 The first is with frame F non-NULL. In this case, make DRIVER
3265 available (but not yet activated) on F. All frame creaters
3266 (e.g. Fx_create_frame) must call this function at least once with
3267 an available font-driver.
3269 The second is with frame F NULL. In this case, DRIVER is globally
3270 registered in the variable `font_driver_list'. All font-driver
3271 implementations must call this function in its syms_of_XXXX
3272 (e.g. syms_of_xfont). */
3275 register_font_driver (driver
, f
)
3276 struct font_driver
*driver
;
3279 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3280 struct font_driver_list
*prev
, *list
;
3282 if (f
&& ! driver
->draw
)
3283 error ("Unusable font driver for a frame: %s",
3284 SDATA (SYMBOL_NAME (driver
->type
)));
3286 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3287 if (EQ (list
->driver
->type
, driver
->type
))
3288 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3290 list
= malloc (sizeof (struct font_driver_list
));
3292 list
->driver
= driver
;
3297 f
->font_driver_list
= list
;
3299 font_driver_list
= list
;
3305 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3306 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3307 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3309 A caller must free all realized faces if any in advance. The
3310 return value is a list of font backends actually made used on
3314 font_update_drivers (f
, new_drivers
)
3316 Lisp_Object new_drivers
;
3318 Lisp_Object active_drivers
= Qnil
;
3319 struct font_driver
*driver
;
3320 struct font_driver_list
*list
;
3322 /* At first, turn off non-requested drivers, and turn on requested
3324 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3326 driver
= list
->driver
;
3327 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3332 if (driver
->end_for_frame
)
3333 driver
->end_for_frame (f
);
3334 font_finish_cache (f
, driver
);
3339 if (! driver
->start_for_frame
3340 || driver
->start_for_frame (f
) == 0)
3342 font_prepare_cache (f
, driver
);
3349 if (NILP (new_drivers
))
3352 if (! EQ (new_drivers
, Qt
))
3354 /* Re-order the driver list according to new_drivers. */
3355 struct font_driver_list
**list_table
, **next
;
3359 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3360 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3362 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3363 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3366 list_table
[i
++] = list
;
3368 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3370 list_table
[i
] = list
;
3371 list_table
[i
] = NULL
;
3373 next
= &f
->font_driver_list
;
3374 for (i
= 0; list_table
[i
]; i
++)
3376 *next
= list_table
[i
];
3377 next
= &(*next
)->next
;
3382 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3384 active_drivers
= nconc2 (active_drivers
,
3385 Fcons (list
->driver
->type
, Qnil
));
3386 return active_drivers
;
3390 font_put_frame_data (f
, driver
, data
)
3392 struct font_driver
*driver
;
3395 struct font_data_list
*list
, *prev
;
3397 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3398 prev
= list
, list
= list
->next
)
3399 if (list
->driver
== driver
)
3406 prev
->next
= list
->next
;
3408 f
->font_data_list
= list
->next
;
3416 list
= malloc (sizeof (struct font_data_list
));
3419 list
->driver
= driver
;
3420 list
->next
= f
->font_data_list
;
3421 f
->font_data_list
= list
;
3429 font_get_frame_data (f
, driver
)
3431 struct font_driver
*driver
;
3433 struct font_data_list
*list
;
3435 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3436 if (list
->driver
== driver
)
3444 /* Return the font used to draw character C by FACE at buffer position
3445 POS in window W. If STRING is non-nil, it is a string containing C
3446 at index POS. If C is negative, get C from the current buffer or
3450 font_at (c
, pos
, face
, w
, string
)
3459 Lisp_Object font_object
;
3465 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3468 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3470 c
= FETCH_CHAR (pos_byte
);
3473 c
= FETCH_BYTE (pos
);
3479 multibyte
= STRING_MULTIBYTE (string
);
3482 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3484 str
= SDATA (string
) + pos_byte
;
3485 c
= STRING_CHAR (str
, 0);
3488 c
= SDATA (string
)[pos
];
3492 f
= XFRAME (w
->frame
);
3493 if (! FRAME_WINDOW_P (f
))
3500 if (STRINGP (string
))
3501 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3502 DEFAULT_FACE_ID
, 0);
3504 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3506 face
= FACE_FROM_ID (f
, face_id
);
3510 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3511 face
= FACE_FROM_ID (f
, face_id
);
3516 XSETFONT (font_object
, face
->font
);
3521 /* Check how many characters after POS (at most to LIMIT) can be
3522 displayed by the same font. FACE is the face selected for the
3523 character as POS on frame F. STRING, if not nil, is the string to
3524 check instead of the current buffer.
3526 The return value is the position of the character that is displayed
3527 by the differnt font than that of the character as POS. */
3530 font_range (pos
, limit
, face
, f
, string
)
3531 EMACS_INT pos
, limit
;
3544 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3545 pos_byte
= CHAR_TO_BYTE (pos
);
3549 multibyte
= STRING_MULTIBYTE (string
);
3550 pos_byte
= string_char_to_byte (string
, pos
);
3554 /* All unibyte character are displayed by the same font. */
3562 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3564 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3565 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3566 face
= FACE_FROM_ID (f
, face_id
);
3573 else if (font
!= face
->font
)
3585 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3586 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3587 Return nil otherwise.
3588 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3589 which kind of font it is. It must be one of `font-spec', `font-entity',
3591 (object
, extra_type
)
3592 Lisp_Object object
, extra_type
;
3594 if (NILP (extra_type
))
3595 return (FONTP (object
) ? Qt
: Qnil
);
3596 if (EQ (extra_type
, Qfont_spec
))
3597 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3598 if (EQ (extra_type
, Qfont_entity
))
3599 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3600 if (EQ (extra_type
, Qfont_object
))
3601 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3602 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3605 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3606 doc
: /* Return a newly created font-spec with arguments as properties.
3608 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3609 valid font property name listed below:
3611 `:family', `:weight', `:slant', `:width'
3613 They are the same as face attributes of the same name. See
3614 `set-face-attribute'.
3618 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3622 VALUE must be a string or a symbol specifying the additional
3623 typographic style information of a font, e.g. ``sans''.
3627 VALUE must be a string or a symbol specifying the charset registry and
3628 encoding of a font, e.g. ``iso8859-1''.
3632 VALUE must be a non-negative integer or a floating point number
3633 specifying the font size. It specifies the font size in pixels
3634 (if VALUE is an integer), or in points (if VALUE is a float).
3638 VALUE must be a string of XLFD-style or fontconfig-style font name.
3639 usage: (font-spec ARGS ...) */)
3644 Lisp_Object spec
= font_make_spec ();
3647 for (i
= 0; i
< nargs
; i
+= 2)
3649 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3651 if (EQ (key
, QCname
))
3654 font_parse_name ((char *) SDATA (val
), spec
);
3655 font_put_extra (spec
, key
, val
);
3659 int idx
= get_font_prop_index (key
);
3663 val
= font_prop_validate (idx
, Qnil
, val
);
3664 if (idx
< FONT_EXTRA_INDEX
)
3665 ASET (spec
, idx
, val
);
3667 font_put_extra (spec
, key
, val
);
3670 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3676 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3677 doc
: /* Return a copy of FONT as a font-spec. */)
3681 Lisp_Object new_spec
, tail
, extra
;
3685 new_spec
= font_make_spec ();
3686 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3687 ASET (new_spec
, i
, AREF (font
, i
));
3689 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3691 if (! EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3692 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3694 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3698 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3699 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3700 Every specified properties in FROM override the corresponding
3701 properties in TO. */)
3703 Lisp_Object from
, to
;
3705 Lisp_Object extra
, tail
;
3710 to
= Fcopy_font_spec (to
);
3711 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3712 ASET (to
, i
, AREF (from
, i
));
3713 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3714 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3715 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3717 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3720 XSETCDR (slot
, XCDR (XCAR (tail
)));
3722 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3724 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3728 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3729 doc
: /* Return the value of FONT's property KEY.
3730 FONT is a font-spec, a font-entity, or a font-object. */)
3732 Lisp_Object font
, key
;
3739 idx
= get_font_prop_index (key
);
3740 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3741 return font_style_symbolic (font
, idx
, 0);
3742 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3743 return AREF (font
, idx
);
3744 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3747 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3748 doc
: /* Return a plist of face attributes generated by FONT.
3749 FONT is a font name, a font-spec, a font-entity, or a font-object.
3750 The return value is a list of the form
3752 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3754 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3755 compatible with `set-face-attribute'.
3757 The optional argument FRAME specifies the frame that the face attributes
3758 are to be displayed on. If omitted, the selected frame is used. */)
3760 Lisp_Object font
, frame
;
3763 Lisp_Object plist
[10];
3767 frame
= selected_frame
;
3768 CHECK_LIVE_FRAME (frame
);
3773 int fontset
= fs_query_fontset (font
, 0);
3774 Lisp_Object name
= font
;
3776 font
= fontset_ascii (fontset
);
3777 font
= font_spec_from_name (name
);
3779 signal_error ("Invalid font name", name
);
3781 else if (! FONTP (font
))
3782 signal_error ("Invalid font object", font
);
3784 plist
[0] = QCfamily
;
3785 val
= AREF (font
, FONT_FAMILY_INDEX
);
3786 plist
[1] = NILP (val
) ? Qnil
: SYMBOL_NAME (val
);
3788 plist
[2] = QCheight
;
3789 val
= AREF (font
, FONT_SIZE_INDEX
);
3792 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
3793 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
3794 plist
[3] = make_number (10 * PIXEL_TO_POINT (XINT (val
), dpi
));
3796 else if (FLOATP (val
))
3797 plist
[3] = make_number (10 * (int) XFLOAT_DATA (val
));
3801 plist
[4] = QCweight
;
3802 val
= FONT_WEIGHT_FOR_FACE (font
);
3803 plist
[5] = NILP (val
) ? Qnormal
: val
;
3806 val
= FONT_SLANT_FOR_FACE (font
);
3807 plist
[7] = NILP (val
) ? Qnormal
: val
;
3810 val
= FONT_WIDTH_FOR_FACE (font
);
3811 plist
[9] = NILP (val
) ? Qnormal
: val
;
3813 return Flist (10, plist
);
3816 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3817 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
3818 (font_spec
, prop
, val
)
3819 Lisp_Object font_spec
, prop
, val
;
3823 CHECK_FONT_SPEC (font_spec
);
3824 idx
= get_font_prop_index (prop
);
3825 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3826 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
3828 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
3832 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3833 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3834 Optional 2nd argument FRAME specifies the target frame.
3835 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3836 Optional 4th argument PREFER, if non-nil, is a font-spec to
3837 control the order of the returned list. Fonts are sorted by
3838 how close they are to PREFER. */)
3839 (font_spec
, frame
, num
, prefer
)
3840 Lisp_Object font_spec
, frame
, num
, prefer
;
3842 Lisp_Object vec
, list
, tail
;
3846 frame
= selected_frame
;
3847 CHECK_LIVE_FRAME (frame
);
3848 CHECK_FONT_SPEC (font_spec
);
3856 if (! NILP (prefer
))
3857 CHECK_FONT_SPEC (prefer
);
3859 vec
= font_list_entities (frame
, font_spec
);
3864 return Fcons (AREF (vec
, 0), Qnil
);
3866 if (! NILP (prefer
))
3867 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
, 0);
3869 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3870 if (n
== 0 || n
> len
)
3872 for (i
= 1; i
< n
; i
++)
3874 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3876 XSETCDR (tail
, val
);
3882 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
3883 doc
: /* List available font families on the current frame.
3884 Optional argument FRAME, if non-nil, specifies the target frame. */)
3889 struct font_driver_list
*driver_list
;
3893 frame
= selected_frame
;
3894 CHECK_LIVE_FRAME (frame
);
3897 for (driver_list
= f
->font_driver_list
; driver_list
;
3898 driver_list
= driver_list
->next
)
3899 if (driver_list
->driver
->list_family
)
3901 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3907 Lisp_Object tail
= list
;
3909 for (; CONSP (val
); val
= XCDR (val
))
3910 if (NILP (Fmemq (XCAR (val
), tail
)))
3911 list
= Fcons (XCAR (val
), list
);
3917 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3918 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3919 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3921 Lisp_Object font_spec
, frame
;
3923 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3930 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
3931 doc
: /* Return XLFD name of FONT.
3932 FONT is a font-spec, font-entity, or font-object.
3933 If the name is too long for XLFD (maximum 255 chars), return nil.
3934 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
3935 the consecutive wildcards are folded to one. */)
3936 (font
, fold_wildcards
)
3937 Lisp_Object font
, fold_wildcards
;
3944 if (FONT_OBJECT_P (font
))
3946 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
3948 if (STRINGP (font_name
)
3949 && SDATA (font_name
)[0] == '-')
3951 if (NILP (fold_wildcards
))
3953 strcpy (name
, (char *) SDATA (font_name
));
3956 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
3958 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3961 if (! NILP (fold_wildcards
))
3963 char *p0
= name
, *p1
;
3965 while ((p1
= strstr (p0
, "-*-*")))
3967 strcpy (p1
, p1
+ 2);
3972 return build_string (name
);
3975 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3976 doc
: /* Clear font cache. */)
3979 Lisp_Object list
, frame
;
3981 FOR_EACH_FRAME (list
, frame
)
3983 FRAME_PTR f
= XFRAME (frame
);
3984 struct font_driver_list
*driver_list
= f
->font_driver_list
;
3986 for (; driver_list
; driver_list
= driver_list
->next
)
3987 if (driver_list
->on
)
3989 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
3994 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
3996 font_assert (! NILP (val
));
3997 val
= XCDR (XCAR (val
));
3998 if (XINT (XCAR (val
)) == 0)
4000 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4001 XSETCDR (cache
, XCDR (val
));
4009 /* The following three functions are still experimental. */
4011 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
4012 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
4013 FONT-OBJECT may be nil if it is not yet known.
4015 G-string is sequence of glyphs of a specific font,
4016 and is a vector of this form:
4017 [ HEADER GLYPH ... ]
4018 HEADER is a vector of this form:
4019 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
4021 FONT-OBJECT is a font-object for all glyphs in the g-string,
4022 WIDTH thru DESCENT are the metrics (in pixels) of the whole G-string.
4023 GLYPH is a vector of this form:
4024 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
4025 [ [X-OFF Y-OFF WADJUST] | nil] ]
4027 FROM-IDX and TO-IDX are used internally and should not be touched.
4028 C is the character of the glyph.
4029 CODE is the glyph-code of C in FONT-OBJECT.
4030 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4031 X-OFF and Y-OFF are offests to the base position for the glyph.
4032 WADJUST is the adjustment to the normal width of the glyph. */)
4034 Lisp_Object font_object
, num
;
4036 Lisp_Object gstring
, g
;
4040 if (! NILP (font_object
))
4041 CHECK_FONT_OBJECT (font_object
);
4044 len
= XINT (num
) + 1;
4045 gstring
= Fmake_vector (make_number (len
), Qnil
);
4046 g
= Fmake_vector (make_number (6), Qnil
);
4047 ASET (g
, 0, font_object
);
4048 ASET (gstring
, 0, g
);
4049 for (i
= 1; i
< len
; i
++)
4050 ASET (gstring
, i
, Fmake_vector (make_number (10), Qnil
));
4054 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
4055 doc
: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
4056 START and END specify the region to extract characters.
4057 If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
4058 where to extract characters.
4059 FONT-OBJECT may be nil if GSTRING already contains one. */)
4060 (gstring
, font_object
, start
, end
, object
)
4061 Lisp_Object gstring
, font_object
, start
, end
, object
;
4067 CHECK_VECTOR (gstring
);
4068 if (NILP (font_object
))
4069 font_object
= LGSTRING_FONT (gstring
);
4070 font
= XFONT_OBJECT (font_object
);
4072 if (STRINGP (object
))
4074 const unsigned char *p
;
4076 CHECK_NATNUM (start
);
4078 if (XINT (start
) > XINT (end
)
4079 || XINT (end
) > ASIZE (object
)
4080 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
4081 args_out_of_range_3 (object
, start
, end
);
4083 len
= XINT (end
) - XINT (start
);
4084 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
4085 for (i
= 0; i
< len
; i
++)
4087 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4088 /* Shut up GCC warning in comparison with
4089 MOST_POSITIVE_FIXNUM below. */
4092 c
= STRING_CHAR_ADVANCE (p
);
4093 cod
= code
= font
->driver
->encode_char (font
, c
);
4094 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
4096 LGLYPH_SET_FROM (g
, i
);
4097 LGLYPH_SET_TO (g
, i
);
4098 LGLYPH_SET_CHAR (g
, c
);
4099 LGLYPH_SET_CODE (g
, code
);
4106 if (! NILP (object
))
4107 Fset_buffer (object
);
4108 validate_region (&start
, &end
);
4109 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
4110 args_out_of_range (start
, end
);
4111 len
= XINT (end
) - XINT (start
);
4113 pos_byte
= CHAR_TO_BYTE (pos
);
4114 for (i
= 0; i
< len
; i
++)
4116 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4117 /* Shut up GCC warning in comparison with
4118 MOST_POSITIVE_FIXNUM below. */
4121 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
4122 cod
= code
= font
->driver
->encode_char (font
, c
);
4123 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
4125 LGLYPH_SET_FROM (g
, i
);
4126 LGLYPH_SET_TO (g
, i
);
4127 LGLYPH_SET_CHAR (g
, c
);
4128 LGLYPH_SET_CODE (g
, code
);
4131 for (; i
< LGSTRING_LENGTH (gstring
); i
++)
4132 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
4136 DEFUN ("font-shape-text", Ffont_shape_text
, Sfont_shape_text
, 3, 4, 0,
4137 doc
: /* Shape text between FROM and TO by FONT-OBJECT.
4138 If optional 4th argument STRING is non-nil, it is a string to shape,
4139 and FROM and TO are indices to the string.
4140 The value is the end position of the text that can be shaped by
4142 (from
, to
, font_object
, string
)
4143 Lisp_Object from
, to
, font_object
, string
;
4146 struct font_metrics metrics
;
4147 EMACS_INT start
, end
;
4148 Lisp_Object gstring
, n
;
4151 if (! FONT_OBJECT_P (font_object
))
4153 font
= XFONT_OBJECT (font_object
);
4154 if (! font
->driver
->shape
)
4159 validate_region (&from
, &to
);
4160 start
= XFASTINT (from
);
4161 end
= XFASTINT (to
);
4162 modify_region (current_buffer
, start
, end
, 0);
4166 CHECK_STRING (string
);
4167 start
= XINT (from
);
4169 if (start
< 0 || start
> end
|| end
> SCHARS (string
))
4170 args_out_of_range_3 (string
, from
, to
);
4174 gstring
= Ffont_make_gstring (font_object
, make_number (len
));
4175 Ffont_fill_gstring (gstring
, font_object
, from
, to
, string
);
4177 /* Try at most three times with larger gstring each time. */
4178 for (i
= 0; i
< 3; i
++)
4180 Lisp_Object args
[2];
4182 n
= font
->driver
->shape (gstring
);
4186 args
[1] = Fmake_vector (make_number (len
), Qnil
);
4187 gstring
= Fvconcat (2, args
);
4189 if (! INTEGERP (n
) || XINT (n
) == 0)
4193 for (i
= 0; i
< len
;)
4196 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4197 EMACS_INT this_from
= LGLYPH_FROM (g
);
4198 EMACS_INT this_to
= LGLYPH_TO (g
) + 1;
4200 int need_composition
= 0;
4202 metrics
.lbearing
= LGLYPH_LBEARING (g
);
4203 metrics
.rbearing
= LGLYPH_RBEARING (g
);
4204 metrics
.ascent
= LGLYPH_ASCENT (g
);
4205 metrics
.descent
= LGLYPH_DESCENT (g
);
4206 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4208 metrics
.width
= LGLYPH_WIDTH (g
);
4209 if (LGLYPH_CHAR (g
) == 0 || metrics
.width
== 0)
4210 need_composition
= 1;
4214 metrics
.width
= LGLYPH_WADJUST (g
);
4215 metrics
.lbearing
+= LGLYPH_XOFF (g
);
4216 metrics
.rbearing
+= LGLYPH_XOFF (g
);
4217 metrics
.ascent
-= LGLYPH_YOFF (g
);
4218 metrics
.descent
+= LGLYPH_YOFF (g
);
4219 need_composition
= 1;
4221 for (j
= i
+ 1; j
< len
; j
++)
4225 g
= LGSTRING_GLYPH (gstring
, j
);
4226 if (this_from
!= LGLYPH_FROM (g
))
4228 need_composition
= 1;
4229 x
= metrics
.width
+ LGLYPH_LBEARING (g
) + LGLYPH_XOFF (g
);
4230 if (metrics
.lbearing
> x
)
4231 metrics
.lbearing
= x
;
4232 x
= metrics
.width
+ LGLYPH_RBEARING (g
) + LGLYPH_XOFF (g
);
4233 if (metrics
.rbearing
< x
)
4234 metrics
.rbearing
= x
;
4235 x
= LGLYPH_ASCENT (g
) - LGLYPH_YOFF (g
);
4236 if (metrics
.ascent
< x
)
4238 x
= LGLYPH_DESCENT (g
) - LGLYPH_YOFF (g
);
4239 if (metrics
.descent
< x
)
4240 metrics
.descent
= x
;
4241 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4242 metrics
.width
+= LGLYPH_WIDTH (g
);
4244 metrics
.width
+= LGLYPH_WADJUST (g
);
4247 if (need_composition
)
4249 gstr
= Ffont_make_gstring (font_object
, make_number (j
- i
));
4250 LGSTRING_SET_WIDTH (gstr
, metrics
.width
);
4251 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
4252 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
);
4253 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
4254 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
4255 for (k
= i
; i
< j
; i
++)
4257 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4259 LGLYPH_SET_FROM (g
, LGLYPH_FROM (g
) - this_from
);
4260 LGLYPH_SET_TO (g
, LGLYPH_TO (g
) - this_from
);
4261 LGSTRING_SET_GLYPH (gstr
, i
- k
, LGSTRING_GLYPH (gstring
, i
));
4263 from
= make_number (start
+ this_from
);
4264 to
= make_number (start
+ this_to
);
4266 Fcompose_region_internal (from
, to
, gstr
, Qnil
);
4268 Fcompose_string_internal (string
, from
, to
, gstr
, Qnil
);
4279 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4280 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4281 OTF-FEATURES specifies which features to apply in this format:
4282 (SCRIPT LANGSYS GSUB GPOS)
4284 SCRIPT is a symbol specifying a script tag of OpenType,
4285 LANGSYS is a symbol specifying a langsys tag of OpenType,
4286 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4288 If LANGYS is nil, the default langsys is selected.
4290 The features are applied in the order they appear in the list. The
4291 symbol `*' means to apply all available features not present in this
4292 list, and the remaining features are ignored. For instance, (vatu
4293 pstf * haln) is to apply vatu and pstf in this order, then to apply
4294 all available features other than vatu, pstf, and haln.
4296 The features are applied to the glyphs in the range FROM and TO of
4297 the glyph-string GSTRING-IN.
4299 If some feature is actually applicable, the resulting glyphs are
4300 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4301 this case, the value is the number of produced glyphs.
4303 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4306 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4307 produced in GSTRING-OUT, and the value is nil.
4309 See the documentation of `font-make-gstring' for the format of
4311 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4312 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4314 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4319 check_otf_features (otf_features
);
4320 CHECK_FONT_OBJECT (font_object
);
4321 font
= XFONT_OBJECT (font_object
);
4322 if (! font
->driver
->otf_drive
)
4323 error ("Font backend %s can't drive OpenType GSUB table",
4324 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4325 CHECK_CONS (otf_features
);
4326 CHECK_SYMBOL (XCAR (otf_features
));
4327 val
= XCDR (otf_features
);
4328 CHECK_SYMBOL (XCAR (val
));
4329 val
= XCDR (otf_features
);
4332 len
= check_gstring (gstring_in
);
4333 CHECK_VECTOR (gstring_out
);
4334 CHECK_NATNUM (from
);
4336 CHECK_NATNUM (index
);
4338 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4339 args_out_of_range_3 (from
, to
, make_number (len
));
4340 if (XINT (index
) >= ASIZE (gstring_out
))
4341 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4342 num
= font
->driver
->otf_drive (font
, otf_features
,
4343 gstring_in
, XINT (from
), XINT (to
),
4344 gstring_out
, XINT (index
), 0);
4347 return make_number (num
);
4350 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4352 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4353 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4355 (SCRIPT LANGSYS FEATURE ...)
4356 See the documentation of `font-drive-otf' for more detail.
4358 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4359 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4360 character code corresponding to the glyph or nil if there's no
4361 corresponding character. */)
4362 (font_object
, character
, otf_features
)
4363 Lisp_Object font_object
, character
, otf_features
;
4366 Lisp_Object gstring_in
, gstring_out
, g
;
4367 Lisp_Object alternates
;
4370 CHECK_FONT_GET_OBJECT (font_object
, font
);
4371 if (! font
->driver
->otf_drive
)
4372 error ("Font backend %s can't drive OpenType GSUB table",
4373 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4374 CHECK_CHARACTER (character
);
4375 CHECK_CONS (otf_features
);
4377 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4378 g
= LGSTRING_GLYPH (gstring_in
, 0);
4379 LGLYPH_SET_CHAR (g
, XINT (character
));
4380 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4381 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4382 gstring_out
, 0, 1)) < 0)
4383 gstring_out
= Ffont_make_gstring (font_object
,
4384 make_number (ASIZE (gstring_out
) * 2));
4386 for (i
= 0; i
< num
; i
++)
4388 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4389 int c
= LGLYPH_CHAR (g
);
4390 unsigned code
= LGLYPH_CODE (g
);
4392 alternates
= Fcons (Fcons (make_number (code
),
4393 c
> 0 ? make_number (c
) : Qnil
),
4396 return Fnreverse (alternates
);
4402 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4403 doc
: /* Open FONT-ENTITY. */)
4404 (font_entity
, size
, frame
)
4405 Lisp_Object font_entity
;
4411 CHECK_FONT_ENTITY (font_entity
);
4413 frame
= selected_frame
;
4414 CHECK_LIVE_FRAME (frame
);
4417 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4420 CHECK_NUMBER_OR_FLOAT (size
);
4422 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
4424 isize
= XINT (size
);
4428 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4431 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4432 doc
: /* Close FONT-OBJECT. */)
4433 (font_object
, frame
)
4434 Lisp_Object font_object
, frame
;
4436 CHECK_FONT_OBJECT (font_object
);
4438 frame
= selected_frame
;
4439 CHECK_LIVE_FRAME (frame
);
4440 font_close_object (XFRAME (frame
), font_object
);
4444 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4445 doc
: /* Return information about FONT-OBJECT.
4446 The value is a vector:
4447 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4450 NAME is a string of the font name (or nil if the font backend doesn't
4453 FILENAME is a string of the font file (or nil if the font backend
4454 doesn't provide a file name).
4456 PIXEL-SIZE is a pixel size by which the font is opened.
4458 SIZE is a maximum advance width of the font in pixels.
4460 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4463 CAPABILITY is a list whose first element is a symbol representing the
4464 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4465 remaining elements describe the details of the font capability.
4467 If the font is OpenType font, the form of the list is
4468 \(opentype GSUB GPOS)
4469 where GSUB shows which "GSUB" features the font supports, and GPOS
4470 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4471 lists of the format:
4472 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4474 If the font is not OpenType font, currently the length of the form is
4477 SCRIPT is a symbol representing OpenType script tag.
4479 LANGSYS is a symbol representing OpenType langsys tag, or nil
4480 representing the default langsys.
4482 FEATURE is a symbol representing OpenType feature tag.
4484 If the font is not OpenType font, CAPABILITY is nil. */)
4486 Lisp_Object font_object
;
4491 CHECK_FONT_GET_OBJECT (font_object
, font
);
4493 val
= Fmake_vector (make_number (9), Qnil
);
4494 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4495 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4496 ASET (val
, 2, make_number (font
->pixel_size
));
4497 ASET (val
, 3, make_number (font
->max_width
));
4498 ASET (val
, 4, make_number (font
->ascent
));
4499 ASET (val
, 5, make_number (font
->descent
));
4500 ASET (val
, 6, make_number (font
->space_width
));
4501 ASET (val
, 7, make_number (font
->average_width
));
4502 if (font
->driver
->otf_capability
)
4503 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4507 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4508 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4509 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4510 (font_object
, string
)
4511 Lisp_Object font_object
, string
;
4517 CHECK_FONT_GET_OBJECT (font_object
, font
);
4518 CHECK_STRING (string
);
4519 len
= SCHARS (string
);
4520 vec
= Fmake_vector (make_number (len
), Qnil
);
4521 for (i
= 0; i
< len
; i
++)
4523 Lisp_Object ch
= Faref (string
, make_number (i
));
4528 struct font_metrics metrics
;
4530 cod
= code
= font
->driver
->encode_char (font
, c
);
4531 if (code
== FONT_INVALID_CODE
)
4533 val
= Fmake_vector (make_number (6), Qnil
);
4534 if (cod
<= MOST_POSITIVE_FIXNUM
)
4535 ASET (val
, 0, make_number (code
));
4537 ASET (val
, 0, Fcons (make_number (code
>> 16),
4538 make_number (code
& 0xFFFF)));
4539 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4540 ASET (val
, 1, make_number (metrics
.lbearing
));
4541 ASET (val
, 2, make_number (metrics
.rbearing
));
4542 ASET (val
, 3, make_number (metrics
.width
));
4543 ASET (val
, 4, make_number (metrics
.ascent
));
4544 ASET (val
, 5, make_number (metrics
.descent
));
4550 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4551 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4552 FONT is a font-spec, font-entity, or font-object. */)
4554 Lisp_Object spec
, font
;
4556 CHECK_FONT_SPEC (spec
);
4559 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4562 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4563 doc
: /* Return a font-object for displaying a character at POSITION.
4564 Optional second arg WINDOW, if non-nil, is a window displaying
4565 the current buffer. It defaults to the currently selected window. */)
4566 (position
, window
, string
)
4567 Lisp_Object position
, window
, string
;
4574 CHECK_NUMBER_COERCE_MARKER (position
);
4575 pos
= XINT (position
);
4576 if (pos
< BEGV
|| pos
>= ZV
)
4577 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4581 CHECK_NUMBER (position
);
4582 CHECK_STRING (string
);
4583 pos
= XINT (position
);
4584 if (pos
< 0 || pos
>= SCHARS (string
))
4585 args_out_of_range (string
, position
);
4588 window
= selected_window
;
4589 CHECK_LIVE_WINDOW (window
);
4590 w
= XWINDOW (window
);
4592 return font_at (-1, pos
, NULL
, w
, string
);
4596 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4597 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4598 The value is a number of glyphs drawn.
4599 Type C-l to recover what previously shown. */)
4600 (font_object
, string
)
4601 Lisp_Object font_object
, string
;
4603 Lisp_Object frame
= selected_frame
;
4604 FRAME_PTR f
= XFRAME (frame
);
4610 CHECK_FONT_GET_OBJECT (font_object
, font
);
4611 CHECK_STRING (string
);
4612 len
= SCHARS (string
);
4613 code
= alloca (sizeof (unsigned) * len
);
4614 for (i
= 0; i
< len
; i
++)
4616 Lisp_Object ch
= Faref (string
, make_number (i
));
4620 code
[i
] = font
->driver
->encode_char (font
, c
);
4621 if (code
[i
] == FONT_INVALID_CODE
)
4624 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4626 if (font
->driver
->prepare_face
)
4627 font
->driver
->prepare_face (f
, face
);
4628 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4629 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4630 if (font
->driver
->done_face
)
4631 font
->driver
->done_face (f
, face
);
4633 return make_number (len
);
4637 #endif /* FONT_DEBUG */
4639 #ifdef HAVE_WINDOW_SYSTEM
4641 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4642 doc
: /* Return information about a font named NAME on frame FRAME.
4643 If FRAME is omitted or nil, use the selected frame.
4644 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4645 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4647 OPENED-NAME is the name used for opening the font,
4648 FULL-NAME is the full name of the font,
4649 SIZE is the maximum bound width of the font,
4650 HEIGHT is the height of the font,
4651 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4652 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4653 how to compose characters.
4654 If the named font is not yet loaded, return nil. */)
4656 Lisp_Object name
, frame
;
4661 Lisp_Object font_object
;
4663 (*check_window_system_func
) ();
4666 CHECK_STRING (name
);
4668 frame
= selected_frame
;
4669 CHECK_LIVE_FRAME (frame
);
4674 int fontset
= fs_query_fontset (name
, 0);
4677 name
= fontset_ascii (fontset
);
4678 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4680 else if (FONT_OBJECT_P (name
))
4682 else if (FONT_ENTITY_P (name
))
4683 font_object
= font_open_entity (f
, name
, 0);
4686 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4687 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4689 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4691 if (NILP (font_object
))
4693 font
= XFONT_OBJECT (font_object
);
4695 info
= Fmake_vector (make_number (7), Qnil
);
4696 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4697 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4698 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4699 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4700 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4701 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4702 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4705 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4706 close it now. Perhaps, we should manage font-objects
4707 by `reference-count'. */
4708 font_close_object (f
, font_object
);
4715 #define BUILD_STYLE_TABLE(TBL) \
4716 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4719 build_style_table (entry
, nelement
)
4720 struct table_entry
*entry
;
4724 Lisp_Object table
, elt
;
4726 table
= Fmake_vector (make_number (nelement
), Qnil
);
4727 for (i
= 0; i
< nelement
; i
++)
4729 for (j
= 0; entry
[i
].names
[j
]; j
++);
4730 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4731 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4732 for (j
= 0; entry
[i
].names
[j
]; j
++)
4733 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4734 ASET (table
, i
, elt
);
4739 static Lisp_Object Vfont_log
;
4740 static int font_log_env_checked
;
4743 font_add_log (action
, arg
, result
)
4745 Lisp_Object arg
, result
;
4747 Lisp_Object tail
, val
;
4750 if (! font_log_env_checked
)
4752 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
4753 font_log_env_checked
= 1;
4755 if (EQ (Vfont_log
, Qt
))
4758 arg
= Ffont_xlfd_name (arg
, Qt
);
4760 result
= Ffont_xlfd_name (result
, Qt
);
4761 else if (CONSP (result
))
4763 result
= Fcopy_sequence (result
);
4764 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4768 val
= Ffont_xlfd_name (val
, Qt
);
4769 XSETCAR (tail
, val
);
4772 else if (VECTORP (result
))
4774 result
= Fcopy_sequence (result
);
4775 for (i
= 0; i
< ASIZE (result
); i
++)
4777 val
= AREF (result
, i
);
4779 val
= Ffont_xlfd_name (val
, Qt
);
4780 ASET (result
, i
, val
);
4783 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4786 extern void syms_of_ftfont
P_ (());
4787 extern void syms_of_xfont
P_ (());
4788 extern void syms_of_xftfont
P_ (());
4789 extern void syms_of_ftxfont
P_ (());
4790 extern void syms_of_bdffont
P_ (());
4791 extern void syms_of_w32font
P_ (());
4792 extern void syms_of_atmfont
P_ (());
4797 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
4798 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
4799 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
4800 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
4801 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
4802 /* Note that the other elements in sort_shift_bits are not used. */
4804 staticpro (&font_charset_alist
);
4805 font_charset_alist
= Qnil
;
4807 DEFSYM (Qfont_spec
, "font-spec");
4808 DEFSYM (Qfont_entity
, "font-entity");
4809 DEFSYM (Qfont_object
, "font-object");
4811 DEFSYM (Qopentype
, "opentype");
4813 DEFSYM (Qascii_0
, "ascii-0");
4814 DEFSYM (Qiso8859_1
, "iso8859-1");
4815 DEFSYM (Qiso10646_1
, "iso10646-1");
4816 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4817 DEFSYM (Qunicode_sip
, "unicode-sip");
4819 DEFSYM (QCotf
, ":otf");
4820 DEFSYM (QClang
, ":lang");
4821 DEFSYM (QCscript
, ":script");
4822 DEFSYM (QCantialias
, ":antialias");
4824 DEFSYM (QCfoundry
, ":foundry");
4825 DEFSYM (QCadstyle
, ":adstyle");
4826 DEFSYM (QCregistry
, ":registry");
4827 DEFSYM (QCspacing
, ":spacing");
4828 DEFSYM (QCdpi
, ":dpi");
4829 DEFSYM (QCscalable
, ":scalable");
4830 DEFSYM (QCavgwidth
, ":avgwidth");
4831 DEFSYM (QCfont_entity
, ":font-entity");
4832 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
4839 staticpro (&null_vector
);
4840 null_vector
= Fmake_vector (make_number (0), Qnil
);
4842 staticpro (&scratch_font_spec
);
4843 scratch_font_spec
= Ffont_spec (0, NULL
);
4844 staticpro (&scratch_font_prefer
);
4845 scratch_font_prefer
= Ffont_spec (0, NULL
);
4849 staticpro (&otf_list
);
4851 #endif /* HAVE_LIBOTF */
4855 defsubr (&Sfont_spec
);
4856 defsubr (&Sfont_get
);
4857 defsubr (&Sfont_face_attributes
);
4858 defsubr (&Sfont_put
);
4859 defsubr (&Slist_fonts
);
4860 defsubr (&Sfont_family_list
);
4861 defsubr (&Sfind_font
);
4862 defsubr (&Sfont_xlfd_name
);
4863 defsubr (&Sclear_font_cache
);
4864 defsubr (&Sfont_make_gstring
);
4865 defsubr (&Sfont_fill_gstring
);
4866 defsubr (&Sfont_shape_text
);
4868 defsubr (&Sfont_drive_otf
);
4869 defsubr (&Sfont_otf_alternates
);
4873 defsubr (&Sopen_font
);
4874 defsubr (&Sclose_font
);
4875 defsubr (&Squery_font
);
4876 defsubr (&Sget_font_glyphs
);
4877 defsubr (&Sfont_match_p
);
4878 defsubr (&Sfont_at
);
4880 defsubr (&Sdraw_string
);
4882 #endif /* FONT_DEBUG */
4883 #ifdef HAVE_WINDOW_SYSTEM
4884 defsubr (&Sfont_info
);
4887 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
4889 Alist of fontname patterns vs the corresponding encoding and repertory info.
4890 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
4891 where ENCODING is a charset or a char-table,
4892 and REPERTORY is a charset, a char-table, or nil.
4894 If ENCODING and REPERTORY are the same, the element can have the form
4895 \(REGEXP . ENCODING).
4897 ENCODING is for converting a character to a glyph code of the font.
4898 If ENCODING is a charset, encoding a character by the charset gives
4899 the corresponding glyph code. If ENCODING is a char-table, looking up
4900 the table by a character gives the corresponding glyph code.
4902 REPERTORY specifies a repertory of characters supported by the font.
4903 If REPERTORY is a charset, all characters beloging to the charset are
4904 supported. If REPERTORY is a char-table, all characters who have a
4905 non-nil value in the table are supported. If REPERTORY is nil, Emacs
4906 gets the repertory information by an opened font and ENCODING. */);
4907 Vfont_encoding_alist
= Qnil
;
4909 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
4910 doc
: /* Vector of valid font weight values.
4911 Each element has the form:
4912 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
4913 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
4914 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
4916 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
4917 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
4918 See `font-weight-table' for the format of the vector. */);
4919 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
4921 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
4922 doc
: /* Alist of font width symbols vs the corresponding numeric values.
4923 See `font-weight-table' for the format of the vector. */);
4924 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
4926 staticpro (&font_style_table
);
4927 font_style_table
= Fmake_vector (make_number (3), Qnil
);
4928 ASET (font_style_table
, 0, Vfont_weight_table
);
4929 ASET (font_style_table
, 1, Vfont_slant_table
);
4930 ASET (font_style_table
, 2, Vfont_width_table
);
4932 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
4933 *Logging list of font related actions and results.
4934 The value t means to suppress the logging.
4935 The initial value is set to nil if the environment variable
4936 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
4939 #ifdef HAVE_WINDOW_SYSTEM
4940 #ifdef HAVE_FREETYPE
4942 #ifdef HAVE_X_WINDOWS
4947 #endif /* HAVE_XFT */
4948 #endif /* HAVE_X_WINDOWS */
4949 #else /* not HAVE_FREETYPE */
4950 #ifdef HAVE_X_WINDOWS
4952 #endif /* HAVE_X_WINDOWS */
4953 #endif /* not HAVE_FREETYPE */
4956 #endif /* HAVE_BDFFONT */
4959 #endif /* WINDOWSNT */
4963 #endif /* HAVE_WINDOW_SYSTEM */
4966 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
4967 (do not change this comment) */