1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
3 Copyright (C) 2006, 2007, 2008
4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H13PRO009
7 This file is part of GNU Emacs.
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
34 #include "dispextern.h"
36 #include "character.h"
37 #include "composite.h"
43 #endif /* HAVE_X_WINDOWS */
47 #endif /* HAVE_NTGUI */
53 Lisp_Object Qfont_spec
, Qfont_entity
, Qfont_object
;
55 Lisp_Object Qopentype
;
57 /* Important character set strings. */
58 Lisp_Object Qascii_0
, Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
60 /* Special vector of zero length. This is repeatedly used by (struct
61 font_driver *)->list when a specified font is not found. */
62 static Lisp_Object null_vector
;
64 static Lisp_Object Vfont_weight_table
, Vfont_slant_table
, Vfont_width_table
;
66 /* Vector of Vfont_weight_table, Vfont_slant_table, and Vfont_width_table. */
67 static Lisp_Object font_style_table
;
69 /* Structure used for tables mapping weight, slant, and width numeric
70 values and their names. */
75 /* The first one is a valid name as a face attribute.
76 The second one (if any) is a typical name in XLFD field. */
81 /* Table of weight numeric values and their names. This table must be
82 sorted by numeric values in ascending order. */
84 static struct table_entry weight_table
[] =
87 { 20, { "ultra-light", "ultralight" }},
88 { 40, { "extra-light", "extralight" }},
90 { 75, { "semi-light", "semilight", "demilight", "book" }},
91 { 100, { "normal", "medium", "regular" }},
92 { 180, { "semi-bold", "semibold", "demibold", "demi" }},
94 { 205, { "extra-bold", "extrabold" }},
95 { 210, { "ultra-bold", "ultrabold", "black" }}
98 /* Table of slant numeric values and their names. This table must be
99 sorted by numeric values in ascending order. */
101 static struct table_entry slant_table
[] =
103 { 0, { "reverse-oblique", "ro" }},
104 { 10, { "reverse-italic", "ri" }},
105 { 100, { "normal", "r" }},
106 { 200, { "italic" ,"i", "ot" }},
107 { 210, { "oblique", "o" }}
110 /* Table of width numeric values and their names. This table must be
111 sorted by numeric values in ascending order. */
113 static struct table_entry width_table
[] =
115 { 50, { "ultra-condensed", "ultracondensed" }},
116 { 63, { "extra-condensed", "extracondensed" }},
117 { 75, { "condensed", "compressed", "narrow" }},
118 { 87, { "semi-condensed", "semicondensed", "demicondensed" }},
119 { 100, { "normal", "medium", "regular" }},
120 { 113, { "semi-expanded", "semiexpanded", "demiexpanded" }},
121 { 125, { "expanded" }},
122 { 150, { "extra-expanded", "extraexpanded" }},
123 { 200, { "ultra-expanded", "ultraexpanded", "wide" }}
126 extern Lisp_Object Qnormal
;
128 /* Symbols representing keys of normal font properties. */
129 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
;
130 extern Lisp_Object QCheight
, QCsize
, QCname
;
132 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
;
133 /* Symbols representing keys of font extra info. */
134 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
135 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
136 /* Symbols representing values of font spacing property. */
137 Lisp_Object Qc
, Qm
, Qp
, Qd
;
139 Lisp_Object Vfont_encoding_alist
;
141 /* Alist of font registry symbol and the corresponding charsets
142 information. The information is retrieved from
143 Vfont_encoding_alist on demand.
145 Eash element has the form:
146 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
150 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
151 encodes a character code to a glyph code of a font, and
152 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
153 character is supported by a font.
155 The latter form means that the information for REGISTRY couldn't be
157 static Lisp_Object font_charset_alist
;
159 /* List of all font drivers. Each font-backend (XXXfont.c) calls
160 register_font_driver in syms_of_XXXfont to register its font-driver
162 static struct font_driver_list
*font_driver_list
;
166 /* Creaters of font-related Lisp object. */
171 Lisp_Object font_spec
;
172 struct font_spec
*spec
173 = ((struct font_spec
*)
174 allocate_pseudovector (VECSIZE (struct font_spec
),
175 FONT_SPEC_MAX
, PVEC_FONT
));
176 XSETFONT (font_spec
, spec
);
183 Lisp_Object font_entity
;
184 struct font_entity
*entity
185 = ((struct font_entity
*)
186 allocate_pseudovector (VECSIZE (struct font_entity
),
187 FONT_ENTITY_MAX
, PVEC_FONT
));
188 XSETFONT (font_entity
, entity
);
193 font_make_object (size
)
196 Lisp_Object font_object
;
198 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
199 XSETFONT (font_object
, font
);
206 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
207 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
208 static Lisp_Object font_matching_entity
P_ ((FRAME_PTR
, Lisp_Object
*,
211 /* Number of registered font drivers. */
212 static int num_font_drivers
;
215 /* Return a Lispy value of a font property value at STR and LEN bytes.
216 If STR is "*", it returns nil.
217 If FORCE_SYMBOL is zero and all characters in STR are digits, it
218 returns an integer. Otherwise, it returns a symbol interned from
222 font_intern_prop (str
, len
, force_symbol
)
231 if (len
== 1 && *str
== '*')
233 if (!force_symbol
&& len
>=1 && isdigit (*str
))
235 for (i
= 1; i
< len
; i
++)
236 if (! isdigit (str
[i
]))
239 return make_number (atoi (str
));
242 /* The following code is copied from the function intern (in lread.c). */
244 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
245 obarray
= check_obarray (obarray
);
246 tem
= oblookup (obarray
, str
, len
, len
);
249 return Fintern (make_unibyte_string (str
, len
), obarray
);
252 /* Return a pixel size of font-spec SPEC on frame F. */
255 font_pixel_size (f
, spec
)
259 #ifdef HAVE_WINDOW_SYSTEM
260 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
269 font_assert (FLOATP (size
));
270 point_size
= XFLOAT_DATA (size
);
271 val
= AREF (spec
, FONT_DPI_INDEX
);
276 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
284 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
285 font vector. If VAL is not valid (i.e. not registered in
286 font_style_table), return -1 if NOERROR is zero, and return a
287 proper index if NOERROR is nonzero. In that case, register VAL in
288 font_style_table if VAL is a symbol, and return a closest index if
289 VAL is an integer. */
292 font_style_to_value (prop
, val
, noerror
)
293 enum font_property_index prop
;
297 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
298 int len
= ASIZE (table
);
304 Lisp_Object args
[2], elt
;
306 /* At first try exact match. */
307 for (i
= 0; i
< len
; i
++)
308 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
309 if (EQ (val
, AREF (AREF (table
, i
), j
)))
310 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
311 | (i
<< 4) | (j
- 1));
312 /* Try also with case-folding match. */
313 s
= SDATA (SYMBOL_NAME (val
));
314 for (i
= 0; i
< len
; i
++)
315 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
317 elt
= AREF (AREF (table
, i
), j
);
318 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
319 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
320 | (i
<< 4) | (j
- 1));
326 elt
= Fmake_vector (make_number (2), make_number (255));
329 args
[1] = Fmake_vector (make_number (1), elt
);
330 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
331 return (255 << 8) | (i
<< 4);
336 int numeric
= XINT (val
);
338 for (i
= 0, last_n
= -1; i
< len
; i
++)
340 int n
= XINT (AREF (AREF (table
, i
), 0));
343 return (n
<< 8) | (i
<< 4);
348 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
349 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
355 return ((last_n
<< 8) | ((i
- 1) << 4));
360 font_style_symbolic (font
, prop
, for_face
)
362 enum font_property_index prop
;
365 Lisp_Object val
= AREF (font
, prop
);
366 Lisp_Object table
, elt
;
371 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
372 i
= XINT (val
) & 0xFF;
373 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
374 elt
= AREF (table
, ((i
>> 4) & 0xF));
375 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
376 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
379 extern Lisp_Object Vface_alternative_font_family_alist
;
381 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
384 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
385 FONTNAME. ENCODING is a charset symbol that specifies the encoding
386 of the font. REPERTORY is a charset symbol or nil. */
389 find_font_encoding (fontname
)
390 Lisp_Object fontname
;
392 Lisp_Object tail
, elt
;
394 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
398 && STRINGP (XCAR (elt
))
399 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
400 && (SYMBOLP (XCDR (elt
))
401 ? CHARSETP (XCDR (elt
))
402 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
405 /* We don't know the encoding of this font. Let's assume `ascii'. */
409 /* Return encoding charset and repertory charset for REGISTRY in
410 ENCODING and REPERTORY correspondingly. If correct information for
411 REGISTRY is available, return 0. Otherwise return -1. */
414 font_registry_charsets (registry
, encoding
, repertory
)
415 Lisp_Object registry
;
416 struct charset
**encoding
, **repertory
;
419 int encoding_id
, repertory_id
;
421 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
427 encoding_id
= XINT (XCAR (val
));
428 repertory_id
= XINT (XCDR (val
));
432 val
= find_font_encoding (SYMBOL_NAME (registry
));
433 if (SYMBOLP (val
) && CHARSETP (val
))
435 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
437 else if (CONSP (val
))
439 if (! CHARSETP (XCAR (val
)))
441 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
442 if (NILP (XCDR (val
)))
446 if (! CHARSETP (XCDR (val
)))
448 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
453 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
455 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
459 *encoding
= CHARSET_FROM_ID (encoding_id
);
461 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
466 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
471 /* Font property value validaters. See the comment of
472 font_property_table for the meaning of the arguments. */
474 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
475 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
476 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
477 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
478 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
479 static int get_font_prop_index
P_ ((Lisp_Object
));
482 font_prop_validate_symbol (prop
, val
)
483 Lisp_Object prop
, val
;
486 val
= Fintern (val
, Qnil
);
489 else if (EQ (prop
, QCregistry
))
490 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
496 font_prop_validate_style (style
, val
)
497 Lisp_Object style
, val
;
499 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
500 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
507 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
511 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
513 if ((n
& 0xF) + 1 >= ASIZE (elt
))
515 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
519 else if (SYMBOLP (val
))
521 int n
= font_style_to_value (prop
, val
, 0);
523 val
= n
>= 0 ? make_number (n
) : Qerror
;
531 font_prop_validate_non_neg (prop
, val
)
532 Lisp_Object prop
, val
;
534 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
539 font_prop_validate_spacing (prop
, val
)
540 Lisp_Object prop
, val
;
542 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
544 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
546 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
548 if (spacing
== 'c' || spacing
== 'C')
549 return make_number (FONT_SPACING_CHARCELL
);
550 if (spacing
== 'm' || spacing
== 'M')
551 return make_number (FONT_SPACING_MONO
);
552 if (spacing
== 'p' || spacing
== 'P')
553 return make_number (FONT_SPACING_PROPORTIONAL
);
554 if (spacing
== 'd' || spacing
== 'D')
555 return make_number (FONT_SPACING_DUAL
);
561 font_prop_validate_otf (prop
, val
)
562 Lisp_Object prop
, val
;
564 Lisp_Object tail
, tmp
;
567 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
568 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
569 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
572 if (! SYMBOLP (XCAR (val
)))
577 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
579 for (i
= 0; i
< 2; i
++)
586 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
587 if (! SYMBOLP (XCAR (tmp
)))
595 /* Structure of known font property keys and validater of the
599 /* Pointer to the key symbol. */
601 /* Function to validate PROP's value VAL, or NULL if any value is
602 ok. The value is VAL or its regularized value if VAL is valid,
603 and Qerror if not. */
604 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
605 } font_property_table
[] =
606 { { &QCtype
, font_prop_validate_symbol
},
607 { &QCfoundry
, font_prop_validate_symbol
},
608 { &QCfamily
, font_prop_validate_symbol
},
609 { &QCadstyle
, font_prop_validate_symbol
},
610 { &QCregistry
, font_prop_validate_symbol
},
611 { &QCweight
, font_prop_validate_style
},
612 { &QCslant
, font_prop_validate_style
},
613 { &QCwidth
, font_prop_validate_style
},
614 { &QCsize
, font_prop_validate_non_neg
},
615 { &QCdpi
, font_prop_validate_non_neg
},
616 { &QCspacing
, font_prop_validate_spacing
},
617 { &QCavgwidth
, font_prop_validate_non_neg
},
618 /* The order of the above entries must match with enum
619 font_property_index. */
620 { &QClang
, font_prop_validate_symbol
},
621 { &QCscript
, font_prop_validate_symbol
},
622 { &QCotf
, font_prop_validate_otf
}
625 /* Size (number of elements) of the above table. */
626 #define FONT_PROPERTY_TABLE_SIZE \
627 ((sizeof font_property_table) / (sizeof *font_property_table))
629 /* Return an index number of font property KEY or -1 if KEY is not an
630 already known property. */
633 get_font_prop_index (key
)
638 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
639 if (EQ (key
, *font_property_table
[i
].key
))
644 /* Validate the font property. The property key is specified by the
645 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
646 signal an error. The value is VAL or the regularized one. */
649 font_prop_validate (idx
, prop
, val
)
651 Lisp_Object prop
, val
;
653 Lisp_Object validated
;
658 prop
= *font_property_table
[idx
].key
;
661 idx
= get_font_prop_index (prop
);
665 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
666 if (EQ (validated
, Qerror
))
667 signal_error ("invalid font property", Fcons (prop
, val
));
672 /* Store VAL as a value of extra font property PROP in FONT while
673 keeping the sorting order. Don't check the validity of VAL. */
676 font_put_extra (font
, prop
, val
)
677 Lisp_Object font
, prop
, val
;
679 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
680 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
684 Lisp_Object prev
= Qnil
;
687 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
688 prev
= extra
, extra
= XCDR (extra
);
690 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
692 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
700 /* Font name parser and unparser */
702 static int parse_matrix
P_ ((char *));
703 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
704 static int font_parse_name
P_ ((char *, Lisp_Object
));
706 /* An enumerator for each field of an XLFD font name. */
707 enum xlfd_field_index
726 /* An enumerator for mask bit corresponding to each XLFD field. */
729 XLFD_FOUNDRY_MASK
= 0x0001,
730 XLFD_FAMILY_MASK
= 0x0002,
731 XLFD_WEIGHT_MASK
= 0x0004,
732 XLFD_SLANT_MASK
= 0x0008,
733 XLFD_SWIDTH_MASK
= 0x0010,
734 XLFD_ADSTYLE_MASK
= 0x0020,
735 XLFD_PIXEL_MASK
= 0x0040,
736 XLFD_POINT_MASK
= 0x0080,
737 XLFD_RESX_MASK
= 0x0100,
738 XLFD_RESY_MASK
= 0x0200,
739 XLFD_SPACING_MASK
= 0x0400,
740 XLFD_AVGWIDTH_MASK
= 0x0800,
741 XLFD_REGISTRY_MASK
= 0x1000,
742 XLFD_ENCODING_MASK
= 0x2000
746 /* Parse P pointing the pixel/point size field of the form
747 `[A B C D]' which specifies a transformation matrix:
753 by which all glyphs of the font are transformed. The spec says
754 that scalar value N for the pixel/point size is equivalent to:
755 A = N * resx/resy, B = C = 0, D = N.
757 Return the scalar value N if the form is valid. Otherwise return
768 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
771 matrix
[i
] = - strtod (p
+ 1, &end
);
773 matrix
[i
] = strtod (p
, &end
);
776 return (i
== 4 ? (int) matrix
[3] : -1);
779 /* Expand a wildcard field in FIELD (the first N fields are filled) to
780 multiple fields to fill in all 14 XLFD fields while restring a
781 field position by its contents. */
784 font_expand_wildcards (field
, n
)
785 Lisp_Object field
[XLFD_LAST_INDEX
];
789 Lisp_Object tmp
[XLFD_LAST_INDEX
];
790 /* Array of information about where this element can go. Nth
791 element is for Nth element of FIELD. */
793 /* Minimum possible field. */
795 /* Maxinum possible field. */
797 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
799 } range
[XLFD_LAST_INDEX
];
801 int range_from
, range_to
;
804 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
805 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
806 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
807 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
808 | XLFD_AVGWIDTH_MASK)
809 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
811 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
812 field. The value is shifted to left one bit by one in the
814 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
815 range_mask
= (range_mask
<< 1) | 1;
817 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
818 position-based retriction for FIELD[I]. */
819 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
820 i
++, range_from
++, range_to
++, range_mask
<<= 1)
822 Lisp_Object val
= field
[i
];
828 range
[i
].from
= range_from
;
829 range
[i
].to
= range_to
;
830 range
[i
].mask
= range_mask
;
834 /* The triplet FROM, TO, and MASK is a value-based
835 retriction for FIELD[I]. */
841 int numeric
= XINT (val
);
844 from
= to
= XLFD_ENCODING_INDEX
,
845 mask
= XLFD_ENCODING_MASK
;
846 else if (numeric
== 0)
847 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
848 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
849 else if (numeric
<= 48)
850 from
= to
= XLFD_PIXEL_INDEX
,
851 mask
= XLFD_PIXEL_MASK
;
853 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
854 mask
= XLFD_LARGENUM_MASK
;
856 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
857 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
858 mask
= XLFD_NULL_MASK
;
860 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
863 Lisp_Object name
= SYMBOL_NAME (val
);
865 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
866 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
867 mask
= XLFD_REGENC_MASK
;
869 from
= to
= XLFD_ENCODING_INDEX
,
870 mask
= XLFD_ENCODING_MASK
;
872 else if (range_from
<= XLFD_WEIGHT_INDEX
873 && range_to
>= XLFD_WEIGHT_INDEX
874 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
875 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
876 else if (range_from
<= XLFD_SLANT_INDEX
877 && range_to
>= XLFD_SLANT_INDEX
878 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
879 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
880 else if (range_from
<= XLFD_SWIDTH_INDEX
881 && range_to
>= XLFD_SWIDTH_INDEX
882 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
883 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
886 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
887 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
889 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
890 mask
= XLFD_SYMBOL_MASK
;
893 /* Merge position-based and value-based restrictions. */
895 while (from
< range_from
)
896 mask
&= ~(1 << from
++);
897 while (from
< 14 && ! (mask
& (1 << from
)))
899 while (to
> range_to
)
900 mask
&= ~(1 << to
--);
901 while (to
>= 0 && ! (mask
& (1 << to
)))
905 range
[i
].from
= from
;
907 range
[i
].mask
= mask
;
909 if (from
> range_from
|| to
< range_to
)
911 /* The range is narrowed by value-based restrictions.
912 Reflect it to the other fields. */
914 /* Following fields should be after FROM. */
916 /* Preceding fields should be before TO. */
917 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
919 /* Check FROM for non-wildcard field. */
920 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
922 while (range
[j
].from
< from
)
923 range
[j
].mask
&= ~(1 << range
[j
].from
++);
924 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
926 range
[j
].from
= from
;
929 from
= range
[j
].from
;
930 if (range
[j
].to
> to
)
932 while (range
[j
].to
> to
)
933 range
[j
].mask
&= ~(1 << range
[j
].to
--);
934 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
947 /* Decide all fileds from restrictions in RANGE. */
948 for (i
= j
= 0; i
< n
; i
++)
950 if (j
< range
[i
].from
)
952 if (i
== 0 || ! NILP (tmp
[i
- 1]))
953 /* None of TMP[X] corresponds to Jth field. */
955 for (; j
< range
[i
].from
; j
++)
960 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
962 for (; j
< XLFD_LAST_INDEX
; j
++)
964 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
965 field
[XLFD_ENCODING_INDEX
]
966 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
971 #ifdef ENABLE_CHECKING
972 /* Match a 14-field XLFD pattern against a full XLFD font name. */
974 font_match_xlfd (char *pattern
, char *name
)
976 while (*pattern
&& *name
)
978 if (*pattern
== *name
)
980 else if (*pattern
== '*')
981 if (*name
== pattern
[1])
992 /* Make sure the font object matches the XLFD font name. */
994 font_check_xlfd_parse (Lisp_Object font
, char *name
)
996 char name_check
[256];
997 font_unparse_xlfd (font
, 0, name_check
, 255);
998 return font_match_xlfd (name_check
, name
);
1004 /* Parse NAME (null terminated) as XLFD and store information in FONT
1005 (font-spec or font-entity). Size property of FONT is set as
1007 specified XLFD fields FONT property
1008 --------------------- -------------
1009 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1010 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1011 POINT_SIZE POINT_SIZE/10 (Lisp float)
1013 If NAME is successfully parsed, return 0. Otherwise return -1.
1015 FONT is usually a font-spec, but when this function is called from
1016 X font backend driver, it is a font-entity. In that case, NAME is
1017 a fully specified XLFD. */
1020 font_parse_xlfd (name
, font
)
1024 int len
= strlen (name
);
1026 char *f
[XLFD_LAST_INDEX
+ 1];
1031 /* Maximum XLFD name length is 255. */
1033 /* Accept "*-.." as a fully specified XLFD. */
1034 if (name
[0] == '*' && name
[1] == '-')
1035 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1038 for (p
= name
+ i
; *p
; p
++)
1042 if (i
== XLFD_LAST_INDEX
)
1047 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1048 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1050 if (i
== XLFD_LAST_INDEX
)
1052 /* Fully specified XLFD. */
1055 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1056 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1057 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1058 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1060 val
= INTERN_FIELD_SYM (i
);
1063 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1065 ASET (font
, j
, make_number (n
));
1068 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1069 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1070 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1072 ASET (font
, FONT_REGISTRY_INDEX
,
1073 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1074 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1076 p
= f
[XLFD_PIXEL_INDEX
];
1077 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1078 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1081 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1083 ASET (font
, FONT_SIZE_INDEX
, val
);
1086 double point_size
= -1;
1088 font_assert (FONT_SPEC_P (font
));
1089 p
= f
[XLFD_POINT_INDEX
];
1091 point_size
= parse_matrix (p
);
1092 else if (isdigit (*p
))
1093 point_size
= atoi (p
), point_size
/= 10;
1094 if (point_size
>= 0)
1095 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1099 ASET (font
, FONT_DPI_INDEX
, INTERN_FIELD (XLFD_RESY_INDEX
));
1100 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1103 val
= font_prop_validate_spacing (QCspacing
, val
);
1104 if (! INTEGERP (val
))
1106 ASET (font
, FONT_SPACING_INDEX
, val
);
1108 p
= f
[XLFD_AVGWIDTH_INDEX
];
1111 ASET (font
, FONT_AVGWIDTH_INDEX
,
1112 font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 0));
1116 int wild_card_found
= 0;
1117 Lisp_Object prop
[XLFD_LAST_INDEX
];
1119 if (FONT_ENTITY_P (font
))
1121 for (j
= 0; j
< i
; j
++)
1125 if (f
[j
][1] && f
[j
][1] != '-')
1128 wild_card_found
= 1;
1131 prop
[j
] = INTERN_FIELD (j
);
1133 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1135 if (! wild_card_found
)
1137 if (font_expand_wildcards (prop
, i
) < 0)
1140 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1141 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1142 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1143 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1144 if (! NILP (prop
[i
]))
1146 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1148 ASET (font
, j
, make_number (n
));
1150 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1151 val
= prop
[XLFD_REGISTRY_INDEX
];
1154 val
= prop
[XLFD_ENCODING_INDEX
];
1156 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1158 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1159 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1161 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1162 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1164 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1166 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1167 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1168 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1170 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1172 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1175 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1176 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1177 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1179 val
= font_prop_validate_spacing (QCspacing
,
1180 prop
[XLFD_SPACING_INDEX
]);
1181 if (! INTEGERP (val
))
1183 ASET (font
, FONT_SPACING_INDEX
, val
);
1185 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1186 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1192 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1193 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1194 0, use PIXEL_SIZE instead. */
1197 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1203 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1207 font_assert (FONTP (font
));
1209 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1212 if (i
== FONT_ADSTYLE_INDEX
)
1213 j
= XLFD_ADSTYLE_INDEX
;
1214 else if (i
== FONT_REGISTRY_INDEX
)
1215 j
= XLFD_REGISTRY_INDEX
;
1216 val
= AREF (font
, i
);
1219 if (j
== XLFD_REGISTRY_INDEX
)
1220 f
[j
] = "*-*", len
+= 4;
1222 f
[j
] = "*", len
+= 2;
1227 val
= SYMBOL_NAME (val
);
1228 if (j
== XLFD_REGISTRY_INDEX
1229 && ! strchr ((char *) SDATA (val
), '-'))
1231 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1232 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1234 f
[j
] = alloca (SBYTES (val
) + 3);
1235 sprintf (f
[j
], "%s-*", SDATA (val
));
1236 len
+= SBYTES (val
) + 3;
1240 f
[j
] = alloca (SBYTES (val
) + 4);
1241 sprintf (f
[j
], "%s*-*", SDATA (val
));
1242 len
+= SBYTES (val
) + 4;
1246 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1250 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1253 val
= font_style_symbolic (font
, i
, 0);
1255 f
[j
] = "*", len
+= 2;
1258 val
= SYMBOL_NAME (val
);
1259 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1263 val
= AREF (font
, FONT_SIZE_INDEX
);
1264 font_assert (NUMBERP (val
) || NILP (val
));
1272 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1273 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1276 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1278 else if (FLOATP (val
))
1280 i
= XFLOAT_DATA (val
) * 10;
1281 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1282 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1285 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1287 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1289 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1290 f
[XLFD_RESX_INDEX
] = alloca (22);
1291 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1295 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1296 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1298 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1300 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1301 : spacing
<= FONT_SPACING_DUAL
? "d"
1302 : spacing
<= FONT_SPACING_MONO
? "m"
1307 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1308 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1310 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1311 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
],
1312 "%d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1315 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1316 len
++; /* for terminating '\0'. */
1319 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1320 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1321 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1322 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1323 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1324 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1325 f
[XLFD_REGISTRY_INDEX
]);
1328 /* Parse NAME (null terminated) and store information in FONT
1329 (font-spec or font-entity). NAME is supplied in either the
1330 Fontconfig or GTK font name format. If NAME is successfully
1331 parsed, return 0. Otherwise return -1.
1333 The fontconfig format is
1335 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1339 FAMILY [PROPS...] [SIZE]
1341 This function tries to guess which format it is. */
1344 font_parse_fcname (name
, font
)
1349 char *size_beg
= NULL
, *size_end
= NULL
;
1350 char *props_beg
= NULL
, *family_end
= NULL
;
1351 int len
= strlen (name
);
1356 for (p
= name
; *p
; p
++)
1358 if (*p
== '\\' && p
[1])
1362 props_beg
= family_end
= p
;
1367 int decimal
= 0, size_found
= 1;
1368 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1371 if (*q
!= '.' || decimal
)
1390 /* A fontconfig name with size and/or property data. */
1391 if (family_end
> name
)
1394 family
= font_intern_prop (name
, family_end
- name
, 1);
1395 ASET (font
, FONT_FAMILY_INDEX
, family
);
1399 double point_size
= strtod (size_beg
, &size_end
);
1400 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1401 if (*size_end
== ':' && size_end
[1])
1402 props_beg
= size_end
;
1406 /* Now parse ":KEY=VAL" patterns. */
1409 for (p
= props_beg
; *p
; p
= q
)
1411 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1414 /* Must be an enumerated value. */
1418 val
= font_intern_prop (p
, q
- p
, 1);
1420 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1422 if (PROP_MATCH ("light", 5)
1423 || PROP_MATCH ("medium", 6)
1424 || PROP_MATCH ("demibold", 8)
1425 || PROP_MATCH ("bold", 4)
1426 || PROP_MATCH ("black", 5))
1427 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1428 else if (PROP_MATCH ("roman", 5)
1429 || PROP_MATCH ("italic", 6)
1430 || PROP_MATCH ("oblique", 7))
1431 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1432 else if (PROP_MATCH ("charcell", 8))
1433 ASET (font
, FONT_SPACING_INDEX
,
1434 make_number (FONT_SPACING_CHARCELL
));
1435 else if (PROP_MATCH ("mono", 4))
1436 ASET (font
, FONT_SPACING_INDEX
,
1437 make_number (FONT_SPACING_MONO
));
1438 else if (PROP_MATCH ("proportional", 12))
1439 ASET (font
, FONT_SPACING_INDEX
,
1440 make_number (FONT_SPACING_PROPORTIONAL
));
1449 if (q
- p
== 10 && memcmp (p
+ 1, "pixelsize", 9) == 0)
1450 prop
= FONT_SIZE_INDEX
;
1453 key
= font_intern_prop (p
, q
- p
, 1);
1454 prop
= get_font_prop_index (key
);
1458 for (q
= p
; *q
&& *q
!= ':'; q
++);
1459 val
= font_intern_prop (p
, q
- p
, 0);
1461 if (prop
>= FONT_FOUNDRY_INDEX
1462 && prop
< FONT_EXTRA_INDEX
)
1463 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1465 Ffont_put (font
, key
, val
);
1473 /* Either a fontconfig-style name with no size and property
1474 data, or a GTK-style name. */
1476 int word_len
, prop_found
= 0;
1478 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1484 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1492 double point_size
= strtod (p
, &q
);
1493 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1498 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1499 if (*q
== '\\' && q
[1])
1503 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1505 if (PROP_MATCH ("Ultra-Light", 11))
1508 prop
= font_intern_prop ("ultra-light", 11, 1);
1509 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1511 else if (PROP_MATCH ("Light", 5))
1514 prop
= font_intern_prop ("light", 5, 1);
1515 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1517 else if (PROP_MATCH ("Semi-Bold", 9))
1520 prop
= font_intern_prop ("semi-bold", 9, 1);
1521 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1523 else if (PROP_MATCH ("Bold", 4))
1526 prop
= font_intern_prop ("bold", 4, 1);
1527 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1529 else if (PROP_MATCH ("Italic", 6))
1532 prop
= font_intern_prop ("italic", 4, 1);
1533 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1535 else if (PROP_MATCH ("Oblique", 7))
1538 prop
= font_intern_prop ("oblique", 7, 1);
1539 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1543 return -1; /* Unknown property in GTK-style font name. */
1552 family
= font_intern_prop (name
, family_end
- name
, 1);
1553 ASET (font
, FONT_FAMILY_INDEX
, family
);
1560 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1561 NAME (NBYTES length), and return the name length. If
1562 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1565 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1571 Lisp_Object family
, foundry
;
1572 Lisp_Object tail
, val
;
1577 Lisp_Object styles
[3];
1578 char *style_names
[3] = { "weight", "slant", "width" };
1581 family
= AREF (font
, FONT_FAMILY_INDEX
);
1582 if (! NILP (family
))
1584 if (SYMBOLP (family
))
1586 family
= SYMBOL_NAME (family
);
1587 len
+= SBYTES (family
);
1593 val
= AREF (font
, FONT_SIZE_INDEX
);
1596 if (XINT (val
) != 0)
1597 pixel_size
= XINT (val
);
1599 len
+= 21; /* for ":pixelsize=NUM" */
1601 else if (FLOATP (val
))
1604 point_size
= (int) XFLOAT_DATA (val
);
1605 len
+= 11; /* for "-NUM" */
1608 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1609 if (! NILP (foundry
))
1611 if (SYMBOLP (foundry
))
1613 foundry
= SYMBOL_NAME (foundry
);
1614 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1620 for (i
= 0; i
< 3; i
++)
1622 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1623 if (! NILP (styles
[i
]))
1624 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1625 SDATA (SYMBOL_NAME (styles
[i
])));
1628 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1629 len
+= sprintf (work
, ":dpi=%d", dpi
);
1630 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1631 len
+= strlen (":spacing=100");
1632 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1633 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1634 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1636 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1638 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1640 len
+= SBYTES (val
);
1641 else if (INTEGERP (val
))
1642 len
+= sprintf (work
, "%d", XINT (val
));
1643 else if (SYMBOLP (val
))
1644 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1650 if (! NILP (family
))
1651 p
+= sprintf (p
, "%s", SDATA (family
));
1655 p
+= sprintf (p
, "%d", point_size
);
1657 p
+= sprintf (p
, "-%d", point_size
);
1659 else if (pixel_size
> 0)
1660 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1661 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1662 p
+= sprintf (p
, ":foundry=%s",
1663 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1664 for (i
= 0; i
< 3; i
++)
1665 if (! NILP (styles
[i
]))
1666 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1667 SDATA (SYMBOL_NAME (styles
[i
])));
1668 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1669 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1670 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1671 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1672 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1674 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1675 p
+= sprintf (p
, ":scalable=true");
1677 p
+= sprintf (p
, ":scalable=false");
1682 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1683 NAME (NBYTES length), and return the name length. F is the frame
1684 on which the font is displayed; it is used to calculate the point
1688 font_unparse_gtkname (font
, f
, name
, nbytes
)
1696 Lisp_Object family
, weight
, slant
, size
;
1697 int point_size
= -1;
1699 family
= AREF (font
, FONT_FAMILY_INDEX
);
1700 if (! NILP (family
))
1702 if (! SYMBOLP (family
))
1704 family
= SYMBOL_NAME (family
);
1705 len
+= SBYTES (family
);
1708 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1709 if (EQ (weight
, Qnormal
))
1711 else if (! NILP (weight
))
1713 weight
= SYMBOL_NAME (weight
);
1714 len
+= SBYTES (weight
);
1717 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1718 if (EQ (slant
, Qnormal
))
1720 else if (! NILP (slant
))
1722 slant
= SYMBOL_NAME (slant
);
1723 len
+= SBYTES (slant
);
1726 size
= AREF (font
, FONT_SIZE_INDEX
);
1727 /* Convert pixel size to point size. */
1728 if (INTEGERP (size
))
1730 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1732 if (INTEGERP (font_dpi
))
1733 dpi
= XINT (font_dpi
);
1736 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1739 else if (FLOATP (size
))
1741 point_size
= (int) XFLOAT_DATA (size
);
1748 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1750 if (! NILP (weight
))
1753 p
+= sprintf (p
, " %s", SDATA (weight
));
1754 q
[1] = toupper (q
[1]);
1760 p
+= sprintf (p
, " %s", SDATA (slant
));
1761 q
[1] = toupper (q
[1]);
1765 p
+= sprintf (p
, " %d", point_size
);
1770 /* Parse NAME (null terminated) and store information in FONT
1771 (font-spec or font-entity). If NAME is successfully parsed, return
1772 0. Otherwise return -1. */
1775 font_parse_name (name
, font
)
1779 if (name
[0] == '-' || index (name
, '*'))
1780 return font_parse_xlfd (name
, font
);
1781 return font_parse_fcname (name
, font
);
1785 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1786 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1790 font_parse_family_registry (family
, registry
, font_spec
)
1791 Lisp_Object family
, registry
, font_spec
;
1797 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1799 CHECK_STRING (family
);
1800 len
= SBYTES (family
);
1801 p0
= (char *) SDATA (family
);
1802 p1
= index (p0
, '-');
1805 if ((*p0
!= '*' || p1
- p0
> 1)
1806 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1807 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1810 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1813 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1815 if (! NILP (registry
))
1817 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1818 CHECK_STRING (registry
);
1819 len
= SBYTES (registry
);
1820 p0
= (char *) SDATA (registry
);
1821 p1
= index (p0
, '-');
1824 if (SDATA (registry
)[len
- 1] == '*')
1825 registry
= concat2 (registry
, build_string ("-*"));
1827 registry
= concat2 (registry
, build_string ("*-*"));
1829 registry
= Fdowncase (registry
);
1830 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1835 /* This part (through the next ^L) is still experimental and not
1836 tested much. We may drastically change codes. */
1842 #define LGSTRING_HEADER_SIZE 6
1843 #define LGSTRING_GLYPH_SIZE 8
1846 check_gstring (gstring
)
1847 Lisp_Object gstring
;
1852 CHECK_VECTOR (gstring
);
1853 val
= AREF (gstring
, 0);
1855 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1857 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1858 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1859 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1860 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1861 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1862 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1863 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1864 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1865 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1866 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1867 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1869 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1871 val
= LGSTRING_GLYPH (gstring
, i
);
1873 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1875 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1877 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1878 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1879 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1880 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1881 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1882 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1883 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1884 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1886 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1888 if (ASIZE (val
) < 3)
1890 for (j
= 0; j
< 3; j
++)
1891 CHECK_NUMBER (AREF (val
, j
));
1896 error ("Invalid glyph-string format");
1901 check_otf_features (otf_features
)
1902 Lisp_Object otf_features
;
1906 CHECK_CONS (otf_features
);
1907 CHECK_SYMBOL (XCAR (otf_features
));
1908 otf_features
= XCDR (otf_features
);
1909 CHECK_CONS (otf_features
);
1910 CHECK_SYMBOL (XCAR (otf_features
));
1911 otf_features
= XCDR (otf_features
);
1912 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1914 CHECK_SYMBOL (Fcar (val
));
1915 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1916 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1918 otf_features
= XCDR (otf_features
);
1919 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1921 CHECK_SYMBOL (Fcar (val
));
1922 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1923 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1930 Lisp_Object otf_list
;
1933 otf_tag_symbol (tag
)
1938 OTF_tag_name (tag
, name
);
1939 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1946 Lisp_Object val
= Fassoc (file
, otf_list
);
1950 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1953 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1954 val
= make_save_value (otf
, 0);
1955 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1961 /* Return a list describing which scripts/languages FONT supports by
1962 which GSUB/GPOS features of OpenType tables. See the comment of
1963 (struct font_driver).otf_capability. */
1966 font_otf_capability (font
)
1970 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1973 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1976 for (i
= 0; i
< 2; i
++)
1978 OTF_GSUB_GPOS
*gsub_gpos
;
1979 Lisp_Object script_list
= Qnil
;
1982 if (OTF_get_features (otf
, i
== 0) < 0)
1984 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1985 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1987 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1988 Lisp_Object langsys_list
= Qnil
;
1989 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1992 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1994 OTF_LangSys
*langsys
;
1995 Lisp_Object feature_list
= Qnil
;
1996 Lisp_Object langsys_tag
;
1999 if (k
== script
->LangSysCount
)
2001 langsys
= &script
->DefaultLangSys
;
2006 langsys
= script
->LangSys
+ k
;
2008 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2010 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2012 OTF_Feature
*feature
2013 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2014 Lisp_Object feature_tag
2015 = otf_tag_symbol (feature
->FeatureTag
);
2017 feature_list
= Fcons (feature_tag
, feature_list
);
2019 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2022 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2027 XSETCAR (capability
, script_list
);
2029 XSETCDR (capability
, script_list
);
2035 /* Parse OTF features in SPEC and write a proper features spec string
2036 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2037 assured that the sufficient memory has already allocated for
2041 generate_otf_features (spec
, features
)
2051 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2057 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2062 else if (! asterisk
)
2064 val
= SYMBOL_NAME (val
);
2065 p
+= sprintf (p
, "%s", SDATA (val
));
2069 val
= SYMBOL_NAME (val
);
2070 p
+= sprintf (p
, "~%s", SDATA (val
));
2074 error ("OTF spec too long");
2078 font_otf_DeviceTable (device_table
)
2079 OTF_DeviceTable
*device_table
;
2081 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2083 return Fcons (make_number (len
),
2084 make_unibyte_string (device_table
->DeltaValue
, len
));
2088 font_otf_ValueRecord (value_format
, value_record
)
2090 OTF_ValueRecord
*value_record
;
2092 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2094 if (value_format
& OTF_XPlacement
)
2095 ASET (val
, 0, make_number (value_record
->XPlacement
));
2096 if (value_format
& OTF_YPlacement
)
2097 ASET (val
, 1, make_number (value_record
->YPlacement
));
2098 if (value_format
& OTF_XAdvance
)
2099 ASET (val
, 2, make_number (value_record
->XAdvance
));
2100 if (value_format
& OTF_YAdvance
)
2101 ASET (val
, 3, make_number (value_record
->YAdvance
));
2102 if (value_format
& OTF_XPlaDevice
)
2103 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2104 if (value_format
& OTF_YPlaDevice
)
2105 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2106 if (value_format
& OTF_XAdvDevice
)
2107 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2108 if (value_format
& OTF_YAdvDevice
)
2109 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2114 font_otf_Anchor (anchor
)
2119 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2120 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2121 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2122 if (anchor
->AnchorFormat
== 2)
2123 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2126 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2127 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2131 #endif /* HAVE_LIBOTF */
2134 /* G-string (glyph string) handler */
2136 /* G-string is a vector of the form [HEADER GLYPH ...].
2137 See the docstring of `font-make-gstring' for more detail. */
2140 font_prepare_composition (cmp
, f
)
2141 struct composition
*cmp
;
2145 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
2146 cmp
->hash_index
* 2);
2148 cmp
->font
= XFONT_OBJECT (LGSTRING_FONT (gstring
));
2149 cmp
->glyph_len
= LGSTRING_LENGTH (gstring
);
2150 cmp
->pixel_width
= LGSTRING_WIDTH (gstring
);
2151 cmp
->lbearing
= LGSTRING_LBEARING (gstring
);
2152 cmp
->rbearing
= LGSTRING_RBEARING (gstring
);
2153 cmp
->ascent
= LGSTRING_ASCENT (gstring
);
2154 cmp
->descent
= LGSTRING_DESCENT (gstring
);
2155 cmp
->width
= cmp
->pixel_width
/ FRAME_COLUMN_WIDTH (f
);
2156 if (cmp
->width
== 0)
2165 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2166 static int font_compare
P_ ((const void *, const void *));
2167 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
2170 /* We sort fonts by scoring each of them against a specified
2171 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2172 the value is, the closer the font is to the font-spec.
2174 The lowest 2 bits of the score is used for driver type. The font
2175 available by the most preferred font driver is 0.
2177 Each 7-bit in the higher 28 bits are used for numeric properties
2178 WEIGHT, SLANT, WIDTH, and SIZE. */
2180 /* How many bits to shift to store the difference value of each font
2181 property in a score. Note that flots for FONT_TYPE_INDEX and
2182 FONT_REGISTRY_INDEX are not used. */
2183 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2185 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2186 The return value indicates how different ENTITY is compared with
2189 ALTERNATE_FAMILIES, if non-nil, is a pre-calculated list of
2190 alternate family names for AREF (SPEC_PROP, FONT_FAMILY_INDEX). */
2193 font_score (entity
, spec_prop
)
2194 Lisp_Object entity
, *spec_prop
;
2199 /* Score three style numeric fields. Maximum difference is 127. */
2200 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2201 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2203 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2208 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2211 /* Score the size. Maximum difference is 127. */
2212 i
= FONT_SIZE_INDEX
;
2213 if (! NILP (spec_prop
[i
]) && XINT (AREF (entity
, i
)) > 0)
2215 /* We use the higher 6-bit for the actual size difference. The
2216 lowest bit is set if the DPI is different. */
2217 int diff
= XINT (spec_prop
[i
]) - XINT (AREF (entity
, i
));
2222 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2223 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2225 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2232 /* The comparison function for qsort. */
2235 font_compare (d1
, d2
)
2236 const void *d1
, *d2
;
2238 return (*(unsigned *) d1
- *(unsigned *) d2
);
2242 /* The structure for elements being sorted by qsort. */
2243 struct font_sort_data
2250 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2251 If PREFER specifies a point-size, calculate the corresponding
2252 pixel-size from QCdpi property of PREFER or from the Y-resolution
2253 of FRAME before sorting.
2255 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2256 return the sorted VEC. */
2259 font_sort_entites (vec
, prefer
, frame
, best_only
)
2260 Lisp_Object vec
, prefer
, frame
;
2263 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2265 struct font_sort_data
*data
;
2266 unsigned best_score
;
2267 Lisp_Object best_entity
, driver_type
;
2269 struct frame
*f
= XFRAME (frame
);
2270 struct font_driver_list
*list
;
2275 return best_only
? AREF (vec
, 0) : vec
;
2277 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_DPI_INDEX
; i
++)
2278 prefer_prop
[i
] = AREF (prefer
, i
);
2279 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2280 prefer_prop
[FONT_SIZE_INDEX
]
2281 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2283 /* Scoring and sorting. */
2284 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2285 best_score
= 0xFFFFFFFF;
2286 /* We are sure that the length of VEC > 1. */
2287 driver_type
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2288 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2289 driver_order
++, list
= list
->next
)
2290 if (EQ (driver_type
, list
->driver
->type
))
2292 best_entity
= data
[0].entity
= AREF (vec
, 0);
2293 best_score
= data
[0].score
2294 = font_score (data
[0].entity
, prefer_prop
) | driver_order
;
2295 for (i
= 0; i
< len
; i
++)
2297 if (!EQ (driver_type
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2298 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2299 driver_order
++, list
= list
->next
)
2300 if (EQ (driver_type
, list
->driver
->type
))
2302 data
[i
].entity
= AREF (vec
, i
);
2303 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
) | driver_order
;
2304 if (best_only
&& best_score
> data
[i
].score
)
2306 best_score
= data
[i
].score
;
2307 best_entity
= data
[i
].entity
;
2308 if (best_score
== 0)
2314 qsort (data
, len
, sizeof *data
, font_compare
);
2315 for (i
= 0; i
< len
; i
++)
2316 ASET (vec
, i
, data
[i
].entity
);
2322 font_add_log ("sort-by", prefer
, vec
);
2327 /* API of Font Service Layer. */
2329 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2330 sort_shift_bits. Finternal_set_font_selection_order calls this
2331 function with font_sort_order after setting up it. */
2334 font_update_sort_order (order
)
2339 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2341 int xlfd_idx
= order
[i
];
2343 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2344 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2345 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2346 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2347 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2348 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2350 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2355 /* Check if ENTITY matches with the font specification SPEC. */
2358 font_match_p (spec
, entity
)
2359 Lisp_Object spec
, entity
;
2361 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2362 Lisp_Object alternate_families
= Qnil
;
2365 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2366 prefer_prop
[i
] = AREF (spec
, i
);
2367 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2368 prefer_prop
[FONT_SIZE_INDEX
]
2369 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2370 if (! NILP (prefer_prop
[FONT_FAMILY_INDEX
]))
2373 = Fassoc_string (prefer_prop
[FONT_FAMILY_INDEX
],
2374 Vface_alternative_font_family_alist
, Qt
);
2375 if (CONSP (alternate_families
))
2376 alternate_families
= XCDR (alternate_families
);
2379 return (font_score (entity
, prefer_prop
) == 0);
2385 Each font backend has the callback function get_cache, and it
2386 returns a cons cell of which cdr part can be freely used for
2387 caching fonts. The cons cell may be shared by multiple frames
2388 and/or multiple font drivers. So, we arrange the cdr part as this:
2390 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2392 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2393 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2394 cons (FONT-SPEC FONT-ENTITY ...). */
2396 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2397 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2398 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2399 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2400 struct font_driver
*));
2403 font_prepare_cache (f
, driver
)
2405 struct font_driver
*driver
;
2407 Lisp_Object cache
, val
;
2409 cache
= driver
->get_cache (f
);
2411 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2415 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2416 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2420 val
= XCDR (XCAR (val
));
2421 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2427 font_finish_cache (f
, driver
)
2429 struct font_driver
*driver
;
2431 Lisp_Object cache
, val
, tmp
;
2434 cache
= driver
->get_cache (f
);
2436 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2437 cache
= val
, val
= XCDR (val
);
2438 font_assert (! NILP (val
));
2439 tmp
= XCDR (XCAR (val
));
2440 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2441 if (XINT (XCAR (tmp
)) == 0)
2443 font_clear_cache (f
, XCAR (val
), driver
);
2444 XSETCDR (cache
, XCDR (val
));
2450 font_get_cache (f
, driver
)
2452 struct font_driver
*driver
;
2454 Lisp_Object val
= driver
->get_cache (f
);
2455 Lisp_Object type
= driver
->type
;
2457 font_assert (CONSP (val
));
2458 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2459 font_assert (CONSP (val
));
2460 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2461 val
= XCDR (XCAR (val
));
2465 static int num_fonts
;
2468 font_clear_cache (f
, cache
, driver
)
2471 struct font_driver
*driver
;
2473 Lisp_Object tail
, elt
;
2475 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2476 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2479 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)) && VECTORP (XCDR (elt
)))
2481 Lisp_Object vec
= XCDR (elt
);
2484 for (i
= 0; i
< ASIZE (vec
); i
++)
2486 Lisp_Object entity
= AREF (vec
, i
);
2488 if (EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2490 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2492 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2494 Lisp_Object val
= XCAR (objlist
);
2495 struct font
*font
= XFONT_OBJECT (val
);
2497 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2499 font_assert (font
&& driver
== font
->driver
);
2500 driver
->close (f
, font
);
2504 if (driver
->free_entity
)
2505 driver
->free_entity (entity
);
2510 XSETCDR (cache
, Qnil
);
2514 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2517 font_delete_unmatched (list
, spec
, size
)
2518 Lisp_Object list
, spec
;
2521 Lisp_Object entity
, val
;
2522 enum font_property_index prop
;
2524 for (val
= Qnil
; CONSP (list
); list
= XCDR (list
))
2526 entity
= XCAR (list
);
2527 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2528 if (INTEGERP (AREF (spec
, prop
))
2529 && ((XINT (AREF (spec
, prop
)) >> 8)
2530 != (XINT (AREF (entity
, prop
)) >> 8)))
2531 prop
= FONT_SPEC_MAX
;
2532 if (prop
< FONT_SPEC_MAX
2534 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2536 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2539 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2540 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2541 prop
= FONT_SPEC_MAX
;
2543 if (prop
< FONT_SPEC_MAX
2544 && INTEGERP (AREF (spec
, FONT_DPI_INDEX
))
2545 && INTEGERP (AREF (entity
, FONT_DPI_INDEX
))
2546 && ! EQ (AREF (spec
, FONT_DPI_INDEX
), AREF (entity
, FONT_DPI_INDEX
)))
2547 prop
= FONT_SPEC_MAX
;
2548 if (prop
< FONT_SPEC_MAX
2549 && INTEGERP (AREF (spec
, FONT_AVGWIDTH_INDEX
))
2550 && INTEGERP (AREF (entity
, FONT_AVGWIDTH_INDEX
))
2551 && ! EQ (AREF (spec
, FONT_AVGWIDTH_INDEX
),
2552 AREF (entity
, FONT_AVGWIDTH_INDEX
)))
2553 prop
= FONT_SPEC_MAX
;
2554 if (prop
< FONT_SPEC_MAX
)
2555 val
= Fcons (entity
, val
);
2561 /* Return a vector of font-entities matching with SPEC on FRAME. */
2564 font_list_entities (frame
, spec
)
2565 Lisp_Object frame
, spec
;
2567 FRAME_PTR f
= XFRAME (frame
);
2568 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2569 Lisp_Object ftype
, val
;
2572 int need_filtering
= 0;
2575 font_assert (FONT_SPEC_P (spec
));
2577 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2578 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2579 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2580 size
= font_pixel_size (f
, spec
);
2584 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2585 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2586 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2587 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2589 ASET (scratch_font_spec
, i
, Qnil
);
2590 if (! NILP (AREF (spec
, i
)))
2592 if (i
== FONT_DPI_INDEX
)
2593 /* Skip FONT_SPACING_INDEX */
2596 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2597 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2599 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2603 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2605 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2607 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2609 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2610 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2617 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2618 copy
= Fcopy_font_spec (scratch_font_spec
);
2619 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2620 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2622 if (! NILP (val
) && need_filtering
)
2623 val
= font_delete_unmatched (val
, spec
, size
);
2628 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2629 font_add_log ("list", spec
, val
);
2634 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2635 nil, is an array of face's attributes, which specifies preferred
2636 font-related attributes. */
2639 font_matching_entity (f
, attrs
, spec
)
2641 Lisp_Object
*attrs
, spec
;
2643 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2644 Lisp_Object ftype
, size
, entity
;
2647 XSETFRAME (frame
, f
);
2648 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2649 size
= AREF (spec
, FONT_SIZE_INDEX
);
2651 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2653 for (; driver_list
; driver_list
= driver_list
->next
)
2655 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2657 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2660 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2661 entity
= assoc_no_quit (spec
, XCDR (cache
));
2663 entity
= XCDR (entity
);
2666 entity
= driver_list
->driver
->match (frame
, spec
);
2667 copy
= Fcopy_font_spec (spec
);
2668 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2669 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2671 if (! NILP (entity
))
2674 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2675 ASET (spec
, FONT_SIZE_INDEX
, size
);
2676 font_add_log ("match", spec
, entity
);
2681 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2682 opened font object. */
2685 font_open_entity (f
, entity
, pixel_size
)
2690 struct font_driver_list
*driver_list
;
2691 Lisp_Object objlist
, size
, val
, font_object
;
2693 int min_width
, height
;
2695 font_assert (FONT_ENTITY_P (entity
));
2696 size
= AREF (entity
, FONT_SIZE_INDEX
);
2697 if (XINT (size
) != 0)
2698 pixel_size
= XINT (size
);
2700 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2701 objlist
= XCDR (objlist
))
2702 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2703 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2704 return XCAR (objlist
);
2706 val
= AREF (entity
, FONT_TYPE_INDEX
);
2707 for (driver_list
= f
->font_driver_list
;
2708 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2709 driver_list
= driver_list
->next
);
2713 font_object
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2714 font_add_log ("open", entity
, font_object
);
2715 if (NILP (font_object
))
2717 ASET (entity
, FONT_OBJLIST_INDEX
,
2718 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2719 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
2722 font
= XFONT_OBJECT (font_object
);
2723 min_width
= (font
->min_width
? font
->min_width
2724 : font
->average_width
? font
->average_width
2725 : font
->space_width
? font
->space_width
2727 height
= (font
->height
? font
->height
: 1);
2728 #ifdef HAVE_WINDOW_SYSTEM
2729 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2730 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2732 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2733 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
;
2734 fonts_changed_p
= 1;
2738 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2739 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2740 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > height
)
2741 FRAME_SMALLEST_FONT_HEIGHT (f
) = height
, fonts_changed_p
= 1;
2749 /* Close FONT_OBJECT that is opened on frame F. */
2752 font_close_object (f
, font_object
)
2754 Lisp_Object font_object
;
2756 struct font
*font
= XFONT_OBJECT (font_object
);
2758 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2759 /* Already closed. */
2761 font_add_log ("close", font_object
, Qnil
);
2762 font
->driver
->close (f
, font
);
2763 #ifdef HAVE_WINDOW_SYSTEM
2764 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2765 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2771 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2772 FONT is a font-entity and it must be opened to check. */
2775 font_has_char (f
, font
, c
)
2782 if (FONT_ENTITY_P (font
))
2784 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2785 struct font_driver_list
*driver_list
;
2787 for (driver_list
= f
->font_driver_list
;
2788 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2789 driver_list
= driver_list
->next
);
2792 if (! driver_list
->driver
->has_char
)
2794 return driver_list
->driver
->has_char (font
, c
);
2797 font_assert (FONT_OBJECT_P (font
));
2798 fontp
= XFONT_OBJECT (font
);
2799 if (fontp
->driver
->has_char
)
2801 int result
= fontp
->driver
->has_char (font
, c
);
2806 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2810 /* Return the glyph ID of FONT_OBJECT for character C. */
2813 font_encode_char (font_object
, c
)
2814 Lisp_Object font_object
;
2819 font_assert (FONT_OBJECT_P (font_object
));
2820 font
= XFONT_OBJECT (font_object
);
2821 return font
->driver
->encode_char (font
, c
);
2825 /* Return the name of FONT_OBJECT. */
2828 font_get_name (font_object
)
2829 Lisp_Object font_object
;
2831 font_assert (FONT_OBJECT_P (font_object
));
2832 return AREF (font_object
, FONT_NAME_INDEX
);
2836 /* Return the specification of FONT_OBJECT. */
2839 font_get_spec (font_object
)
2840 Lisp_Object font_object
;
2842 Lisp_Object spec
= font_make_spec ();
2845 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2846 ASET (spec
, i
, AREF (font_object
, i
));
2847 ASET (spec
, FONT_SIZE_INDEX
,
2848 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2853 font_spec_from_name (font_name
)
2854 Lisp_Object font_name
;
2856 Lisp_Object args
[2];
2859 args
[1] = font_name
;
2860 return Ffont_spec (2, args
);
2865 font_clear_prop (attrs
, prop
)
2867 enum font_property_index prop
;
2869 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2873 if (NILP (AREF (font
, prop
))
2874 && prop
!= FONT_FAMILY_INDEX
&& prop
!= FONT_FOUNDRY_INDEX
2875 && prop
!= FONT_SIZE_INDEX
)
2877 font
= Fcopy_font_spec (font
);
2878 ASET (font
, prop
, Qnil
);
2879 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
2881 if (prop
== FONT_FAMILY_INDEX
)
2882 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
2883 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
2884 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
2885 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
2886 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2887 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2888 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2890 else if (prop
== FONT_SIZE_INDEX
)
2892 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2893 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2894 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2896 attrs
[LFACE_FONT_INDEX
] = font
;
2900 font_update_lface (f
, attrs
)
2906 spec
= attrs
[LFACE_FONT_INDEX
];
2907 if (! FONT_SPEC_P (spec
))
2910 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
2911 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
2912 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2913 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
2914 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
2915 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
2916 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
2917 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);;
2918 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
2919 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
2920 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
2924 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2929 val
= Ffont_get (spec
, QCdpi
);
2932 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
2935 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2936 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
2937 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
2942 /* Return a font-entity satisfying SPEC and best matching with face's
2943 font related attributes in ATTRS. C, if not negative, is a
2944 character that the entity must support. */
2947 font_find_for_lface (f
, attrs
, spec
, c
)
2954 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
2955 Lisp_Object size
, foundry
[3], *family
, registry
[3], adstyle
[3];
2957 int i
, j
, k
, l
, result
;
2959 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
2960 if (NILP (registry
[0]))
2962 registry
[0] = Qiso8859_1
;
2963 registry
[1] = Qascii_0
;
2964 registry
[2] = null_vector
;
2967 registry
[1] = null_vector
;
2969 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
2971 struct charset
*encoding
, *repertory
;
2973 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
2974 &encoding
, &repertory
) < 0)
2978 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
2980 /* Any font of this registry support C. So, let's
2981 suppress the further checking. */
2984 else if (c
> encoding
->max_char
)
2988 work
= Fcopy_font_spec (spec
);
2989 XSETFRAME (frame
, f
);
2990 size
= AREF (spec
, FONT_SIZE_INDEX
);
2991 pixel_size
= font_pixel_size (f
, spec
);
2992 if (pixel_size
== 0)
2994 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
2996 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
2998 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
2999 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3000 if (! NILP (foundry
[0]))
3001 foundry
[1] = null_vector
;
3002 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3004 foundry
[0] = font_intern_prop (SDATA (attrs
[LFACE_FOUNDRY_INDEX
]),
3005 SBYTES (attrs
[LFACE_FOUNDRY_INDEX
]), 1);
3007 foundry
[2] = null_vector
;
3010 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3012 adstyle
[0] = AREF (work
, FONT_ADSTYLE_INDEX
);
3013 if (! NILP (adstyle
[0]))
3014 adstyle
[1] = null_vector
;
3015 else if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3017 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3019 if (! NILP (AREF (face_font
, FONT_ADSTYLE_INDEX
)))
3021 adstyle
[0] = AREF (face_font
, FONT_ADSTYLE_INDEX
);
3023 adstyle
[2] = null_vector
;
3026 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3029 adstyle
[0] = Qnil
, adstyle
[1] = null_vector
;
3032 val
= AREF (work
, FONT_FAMILY_INDEX
);
3033 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3034 val
= font_intern_prop (SDATA (attrs
[LFACE_FAMILY_INDEX
]),
3035 SBYTES (attrs
[LFACE_FAMILY_INDEX
]), 1);
3038 family
= alloca ((sizeof family
[0]) * 2);
3040 family
[1] = null_vector
; /* terminator. */
3045 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3047 if (! NILP (alters
))
3049 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3050 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3051 family
[i
] = XCAR (alters
);
3052 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3054 family
[i
] = null_vector
;
3058 family
= alloca ((sizeof family
[0]) * 3);
3061 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3063 family
[i
] = null_vector
;
3067 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3069 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3070 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3072 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3073 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3075 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3076 for (l
= 0; SYMBOLP (adstyle
[l
]); l
++)
3078 ASET (work
, FONT_ADSTYLE_INDEX
, adstyle
[l
]);
3079 entities
= font_list_entities (frame
, work
);
3080 if (ASIZE (entities
) > 0)
3088 if (ASIZE (entities
) == 1)
3091 return AREF (entities
, 0);
3095 /* Sort fonts by properties specified in LFACE. */
3096 Lisp_Object prefer
= scratch_font_prefer
;
3098 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3099 ASET (prefer
, i
, AREF (work
, i
));
3100 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3102 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3104 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3105 if (NILP (AREF (prefer
, i
)))
3106 ASET (prefer
, i
, AREF (face_font
, i
));
3108 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3109 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3110 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3111 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3112 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3113 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3114 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3115 entities
= font_sort_entites (entities
, prefer
, frame
, c
< 0);
3120 for (i
= 0; i
< ASIZE (entities
); i
++)
3124 val
= AREF (entities
, i
);
3127 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3128 if (! EQ (AREF (val
, j
), props
[j
]))
3130 if (j
> FONT_REGISTRY_INDEX
)
3133 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3134 props
[j
] = AREF (val
, j
);
3135 result
= font_has_char (f
, val
, c
);
3140 val
= font_open_for_lface (f
, val
, attrs
, spec
);
3143 result
= font_has_char (f
, val
, c
);
3144 font_close_object (f
, val
);
3146 return AREF (entities
, i
);
3153 font_open_for_lface (f
, entity
, attrs
, spec
)
3161 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3162 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3163 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3164 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3165 size
= font_pixel_size (f
, spec
);
3168 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3171 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3173 return font_open_entity (f
, entity
, size
);
3177 /* Find a font satisfying SPEC and best matching with face's
3178 attributes in ATTRS on FRAME, and return the opened
3182 font_load_for_lface (f
, attrs
, spec
)
3184 Lisp_Object
*attrs
, spec
;
3188 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3191 /* No font is listed for SPEC, but each font-backend may have
3192 the different criteria about "font matching". So, try
3194 entity
= font_matching_entity (f
, attrs
, spec
);
3198 return font_open_for_lface (f
, entity
, attrs
, spec
);
3202 /* Make FACE on frame F ready to use the font opened for FACE. */
3205 font_prepare_for_face (f
, face
)
3209 if (face
->font
->driver
->prepare_face
)
3210 face
->font
->driver
->prepare_face (f
, face
);
3214 /* Make FACE on frame F stop using the font opened for FACE. */
3217 font_done_for_face (f
, face
)
3221 if (face
->font
->driver
->done_face
)
3222 face
->font
->driver
->done_face (f
, face
);
3227 /* Open a font best matching with NAME on frame F. If no proper font
3228 is found, return Qnil. */
3231 font_open_by_name (f
, name
)
3235 Lisp_Object args
[2];
3236 Lisp_Object spec
, attrs
[LFACE_VECTOR_SIZE
];
3239 args
[1] = make_unibyte_string (name
, strlen (name
));
3240 spec
= Ffont_spec (2, args
);
3241 /* We set up the default font-related attributes of a face to prefer
3243 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3244 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3245 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3246 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3247 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3249 return font_load_for_lface (f
, attrs
, spec
);
3253 /* Register font-driver DRIVER. This function is used in two ways.
3255 The first is with frame F non-NULL. In this case, make DRIVER
3256 available (but not yet activated) on F. All frame creaters
3257 (e.g. Fx_create_frame) must call this function at least once with
3258 an available font-driver.
3260 The second is with frame F NULL. In this case, DRIVER is globally
3261 registered in the variable `font_driver_list'. All font-driver
3262 implementations must call this function in its syms_of_XXXX
3263 (e.g. syms_of_xfont). */
3266 register_font_driver (driver
, f
)
3267 struct font_driver
*driver
;
3270 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3271 struct font_driver_list
*prev
, *list
;
3273 if (f
&& ! driver
->draw
)
3274 error ("Unusable font driver for a frame: %s",
3275 SDATA (SYMBOL_NAME (driver
->type
)));
3277 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3278 if (EQ (list
->driver
->type
, driver
->type
))
3279 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3281 list
= malloc (sizeof (struct font_driver_list
));
3283 list
->driver
= driver
;
3288 f
->font_driver_list
= list
;
3290 font_driver_list
= list
;
3296 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3297 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3298 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3300 A caller must free all realized faces if any in advance. The
3301 return value is a list of font backends actually made used on
3305 font_update_drivers (f
, new_drivers
)
3307 Lisp_Object new_drivers
;
3309 Lisp_Object active_drivers
= Qnil
;
3310 struct font_driver
*driver
;
3311 struct font_driver_list
*list
;
3313 /* At first, turn off non-requested drivers, and turn on requested
3315 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3317 driver
= list
->driver
;
3318 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3323 if (driver
->end_for_frame
)
3324 driver
->end_for_frame (f
);
3325 font_finish_cache (f
, driver
);
3330 if (! driver
->start_for_frame
3331 || driver
->start_for_frame (f
) == 0)
3333 font_prepare_cache (f
, driver
);
3340 if (NILP (new_drivers
))
3343 if (! EQ (new_drivers
, Qt
))
3345 /* Re-order the driver list according to new_drivers. */
3346 struct font_driver_list
**list_table
, **next
;
3350 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3351 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3353 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3354 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3357 list_table
[i
++] = list
;
3359 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3361 list_table
[i
] = list
;
3362 list_table
[i
] = NULL
;
3364 next
= &f
->font_driver_list
;
3365 for (i
= 0; list_table
[i
]; i
++)
3367 *next
= list_table
[i
];
3368 next
= &(*next
)->next
;
3373 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3375 active_drivers
= nconc2 (active_drivers
,
3376 Fcons (list
->driver
->type
, Qnil
));
3377 return active_drivers
;
3381 font_put_frame_data (f
, driver
, data
)
3383 struct font_driver
*driver
;
3386 struct font_data_list
*list
, *prev
;
3388 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3389 prev
= list
, list
= list
->next
)
3390 if (list
->driver
== driver
)
3397 prev
->next
= list
->next
;
3399 f
->font_data_list
= list
->next
;
3407 list
= malloc (sizeof (struct font_data_list
));
3410 list
->driver
= driver
;
3411 list
->next
= f
->font_data_list
;
3412 f
->font_data_list
= list
;
3420 font_get_frame_data (f
, driver
)
3422 struct font_driver
*driver
;
3424 struct font_data_list
*list
;
3426 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3427 if (list
->driver
== driver
)
3435 /* Return the font used to draw character C by FACE at buffer position
3436 POS in window W. If STRING is non-nil, it is a string containing C
3437 at index POS. If C is negative, get C from the current buffer or
3441 font_at (c
, pos
, face
, w
, string
)
3450 Lisp_Object font_object
;
3456 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3459 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3461 c
= FETCH_CHAR (pos_byte
);
3464 c
= FETCH_BYTE (pos
);
3470 multibyte
= STRING_MULTIBYTE (string
);
3473 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3475 str
= SDATA (string
) + pos_byte
;
3476 c
= STRING_CHAR (str
, 0);
3479 c
= SDATA (string
)[pos
];
3483 f
= XFRAME (w
->frame
);
3484 if (! FRAME_WINDOW_P (f
))
3491 if (STRINGP (string
))
3492 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3493 DEFAULT_FACE_ID
, 0);
3495 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3497 face
= FACE_FROM_ID (f
, face_id
);
3501 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3502 face
= FACE_FROM_ID (f
, face_id
);
3507 XSETFONT (font_object
, face
->font
);
3512 /* Check how many characters after POS (at most to LIMIT) can be
3513 displayed by the same font. FACE is the face selected for the
3514 character as POS on frame F. STRING, if not nil, is the string to
3515 check instead of the current buffer.
3517 The return value is the position of the character that is displayed
3518 by the differnt font than that of the character as POS. */
3521 font_range (pos
, limit
, face
, f
, string
)
3522 EMACS_INT pos
, limit
;
3535 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3536 pos_byte
= CHAR_TO_BYTE (pos
);
3540 multibyte
= STRING_MULTIBYTE (string
);
3541 pos_byte
= string_char_to_byte (string
, pos
);
3545 /* All unibyte character are displayed by the same font. */
3553 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3555 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3556 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3557 face
= FACE_FROM_ID (f
, face_id
);
3564 else if (font
!= face
->font
)
3576 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3577 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3578 Return nil otherwise.
3579 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3580 which kind of font it is. It must be one of `font-spec', `font-entity',
3582 (object
, extra_type
)
3583 Lisp_Object object
, extra_type
;
3585 if (NILP (extra_type
))
3586 return (FONTP (object
) ? Qt
: Qnil
);
3587 if (EQ (extra_type
, Qfont_spec
))
3588 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3589 if (EQ (extra_type
, Qfont_entity
))
3590 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3591 if (EQ (extra_type
, Qfont_object
))
3592 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3593 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3596 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3597 doc
: /* Return a newly created font-spec with arguments as properties.
3599 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3600 valid font property name listed below:
3602 `:family', `:weight', `:slant', `:width'
3604 They are the same as face attributes of the same name. See
3605 `set-face-attribute'.
3609 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3613 VALUE must be a string or a symbol specifying the additional
3614 typographic style information of a font, e.g. ``sans''.
3618 VALUE must be a string or a symbol specifying the charset registry and
3619 encoding of a font, e.g. ``iso8859-1''.
3623 VALUE must be a non-negative integer or a floating point number
3624 specifying the font size. It specifies the font size in pixels
3625 (if VALUE is an integer), or in points (if VALUE is a float).
3629 VALUE must be a string of XLFD-style or fontconfig-style font name.
3630 usage: (font-spec ARGS ...) */)
3635 Lisp_Object spec
= font_make_spec ();
3638 for (i
= 0; i
< nargs
; i
+= 2)
3640 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3642 if (EQ (key
, QCname
))
3645 font_parse_name ((char *) SDATA (val
), spec
);
3646 font_put_extra (spec
, key
, val
);
3650 int idx
= get_font_prop_index (key
);
3654 val
= font_prop_validate (idx
, Qnil
, val
);
3655 if (idx
< FONT_EXTRA_INDEX
)
3656 ASET (spec
, idx
, val
);
3658 font_put_extra (spec
, key
, val
);
3661 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3667 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3668 doc
: /* Return a copy of FONT as a font-spec. */)
3672 Lisp_Object new_spec
, tail
, prev
, extra
;
3676 new_spec
= font_make_spec ();
3677 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3678 ASET (new_spec
, i
, AREF (font
, i
));
3679 extra
= Fcopy_sequence (AREF (font
, FONT_EXTRA_INDEX
));
3680 /* We must remove :font-entity property. */
3681 for (prev
= Qnil
, tail
= extra
; CONSP (tail
); prev
= tail
, tail
= XCDR (tail
))
3682 if (EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3685 extra
= XCDR (extra
);
3687 XSETCDR (prev
, XCDR (tail
));
3690 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3694 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3695 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3696 Every specified properties in FROM override the corresponding
3697 properties in TO. */)
3699 Lisp_Object from
, to
;
3701 Lisp_Object extra
, tail
;
3706 to
= Fcopy_font_spec (to
);
3707 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3708 ASET (to
, i
, AREF (from
, i
));
3709 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3710 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3711 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3713 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3716 XSETCDR (slot
, XCDR (XCAR (tail
)));
3718 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3720 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3724 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3725 doc
: /* Return the value of FONT's property KEY.
3726 FONT is a font-spec, a font-entity, or a font-object. */)
3728 Lisp_Object font
, key
;
3735 idx
= get_font_prop_index (key
);
3736 if (idx
>= FONT_WEIGHT_INDEX
&& idx
<= FONT_WIDTH_INDEX
)
3737 return font_style_symbolic (font
, idx
, 0);
3738 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3739 return AREF (font
, idx
);
3740 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3743 #ifdef HAVE_WINDOW_SYSTEM
3745 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3746 doc
: /* Return a plist of face attributes generated by FONT.
3747 FONT is a font name, a font-spec, a font-entity, or a font-object.
3748 The return value is a list of the form
3750 \(:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3752 where FAMILY, HEIGHT, WEIGHT, SLANT, and WIDTH are face attribute values
3753 compatible with `set-face-attribute'. Some of these key-attribute pairs
3754 may be omitted from the list if they are not specified by FONT.
3756 The optional argument FRAME specifies the frame that the face attributes
3757 are to be displayed on. If omitted, the selected frame is used. */)
3759 Lisp_Object font
, frame
;
3762 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 val
= AREF (font
, FONT_FAMILY_INDEX
);
3787 plist
[n
++] = QCfamily
;
3788 plist
[n
++] = SYMBOL_NAME (val
);
3791 val
= AREF (font
, FONT_SIZE_INDEX
);
3794 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
3795 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
3796 plist
[n
++] = QCheight
;
3797 plist
[n
++] = make_number (PIXEL_TO_POINT (XINT (val
) * 10, dpi
));
3799 else if (FLOATP (val
))
3801 plist
[n
++] = QCheight
;
3802 plist
[n
++] = make_number (10 * (int) XFLOAT_DATA (val
));
3805 val
= FONT_WEIGHT_FOR_FACE (font
);
3808 plist
[n
++] = QCweight
;
3812 val
= FONT_SLANT_FOR_FACE (font
);
3815 plist
[n
++] = QCslant
;
3819 val
= FONT_WIDTH_FOR_FACE (font
);
3822 plist
[n
++] = QCwidth
;
3826 return Flist (n
, plist
);
3831 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3832 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
3833 (font_spec
, prop
, val
)
3834 Lisp_Object font_spec
, prop
, val
;
3838 CHECK_FONT_SPEC (font_spec
);
3839 idx
= get_font_prop_index (prop
);
3840 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3841 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
3843 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
3847 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3848 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3849 Optional 2nd argument FRAME specifies the target frame.
3850 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3851 Optional 4th argument PREFER, if non-nil, is a font-spec to
3852 control the order of the returned list. Fonts are sorted by
3853 how close they are to PREFER. */)
3854 (font_spec
, frame
, num
, prefer
)
3855 Lisp_Object font_spec
, frame
, num
, prefer
;
3857 Lisp_Object vec
, list
, tail
;
3861 frame
= selected_frame
;
3862 CHECK_LIVE_FRAME (frame
);
3863 CHECK_FONT_SPEC (font_spec
);
3871 if (! NILP (prefer
))
3872 CHECK_FONT_SPEC (prefer
);
3874 vec
= font_list_entities (frame
, font_spec
);
3879 return Fcons (AREF (vec
, 0), Qnil
);
3881 if (! NILP (prefer
))
3882 vec
= font_sort_entites (vec
, prefer
, frame
, 0);
3884 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3885 if (n
== 0 || n
> len
)
3887 for (i
= 1; i
< n
; i
++)
3889 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3891 XSETCDR (tail
, val
);
3897 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
3898 doc
: /* List available font families on the current frame.
3899 Optional argument FRAME, if non-nil, specifies the target frame. */)
3904 struct font_driver_list
*driver_list
;
3908 frame
= selected_frame
;
3909 CHECK_LIVE_FRAME (frame
);
3912 for (driver_list
= f
->font_driver_list
; driver_list
;
3913 driver_list
= driver_list
->next
)
3914 if (driver_list
->driver
->list_family
)
3916 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3922 Lisp_Object tail
= list
;
3924 for (; CONSP (val
); val
= XCDR (val
))
3925 if (NILP (Fmemq (XCAR (val
), tail
)))
3926 list
= Fcons (XCAR (val
), list
);
3932 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3933 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3934 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3936 Lisp_Object font_spec
, frame
;
3938 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3945 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
3946 doc
: /* Return XLFD name of FONT.
3947 FONT is a font-spec, font-entity, or font-object.
3948 If the name is too long for XLFD (maximum 255 chars), return nil.
3949 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
3950 the consecutive wildcards are folded to one. */)
3951 (font
, fold_wildcards
)
3952 Lisp_Object font
, fold_wildcards
;
3959 if (FONT_OBJECT_P (font
))
3961 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
3963 if (STRINGP (font_name
)
3964 && SDATA (font_name
)[0] == '-')
3966 if (NILP (fold_wildcards
))
3968 strcpy (name
, (char *) SDATA (font_name
));
3971 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
3973 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3976 if (! NILP (fold_wildcards
))
3978 char *p0
= name
, *p1
;
3980 while ((p1
= strstr (p0
, "-*-*")))
3982 strcpy (p1
, p1
+ 2);
3987 return build_string (name
);
3990 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3991 doc
: /* Clear font cache. */)
3994 Lisp_Object list
, frame
;
3996 FOR_EACH_FRAME (list
, frame
)
3998 FRAME_PTR f
= XFRAME (frame
);
3999 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4001 for (; driver_list
; driver_list
= driver_list
->next
)
4002 if (driver_list
->on
)
4004 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4009 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4011 font_assert (! NILP (val
));
4012 val
= XCDR (XCAR (val
));
4013 if (XINT (XCAR (val
)) == 0)
4015 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4016 XSETCDR (cache
, XCDR (val
));
4024 /* The following three functions are still experimental. */
4026 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
4027 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
4028 FONT-OBJECT may be nil if it is not yet known.
4030 G-string is sequence of glyphs of a specific font,
4031 and is a vector of this form:
4032 [ HEADER GLYPH ... ]
4033 HEADER is a vector of this form:
4034 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
4036 FONT-OBJECT is a font-object for all glyphs in the g-string,
4037 WIDTH thru DESCENT are the metrics (in pixels) of the whole G-string.
4038 GLYPH is a vector of this form:
4039 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
4040 [ [X-OFF Y-OFF WADJUST] | nil] ]
4042 FROM-IDX and TO-IDX are used internally and should not be touched.
4043 C is the character of the glyph.
4044 CODE is the glyph-code of C in FONT-OBJECT.
4045 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4046 X-OFF and Y-OFF are offests to the base position for the glyph.
4047 WADJUST is the adjustment to the normal width of the glyph. */)
4049 Lisp_Object font_object
, num
;
4051 Lisp_Object gstring
, g
;
4055 if (! NILP (font_object
))
4056 CHECK_FONT_OBJECT (font_object
);
4059 len
= XINT (num
) + 1;
4060 gstring
= Fmake_vector (make_number (len
), Qnil
);
4061 g
= Fmake_vector (make_number (6), Qnil
);
4062 ASET (g
, 0, font_object
);
4063 ASET (gstring
, 0, g
);
4064 for (i
= 1; i
< len
; i
++)
4065 ASET (gstring
, i
, Fmake_vector (make_number (10), Qnil
));
4069 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
4070 doc
: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
4071 START and END specify the region to extract characters.
4072 If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
4073 where to extract characters.
4074 FONT-OBJECT may be nil if GSTRING already contains one. */)
4075 (gstring
, font_object
, start
, end
, object
)
4076 Lisp_Object gstring
, font_object
, start
, end
, object
;
4082 CHECK_VECTOR (gstring
);
4083 if (NILP (font_object
))
4084 font_object
= LGSTRING_FONT (gstring
);
4085 font
= XFONT_OBJECT (font_object
);
4087 if (STRINGP (object
))
4089 const unsigned char *p
;
4091 CHECK_NATNUM (start
);
4093 if (XINT (start
) > XINT (end
)
4094 || XINT (end
) > ASIZE (object
)
4095 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
4096 args_out_of_range_3 (object
, start
, end
);
4098 len
= XINT (end
) - XINT (start
);
4099 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
4100 for (i
= 0; i
< len
; i
++)
4102 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4103 /* Shut up GCC warning in comparison with
4104 MOST_POSITIVE_FIXNUM below. */
4107 c
= STRING_CHAR_ADVANCE (p
);
4108 cod
= code
= font
->driver
->encode_char (font
, c
);
4109 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
4111 LGLYPH_SET_FROM (g
, i
);
4112 LGLYPH_SET_TO (g
, i
);
4113 LGLYPH_SET_CHAR (g
, c
);
4114 LGLYPH_SET_CODE (g
, code
);
4121 if (! NILP (object
))
4122 Fset_buffer (object
);
4123 validate_region (&start
, &end
);
4124 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
4125 args_out_of_range (start
, end
);
4126 len
= XINT (end
) - XINT (start
);
4128 pos_byte
= CHAR_TO_BYTE (pos
);
4129 for (i
= 0; i
< len
; i
++)
4131 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4132 /* Shut up GCC warning in comparison with
4133 MOST_POSITIVE_FIXNUM below. */
4136 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
4137 cod
= code
= font
->driver
->encode_char (font
, c
);
4138 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
4140 LGLYPH_SET_FROM (g
, i
);
4141 LGLYPH_SET_TO (g
, i
);
4142 LGLYPH_SET_CHAR (g
, c
);
4143 LGLYPH_SET_CODE (g
, code
);
4146 for (; i
< LGSTRING_LENGTH (gstring
); i
++)
4147 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
4151 DEFUN ("font-shape-text", Ffont_shape_text
, Sfont_shape_text
, 3, 4, 0,
4152 doc
: /* Shape text between FROM and TO by FONT-OBJECT.
4153 If optional 4th argument STRING is non-nil, it is a string to shape,
4154 and FROM and TO are indices to the string.
4155 The value is the end position of the text that can be shaped by
4157 (from
, to
, font_object
, string
)
4158 Lisp_Object from
, to
, font_object
, string
;
4161 struct font_metrics metrics
;
4162 EMACS_INT start
, end
;
4163 Lisp_Object gstring
, n
;
4166 if (! FONT_OBJECT_P (font_object
))
4168 font
= XFONT_OBJECT (font_object
);
4169 if (! font
->driver
->shape
)
4174 validate_region (&from
, &to
);
4175 start
= XFASTINT (from
);
4176 end
= XFASTINT (to
);
4177 modify_region (current_buffer
, start
, end
, 0);
4181 CHECK_STRING (string
);
4182 start
= XINT (from
);
4184 if (start
< 0 || start
> end
|| end
> SCHARS (string
))
4185 args_out_of_range_3 (string
, from
, to
);
4189 gstring
= Ffont_make_gstring (font_object
, make_number (len
));
4190 Ffont_fill_gstring (gstring
, font_object
, from
, to
, string
);
4192 /* Try at most three times with larger gstring each time. */
4193 for (i
= 0; i
< 3; i
++)
4195 Lisp_Object args
[2];
4197 n
= font
->driver
->shape (gstring
);
4201 args
[1] = Fmake_vector (make_number (len
), Qnil
);
4202 gstring
= Fvconcat (2, args
);
4204 if (! INTEGERP (n
) || XINT (n
) == 0)
4208 for (i
= 0; i
< len
;)
4211 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4212 EMACS_INT this_from
= LGLYPH_FROM (g
);
4213 EMACS_INT this_to
= LGLYPH_TO (g
) + 1;
4215 int need_composition
= 0;
4217 metrics
.lbearing
= LGLYPH_LBEARING (g
);
4218 metrics
.rbearing
= LGLYPH_RBEARING (g
);
4219 metrics
.ascent
= LGLYPH_ASCENT (g
);
4220 metrics
.descent
= LGLYPH_DESCENT (g
);
4221 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4223 metrics
.width
= LGLYPH_WIDTH (g
);
4224 if (LGLYPH_CHAR (g
) == 0 || metrics
.width
== 0)
4225 need_composition
= 1;
4229 metrics
.width
= LGLYPH_WADJUST (g
);
4230 metrics
.lbearing
+= LGLYPH_XOFF (g
);
4231 metrics
.rbearing
+= LGLYPH_XOFF (g
);
4232 metrics
.ascent
-= LGLYPH_YOFF (g
);
4233 metrics
.descent
+= LGLYPH_YOFF (g
);
4234 need_composition
= 1;
4236 for (j
= i
+ 1; j
< len
; j
++)
4240 g
= LGSTRING_GLYPH (gstring
, j
);
4241 if (this_from
!= LGLYPH_FROM (g
))
4243 need_composition
= 1;
4244 x
= metrics
.width
+ LGLYPH_LBEARING (g
) + LGLYPH_XOFF (g
);
4245 if (metrics
.lbearing
> x
)
4246 metrics
.lbearing
= x
;
4247 x
= metrics
.width
+ LGLYPH_RBEARING (g
) + LGLYPH_XOFF (g
);
4248 if (metrics
.rbearing
< x
)
4249 metrics
.rbearing
= x
;
4250 x
= LGLYPH_ASCENT (g
) - LGLYPH_YOFF (g
);
4251 if (metrics
.ascent
< x
)
4253 x
= LGLYPH_DESCENT (g
) - LGLYPH_YOFF (g
);
4254 if (metrics
.descent
< x
)
4255 metrics
.descent
= x
;
4256 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4257 metrics
.width
+= LGLYPH_WIDTH (g
);
4259 metrics
.width
+= LGLYPH_WADJUST (g
);
4262 if (need_composition
)
4264 gstr
= Ffont_make_gstring (font_object
, make_number (j
- i
));
4265 LGSTRING_SET_WIDTH (gstr
, metrics
.width
);
4266 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
4267 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
);
4268 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
4269 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
4270 for (k
= i
; i
< j
; i
++)
4272 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4274 LGLYPH_SET_FROM (g
, LGLYPH_FROM (g
) - this_from
);
4275 LGLYPH_SET_TO (g
, LGLYPH_TO (g
) - this_from
);
4276 LGSTRING_SET_GLYPH (gstr
, i
- k
, LGSTRING_GLYPH (gstring
, i
));
4278 from
= make_number (start
+ this_from
);
4279 to
= make_number (start
+ this_to
);
4281 Fcompose_region_internal (from
, to
, gstr
, Qnil
);
4283 Fcompose_string_internal (string
, from
, to
, gstr
, Qnil
);
4294 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4295 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4296 OTF-FEATURES specifies which features to apply in this format:
4297 (SCRIPT LANGSYS GSUB GPOS)
4299 SCRIPT is a symbol specifying a script tag of OpenType,
4300 LANGSYS is a symbol specifying a langsys tag of OpenType,
4301 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4303 If LANGYS is nil, the default langsys is selected.
4305 The features are applied in the order they appear in the list. The
4306 symbol `*' means to apply all available features not present in this
4307 list, and the remaining features are ignored. For instance, (vatu
4308 pstf * haln) is to apply vatu and pstf in this order, then to apply
4309 all available features other than vatu, pstf, and haln.
4311 The features are applied to the glyphs in the range FROM and TO of
4312 the glyph-string GSTRING-IN.
4314 If some feature is actually applicable, the resulting glyphs are
4315 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4316 this case, the value is the number of produced glyphs.
4318 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4321 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4322 produced in GSTRING-OUT, and the value is nil.
4324 See the documentation of `font-make-gstring' for the format of
4326 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4327 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4329 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4334 check_otf_features (otf_features
);
4335 CHECK_FONT_OBJECT (font_object
);
4336 font
= XFONT_OBJECT (font_object
);
4337 if (! font
->driver
->otf_drive
)
4338 error ("Font backend %s can't drive OpenType GSUB table",
4339 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4340 CHECK_CONS (otf_features
);
4341 CHECK_SYMBOL (XCAR (otf_features
));
4342 val
= XCDR (otf_features
);
4343 CHECK_SYMBOL (XCAR (val
));
4344 val
= XCDR (otf_features
);
4347 len
= check_gstring (gstring_in
);
4348 CHECK_VECTOR (gstring_out
);
4349 CHECK_NATNUM (from
);
4351 CHECK_NATNUM (index
);
4353 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4354 args_out_of_range_3 (from
, to
, make_number (len
));
4355 if (XINT (index
) >= ASIZE (gstring_out
))
4356 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4357 num
= font
->driver
->otf_drive (font
, otf_features
,
4358 gstring_in
, XINT (from
), XINT (to
),
4359 gstring_out
, XINT (index
), 0);
4362 return make_number (num
);
4365 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4367 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4368 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4370 (SCRIPT LANGSYS FEATURE ...)
4371 See the documentation of `font-drive-otf' for more detail.
4373 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4374 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4375 character code corresponding to the glyph or nil if there's no
4376 corresponding character. */)
4377 (font_object
, character
, otf_features
)
4378 Lisp_Object font_object
, character
, otf_features
;
4381 Lisp_Object gstring_in
, gstring_out
, g
;
4382 Lisp_Object alternates
;
4385 CHECK_FONT_GET_OBJECT (font_object
, font
);
4386 if (! font
->driver
->otf_drive
)
4387 error ("Font backend %s can't drive OpenType GSUB table",
4388 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4389 CHECK_CHARACTER (character
);
4390 CHECK_CONS (otf_features
);
4392 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4393 g
= LGSTRING_GLYPH (gstring_in
, 0);
4394 LGLYPH_SET_CHAR (g
, XINT (character
));
4395 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4396 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4397 gstring_out
, 0, 1)) < 0)
4398 gstring_out
= Ffont_make_gstring (font_object
,
4399 make_number (ASIZE (gstring_out
) * 2));
4401 for (i
= 0; i
< num
; i
++)
4403 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4404 int c
= LGLYPH_CHAR (g
);
4405 unsigned code
= LGLYPH_CODE (g
);
4407 alternates
= Fcons (Fcons (make_number (code
),
4408 c
> 0 ? make_number (c
) : Qnil
),
4411 return Fnreverse (alternates
);
4417 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4418 doc
: /* Open FONT-ENTITY. */)
4419 (font_entity
, size
, frame
)
4420 Lisp_Object font_entity
;
4426 CHECK_FONT_ENTITY (font_entity
);
4428 frame
= selected_frame
;
4429 CHECK_LIVE_FRAME (frame
);
4432 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4435 CHECK_NUMBER_OR_FLOAT (size
);
4437 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
4439 isize
= XINT (size
);
4443 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4446 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4447 doc
: /* Close FONT-OBJECT. */)
4448 (font_object
, frame
)
4449 Lisp_Object font_object
, frame
;
4451 CHECK_FONT_OBJECT (font_object
);
4453 frame
= selected_frame
;
4454 CHECK_LIVE_FRAME (frame
);
4455 font_close_object (XFRAME (frame
), font_object
);
4459 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4460 doc
: /* Return information about FONT-OBJECT.
4461 The value is a vector:
4462 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4465 NAME is a string of the font name (or nil if the font backend doesn't
4468 FILENAME is a string of the font file (or nil if the font backend
4469 doesn't provide a file name).
4471 PIXEL-SIZE is a pixel size by which the font is opened.
4473 SIZE is a maximum advance width of the font in pixels.
4475 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4478 CAPABILITY is a list whose first element is a symbol representing the
4479 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4480 remaining elements describe the details of the font capability.
4482 If the font is OpenType font, the form of the list is
4483 \(opentype GSUB GPOS)
4484 where GSUB shows which "GSUB" features the font supports, and GPOS
4485 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4486 lists of the format:
4487 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4489 If the font is not OpenType font, currently the length of the form is
4492 SCRIPT is a symbol representing OpenType script tag.
4494 LANGSYS is a symbol representing OpenType langsys tag, or nil
4495 representing the default langsys.
4497 FEATURE is a symbol representing OpenType feature tag.
4499 If the font is not OpenType font, CAPABILITY is nil. */)
4501 Lisp_Object font_object
;
4506 CHECK_FONT_GET_OBJECT (font_object
, font
);
4508 val
= Fmake_vector (make_number (9), Qnil
);
4509 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4510 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4511 ASET (val
, 2, make_number (font
->pixel_size
));
4512 ASET (val
, 3, make_number (font
->max_width
));
4513 ASET (val
, 4, make_number (font
->ascent
));
4514 ASET (val
, 5, make_number (font
->descent
));
4515 ASET (val
, 6, make_number (font
->space_width
));
4516 ASET (val
, 7, make_number (font
->average_width
));
4517 if (font
->driver
->otf_capability
)
4518 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4522 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4523 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4524 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4525 (font_object
, string
)
4526 Lisp_Object font_object
, string
;
4532 CHECK_FONT_GET_OBJECT (font_object
, font
);
4533 CHECK_STRING (string
);
4534 len
= SCHARS (string
);
4535 vec
= Fmake_vector (make_number (len
), Qnil
);
4536 for (i
= 0; i
< len
; i
++)
4538 Lisp_Object ch
= Faref (string
, make_number (i
));
4543 struct font_metrics metrics
;
4545 cod
= code
= font
->driver
->encode_char (font
, c
);
4546 if (code
== FONT_INVALID_CODE
)
4548 val
= Fmake_vector (make_number (6), Qnil
);
4549 if (cod
<= MOST_POSITIVE_FIXNUM
)
4550 ASET (val
, 0, make_number (code
));
4552 ASET (val
, 0, Fcons (make_number (code
>> 16),
4553 make_number (code
& 0xFFFF)));
4554 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4555 ASET (val
, 1, make_number (metrics
.lbearing
));
4556 ASET (val
, 2, make_number (metrics
.rbearing
));
4557 ASET (val
, 3, make_number (metrics
.width
));
4558 ASET (val
, 4, make_number (metrics
.ascent
));
4559 ASET (val
, 5, make_number (metrics
.descent
));
4565 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4566 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4567 FONT is a font-spec, font-entity, or font-object. */)
4569 Lisp_Object spec
, font
;
4571 CHECK_FONT_SPEC (spec
);
4574 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4577 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4578 doc
: /* Return a font-object for displaying a character at POSITION.
4579 Optional second arg WINDOW, if non-nil, is a window displaying
4580 the current buffer. It defaults to the currently selected window. */)
4581 (position
, window
, string
)
4582 Lisp_Object position
, window
, string
;
4589 CHECK_NUMBER_COERCE_MARKER (position
);
4590 pos
= XINT (position
);
4591 if (pos
< BEGV
|| pos
>= ZV
)
4592 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4596 CHECK_NUMBER (position
);
4597 CHECK_STRING (string
);
4598 pos
= XINT (position
);
4599 if (pos
< 0 || pos
>= SCHARS (string
))
4600 args_out_of_range (string
, position
);
4603 window
= selected_window
;
4604 CHECK_LIVE_WINDOW (window
);
4605 w
= XWINDOW (window
);
4607 return font_at (-1, pos
, NULL
, w
, string
);
4611 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4612 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4613 The value is a number of glyphs drawn.
4614 Type C-l to recover what previously shown. */)
4615 (font_object
, string
)
4616 Lisp_Object font_object
, string
;
4618 Lisp_Object frame
= selected_frame
;
4619 FRAME_PTR f
= XFRAME (frame
);
4625 CHECK_FONT_GET_OBJECT (font_object
, font
);
4626 CHECK_STRING (string
);
4627 len
= SCHARS (string
);
4628 code
= alloca (sizeof (unsigned) * len
);
4629 for (i
= 0; i
< len
; i
++)
4631 Lisp_Object ch
= Faref (string
, make_number (i
));
4635 code
[i
] = font
->driver
->encode_char (font
, c
);
4636 if (code
[i
] == FONT_INVALID_CODE
)
4639 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4641 if (font
->driver
->prepare_face
)
4642 font
->driver
->prepare_face (f
, face
);
4643 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4644 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4645 if (font
->driver
->done_face
)
4646 font
->driver
->done_face (f
, face
);
4648 return make_number (len
);
4652 #endif /* FONT_DEBUG */
4654 #ifdef HAVE_WINDOW_SYSTEM
4656 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4657 doc
: /* Return information about a font named NAME on frame FRAME.
4658 If FRAME is omitted or nil, use the selected frame.
4659 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4660 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4662 OPENED-NAME is the name used for opening the font,
4663 FULL-NAME is the full name of the font,
4664 SIZE is the maximum bound width of the font,
4665 HEIGHT is the height of the font,
4666 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4667 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4668 how to compose characters.
4669 If the named font is not yet loaded, return nil. */)
4671 Lisp_Object name
, frame
;
4676 Lisp_Object font_object
;
4678 (*check_window_system_func
) ();
4681 CHECK_STRING (name
);
4683 frame
= selected_frame
;
4684 CHECK_LIVE_FRAME (frame
);
4689 int fontset
= fs_query_fontset (name
, 0);
4692 name
= fontset_ascii (fontset
);
4693 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4695 else if (FONT_OBJECT_P (name
))
4697 else if (FONT_ENTITY_P (name
))
4698 font_object
= font_open_entity (f
, name
, 0);
4701 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4702 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4704 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4706 if (NILP (font_object
))
4708 font
= XFONT_OBJECT (font_object
);
4710 info
= Fmake_vector (make_number (7), Qnil
);
4711 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4712 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4713 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4714 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4715 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4716 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4717 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4720 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4721 close it now. Perhaps, we should manage font-objects
4722 by `reference-count'. */
4723 font_close_object (f
, font_object
);
4730 #define BUILD_STYLE_TABLE(TBL) \
4731 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4734 build_style_table (entry
, nelement
)
4735 struct table_entry
*entry
;
4739 Lisp_Object table
, elt
;
4741 table
= Fmake_vector (make_number (nelement
), Qnil
);
4742 for (i
= 0; i
< nelement
; i
++)
4744 for (j
= 0; entry
[i
].names
[j
]; j
++);
4745 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4746 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4747 for (j
= 0; entry
[i
].names
[j
]; j
++)
4748 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4749 ASET (table
, i
, elt
);
4754 static Lisp_Object Vfont_log
;
4755 static int font_log_env_checked
;
4758 font_add_log (action
, arg
, result
)
4760 Lisp_Object arg
, result
;
4762 Lisp_Object tail
, val
;
4765 if (! font_log_env_checked
)
4767 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
4768 font_log_env_checked
= 1;
4770 if (EQ (Vfont_log
, Qt
))
4773 arg
= Ffont_xlfd_name (arg
, Qt
);
4776 val
= Ffont_xlfd_name (result
, Qt
);
4777 if (! FONT_SPEC_P (result
))
4778 val
= concat3 (SYMBOL_NAME (AREF (result
, FONT_TYPE_INDEX
)),
4779 build_string (":"), val
);
4782 else if (CONSP (result
))
4784 result
= Fcopy_sequence (result
);
4785 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4789 val
= Ffont_xlfd_name (val
, Qt
);
4790 XSETCAR (tail
, val
);
4793 else if (VECTORP (result
))
4795 result
= Fcopy_sequence (result
);
4796 for (i
= 0; i
< ASIZE (result
); i
++)
4798 val
= AREF (result
, i
);
4800 val
= Ffont_xlfd_name (val
, Qt
);
4801 ASET (result
, i
, val
);
4804 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4807 extern void syms_of_ftfont
P_ (());
4808 extern void syms_of_xfont
P_ (());
4809 extern void syms_of_xftfont
P_ (());
4810 extern void syms_of_ftxfont
P_ (());
4811 extern void syms_of_bdffont
P_ (());
4812 extern void syms_of_w32font
P_ (());
4813 extern void syms_of_atmfont
P_ (());
4818 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
4819 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
4820 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
4821 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
4822 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
4823 /* Note that the other elements in sort_shift_bits are not used. */
4825 staticpro (&font_charset_alist
);
4826 font_charset_alist
= Qnil
;
4828 DEFSYM (Qfont_spec
, "font-spec");
4829 DEFSYM (Qfont_entity
, "font-entity");
4830 DEFSYM (Qfont_object
, "font-object");
4832 DEFSYM (Qopentype
, "opentype");
4834 DEFSYM (Qascii_0
, "ascii-0");
4835 DEFSYM (Qiso8859_1
, "iso8859-1");
4836 DEFSYM (Qiso10646_1
, "iso10646-1");
4837 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4838 DEFSYM (Qunicode_sip
, "unicode-sip");
4840 DEFSYM (QCotf
, ":otf");
4841 DEFSYM (QClang
, ":lang");
4842 DEFSYM (QCscript
, ":script");
4843 DEFSYM (QCantialias
, ":antialias");
4845 DEFSYM (QCfoundry
, ":foundry");
4846 DEFSYM (QCadstyle
, ":adstyle");
4847 DEFSYM (QCregistry
, ":registry");
4848 DEFSYM (QCspacing
, ":spacing");
4849 DEFSYM (QCdpi
, ":dpi");
4850 DEFSYM (QCscalable
, ":scalable");
4851 DEFSYM (QCavgwidth
, ":avgwidth");
4852 DEFSYM (QCfont_entity
, ":font-entity");
4853 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
4860 staticpro (&null_vector
);
4861 null_vector
= Fmake_vector (make_number (0), Qnil
);
4863 staticpro (&scratch_font_spec
);
4864 scratch_font_spec
= Ffont_spec (0, NULL
);
4865 staticpro (&scratch_font_prefer
);
4866 scratch_font_prefer
= Ffont_spec (0, NULL
);
4870 staticpro (&otf_list
);
4872 #endif /* HAVE_LIBOTF */
4876 defsubr (&Sfont_spec
);
4877 defsubr (&Sfont_get
);
4878 #ifdef HAVE_WINDOW_SYSTEM
4879 defsubr (&Sfont_face_attributes
);
4881 defsubr (&Sfont_put
);
4882 defsubr (&Slist_fonts
);
4883 defsubr (&Sfont_family_list
);
4884 defsubr (&Sfind_font
);
4885 defsubr (&Sfont_xlfd_name
);
4886 defsubr (&Sclear_font_cache
);
4887 defsubr (&Sfont_make_gstring
);
4888 defsubr (&Sfont_fill_gstring
);
4889 defsubr (&Sfont_shape_text
);
4891 defsubr (&Sfont_drive_otf
);
4892 defsubr (&Sfont_otf_alternates
);
4896 defsubr (&Sopen_font
);
4897 defsubr (&Sclose_font
);
4898 defsubr (&Squery_font
);
4899 defsubr (&Sget_font_glyphs
);
4900 defsubr (&Sfont_match_p
);
4901 defsubr (&Sfont_at
);
4903 defsubr (&Sdraw_string
);
4905 #endif /* FONT_DEBUG */
4906 #ifdef HAVE_WINDOW_SYSTEM
4907 defsubr (&Sfont_info
);
4910 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
4912 Alist of fontname patterns vs the corresponding encoding and repertory info.
4913 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
4914 where ENCODING is a charset or a char-table,
4915 and REPERTORY is a charset, a char-table, or nil.
4917 If ENCODING and REPERTORY are the same, the element can have the form
4918 \(REGEXP . ENCODING).
4920 ENCODING is for converting a character to a glyph code of the font.
4921 If ENCODING is a charset, encoding a character by the charset gives
4922 the corresponding glyph code. If ENCODING is a char-table, looking up
4923 the table by a character gives the corresponding glyph code.
4925 REPERTORY specifies a repertory of characters supported by the font.
4926 If REPERTORY is a charset, all characters beloging to the charset are
4927 supported. If REPERTORY is a char-table, all characters who have a
4928 non-nil value in the table are supported. If REPERTORY is nil, Emacs
4929 gets the repertory information by an opened font and ENCODING. */);
4930 Vfont_encoding_alist
= Qnil
;
4932 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
4933 doc
: /* Vector of valid font weight values.
4934 Each element has the form:
4935 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
4936 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
4937 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
4939 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
4940 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
4941 See `font-weight-table' for the format of the vector. */);
4942 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
4944 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
4945 doc
: /* Alist of font width symbols vs the corresponding numeric values.
4946 See `font-weight-table' for the format of the vector. */);
4947 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
4949 staticpro (&font_style_table
);
4950 font_style_table
= Fmake_vector (make_number (3), Qnil
);
4951 ASET (font_style_table
, 0, Vfont_weight_table
);
4952 ASET (font_style_table
, 1, Vfont_slant_table
);
4953 ASET (font_style_table
, 2, Vfont_width_table
);
4955 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
4956 *Logging list of font related actions and results.
4957 The value t means to suppress the logging.
4958 The initial value is set to nil if the environment variable
4959 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
4962 #ifdef HAVE_WINDOW_SYSTEM
4963 #ifdef HAVE_FREETYPE
4965 #ifdef HAVE_X_WINDOWS
4970 #endif /* HAVE_XFT */
4971 #endif /* HAVE_X_WINDOWS */
4972 #else /* not HAVE_FREETYPE */
4973 #ifdef HAVE_X_WINDOWS
4975 #endif /* HAVE_X_WINDOWS */
4976 #endif /* not HAVE_FREETYPE */
4979 #endif /* HAVE_BDFFONT */
4982 #endif /* WINDOWSNT */
4986 #endif /* HAVE_WINDOW_SYSTEM */
4989 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
4990 (do not change this comment) */