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_from_value (prop
, val
, for_face
)
361 enum font_property_index prop
;
365 Lisp_Object table
, elt
;
370 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
371 i
= XINT (val
) & 0xFF;
372 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
373 elt
= AREF (table
, ((i
>> 4) & 0xF));
374 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
375 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
379 font_style_symbolic (font
, prop
, for_face
)
381 enum font_property_index prop
;
384 Lisp_Object val
= AREF (font
, prop
);
385 return font_style_symbolic_from_value (prop
, val
, for_face
);
388 extern Lisp_Object Vface_alternative_font_family_alist
;
390 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
393 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
394 FONTNAME. ENCODING is a charset symbol that specifies the encoding
395 of the font. REPERTORY is a charset symbol or nil. */
398 find_font_encoding (fontname
)
399 Lisp_Object fontname
;
401 Lisp_Object tail
, elt
;
403 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
407 && STRINGP (XCAR (elt
))
408 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
409 && (SYMBOLP (XCDR (elt
))
410 ? CHARSETP (XCDR (elt
))
411 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
414 /* We don't know the encoding of this font. Let's assume `ascii'. */
418 /* Return encoding charset and repertory charset for REGISTRY in
419 ENCODING and REPERTORY correspondingly. If correct information for
420 REGISTRY is available, return 0. Otherwise return -1. */
423 font_registry_charsets (registry
, encoding
, repertory
)
424 Lisp_Object registry
;
425 struct charset
**encoding
, **repertory
;
428 int encoding_id
, repertory_id
;
430 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
436 encoding_id
= XINT (XCAR (val
));
437 repertory_id
= XINT (XCDR (val
));
441 val
= find_font_encoding (SYMBOL_NAME (registry
));
442 if (SYMBOLP (val
) && CHARSETP (val
))
444 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
446 else if (CONSP (val
))
448 if (! CHARSETP (XCAR (val
)))
450 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
451 if (NILP (XCDR (val
)))
455 if (! CHARSETP (XCDR (val
)))
457 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
462 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
464 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
468 *encoding
= CHARSET_FROM_ID (encoding_id
);
470 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
475 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
480 /* Font property value validaters. See the comment of
481 font_property_table for the meaning of the arguments. */
483 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
484 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
485 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
486 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
487 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
488 static int get_font_prop_index
P_ ((Lisp_Object
));
491 font_prop_validate_symbol (prop
, val
)
492 Lisp_Object prop
, val
;
495 val
= Fintern (val
, Qnil
);
498 else if (EQ (prop
, QCregistry
))
499 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
505 font_prop_validate_style (style
, val
)
506 Lisp_Object style
, val
;
508 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
509 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
516 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
520 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
522 if ((n
& 0xF) + 1 >= ASIZE (elt
))
524 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
528 else if (SYMBOLP (val
))
530 int n
= font_style_to_value (prop
, val
, 0);
532 val
= n
>= 0 ? make_number (n
) : Qerror
;
540 font_prop_validate_non_neg (prop
, val
)
541 Lisp_Object prop
, val
;
543 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
548 font_prop_validate_spacing (prop
, val
)
549 Lisp_Object prop
, val
;
551 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
553 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
555 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
557 if (spacing
== 'c' || spacing
== 'C')
558 return make_number (FONT_SPACING_CHARCELL
);
559 if (spacing
== 'm' || spacing
== 'M')
560 return make_number (FONT_SPACING_MONO
);
561 if (spacing
== 'p' || spacing
== 'P')
562 return make_number (FONT_SPACING_PROPORTIONAL
);
563 if (spacing
== 'd' || spacing
== 'D')
564 return make_number (FONT_SPACING_DUAL
);
570 font_prop_validate_otf (prop
, val
)
571 Lisp_Object prop
, val
;
573 Lisp_Object tail
, tmp
;
576 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
577 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
578 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
581 if (! SYMBOLP (XCAR (val
)))
586 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
588 for (i
= 0; i
< 2; i
++)
595 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
596 if (! SYMBOLP (XCAR (tmp
)))
604 /* Structure of known font property keys and validater of the
608 /* Pointer to the key symbol. */
610 /* Function to validate PROP's value VAL, or NULL if any value is
611 ok. The value is VAL or its regularized value if VAL is valid,
612 and Qerror if not. */
613 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
614 } font_property_table
[] =
615 { { &QCtype
, font_prop_validate_symbol
},
616 { &QCfoundry
, font_prop_validate_symbol
},
617 { &QCfamily
, font_prop_validate_symbol
},
618 { &QCadstyle
, font_prop_validate_symbol
},
619 { &QCregistry
, font_prop_validate_symbol
},
620 { &QCweight
, font_prop_validate_style
},
621 { &QCslant
, font_prop_validate_style
},
622 { &QCwidth
, font_prop_validate_style
},
623 { &QCsize
, font_prop_validate_non_neg
},
624 { &QCdpi
, font_prop_validate_non_neg
},
625 { &QCspacing
, font_prop_validate_spacing
},
626 { &QCavgwidth
, font_prop_validate_non_neg
},
627 /* The order of the above entries must match with enum
628 font_property_index. */
629 { &QClang
, font_prop_validate_symbol
},
630 { &QCscript
, font_prop_validate_symbol
},
631 { &QCotf
, font_prop_validate_otf
}
634 /* Size (number of elements) of the above table. */
635 #define FONT_PROPERTY_TABLE_SIZE \
636 ((sizeof font_property_table) / (sizeof *font_property_table))
638 /* Return an index number of font property KEY or -1 if KEY is not an
639 already known property. */
642 get_font_prop_index (key
)
647 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
648 if (EQ (key
, *font_property_table
[i
].key
))
653 /* Validate the font property. The property key is specified by the
654 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
655 signal an error. The value is VAL or the regularized one. */
658 font_prop_validate (idx
, prop
, val
)
660 Lisp_Object prop
, val
;
662 Lisp_Object validated
;
667 prop
= *font_property_table
[idx
].key
;
670 idx
= get_font_prop_index (prop
);
674 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
675 if (EQ (validated
, Qerror
))
676 signal_error ("invalid font property", Fcons (prop
, val
));
681 /* Store VAL as a value of extra font property PROP in FONT while
682 keeping the sorting order. Don't check the validity of VAL. */
685 font_put_extra (font
, prop
, val
)
686 Lisp_Object font
, prop
, val
;
688 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
689 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
693 Lisp_Object prev
= Qnil
;
696 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
697 prev
= extra
, extra
= XCDR (extra
);
699 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
701 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
709 /* Font name parser and unparser */
711 static int parse_matrix
P_ ((char *));
712 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
713 static int font_parse_name
P_ ((char *, Lisp_Object
));
715 /* An enumerator for each field of an XLFD font name. */
716 enum xlfd_field_index
735 /* An enumerator for mask bit corresponding to each XLFD field. */
738 XLFD_FOUNDRY_MASK
= 0x0001,
739 XLFD_FAMILY_MASK
= 0x0002,
740 XLFD_WEIGHT_MASK
= 0x0004,
741 XLFD_SLANT_MASK
= 0x0008,
742 XLFD_SWIDTH_MASK
= 0x0010,
743 XLFD_ADSTYLE_MASK
= 0x0020,
744 XLFD_PIXEL_MASK
= 0x0040,
745 XLFD_POINT_MASK
= 0x0080,
746 XLFD_RESX_MASK
= 0x0100,
747 XLFD_RESY_MASK
= 0x0200,
748 XLFD_SPACING_MASK
= 0x0400,
749 XLFD_AVGWIDTH_MASK
= 0x0800,
750 XLFD_REGISTRY_MASK
= 0x1000,
751 XLFD_ENCODING_MASK
= 0x2000
755 /* Parse P pointing the pixel/point size field of the form
756 `[A B C D]' which specifies a transformation matrix:
762 by which all glyphs of the font are transformed. The spec says
763 that scalar value N for the pixel/point size is equivalent to:
764 A = N * resx/resy, B = C = 0, D = N.
766 Return the scalar value N if the form is valid. Otherwise return
777 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
780 matrix
[i
] = - strtod (p
+ 1, &end
);
782 matrix
[i
] = strtod (p
, &end
);
785 return (i
== 4 ? (int) matrix
[3] : -1);
788 /* Expand a wildcard field in FIELD (the first N fields are filled) to
789 multiple fields to fill in all 14 XLFD fields while restring a
790 field position by its contents. */
793 font_expand_wildcards (field
, n
)
794 Lisp_Object field
[XLFD_LAST_INDEX
];
798 Lisp_Object tmp
[XLFD_LAST_INDEX
];
799 /* Array of information about where this element can go. Nth
800 element is for Nth element of FIELD. */
802 /* Minimum possible field. */
804 /* Maxinum possible field. */
806 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
808 } range
[XLFD_LAST_INDEX
];
810 int range_from
, range_to
;
813 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
814 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
815 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
816 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
817 | XLFD_AVGWIDTH_MASK)
818 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
820 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
821 field. The value is shifted to left one bit by one in the
823 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
824 range_mask
= (range_mask
<< 1) | 1;
826 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
827 position-based retriction for FIELD[I]. */
828 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
829 i
++, range_from
++, range_to
++, range_mask
<<= 1)
831 Lisp_Object val
= field
[i
];
837 range
[i
].from
= range_from
;
838 range
[i
].to
= range_to
;
839 range
[i
].mask
= range_mask
;
843 /* The triplet FROM, TO, and MASK is a value-based
844 retriction for FIELD[I]. */
850 int numeric
= XINT (val
);
853 from
= to
= XLFD_ENCODING_INDEX
,
854 mask
= XLFD_ENCODING_MASK
;
855 else if (numeric
== 0)
856 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
857 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
858 else if (numeric
<= 48)
859 from
= to
= XLFD_PIXEL_INDEX
,
860 mask
= XLFD_PIXEL_MASK
;
862 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
863 mask
= XLFD_LARGENUM_MASK
;
865 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
866 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
867 mask
= XLFD_NULL_MASK
;
869 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
872 Lisp_Object name
= SYMBOL_NAME (val
);
874 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
875 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
876 mask
= XLFD_REGENC_MASK
;
878 from
= to
= XLFD_ENCODING_INDEX
,
879 mask
= XLFD_ENCODING_MASK
;
881 else if (range_from
<= XLFD_WEIGHT_INDEX
882 && range_to
>= XLFD_WEIGHT_INDEX
883 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
884 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
885 else if (range_from
<= XLFD_SLANT_INDEX
886 && range_to
>= XLFD_SLANT_INDEX
887 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
888 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
889 else if (range_from
<= XLFD_SWIDTH_INDEX
890 && range_to
>= XLFD_SWIDTH_INDEX
891 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
892 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
895 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
896 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
898 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
899 mask
= XLFD_SYMBOL_MASK
;
902 /* Merge position-based and value-based restrictions. */
904 while (from
< range_from
)
905 mask
&= ~(1 << from
++);
906 while (from
< 14 && ! (mask
& (1 << from
)))
908 while (to
> range_to
)
909 mask
&= ~(1 << to
--);
910 while (to
>= 0 && ! (mask
& (1 << to
)))
914 range
[i
].from
= from
;
916 range
[i
].mask
= mask
;
918 if (from
> range_from
|| to
< range_to
)
920 /* The range is narrowed by value-based restrictions.
921 Reflect it to the other fields. */
923 /* Following fields should be after FROM. */
925 /* Preceding fields should be before TO. */
926 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
928 /* Check FROM for non-wildcard field. */
929 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
931 while (range
[j
].from
< from
)
932 range
[j
].mask
&= ~(1 << range
[j
].from
++);
933 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
935 range
[j
].from
= from
;
938 from
= range
[j
].from
;
939 if (range
[j
].to
> to
)
941 while (range
[j
].to
> to
)
942 range
[j
].mask
&= ~(1 << range
[j
].to
--);
943 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
956 /* Decide all fileds from restrictions in RANGE. */
957 for (i
= j
= 0; i
< n
; i
++)
959 if (j
< range
[i
].from
)
961 if (i
== 0 || ! NILP (tmp
[i
- 1]))
962 /* None of TMP[X] corresponds to Jth field. */
964 for (; j
< range
[i
].from
; j
++)
969 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
971 for (; j
< XLFD_LAST_INDEX
; j
++)
973 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
974 field
[XLFD_ENCODING_INDEX
]
975 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
980 #ifdef ENABLE_CHECKING
981 /* Match a 14-field XLFD pattern against a full XLFD font name. */
983 font_match_xlfd (char *pattern
, char *name
)
985 while (*pattern
&& *name
)
987 if (*pattern
== *name
)
989 else if (*pattern
== '*')
990 if (*name
== pattern
[1])
1001 /* Make sure the font object matches the XLFD font name. */
1003 font_check_xlfd_parse (Lisp_Object font
, char *name
)
1005 char name_check
[256];
1006 font_unparse_xlfd (font
, 0, name_check
, 255);
1007 return font_match_xlfd (name_check
, name
);
1013 /* Parse NAME (null terminated) as XLFD and store information in FONT
1014 (font-spec or font-entity). Size property of FONT is set as
1016 specified XLFD fields FONT property
1017 --------------------- -------------
1018 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1019 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1020 POINT_SIZE POINT_SIZE/10 (Lisp float)
1022 If NAME is successfully parsed, return 0. Otherwise return -1.
1024 FONT is usually a font-spec, but when this function is called from
1025 X font backend driver, it is a font-entity. In that case, NAME is
1026 a fully specified XLFD. */
1029 font_parse_xlfd (name
, font
)
1033 int len
= strlen (name
);
1035 char *f
[XLFD_LAST_INDEX
+ 1];
1040 /* Maximum XLFD name length is 255. */
1042 /* Accept "*-.." as a fully specified XLFD. */
1043 if (name
[0] == '*' && name
[1] == '-')
1044 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1047 for (p
= name
+ i
; *p
; p
++)
1051 if (i
== XLFD_LAST_INDEX
)
1056 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1057 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1059 if (i
== XLFD_LAST_INDEX
)
1061 /* Fully specified XLFD. */
1064 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1065 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1066 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1067 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1069 val
= INTERN_FIELD_SYM (i
);
1072 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1074 ASET (font
, j
, make_number (n
));
1077 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1078 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1079 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1081 ASET (font
, FONT_REGISTRY_INDEX
,
1082 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1083 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1085 p
= f
[XLFD_PIXEL_INDEX
];
1086 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1087 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1090 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1092 ASET (font
, FONT_SIZE_INDEX
, val
);
1095 double point_size
= -1;
1097 font_assert (FONT_SPEC_P (font
));
1098 p
= f
[XLFD_POINT_INDEX
];
1100 point_size
= parse_matrix (p
);
1101 else if (isdigit (*p
))
1102 point_size
= atoi (p
), point_size
/= 10;
1103 if (point_size
>= 0)
1104 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1108 ASET (font
, FONT_DPI_INDEX
, INTERN_FIELD (XLFD_RESY_INDEX
));
1109 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1112 val
= font_prop_validate_spacing (QCspacing
, val
);
1113 if (! INTEGERP (val
))
1115 ASET (font
, FONT_SPACING_INDEX
, val
);
1117 p
= f
[XLFD_AVGWIDTH_INDEX
];
1120 ASET (font
, FONT_AVGWIDTH_INDEX
,
1121 font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 1));
1125 int wild_card_found
= 0;
1126 Lisp_Object prop
[XLFD_LAST_INDEX
];
1128 if (FONT_ENTITY_P (font
))
1130 for (j
= 0; j
< i
; j
++)
1134 if (f
[j
][1] && f
[j
][1] != '-')
1137 wild_card_found
= 1;
1140 prop
[j
] = INTERN_FIELD (j
);
1142 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1144 if (! wild_card_found
)
1146 if (font_expand_wildcards (prop
, i
) < 0)
1149 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1150 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1151 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1152 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1153 if (! NILP (prop
[i
]))
1155 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1157 ASET (font
, j
, make_number (n
));
1159 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1160 val
= prop
[XLFD_REGISTRY_INDEX
];
1163 val
= prop
[XLFD_ENCODING_INDEX
];
1165 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1167 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1168 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1170 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1171 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1173 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1175 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1176 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1177 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1179 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1181 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1184 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1185 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1186 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1188 val
= font_prop_validate_spacing (QCspacing
,
1189 prop
[XLFD_SPACING_INDEX
]);
1190 if (! INTEGERP (val
))
1192 ASET (font
, FONT_SPACING_INDEX
, val
);
1194 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1195 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1201 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1202 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1203 0, use PIXEL_SIZE instead. */
1206 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1212 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1216 font_assert (FONTP (font
));
1218 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1221 if (i
== FONT_ADSTYLE_INDEX
)
1222 j
= XLFD_ADSTYLE_INDEX
;
1223 else if (i
== FONT_REGISTRY_INDEX
)
1224 j
= XLFD_REGISTRY_INDEX
;
1225 val
= AREF (font
, i
);
1228 if (j
== XLFD_REGISTRY_INDEX
)
1229 f
[j
] = "*-*", len
+= 4;
1231 f
[j
] = "*", len
+= 2;
1236 val
= SYMBOL_NAME (val
);
1237 if (j
== XLFD_REGISTRY_INDEX
1238 && ! strchr ((char *) SDATA (val
), '-'))
1240 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1241 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1243 f
[j
] = alloca (SBYTES (val
) + 3);
1244 sprintf (f
[j
], "%s-*", SDATA (val
));
1245 len
+= SBYTES (val
) + 3;
1249 f
[j
] = alloca (SBYTES (val
) + 4);
1250 sprintf (f
[j
], "%s*-*", SDATA (val
));
1251 len
+= SBYTES (val
) + 4;
1255 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1259 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1262 val
= font_style_symbolic (font
, i
, 0);
1264 f
[j
] = "*", len
+= 2;
1267 val
= SYMBOL_NAME (val
);
1268 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1272 val
= AREF (font
, FONT_SIZE_INDEX
);
1273 font_assert (NUMBERP (val
) || NILP (val
));
1281 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1282 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1285 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1287 else if (FLOATP (val
))
1289 i
= XFLOAT_DATA (val
) * 10;
1290 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1291 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1294 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1296 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1298 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1299 f
[XLFD_RESX_INDEX
] = alloca (22);
1300 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1304 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1305 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1307 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1309 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1310 : spacing
<= FONT_SPACING_DUAL
? "d"
1311 : spacing
<= FONT_SPACING_MONO
? "m"
1316 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1317 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1319 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1320 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
],
1321 "%d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1324 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1325 len
++; /* for terminating '\0'. */
1328 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1329 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1330 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1331 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1332 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1333 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1334 f
[XLFD_REGISTRY_INDEX
]);
1337 /* Parse NAME (null terminated) and store information in FONT
1338 (font-spec or font-entity). NAME is supplied in either the
1339 Fontconfig or GTK font name format. If NAME is successfully
1340 parsed, return 0. Otherwise return -1.
1342 The fontconfig format is
1344 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1348 FAMILY [PROPS...] [SIZE]
1350 This function tries to guess which format it is. */
1353 font_parse_fcname (name
, font
)
1358 char *size_beg
= NULL
, *size_end
= NULL
;
1359 char *props_beg
= NULL
, *family_end
= NULL
;
1360 int len
= strlen (name
);
1365 for (p
= name
; *p
; p
++)
1367 if (*p
== '\\' && p
[1])
1377 int decimal
= 0, size_found
= 1;
1378 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1381 if (*q
!= '.' || decimal
)
1400 /* A fontconfig name with size and/or property data. */
1401 if (family_end
> name
)
1404 family
= font_intern_prop (name
, family_end
- name
, 1);
1405 ASET (font
, FONT_FAMILY_INDEX
, family
);
1409 double point_size
= strtod (size_beg
, &size_end
);
1410 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1411 if (*size_end
== ':' && size_end
[1])
1412 props_beg
= size_end
+ 1;
1416 /* Now parse ":KEY=VAL" patterns. Store known keys and values in
1417 extra, copy unknown ones to COPY. It is stored in extra slot by
1418 the key QCfc_unknown_spec. */
1421 name
= copy
= alloca (name
+ len
- props_beg
);
1431 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1435 /* Must be an enumerated value. */
1436 val
= font_intern_prop (p
, q
- p
, 1);
1438 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1440 if (PROP_MATCH ("light", 5)
1441 || PROP_MATCH ("medium", 6)
1442 || PROP_MATCH ("demibold", 8)
1443 || PROP_MATCH ("bold", 4)
1444 || PROP_MATCH ("black", 5))
1445 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1446 else if (PROP_MATCH ("roman", 5)
1447 || PROP_MATCH ("italic", 6)
1448 || PROP_MATCH ("oblique", 7))
1449 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1450 else if (PROP_MATCH ("charcell", 8))
1451 ASET (font
, FONT_SPACING_INDEX
,
1452 make_number (FONT_SPACING_CHARCELL
));
1453 else if (PROP_MATCH ("mono", 4))
1454 ASET (font
, FONT_SPACING_INDEX
,
1455 make_number (FONT_SPACING_MONO
));
1456 else if (PROP_MATCH ("proportional", 12))
1457 ASET (font
, FONT_SPACING_INDEX
,
1458 make_number (FONT_SPACING_PROPORTIONAL
));
1462 bcopy (p
, copy
, word_len
);
1467 else /* KEY=VAL pairs */
1472 if (word_len
== 9 && memcmp (p
, "pixelsize=", 10) == 0)
1473 prop
= FONT_SIZE_INDEX
;
1476 key
= font_intern_prop (p
, q
- p
, 1);
1477 prop
= get_font_prop_index (key
);
1480 for (q
= p
; *q
&& *q
!= ':'; q
++);
1482 val
= font_intern_prop (p
, q
- p
, 0);
1485 if (prop
>= FONT_FOUNDRY_INDEX
1486 && prop
< FONT_EXTRA_INDEX
)
1488 font_prop_validate (prop
, Qnil
, val
));
1490 Ffont_put (font
, key
, val
);
1492 bcopy (keyhead
, copy
, q
- keyhead
);
1493 copy
+= q
- keyhead
;
1499 font_put_extra (font
, QCfc_unknown_spec
,
1500 make_unibyte_string (name
, copy
- name
));
1505 /* Either a fontconfig-style name with no size and property
1506 data, or a GTK-style name. */
1508 int word_len
, prop_found
= 0;
1510 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1516 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1524 double point_size
= strtod (p
, &q
);
1525 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1530 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1531 if (*q
== '\\' && q
[1])
1535 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1537 if (PROP_MATCH ("Ultra-Light", 11))
1540 prop
= font_intern_prop ("ultra-light", 11, 1);
1541 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1543 else if (PROP_MATCH ("Light", 5))
1546 prop
= font_intern_prop ("light", 5, 1);
1547 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1549 else if (PROP_MATCH ("Semi-Bold", 9))
1552 prop
= font_intern_prop ("semi-bold", 9, 1);
1553 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1555 else if (PROP_MATCH ("Bold", 4))
1558 prop
= font_intern_prop ("bold", 4, 1);
1559 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1561 else if (PROP_MATCH ("Italic", 6))
1564 prop
= font_intern_prop ("italic", 4, 1);
1565 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1567 else if (PROP_MATCH ("Oblique", 7))
1570 prop
= font_intern_prop ("oblique", 7, 1);
1571 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1575 return -1; /* Unknown property in GTK-style font name. */
1584 family
= font_intern_prop (name
, family_end
- name
, 1);
1585 ASET (font
, FONT_FAMILY_INDEX
, family
);
1592 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1593 NAME (NBYTES length), and return the name length. If
1594 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1597 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1603 Lisp_Object family
, foundry
;
1604 Lisp_Object tail
, val
;
1609 Lisp_Object styles
[3];
1610 char *style_names
[3] = { "weight", "slant", "width" };
1613 family
= AREF (font
, FONT_FAMILY_INDEX
);
1614 if (! NILP (family
))
1616 if (SYMBOLP (family
))
1618 family
= SYMBOL_NAME (family
);
1619 len
+= SBYTES (family
);
1625 val
= AREF (font
, FONT_SIZE_INDEX
);
1628 if (XINT (val
) != 0)
1629 pixel_size
= XINT (val
);
1631 len
+= 21; /* for ":pixelsize=NUM" */
1633 else if (FLOATP (val
))
1636 point_size
= (int) XFLOAT_DATA (val
);
1637 len
+= 11; /* for "-NUM" */
1640 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1641 if (! NILP (foundry
))
1643 if (SYMBOLP (foundry
))
1645 foundry
= SYMBOL_NAME (foundry
);
1646 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1652 for (i
= 0; i
< 3; i
++)
1654 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1655 if (! NILP (styles
[i
]))
1656 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1657 SDATA (SYMBOL_NAME (styles
[i
])));
1660 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1661 len
+= sprintf (work
, ":dpi=%d", dpi
);
1662 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1663 len
+= strlen (":spacing=100");
1664 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1665 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1666 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1668 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1670 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1672 len
+= SBYTES (val
);
1673 else if (INTEGERP (val
))
1674 len
+= sprintf (work
, "%d", XINT (val
));
1675 else if (SYMBOLP (val
))
1676 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1682 if (! NILP (family
))
1683 p
+= sprintf (p
, "%s", SDATA (family
));
1687 p
+= sprintf (p
, "%d", point_size
);
1689 p
+= sprintf (p
, "-%d", point_size
);
1691 else if (pixel_size
> 0)
1692 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1693 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1694 p
+= sprintf (p
, ":foundry=%s",
1695 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1696 for (i
= 0; i
< 3; i
++)
1697 if (! NILP (styles
[i
]))
1698 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1699 SDATA (SYMBOL_NAME (styles
[i
])));
1700 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1701 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1702 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1703 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1704 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1706 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1707 p
+= sprintf (p
, ":scalable=true");
1709 p
+= sprintf (p
, ":scalable=false");
1714 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1715 NAME (NBYTES length), and return the name length. F is the frame
1716 on which the font is displayed; it is used to calculate the point
1720 font_unparse_gtkname (font
, f
, name
, nbytes
)
1728 Lisp_Object family
, weight
, slant
, size
;
1729 int point_size
= -1;
1731 family
= AREF (font
, FONT_FAMILY_INDEX
);
1732 if (! NILP (family
))
1734 if (! SYMBOLP (family
))
1736 family
= SYMBOL_NAME (family
);
1737 len
+= SBYTES (family
);
1740 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1741 if (weight
== Qnormal
)
1743 else if (! NILP (weight
))
1745 weight
= SYMBOL_NAME (weight
);
1746 len
+= SBYTES (weight
);
1749 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1750 if (slant
== Qnormal
)
1752 else if (! NILP (slant
))
1754 slant
= SYMBOL_NAME (slant
);
1755 len
+= SBYTES (slant
);
1758 size
= AREF (font
, FONT_SIZE_INDEX
);
1759 /* Convert pixel size to point size. */
1760 if (INTEGERP (size
))
1762 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1764 if (INTEGERP (font_dpi
))
1765 dpi
= XINT (font_dpi
);
1768 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1771 else if (FLOATP (size
))
1773 point_size
= (int) XFLOAT_DATA (size
);
1780 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1782 if (! NILP (weight
))
1785 p
+= sprintf (p
, " %s", SDATA (weight
));
1786 q
[1] = toupper (q
[1]);
1792 p
+= sprintf (p
, " %s", SDATA (slant
));
1793 q
[1] = toupper (q
[1]);
1797 p
+= sprintf (p
, " %d", point_size
);
1802 /* Parse NAME (null terminated) and store information in FONT
1803 (font-spec or font-entity). If NAME is successfully parsed, return
1804 0. Otherwise return -1. */
1807 font_parse_name (name
, font
)
1811 if (name
[0] == '-' || index (name
, '*'))
1812 return font_parse_xlfd (name
, font
);
1813 return font_parse_fcname (name
, font
);
1817 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1818 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1822 font_parse_family_registry (family
, registry
, font_spec
)
1823 Lisp_Object family
, registry
, font_spec
;
1829 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1831 CHECK_STRING (family
);
1832 len
= SBYTES (family
);
1833 p0
= (char *) SDATA (family
);
1834 p1
= index (p0
, '-');
1837 if ((*p0
!= '*' || p1
- p0
> 1)
1838 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1839 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1842 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1845 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1847 if (! NILP (registry
))
1849 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1850 CHECK_STRING (registry
);
1851 len
= SBYTES (registry
);
1852 p0
= (char *) SDATA (registry
);
1853 p1
= index (p0
, '-');
1856 if (SDATA (registry
)[len
- 1] == '*')
1857 registry
= concat2 (registry
, build_string ("-*"));
1859 registry
= concat2 (registry
, build_string ("*-*"));
1861 registry
= Fdowncase (registry
);
1862 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1867 /* This part (through the next ^L) is still experimental and not
1868 tested much. We may drastically change codes. */
1874 #define LGSTRING_HEADER_SIZE 6
1875 #define LGSTRING_GLYPH_SIZE 8
1878 check_gstring (gstring
)
1879 Lisp_Object gstring
;
1884 CHECK_VECTOR (gstring
);
1885 val
= AREF (gstring
, 0);
1887 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1889 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1890 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1891 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1892 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1893 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1894 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1895 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1896 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1897 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1898 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1899 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1901 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1903 val
= LGSTRING_GLYPH (gstring
, i
);
1905 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1907 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1909 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1910 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1911 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1912 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1913 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1914 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1915 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1916 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1918 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1920 if (ASIZE (val
) < 3)
1922 for (j
= 0; j
< 3; j
++)
1923 CHECK_NUMBER (AREF (val
, j
));
1928 error ("Invalid glyph-string format");
1933 check_otf_features (otf_features
)
1934 Lisp_Object otf_features
;
1938 CHECK_CONS (otf_features
);
1939 CHECK_SYMBOL (XCAR (otf_features
));
1940 otf_features
= XCDR (otf_features
);
1941 CHECK_CONS (otf_features
);
1942 CHECK_SYMBOL (XCAR (otf_features
));
1943 otf_features
= XCDR (otf_features
);
1944 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1946 CHECK_SYMBOL (Fcar (val
));
1947 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1948 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1950 otf_features
= XCDR (otf_features
);
1951 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1953 CHECK_SYMBOL (Fcar (val
));
1954 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1955 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1962 Lisp_Object otf_list
;
1965 otf_tag_symbol (tag
)
1970 OTF_tag_name (tag
, name
);
1971 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1978 Lisp_Object val
= Fassoc (file
, otf_list
);
1982 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1985 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1986 val
= make_save_value (otf
, 0);
1987 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1993 /* Return a list describing which scripts/languages FONT supports by
1994 which GSUB/GPOS features of OpenType tables. See the comment of
1995 (struct font_driver).otf_capability. */
1998 font_otf_capability (font
)
2002 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
2005 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
2008 for (i
= 0; i
< 2; i
++)
2010 OTF_GSUB_GPOS
*gsub_gpos
;
2011 Lisp_Object script_list
= Qnil
;
2014 if (OTF_get_features (otf
, i
== 0) < 0)
2016 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2017 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2019 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2020 Lisp_Object langsys_list
= Qnil
;
2021 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2024 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2026 OTF_LangSys
*langsys
;
2027 Lisp_Object feature_list
= Qnil
;
2028 Lisp_Object langsys_tag
;
2031 if (k
== script
->LangSysCount
)
2033 langsys
= &script
->DefaultLangSys
;
2038 langsys
= script
->LangSys
+ k
;
2040 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2042 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2044 OTF_Feature
*feature
2045 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2046 Lisp_Object feature_tag
2047 = otf_tag_symbol (feature
->FeatureTag
);
2049 feature_list
= Fcons (feature_tag
, feature_list
);
2051 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2054 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2059 XSETCAR (capability
, script_list
);
2061 XSETCDR (capability
, script_list
);
2067 /* Parse OTF features in SPEC and write a proper features spec string
2068 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2069 assured that the sufficient memory has already allocated for
2073 generate_otf_features (spec
, features
)
2083 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2089 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2094 else if (! asterisk
)
2096 val
= SYMBOL_NAME (val
);
2097 p
+= sprintf (p
, "%s", SDATA (val
));
2101 val
= SYMBOL_NAME (val
);
2102 p
+= sprintf (p
, "~%s", SDATA (val
));
2106 error ("OTF spec too long");
2110 font_otf_DeviceTable (device_table
)
2111 OTF_DeviceTable
*device_table
;
2113 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2115 return Fcons (make_number (len
),
2116 make_unibyte_string (device_table
->DeltaValue
, len
));
2120 font_otf_ValueRecord (value_format
, value_record
)
2122 OTF_ValueRecord
*value_record
;
2124 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2126 if (value_format
& OTF_XPlacement
)
2127 ASET (val
, 0, make_number (value_record
->XPlacement
));
2128 if (value_format
& OTF_YPlacement
)
2129 ASET (val
, 1, make_number (value_record
->YPlacement
));
2130 if (value_format
& OTF_XAdvance
)
2131 ASET (val
, 2, make_number (value_record
->XAdvance
));
2132 if (value_format
& OTF_YAdvance
)
2133 ASET (val
, 3, make_number (value_record
->YAdvance
));
2134 if (value_format
& OTF_XPlaDevice
)
2135 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2136 if (value_format
& OTF_YPlaDevice
)
2137 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2138 if (value_format
& OTF_XAdvDevice
)
2139 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2140 if (value_format
& OTF_YAdvDevice
)
2141 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2146 font_otf_Anchor (anchor
)
2151 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2152 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2153 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2154 if (anchor
->AnchorFormat
== 2)
2155 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2158 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2159 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2163 #endif /* HAVE_LIBOTF */
2166 /* G-string (glyph string) handler */
2168 /* G-string is a vector of the form [HEADER GLYPH ...].
2169 See the docstring of `font-make-gstring' for more detail. */
2172 font_prepare_composition (cmp
, f
)
2173 struct composition
*cmp
;
2177 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
2178 cmp
->hash_index
* 2);
2180 cmp
->font
= XFONT_OBJECT (LGSTRING_FONT (gstring
));
2181 cmp
->glyph_len
= LGSTRING_LENGTH (gstring
);
2182 cmp
->pixel_width
= LGSTRING_WIDTH (gstring
);
2183 cmp
->lbearing
= LGSTRING_LBEARING (gstring
);
2184 cmp
->rbearing
= LGSTRING_RBEARING (gstring
);
2185 cmp
->ascent
= LGSTRING_ASCENT (gstring
);
2186 cmp
->descent
= LGSTRING_DESCENT (gstring
);
2187 cmp
->width
= cmp
->pixel_width
/ FRAME_COLUMN_WIDTH (f
);
2188 if (cmp
->width
== 0)
2197 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2198 static int font_compare
P_ ((const void *, const void *));
2199 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
2200 Lisp_Object
, Lisp_Object
,
2203 /* We sort fonts by scoring each of them against a specified
2204 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2205 the value is, the closer the font is to the font-spec.
2207 The lowest 2 bits of the score is used for driver type. The font
2208 available by the most preferred font driver is 0.
2210 Each 7-bit in the higher 28 bits are used for numeric properties
2211 WEIGHT, SLANT, WIDTH, and SIZE. */
2213 /* How many bits to shift to store the difference value of each font
2214 property in a score. Note that flots for FONT_TYPE_INDEX and
2215 FONT_REGISTRY_INDEX are not used. */
2216 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2218 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2219 The return value indicates how different ENTITY is compared with
2222 ALTERNATE_FAMILIES, if non-nil, is a pre-calculated list of
2223 alternate family names for AREF (SPEC_PROP, FONT_FAMILY_INDEX). */
2226 font_score (entity
, spec_prop
)
2227 Lisp_Object entity
, *spec_prop
;
2232 /* Score three style numeric fields. Maximum difference is 127. */
2233 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2234 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2236 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2241 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2244 /* Score the size. Maximum difference is 127. */
2245 i
= FONT_SIZE_INDEX
;
2246 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
])
2247 && XINT (AREF (entity
, i
)) > 0)
2249 /* We use the higher 6-bit for the actual size difference. The
2250 lowest bit is set if the DPI is different. */
2251 int diff
= XINT (spec_prop
[i
]) - XINT (AREF (entity
, i
));
2256 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2257 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2259 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2266 /* The comparison function for qsort. */
2269 font_compare (d1
, d2
)
2270 const void *d1
, *d2
;
2272 return (*(unsigned *) d1
- *(unsigned *) d2
);
2276 /* The structure for elements being sorted by qsort. */
2277 struct font_sort_data
2284 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2285 If PREFER specifies a point-size, calculate the corresponding
2286 pixel-size from QCdpi property of PREFER or from the Y-resolution
2287 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
2288 get the font-entities in VEC.
2290 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2291 return the sorted VEC. */
2294 font_sort_entites (vec
, prefer
, frame
, spec
, best_only
)
2295 Lisp_Object vec
, prefer
, frame
, spec
;
2298 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2300 struct font_sort_data
*data
;
2301 unsigned best_score
;
2302 Lisp_Object best_entity
, driver_type
;
2304 struct frame
*f
= XFRAME (frame
);
2305 struct font_driver_list
*list
;
2310 return best_only
? AREF (vec
, 0) : vec
;
2312 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2313 prefer_prop
[i
] = AREF (prefer
, i
);
2317 /* A font driver may return a font that has a property value
2318 different from the value specified in SPEC if the driver
2319 thinks they are the same. That happens, for instance, such a
2320 generic family name as "serif" is specified. So, to ignore
2321 such a difference, for all properties specified in SPEC, set
2322 the corresponding properties in PREFER_PROP to nil. */
2323 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2324 if (! NILP (AREF (spec
, i
)))
2325 prefer_prop
[i
] = Qnil
;
2328 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2329 prefer_prop
[FONT_SIZE_INDEX
]
2330 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2332 /* Scoring and sorting. */
2333 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2334 best_score
= 0xFFFFFFFF;
2335 /* We are sure that the length of VEC > 1. */
2336 driver_type
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2337 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2338 driver_order
++, list
= list
->next
)
2339 if (EQ (driver_type
, list
->driver
->type
))
2341 best_entity
= data
[0].entity
= AREF (vec
, 0);
2342 best_score
= data
[0].score
2343 = font_score (data
[0].entity
, prefer_prop
) | driver_order
;
2344 for (i
= 0; i
< len
; i
++)
2346 if (!EQ (driver_type
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2347 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2348 driver_order
++, list
= list
->next
)
2349 if (EQ (driver_type
, list
->driver
->type
))
2351 data
[i
].entity
= AREF (vec
, i
);
2352 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
) | driver_order
;
2353 if (best_only
&& best_score
> data
[i
].score
)
2355 best_score
= data
[i
].score
;
2356 best_entity
= data
[i
].entity
;
2357 if (best_score
== 0)
2361 if (NILP (best_entity
))
2363 qsort (data
, len
, sizeof *data
, font_compare
);
2364 for (i
= 0; i
< len
; i
++)
2365 ASET (vec
, i
, data
[i
].entity
);
2371 font_add_log ("sort-by", prefer
, vec
);
2376 /* API of Font Service Layer. */
2378 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2379 sort_shift_bits. Finternal_set_font_selection_order calls this
2380 function with font_sort_order after setting up it. */
2383 font_update_sort_order (order
)
2388 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2390 int xlfd_idx
= order
[i
];
2392 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2393 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2394 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2395 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2396 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2397 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2399 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2404 /* Check if ENTITY matches with the font specification SPEC. */
2407 font_match_p (spec
, entity
)
2408 Lisp_Object spec
, entity
;
2410 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2411 Lisp_Object alternate_families
= Qnil
;
2414 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2415 prefer_prop
[i
] = AREF (spec
, i
);
2416 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2417 prefer_prop
[FONT_SIZE_INDEX
]
2418 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2419 if (! NILP (prefer_prop
[FONT_FAMILY_INDEX
]))
2422 = Fassoc_string (prefer_prop
[FONT_FAMILY_INDEX
],
2423 Vface_alternative_font_family_alist
, Qt
);
2424 if (CONSP (alternate_families
))
2425 alternate_families
= XCDR (alternate_families
);
2428 return (font_score (entity
, prefer_prop
) == 0);
2434 Each font backend has the callback function get_cache, and it
2435 returns a cons cell of which cdr part can be freely used for
2436 caching fonts. The cons cell may be shared by multiple frames
2437 and/or multiple font drivers. So, we arrange the cdr part as this:
2439 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2441 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2442 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2443 cons (FONT-SPEC FONT-ENTITY ...). */
2445 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2446 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2447 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2448 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2449 struct font_driver
*));
2452 font_prepare_cache (f
, driver
)
2454 struct font_driver
*driver
;
2456 Lisp_Object cache
, val
;
2458 cache
= driver
->get_cache (f
);
2460 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2464 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2465 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2469 val
= XCDR (XCAR (val
));
2470 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2476 font_finish_cache (f
, driver
)
2478 struct font_driver
*driver
;
2480 Lisp_Object cache
, val
, tmp
;
2483 cache
= driver
->get_cache (f
);
2485 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2486 cache
= val
, val
= XCDR (val
);
2487 font_assert (! NILP (val
));
2488 tmp
= XCDR (XCAR (val
));
2489 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2490 if (XINT (XCAR (tmp
)) == 0)
2492 font_clear_cache (f
, XCAR (val
), driver
);
2493 XSETCDR (cache
, XCDR (val
));
2499 font_get_cache (f
, driver
)
2501 struct font_driver
*driver
;
2503 Lisp_Object val
= driver
->get_cache (f
);
2504 Lisp_Object type
= driver
->type
;
2506 font_assert (CONSP (val
));
2507 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2508 font_assert (CONSP (val
));
2509 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2510 val
= XCDR (XCAR (val
));
2514 static int num_fonts
;
2517 font_clear_cache (f
, cache
, driver
)
2520 struct font_driver
*driver
;
2522 Lisp_Object tail
, elt
;
2524 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2525 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2528 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)) && VECTORP (XCDR (elt
)))
2530 Lisp_Object vec
= XCDR (elt
);
2533 for (i
= 0; i
< ASIZE (vec
); i
++)
2535 Lisp_Object entity
= AREF (vec
, i
);
2537 if (EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2539 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2541 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2543 Lisp_Object val
= XCAR (objlist
);
2544 struct font
*font
= XFONT_OBJECT (val
);
2546 if (! NILP (AREF (val
, FONT_TYPE_INDEX
)))
2548 font_assert (font
&& driver
== font
->driver
);
2549 driver
->close (f
, font
);
2553 if (driver
->free_entity
)
2554 driver
->free_entity (entity
);
2559 XSETCDR (cache
, Qnil
);
2563 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2566 font_delete_unmatched (list
, spec
, size
)
2567 Lisp_Object list
, spec
;
2570 Lisp_Object entity
, val
;
2571 enum font_property_index prop
;
2573 for (val
= Qnil
; CONSP (list
); list
= XCDR (list
))
2575 entity
= XCAR (list
);
2576 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2577 if (INTEGERP (AREF (spec
, prop
))
2578 && ((XINT (AREF (spec
, prop
)) >> 8)
2579 != (XINT (AREF (entity
, prop
)) >> 8)))
2580 prop
= FONT_SPEC_MAX
;
2581 if (prop
++ <= FONT_SIZE_INDEX
2583 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2585 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2588 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2589 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2590 prop
= FONT_SPEC_MAX
;
2592 if (prop
< FONT_SPEC_MAX
)
2593 val
= Fcons (entity
, val
);
2599 /* Return a vector of font-entities matching with SPEC on FRAME. */
2602 font_list_entities (frame
, spec
)
2603 Lisp_Object frame
, spec
;
2605 FRAME_PTR f
= XFRAME (frame
);
2606 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2607 Lisp_Object ftype
, val
;
2610 int need_filtering
= 0;
2613 font_assert (FONT_SPEC_P (spec
));
2615 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2616 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2617 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2618 size
= font_pixel_size (f
, spec
);
2622 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2623 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2624 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2625 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2627 ASET (scratch_font_spec
, i
, Qnil
);
2628 if (! NILP (AREF (spec
, i
)))
2630 if (i
== FONT_DPI_INDEX
)
2631 /* Skip FONT_SPACING_INDEX */
2634 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2635 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2637 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2641 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2643 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2645 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2647 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2648 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2655 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2656 copy
= Fcopy_font_spec (scratch_font_spec
);
2657 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2658 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2660 if (! NILP (val
) && need_filtering
)
2661 val
= font_delete_unmatched (val
, spec
, size
);
2666 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2667 font_add_log ("list", spec
, val
);
2672 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2673 nil, is an array of face's attributes, which specifies preferred
2674 font-related attributes. */
2677 font_matching_entity (f
, attrs
, spec
)
2679 Lisp_Object
*attrs
, spec
;
2681 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2682 Lisp_Object ftype
, size
, entity
;
2685 XSETFRAME (frame
, f
);
2686 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2687 size
= AREF (spec
, FONT_SIZE_INDEX
);
2689 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2691 for (; driver_list
; driver_list
= driver_list
->next
)
2693 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2695 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2698 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2699 entity
= assoc_no_quit (spec
, XCDR (cache
));
2701 entity
= XCDR (entity
);
2704 entity
= driver_list
->driver
->match (frame
, spec
);
2705 copy
= Fcopy_font_spec (spec
);
2706 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2707 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2709 if (! NILP (entity
))
2712 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2713 ASET (spec
, FONT_SIZE_INDEX
, size
);
2714 font_add_log ("match", spec
, entity
);
2719 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2720 opened font object. */
2723 font_open_entity (f
, entity
, pixel_size
)
2728 struct font_driver_list
*driver_list
;
2729 Lisp_Object objlist
, size
, val
, font_object
;
2733 font_assert (FONT_ENTITY_P (entity
));
2734 size
= AREF (entity
, FONT_SIZE_INDEX
);
2735 if (XINT (size
) != 0)
2736 pixel_size
= XINT (size
);
2738 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2739 objlist
= XCDR (objlist
))
2740 if (! NILP (AREF (XCAR (objlist
), FONT_TYPE_INDEX
))
2741 && XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2742 return XCAR (objlist
);
2744 val
= AREF (entity
, FONT_TYPE_INDEX
);
2745 for (driver_list
= f
->font_driver_list
;
2746 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2747 driver_list
= driver_list
->next
);
2751 font_object
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2752 font_add_log ("open", entity
, font_object
);
2753 if (NILP (font_object
))
2755 ASET (entity
, FONT_OBJLIST_INDEX
,
2756 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2757 ASET (font_object
, FONT_OBJLIST_INDEX
, Qnil
);
2760 font
= XFONT_OBJECT (font_object
);
2761 min_width
= (font
->min_width
? font
->min_width
2762 : font
->average_width
? font
->average_width
2763 : font
->space_width
? font
->space_width
2765 #ifdef HAVE_WINDOW_SYSTEM
2766 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2767 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2769 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2770 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
;
2771 fonts_changed_p
= 1;
2775 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2776 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2777 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > font
->height
)
2778 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
, fonts_changed_p
= 1;
2786 /* Close FONT_OBJECT that is opened on frame F. */
2789 font_close_object (f
, font_object
)
2791 Lisp_Object font_object
;
2793 struct font
*font
= XFONT_OBJECT (font_object
);
2795 if (NILP (AREF (font_object
, FONT_TYPE_INDEX
)))
2796 /* Already closed. */
2798 font_add_log ("close", font_object
, Qnil
);
2799 font
->driver
->close (f
, font
);
2800 #ifdef HAVE_WINDOW_SYSTEM
2801 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2802 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2808 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2809 FONT is a font-entity and it must be opened to check. */
2812 font_has_char (f
, font
, c
)
2819 if (FONT_ENTITY_P (font
))
2821 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2822 struct font_driver_list
*driver_list
;
2824 for (driver_list
= f
->font_driver_list
;
2825 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2826 driver_list
= driver_list
->next
);
2829 if (! driver_list
->driver
->has_char
)
2831 return driver_list
->driver
->has_char (font
, c
);
2834 font_assert (FONT_OBJECT_P (font
));
2835 fontp
= XFONT_OBJECT (font
);
2836 if (fontp
->driver
->has_char
)
2838 int result
= fontp
->driver
->has_char (font
, c
);
2843 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2847 /* Return the glyph ID of FONT_OBJECT for character C. */
2850 font_encode_char (font_object
, c
)
2851 Lisp_Object font_object
;
2856 font_assert (FONT_OBJECT_P (font_object
));
2857 font
= XFONT_OBJECT (font_object
);
2858 return font
->driver
->encode_char (font
, c
);
2862 /* Return the name of FONT_OBJECT. */
2865 font_get_name (font_object
)
2866 Lisp_Object font_object
;
2868 font_assert (FONT_OBJECT_P (font_object
));
2869 return AREF (font_object
, FONT_NAME_INDEX
);
2873 /* Return the specification of FONT_OBJECT. */
2876 font_get_spec (font_object
)
2877 Lisp_Object font_object
;
2879 Lisp_Object spec
= font_make_spec ();
2882 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2883 ASET (spec
, i
, AREF (font_object
, i
));
2884 ASET (spec
, FONT_SIZE_INDEX
,
2885 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2890 font_spec_from_name (font_name
)
2891 Lisp_Object font_name
;
2893 Lisp_Object args
[2];
2896 args
[1] = font_name
;
2897 return Ffont_spec (2, args
);
2902 font_clear_prop (attrs
, prop
)
2904 enum font_property_index prop
;
2906 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2910 if (NILP (AREF (font
, prop
))
2911 && prop
!= FONT_FAMILY_INDEX
&& prop
!= FONT_FOUNDRY_INDEX
2912 && prop
!= FONT_SIZE_INDEX
)
2914 font
= Fcopy_font_spec (font
);
2915 ASET (font
, prop
, Qnil
);
2916 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
2918 if (prop
== FONT_FAMILY_INDEX
)
2919 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
2920 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
2921 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
2922 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
2923 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2924 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2925 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2927 else if (prop
== FONT_SIZE_INDEX
)
2929 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2930 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2931 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2933 attrs
[LFACE_FONT_INDEX
] = font
;
2937 font_update_lface (f
, attrs
)
2943 spec
= attrs
[LFACE_FONT_INDEX
];
2944 if (! FONT_SPEC_P (spec
))
2947 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
2948 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
2949 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2950 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
2951 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
2952 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
2953 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
2954 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);;
2955 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
2956 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
2957 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
2961 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2966 val
= Ffont_get (spec
, QCdpi
);
2969 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
2972 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2973 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
2974 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
2979 /* Return a font-entity satisfying SPEC and best matching with face's
2980 font related attributes in ATTRS. C, if not negative, is a
2981 character that the entity must support. */
2984 font_find_for_lface (f
, attrs
, spec
, c
)
2991 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
2992 Lisp_Object size
, foundry
[3], *family
, registry
[3];
2994 int i
, j
, k
, result
;
2996 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
2997 if (NILP (registry
[0]))
2999 registry
[0] = Qiso8859_1
;
3000 registry
[1] = Qascii_0
;
3001 registry
[2] = null_vector
;
3004 registry
[1] = null_vector
;
3006 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3008 struct charset
*encoding
, *repertory
;
3010 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3011 &encoding
, &repertory
) < 0)
3015 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3017 /* Any font of this registry support C. So, let's
3018 suppress the further checking. */
3021 else if (c
> encoding
->max_char
)
3025 work
= Fcopy_font_spec (spec
);
3026 XSETFRAME (frame
, f
);
3027 size
= AREF (spec
, FONT_SIZE_INDEX
);
3028 pixel_size
= font_pixel_size (f
, spec
);
3029 if (pixel_size
== 0)
3031 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3033 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3035 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3036 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3037 if (! NILP (foundry
[0]))
3038 foundry
[1] = null_vector
;
3039 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3041 foundry
[0] = font_intern_prop (SDATA (attrs
[LFACE_FOUNDRY_INDEX
]),
3042 SBYTES (attrs
[LFACE_FOUNDRY_INDEX
]), 1);
3044 foundry
[2] = null_vector
;
3047 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3049 val
= AREF (work
, FONT_FAMILY_INDEX
);
3050 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3051 val
= font_intern_prop (SDATA (attrs
[LFACE_FAMILY_INDEX
]),
3052 SBYTES (attrs
[LFACE_FAMILY_INDEX
]), 1);
3055 family
= alloca ((sizeof family
[0]) * 2);
3057 family
[1] = null_vector
; /* terminator. */
3062 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3064 if (! NILP (alters
))
3066 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3067 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3068 family
[i
] = XCAR (alters
);
3069 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3071 family
[i
] = null_vector
;
3075 family
= alloca ((sizeof family
[0]) * 3);
3078 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3080 family
[i
] = null_vector
;
3084 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3086 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3087 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3089 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3090 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3092 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3093 entities
= font_list_entities (frame
, work
);
3094 if (ASIZE (entities
) > 0)
3101 if (ASIZE (entities
) == 1)
3104 return AREF (entities
, 0);
3108 /* Sort fonts by properties specified in LFACE. */
3109 Lisp_Object prefer
= scratch_font_prefer
;
3111 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3112 ASET (prefer
, i
, AREF (work
, i
));
3113 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3115 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3117 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3118 if (NILP (AREF (prefer
, i
)))
3119 ASET (prefer
, i
, AREF (face_font
, i
));
3121 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3122 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3123 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3124 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3125 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3126 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3127 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3128 entities
= font_sort_entites (entities
, prefer
, frame
, work
, c
< 0);
3133 for (i
= 0; i
< ASIZE (entities
); i
++)
3137 val
= AREF (entities
, i
);
3140 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3141 if (! EQ (AREF (val
, j
), props
[j
]))
3143 if (j
> FONT_REGISTRY_INDEX
)
3146 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3147 props
[j
] = AREF (val
, j
);
3148 result
= font_has_char (f
, val
, c
);
3153 val
= font_open_for_lface (f
, val
, attrs
, spec
);
3156 result
= font_has_char (f
, val
, c
);
3157 font_close_object (f
, val
);
3159 return AREF (entities
, i
);
3166 font_open_for_lface (f
, entity
, attrs
, spec
)
3174 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3175 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3176 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3177 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3178 size
= font_pixel_size (f
, spec
);
3181 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3184 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3186 return font_open_entity (f
, entity
, size
);
3190 /* Find a font satisfying SPEC and best matching with face's
3191 attributes in ATTRS on FRAME, and return the opened
3195 font_load_for_lface (f
, attrs
, spec
)
3197 Lisp_Object
*attrs
, spec
;
3201 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3204 /* No font is listed for SPEC, but each font-backend may have
3205 the different criteria about "font matching". So, try
3207 entity
= font_matching_entity (f
, attrs
, spec
);
3211 return font_open_for_lface (f
, entity
, attrs
, spec
);
3215 /* Make FACE on frame F ready to use the font opened for FACE. */
3218 font_prepare_for_face (f
, face
)
3222 if (face
->font
->driver
->prepare_face
)
3223 face
->font
->driver
->prepare_face (f
, face
);
3227 /* Make FACE on frame F stop using the font opened for FACE. */
3230 font_done_for_face (f
, face
)
3234 if (face
->font
->driver
->done_face
)
3235 face
->font
->driver
->done_face (f
, face
);
3240 /* Open a font best matching with NAME on frame F. If no proper font
3241 is found, return Qnil. */
3244 font_open_by_name (f
, name
)
3248 Lisp_Object args
[2];
3249 Lisp_Object spec
, attrs
[LFACE_VECTOR_SIZE
];
3252 args
[1] = make_unibyte_string (name
, strlen (name
));
3253 spec
= Ffont_spec (2, args
);
3254 /* We set up the default font-related attributes of a face to prefer
3256 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3257 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3258 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3259 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3260 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3262 return font_load_for_lface (f
, attrs
, spec
);
3266 /* Register font-driver DRIVER. This function is used in two ways.
3268 The first is with frame F non-NULL. In this case, make DRIVER
3269 available (but not yet activated) on F. All frame creaters
3270 (e.g. Fx_create_frame) must call this function at least once with
3271 an available font-driver.
3273 The second is with frame F NULL. In this case, DRIVER is globally
3274 registered in the variable `font_driver_list'. All font-driver
3275 implementations must call this function in its syms_of_XXXX
3276 (e.g. syms_of_xfont). */
3279 register_font_driver (driver
, f
)
3280 struct font_driver
*driver
;
3283 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3284 struct font_driver_list
*prev
, *list
;
3286 if (f
&& ! driver
->draw
)
3287 error ("Unusable font driver for a frame: %s",
3288 SDATA (SYMBOL_NAME (driver
->type
)));
3290 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3291 if (EQ (list
->driver
->type
, driver
->type
))
3292 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3294 list
= malloc (sizeof (struct font_driver_list
));
3296 list
->driver
= driver
;
3301 f
->font_driver_list
= list
;
3303 font_driver_list
= list
;
3309 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3310 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3311 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3313 A caller must free all realized faces if any in advance. The
3314 return value is a list of font backends actually made used on
3318 font_update_drivers (f
, new_drivers
)
3320 Lisp_Object new_drivers
;
3322 Lisp_Object active_drivers
= Qnil
;
3323 struct font_driver
*driver
;
3324 struct font_driver_list
*list
;
3326 /* At first, turn off non-requested drivers, and turn on requested
3328 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3330 driver
= list
->driver
;
3331 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3336 if (driver
->end_for_frame
)
3337 driver
->end_for_frame (f
);
3338 font_finish_cache (f
, driver
);
3343 if (! driver
->start_for_frame
3344 || driver
->start_for_frame (f
) == 0)
3346 font_prepare_cache (f
, driver
);
3353 if (NILP (new_drivers
))
3356 if (! EQ (new_drivers
, Qt
))
3358 /* Re-order the driver list according to new_drivers. */
3359 struct font_driver_list
**list_table
, **next
;
3363 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3364 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3366 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3367 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3370 list_table
[i
++] = list
;
3372 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3374 list_table
[i
] = list
;
3375 list_table
[i
] = NULL
;
3377 next
= &f
->font_driver_list
;
3378 for (i
= 0; list_table
[i
]; i
++)
3380 *next
= list_table
[i
];
3381 next
= &(*next
)->next
;
3386 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3388 active_drivers
= nconc2 (active_drivers
,
3389 Fcons (list
->driver
->type
, Qnil
));
3390 return active_drivers
;
3394 font_put_frame_data (f
, driver
, data
)
3396 struct font_driver
*driver
;
3399 struct font_data_list
*list
, *prev
;
3401 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3402 prev
= list
, list
= list
->next
)
3403 if (list
->driver
== driver
)
3410 prev
->next
= list
->next
;
3412 f
->font_data_list
= list
->next
;
3420 list
= malloc (sizeof (struct font_data_list
));
3423 list
->driver
= driver
;
3424 list
->next
= f
->font_data_list
;
3425 f
->font_data_list
= list
;
3433 font_get_frame_data (f
, driver
)
3435 struct font_driver
*driver
;
3437 struct font_data_list
*list
;
3439 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3440 if (list
->driver
== driver
)
3448 /* Return the font used to draw character C by FACE at buffer position
3449 POS in window W. If STRING is non-nil, it is a string containing C
3450 at index POS. If C is negative, get C from the current buffer or
3454 font_at (c
, pos
, face
, w
, string
)
3463 Lisp_Object font_object
;
3469 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3472 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3474 c
= FETCH_CHAR (pos_byte
);
3477 c
= FETCH_BYTE (pos
);
3483 multibyte
= STRING_MULTIBYTE (string
);
3486 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3488 str
= SDATA (string
) + pos_byte
;
3489 c
= STRING_CHAR (str
, 0);
3492 c
= SDATA (string
)[pos
];
3496 f
= XFRAME (w
->frame
);
3497 if (! FRAME_WINDOW_P (f
))
3504 if (STRINGP (string
))
3505 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3506 DEFAULT_FACE_ID
, 0);
3508 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3510 face
= FACE_FROM_ID (f
, face_id
);
3514 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3515 face
= FACE_FROM_ID (f
, face_id
);
3520 XSETFONT (font_object
, face
->font
);
3525 /* Check how many characters after POS (at most to LIMIT) can be
3526 displayed by the same font. FACE is the face selected for the
3527 character as POS on frame F. STRING, if not nil, is the string to
3528 check instead of the current buffer.
3530 The return value is the position of the character that is displayed
3531 by the differnt font than that of the character as POS. */
3534 font_range (pos
, limit
, face
, f
, string
)
3535 EMACS_INT pos
, limit
;
3548 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3549 pos_byte
= CHAR_TO_BYTE (pos
);
3553 multibyte
= STRING_MULTIBYTE (string
);
3554 pos_byte
= string_char_to_byte (string
, pos
);
3558 /* All unibyte character are displayed by the same font. */
3566 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3568 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3569 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3570 face
= FACE_FROM_ID (f
, face_id
);
3577 else if (font
!= face
->font
)
3589 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3590 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3591 Return nil otherwise.
3592 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3593 which kind of font it is. It must be one of `font-spec', `font-entity',
3595 (object
, extra_type
)
3596 Lisp_Object object
, extra_type
;
3598 if (NILP (extra_type
))
3599 return (FONTP (object
) ? Qt
: Qnil
);
3600 if (EQ (extra_type
, Qfont_spec
))
3601 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3602 if (EQ (extra_type
, Qfont_entity
))
3603 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3604 if (EQ (extra_type
, Qfont_object
))
3605 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3606 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3609 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3610 doc
: /* Return a newly created font-spec with arguments as properties.
3612 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3613 valid font property name listed below:
3615 `:family', `:weight', `:slant', `:width'
3617 They are the same as face attributes of the same name. See
3618 `set-face-attribute'.
3622 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3626 VALUE must be a string or a symbol specifying the additional
3627 typographic style information of a font, e.g. ``sans''.
3631 VALUE must be a string or a symbol specifying the charset registry and
3632 encoding of a font, e.g. ``iso8859-1''.
3636 VALUE must be a non-negative integer or a floating point number
3637 specifying the font size. It specifies the font size in pixels
3638 (if VALUE is an integer), or in points (if VALUE is a float).
3639 usage: (font-spec ARGS ...) */)
3644 Lisp_Object spec
= font_make_spec ();
3647 for (i
= 0; i
< nargs
; i
+= 2)
3649 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3651 if (EQ (key
, QCname
))
3654 font_parse_name ((char *) SDATA (val
), spec
);
3655 font_put_extra (spec
, key
, val
);
3659 int idx
= get_font_prop_index (key
);
3663 val
= font_prop_validate (idx
, Qnil
, val
);
3664 if (idx
< FONT_EXTRA_INDEX
)
3665 ASET (spec
, idx
, val
);
3667 font_put_extra (spec
, key
, val
);
3670 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3676 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3677 doc
: /* Return a copy of FONT as a font-spec. */)
3681 Lisp_Object new_spec
, tail
, extra
;
3685 new_spec
= font_make_spec ();
3686 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3687 ASET (new_spec
, i
, AREF (font
, i
));
3689 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3691 if (! EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3692 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3694 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3698 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3699 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3700 Every specified properties in FROM override the corresponding
3701 properties in TO. */)
3703 Lisp_Object from
, to
;
3705 Lisp_Object extra
, tail
;
3710 to
= Fcopy_font_spec (to
);
3711 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3712 ASET (to
, i
, AREF (from
, i
));
3713 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3714 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3715 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3717 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3720 XSETCDR (slot
, XCDR (XCAR (tail
)));
3722 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3724 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3728 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3729 doc
: /* Return the value of FONT's property KEY.
3730 FONT is a font-spec, a font-entity, or a font-object. */)
3732 Lisp_Object font
, key
;
3739 idx
= get_font_prop_index (key
);
3740 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3741 return AREF (font
, idx
);
3742 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
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, FOUNDRY, HEIGHT, WEIGHT, SLANT, and WIDTH are face
3753 attribute values compatible with `set-face-attribute'.
3755 The optional argument FRAME specifies the frame that the face
3756 attributes are to be displayed on. If omitted, the selected frame is
3762 Lisp_Object plist
[10];
3766 frame
= selected_frame
;
3767 CHECK_LIVE_FRAME (frame
);
3772 int fontset
= fs_query_fontset (font
, 0);
3773 Lisp_Object name
= font
;
3775 font
= fontset_ascii (fontset
);
3776 font
= font_spec_from_name (name
);
3778 signal_error ("Invalid font name", name
);
3780 else if (! FONTP (font
))
3781 signal_error ("Invalid font object", font
);
3783 plist
[0] = QCfamily
;
3784 val
= AREF (font
, FONT_FAMILY_INDEX
);
3785 plist
[1] = NILP (val
) ? Qnil
: SYMBOL_NAME (val
);
3787 plist
[2] = QCheight
;
3788 val
= AREF (font
, FONT_SIZE_INDEX
);
3791 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
3792 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
3793 plist
[3] = make_number (10 * PIXEL_TO_POINT (XINT (val
), dpi
));
3795 else if (FLOATP (val
))
3796 plist
[3] = make_number (10 * (int) XFLOAT_DATA (val
));
3800 plist
[4] = QCweight
;
3801 val
= FONT_WEIGHT_FOR_FACE (font
);
3802 plist
[5] = NILP (val
) ? Qnormal
: val
;
3805 val
= FONT_SLANT_FOR_FACE (font
);
3806 plist
[7] = NILP (val
) ? Qnormal
: val
;
3809 val
= FONT_WIDTH_FOR_FACE (font
);
3810 plist
[9] = NILP (val
) ? Qnormal
: val
;
3812 return Flist (10, plist
);
3815 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3816 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
3817 (font_spec
, prop
, val
)
3818 Lisp_Object font_spec
, prop
, val
;
3822 CHECK_FONT_SPEC (font_spec
);
3823 idx
= get_font_prop_index (prop
);
3824 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3825 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
3827 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
3831 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3832 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3833 Optional 2nd argument FRAME specifies the target frame.
3834 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3835 Optional 4th argument PREFER, if non-nil, is a font-spec to
3836 control the order of the returned list. Fonts are sorted by
3837 how close they are to PREFER. */)
3838 (font_spec
, frame
, num
, prefer
)
3839 Lisp_Object font_spec
, frame
, num
, prefer
;
3841 Lisp_Object vec
, list
, tail
;
3845 frame
= selected_frame
;
3846 CHECK_LIVE_FRAME (frame
);
3847 CHECK_FONT_SPEC (font_spec
);
3855 if (! NILP (prefer
))
3856 CHECK_FONT_SPEC (prefer
);
3858 vec
= font_list_entities (frame
, font_spec
);
3863 return Fcons (AREF (vec
, 0), Qnil
);
3865 if (! NILP (prefer
))
3866 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
, 0);
3868 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3869 if (n
== 0 || n
> len
)
3871 for (i
= 1; i
< n
; i
++)
3873 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3875 XSETCDR (tail
, val
);
3881 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
3882 doc
: /* List available font families on the current frame.
3883 Optional argument FRAME, if non-nil, specifies the target frame. */)
3888 struct font_driver_list
*driver_list
;
3892 frame
= selected_frame
;
3893 CHECK_LIVE_FRAME (frame
);
3896 for (driver_list
= f
->font_driver_list
; driver_list
;
3897 driver_list
= driver_list
->next
)
3898 if (driver_list
->driver
->list_family
)
3900 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3906 Lisp_Object tail
= list
;
3908 for (; CONSP (val
); val
= XCDR (val
))
3909 if (NILP (Fmemq (XCAR (val
), tail
)))
3910 list
= Fcons (XCAR (val
), list
);
3916 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3917 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3918 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3920 Lisp_Object font_spec
, frame
;
3922 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3929 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
3930 doc
: /* Return XLFD name of FONT.
3931 FONT is a font-spec, font-entity, or font-object.
3932 If the name is too long for XLFD (maximum 255 chars), return nil.
3933 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
3934 the consecutive wildcards are folded to one. */)
3935 (font
, fold_wildcards
)
3936 Lisp_Object font
, fold_wildcards
;
3943 if (FONT_OBJECT_P (font
))
3945 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
3947 if (STRINGP (font_name
)
3948 && SDATA (font_name
)[0] == '-')
3950 if (NILP (fold_wildcards
))
3952 strcpy (name
, (char *) SDATA (font_name
));
3955 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
3957 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3960 if (! NILP (fold_wildcards
))
3962 char *p0
= name
, *p1
;
3964 while ((p1
= strstr (p0
, "-*-*")))
3966 strcpy (p1
, p1
+ 2);
3971 return build_string (name
);
3974 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3975 doc
: /* Clear font cache. */)
3978 Lisp_Object list
, frame
;
3980 FOR_EACH_FRAME (list
, frame
)
3982 FRAME_PTR f
= XFRAME (frame
);
3983 struct font_driver_list
*driver_list
= f
->font_driver_list
;
3985 for (; driver_list
; driver_list
= driver_list
->next
)
3986 if (driver_list
->on
)
3988 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
3993 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
3995 font_assert (! NILP (val
));
3996 val
= XCDR (XCAR (val
));
3997 if (XINT (XCAR (val
)) == 0)
3999 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4000 XSETCDR (cache
, XCDR (val
));
4008 /* The following three functions are still experimental. */
4010 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
4011 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
4012 FONT-OBJECT may be nil if it is not yet known.
4014 G-string is sequence of glyphs of a specific font,
4015 and is a vector of this form:
4016 [ HEADER GLYPH ... ]
4017 HEADER is a vector of this form:
4018 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
4020 FONT-OBJECT is a font-object for all glyphs in the g-string,
4021 WIDTH thru DESCENT are the metrics (in pixels) of the whole G-string.
4022 GLYPH is a vector of this form:
4023 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
4024 [ [X-OFF Y-OFF WADJUST] | nil] ]
4026 FROM-IDX and TO-IDX are used internally and should not be touched.
4027 C is the character of the glyph.
4028 CODE is the glyph-code of C in FONT-OBJECT.
4029 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4030 X-OFF and Y-OFF are offests to the base position for the glyph.
4031 WADJUST is the adjustment to the normal width of the glyph. */)
4033 Lisp_Object font_object
, num
;
4035 Lisp_Object gstring
, g
;
4039 if (! NILP (font_object
))
4040 CHECK_FONT_OBJECT (font_object
);
4043 len
= XINT (num
) + 1;
4044 gstring
= Fmake_vector (make_number (len
), Qnil
);
4045 g
= Fmake_vector (make_number (6), Qnil
);
4046 ASET (g
, 0, font_object
);
4047 ASET (gstring
, 0, g
);
4048 for (i
= 1; i
< len
; i
++)
4049 ASET (gstring
, i
, Fmake_vector (make_number (10), Qnil
));
4053 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
4054 doc
: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
4055 START and END specify the region to extract characters.
4056 If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
4057 where to extract characters.
4058 FONT-OBJECT may be nil if GSTRING already contains one. */)
4059 (gstring
, font_object
, start
, end
, object
)
4060 Lisp_Object gstring
, font_object
, start
, end
, object
;
4066 CHECK_VECTOR (gstring
);
4067 if (NILP (font_object
))
4068 font_object
= LGSTRING_FONT (gstring
);
4069 font
= XFONT_OBJECT (font_object
);
4071 if (STRINGP (object
))
4073 const unsigned char *p
;
4075 CHECK_NATNUM (start
);
4077 if (XINT (start
) > XINT (end
)
4078 || XINT (end
) > ASIZE (object
)
4079 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
4080 args_out_of_range_3 (object
, start
, end
);
4082 len
= XINT (end
) - XINT (start
);
4083 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
4084 for (i
= 0; i
< len
; i
++)
4086 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4087 /* Shut up GCC warning in comparison with
4088 MOST_POSITIVE_FIXNUM below. */
4091 c
= STRING_CHAR_ADVANCE (p
);
4092 cod
= code
= font
->driver
->encode_char (font
, c
);
4093 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
4095 LGLYPH_SET_FROM (g
, i
);
4096 LGLYPH_SET_TO (g
, i
);
4097 LGLYPH_SET_CHAR (g
, c
);
4098 LGLYPH_SET_CODE (g
, code
);
4105 if (! NILP (object
))
4106 Fset_buffer (object
);
4107 validate_region (&start
, &end
);
4108 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
4109 args_out_of_range (start
, end
);
4110 len
= XINT (end
) - XINT (start
);
4112 pos_byte
= CHAR_TO_BYTE (pos
);
4113 for (i
= 0; i
< len
; i
++)
4115 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4116 /* Shut up GCC warning in comparison with
4117 MOST_POSITIVE_FIXNUM below. */
4120 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
4121 cod
= code
= font
->driver
->encode_char (font
, c
);
4122 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
4124 LGLYPH_SET_FROM (g
, i
);
4125 LGLYPH_SET_TO (g
, i
);
4126 LGLYPH_SET_CHAR (g
, c
);
4127 LGLYPH_SET_CODE (g
, code
);
4130 for (; i
< LGSTRING_LENGTH (gstring
); i
++)
4131 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
4135 DEFUN ("font-shape-text", Ffont_shape_text
, Sfont_shape_text
, 3, 4, 0,
4136 doc
: /* Shape text between FROM and TO by FONT-OBJECT.
4137 If optional 4th argument STRING is non-nil, it is a string to shape,
4138 and FROM and TO are indices to the string.
4139 The value is the end position of the text that can be shaped by
4141 (from
, to
, font_object
, string
)
4142 Lisp_Object from
, to
, font_object
, string
;
4145 struct font_metrics metrics
;
4146 EMACS_INT start
, end
;
4147 Lisp_Object gstring
, n
;
4150 if (! FONT_OBJECT_P (font_object
))
4152 font
= XFONT_OBJECT (font_object
);
4153 if (! font
->driver
->shape
)
4158 validate_region (&from
, &to
);
4159 start
= XFASTINT (from
);
4160 end
= XFASTINT (to
);
4161 modify_region (current_buffer
, start
, end
, 0);
4165 CHECK_STRING (string
);
4166 start
= XINT (from
);
4168 if (start
< 0 || start
> end
|| end
> SCHARS (string
))
4169 args_out_of_range_3 (string
, from
, to
);
4173 gstring
= Ffont_make_gstring (font_object
, make_number (len
));
4174 Ffont_fill_gstring (gstring
, font_object
, from
, to
, string
);
4176 /* Try at most three times with larger gstring each time. */
4177 for (i
= 0; i
< 3; i
++)
4179 Lisp_Object args
[2];
4181 n
= font
->driver
->shape (gstring
);
4185 args
[1] = Fmake_vector (make_number (len
), Qnil
);
4186 gstring
= Fvconcat (2, args
);
4188 if (! INTEGERP (n
) || XINT (n
) == 0)
4192 for (i
= 0; i
< len
;)
4195 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4196 EMACS_INT this_from
= LGLYPH_FROM (g
);
4197 EMACS_INT this_to
= LGLYPH_TO (g
) + 1;
4199 int need_composition
= 0;
4201 metrics
.lbearing
= LGLYPH_LBEARING (g
);
4202 metrics
.rbearing
= LGLYPH_RBEARING (g
);
4203 metrics
.ascent
= LGLYPH_ASCENT (g
);
4204 metrics
.descent
= LGLYPH_DESCENT (g
);
4205 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4207 metrics
.width
= LGLYPH_WIDTH (g
);
4208 if (LGLYPH_CHAR (g
) == 0 || metrics
.width
== 0)
4209 need_composition
= 1;
4213 metrics
.width
= LGLYPH_WADJUST (g
);
4214 metrics
.lbearing
+= LGLYPH_XOFF (g
);
4215 metrics
.rbearing
+= LGLYPH_XOFF (g
);
4216 metrics
.ascent
-= LGLYPH_YOFF (g
);
4217 metrics
.descent
+= LGLYPH_YOFF (g
);
4218 need_composition
= 1;
4220 for (j
= i
+ 1; j
< len
; j
++)
4224 g
= LGSTRING_GLYPH (gstring
, j
);
4225 if (this_from
!= LGLYPH_FROM (g
))
4227 need_composition
= 1;
4228 x
= metrics
.width
+ LGLYPH_LBEARING (g
) + LGLYPH_XOFF (g
);
4229 if (metrics
.lbearing
> x
)
4230 metrics
.lbearing
= x
;
4231 x
= metrics
.width
+ LGLYPH_RBEARING (g
) + LGLYPH_XOFF (g
);
4232 if (metrics
.rbearing
< x
)
4233 metrics
.rbearing
= x
;
4234 x
= LGLYPH_ASCENT (g
) - LGLYPH_YOFF (g
);
4235 if (metrics
.ascent
< x
)
4237 x
= LGLYPH_DESCENT (g
) - LGLYPH_YOFF (g
);
4238 if (metrics
.descent
< x
)
4239 metrics
.descent
= x
;
4240 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4241 metrics
.width
+= LGLYPH_WIDTH (g
);
4243 metrics
.width
+= LGLYPH_WADJUST (g
);
4246 if (need_composition
)
4248 gstr
= Ffont_make_gstring (font_object
, make_number (j
- i
));
4249 LGSTRING_SET_WIDTH (gstr
, metrics
.width
);
4250 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
4251 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
);
4252 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
4253 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
4254 for (k
= i
; i
< j
; i
++)
4256 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4258 LGLYPH_SET_FROM (g
, LGLYPH_FROM (g
) - this_from
);
4259 LGLYPH_SET_TO (g
, LGLYPH_TO (g
) - this_from
);
4260 LGSTRING_SET_GLYPH (gstr
, i
- k
, LGSTRING_GLYPH (gstring
, i
));
4262 from
= make_number (start
+ this_from
);
4263 to
= make_number (start
+ this_to
);
4265 Fcompose_region_internal (from
, to
, gstr
, Qnil
);
4267 Fcompose_string_internal (string
, from
, to
, gstr
, Qnil
);
4278 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4279 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4280 OTF-FEATURES specifies which features to apply in this format:
4281 (SCRIPT LANGSYS GSUB GPOS)
4283 SCRIPT is a symbol specifying a script tag of OpenType,
4284 LANGSYS is a symbol specifying a langsys tag of OpenType,
4285 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4287 If LANGYS is nil, the default langsys is selected.
4289 The features are applied in the order they appear in the list. The
4290 symbol `*' means to apply all available features not present in this
4291 list, and the remaining features are ignored. For instance, (vatu
4292 pstf * haln) is to apply vatu and pstf in this order, then to apply
4293 all available features other than vatu, pstf, and haln.
4295 The features are applied to the glyphs in the range FROM and TO of
4296 the glyph-string GSTRING-IN.
4298 If some feature is actually applicable, the resulting glyphs are
4299 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4300 this case, the value is the number of produced glyphs.
4302 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4305 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4306 produced in GSTRING-OUT, and the value is nil.
4308 See the documentation of `font-make-gstring' for the format of
4310 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4311 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4313 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4318 check_otf_features (otf_features
);
4319 CHECK_FONT_OBJECT (font_object
);
4320 font
= XFONT_OBJECT (font_object
);
4321 if (! font
->driver
->otf_drive
)
4322 error ("Font backend %s can't drive OpenType GSUB table",
4323 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4324 CHECK_CONS (otf_features
);
4325 CHECK_SYMBOL (XCAR (otf_features
));
4326 val
= XCDR (otf_features
);
4327 CHECK_SYMBOL (XCAR (val
));
4328 val
= XCDR (otf_features
);
4331 len
= check_gstring (gstring_in
);
4332 CHECK_VECTOR (gstring_out
);
4333 CHECK_NATNUM (from
);
4335 CHECK_NATNUM (index
);
4337 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4338 args_out_of_range_3 (from
, to
, make_number (len
));
4339 if (XINT (index
) >= ASIZE (gstring_out
))
4340 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4341 num
= font
->driver
->otf_drive (font
, otf_features
,
4342 gstring_in
, XINT (from
), XINT (to
),
4343 gstring_out
, XINT (index
), 0);
4346 return make_number (num
);
4349 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4351 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4352 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4354 (SCRIPT LANGSYS FEATURE ...)
4355 See the documentation of `font-drive-otf' for more detail.
4357 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4358 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4359 character code corresponding to the glyph or nil if there's no
4360 corresponding character. */)
4361 (font_object
, character
, otf_features
)
4362 Lisp_Object font_object
, character
, otf_features
;
4365 Lisp_Object gstring_in
, gstring_out
, g
;
4366 Lisp_Object alternates
;
4369 CHECK_FONT_GET_OBJECT (font_object
, font
);
4370 if (! font
->driver
->otf_drive
)
4371 error ("Font backend %s can't drive OpenType GSUB table",
4372 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4373 CHECK_CHARACTER (character
);
4374 CHECK_CONS (otf_features
);
4376 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4377 g
= LGSTRING_GLYPH (gstring_in
, 0);
4378 LGLYPH_SET_CHAR (g
, XINT (character
));
4379 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4380 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4381 gstring_out
, 0, 1)) < 0)
4382 gstring_out
= Ffont_make_gstring (font_object
,
4383 make_number (ASIZE (gstring_out
) * 2));
4385 for (i
= 0; i
< num
; i
++)
4387 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4388 int c
= LGLYPH_CHAR (g
);
4389 unsigned code
= LGLYPH_CODE (g
);
4391 alternates
= Fcons (Fcons (make_number (code
),
4392 c
> 0 ? make_number (c
) : Qnil
),
4395 return Fnreverse (alternates
);
4401 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4402 doc
: /* Open FONT-ENTITY. */)
4403 (font_entity
, size
, frame
)
4404 Lisp_Object font_entity
;
4410 CHECK_FONT_ENTITY (font_entity
);
4412 frame
= selected_frame
;
4413 CHECK_LIVE_FRAME (frame
);
4416 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4419 CHECK_NUMBER_OR_FLOAT (size
);
4421 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
4423 isize
= XINT (size
);
4427 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4430 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4431 doc
: /* Close FONT-OBJECT. */)
4432 (font_object
, frame
)
4433 Lisp_Object font_object
, frame
;
4435 CHECK_FONT_OBJECT (font_object
);
4437 frame
= selected_frame
;
4438 CHECK_LIVE_FRAME (frame
);
4439 font_close_object (XFRAME (frame
), font_object
);
4443 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4444 doc
: /* Return information about FONT-OBJECT.
4445 The value is a vector:
4446 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4449 NAME is a string of the font name (or nil if the font backend doesn't
4452 FILENAME is a string of the font file (or nil if the font backend
4453 doesn't provide a file name).
4455 PIXEL-SIZE is a pixel size by which the font is opened.
4457 SIZE is a maximum advance width of the font in pixels.
4459 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4462 CAPABILITY is a list whose first element is a symbol representing the
4463 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4464 remaining elements describe the details of the font capability.
4466 If the font is OpenType font, the form of the list is
4467 \(opentype GSUB GPOS)
4468 where GSUB shows which "GSUB" features the font supports, and GPOS
4469 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4470 lists of the format:
4471 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4473 If the font is not OpenType font, currently the length of the form is
4476 SCRIPT is a symbol representing OpenType script tag.
4478 LANGSYS is a symbol representing OpenType langsys tag, or nil
4479 representing the default langsys.
4481 FEATURE is a symbol representing OpenType feature tag.
4483 If the font is not OpenType font, CAPABILITY is nil. */)
4485 Lisp_Object font_object
;
4490 CHECK_FONT_GET_OBJECT (font_object
, font
);
4492 val
= Fmake_vector (make_number (9), Qnil
);
4493 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4494 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4495 ASET (val
, 2, make_number (font
->pixel_size
));
4496 ASET (val
, 3, make_number (font
->max_width
));
4497 ASET (val
, 4, make_number (font
->ascent
));
4498 ASET (val
, 5, make_number (font
->descent
));
4499 ASET (val
, 6, make_number (font
->space_width
));
4500 ASET (val
, 7, make_number (font
->average_width
));
4501 if (font
->driver
->otf_capability
)
4502 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4506 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4507 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4508 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4509 (font_object
, string
)
4510 Lisp_Object font_object
, string
;
4516 CHECK_FONT_GET_OBJECT (font_object
, font
);
4517 CHECK_STRING (string
);
4518 len
= SCHARS (string
);
4519 vec
= Fmake_vector (make_number (len
), Qnil
);
4520 for (i
= 0; i
< len
; i
++)
4522 Lisp_Object ch
= Faref (string
, make_number (i
));
4527 struct font_metrics metrics
;
4529 cod
= code
= font
->driver
->encode_char (font
, c
);
4530 if (code
== FONT_INVALID_CODE
)
4532 val
= Fmake_vector (make_number (6), Qnil
);
4533 if (cod
<= MOST_POSITIVE_FIXNUM
)
4534 ASET (val
, 0, make_number (code
));
4536 ASET (val
, 0, Fcons (make_number (code
>> 16),
4537 make_number (code
& 0xFFFF)));
4538 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4539 ASET (val
, 1, make_number (metrics
.lbearing
));
4540 ASET (val
, 2, make_number (metrics
.rbearing
));
4541 ASET (val
, 3, make_number (metrics
.width
));
4542 ASET (val
, 4, make_number (metrics
.ascent
));
4543 ASET (val
, 5, make_number (metrics
.descent
));
4549 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4550 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4551 FONT is a font-spec, font-entity, or font-object. */)
4553 Lisp_Object spec
, font
;
4555 CHECK_FONT_SPEC (spec
);
4558 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4561 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4562 doc
: /* Return a font-object for displaying a character at POSITION.
4563 Optional second arg WINDOW, if non-nil, is a window displaying
4564 the current buffer. It defaults to the currently selected window. */)
4565 (position
, window
, string
)
4566 Lisp_Object position
, window
, string
;
4573 CHECK_NUMBER_COERCE_MARKER (position
);
4574 pos
= XINT (position
);
4575 if (pos
< BEGV
|| pos
>= ZV
)
4576 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4580 CHECK_NUMBER (position
);
4581 CHECK_STRING (string
);
4582 pos
= XINT (position
);
4583 if (pos
< 0 || pos
>= SCHARS (string
))
4584 args_out_of_range (string
, position
);
4587 window
= selected_window
;
4588 CHECK_LIVE_WINDOW (window
);
4589 w
= XWINDOW (window
);
4591 return font_at (-1, pos
, NULL
, w
, string
);
4595 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4596 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4597 The value is a number of glyphs drawn.
4598 Type C-l to recover what previously shown. */)
4599 (font_object
, string
)
4600 Lisp_Object font_object
, string
;
4602 Lisp_Object frame
= selected_frame
;
4603 FRAME_PTR f
= XFRAME (frame
);
4609 CHECK_FONT_GET_OBJECT (font_object
, font
);
4610 CHECK_STRING (string
);
4611 len
= SCHARS (string
);
4612 code
= alloca (sizeof (unsigned) * len
);
4613 for (i
= 0; i
< len
; i
++)
4615 Lisp_Object ch
= Faref (string
, make_number (i
));
4619 code
[i
] = font
->driver
->encode_char (font
, c
);
4620 if (code
[i
] == FONT_INVALID_CODE
)
4623 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4625 if (font
->driver
->prepare_face
)
4626 font
->driver
->prepare_face (f
, face
);
4627 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4628 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4629 if (font
->driver
->done_face
)
4630 font
->driver
->done_face (f
, face
);
4632 return make_number (len
);
4636 #endif /* FONT_DEBUG */
4638 #ifdef HAVE_WINDOW_SYSTEM
4640 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4641 doc
: /* Return information about a font named NAME on frame FRAME.
4642 If FRAME is omitted or nil, use the selected frame.
4643 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4644 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4646 OPENED-NAME is the name used for opening the font,
4647 FULL-NAME is the full name of the font,
4648 SIZE is the maximum bound width of the font,
4649 HEIGHT is the height of the font,
4650 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4651 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4652 how to compose characters.
4653 If the named font is not yet loaded, return nil. */)
4655 Lisp_Object name
, frame
;
4660 Lisp_Object font_object
;
4662 (*check_window_system_func
) ();
4665 CHECK_STRING (name
);
4667 frame
= selected_frame
;
4668 CHECK_LIVE_FRAME (frame
);
4673 int fontset
= fs_query_fontset (name
, 0);
4676 name
= fontset_ascii (fontset
);
4677 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4679 else if (FONT_OBJECT_P (name
))
4681 else if (FONT_ENTITY_P (name
))
4682 font_object
= font_open_entity (f
, name
, 0);
4685 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4686 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4688 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4690 if (NILP (font_object
))
4692 font
= XFONT_OBJECT (font_object
);
4694 info
= Fmake_vector (make_number (7), Qnil
);
4695 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4696 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4697 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4698 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4699 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4700 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4701 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4704 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4705 close it now. Perhaps, we should manage font-objects
4706 by `reference-count'. */
4707 font_close_object (f
, font_object
);
4714 #define BUILD_STYLE_TABLE(TBL) \
4715 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4718 build_style_table (entry
, nelement
)
4719 struct table_entry
*entry
;
4723 Lisp_Object table
, elt
;
4725 table
= Fmake_vector (make_number (nelement
), Qnil
);
4726 for (i
= 0; i
< nelement
; i
++)
4728 for (j
= 0; entry
[i
].names
[j
]; j
++);
4729 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4730 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4731 for (j
= 0; entry
[i
].names
[j
]; j
++)
4732 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4733 ASET (table
, i
, elt
);
4738 static Lisp_Object Vfont_log
;
4739 static int font_log_env_checked
;
4742 font_add_log (action
, arg
, result
)
4744 Lisp_Object arg
, result
;
4746 Lisp_Object tail
, val
;
4749 if (! font_log_env_checked
)
4751 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
4752 font_log_env_checked
= 1;
4754 if (EQ (Vfont_log
, Qt
))
4757 arg
= Ffont_xlfd_name (arg
, Qt
);
4759 result
= Ffont_xlfd_name (result
, Qt
);
4760 else if (CONSP (result
))
4762 result
= Fcopy_sequence (result
);
4763 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4767 val
= Ffont_xlfd_name (val
, Qt
);
4768 XSETCAR (tail
, val
);
4771 else if (VECTORP (result
))
4773 result
= Fcopy_sequence (result
);
4774 for (i
= 0; i
< ASIZE (result
); i
++)
4776 val
= AREF (result
, i
);
4778 val
= Ffont_xlfd_name (val
, Qt
);
4779 ASET (result
, i
, val
);
4782 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4785 extern void syms_of_ftfont
P_ (());
4786 extern void syms_of_xfont
P_ (());
4787 extern void syms_of_xftfont
P_ (());
4788 extern void syms_of_ftxfont
P_ (());
4789 extern void syms_of_bdffont
P_ (());
4790 extern void syms_of_w32font
P_ (());
4791 extern void syms_of_atmfont
P_ (());
4796 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
4797 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
4798 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
4799 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
4800 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
4801 /* Note that the other elements in sort_shift_bits are not used. */
4803 staticpro (&font_charset_alist
);
4804 font_charset_alist
= Qnil
;
4806 DEFSYM (Qfont_spec
, "font-spec");
4807 DEFSYM (Qfont_entity
, "font-entity");
4808 DEFSYM (Qfont_object
, "font-object");
4810 DEFSYM (Qopentype
, "opentype");
4812 DEFSYM (Qascii_0
, "ascii-0");
4813 DEFSYM (Qiso8859_1
, "iso8859-1");
4814 DEFSYM (Qiso10646_1
, "iso10646-1");
4815 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4816 DEFSYM (Qunicode_sip
, "unicode-sip");
4818 DEFSYM (QCotf
, ":otf");
4819 DEFSYM (QClang
, ":lang");
4820 DEFSYM (QCscript
, ":script");
4821 DEFSYM (QCantialias
, ":antialias");
4823 DEFSYM (QCfoundry
, ":foundry");
4824 DEFSYM (QCadstyle
, ":adstyle");
4825 DEFSYM (QCregistry
, ":registry");
4826 DEFSYM (QCspacing
, ":spacing");
4827 DEFSYM (QCdpi
, ":dpi");
4828 DEFSYM (QCscalable
, ":scalable");
4829 DEFSYM (QCavgwidth
, ":avgwidth");
4830 DEFSYM (QCfont_entity
, ":font-entity");
4831 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
4838 staticpro (&null_vector
);
4839 null_vector
= Fmake_vector (make_number (0), Qnil
);
4841 staticpro (&scratch_font_spec
);
4842 scratch_font_spec
= Ffont_spec (0, NULL
);
4843 staticpro (&scratch_font_prefer
);
4844 scratch_font_prefer
= Ffont_spec (0, NULL
);
4848 staticpro (&otf_list
);
4850 #endif /* HAVE_LIBOTF */
4854 defsubr (&Sfont_spec
);
4855 defsubr (&Sfont_get
);
4856 defsubr (&Sfont_face_attributes
);
4857 defsubr (&Sfont_put
);
4858 defsubr (&Slist_fonts
);
4859 defsubr (&Sfont_family_list
);
4860 defsubr (&Sfind_font
);
4861 defsubr (&Sfont_xlfd_name
);
4862 defsubr (&Sclear_font_cache
);
4863 defsubr (&Sfont_make_gstring
);
4864 defsubr (&Sfont_fill_gstring
);
4865 defsubr (&Sfont_shape_text
);
4867 defsubr (&Sfont_drive_otf
);
4868 defsubr (&Sfont_otf_alternates
);
4872 defsubr (&Sopen_font
);
4873 defsubr (&Sclose_font
);
4874 defsubr (&Squery_font
);
4875 defsubr (&Sget_font_glyphs
);
4876 defsubr (&Sfont_match_p
);
4877 defsubr (&Sfont_at
);
4879 defsubr (&Sdraw_string
);
4881 #endif /* FONT_DEBUG */
4882 #ifdef HAVE_WINDOW_SYSTEM
4883 defsubr (&Sfont_info
);
4886 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
4888 Alist of fontname patterns vs the corresponding encoding and repertory info.
4889 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
4890 where ENCODING is a charset or a char-table,
4891 and REPERTORY is a charset, a char-table, or nil.
4893 If ENCODING and REPERTORY are the same, the element can have the form
4894 \(REGEXP . ENCODING).
4896 ENCODING is for converting a character to a glyph code of the font.
4897 If ENCODING is a charset, encoding a character by the charset gives
4898 the corresponding glyph code. If ENCODING is a char-table, looking up
4899 the table by a character gives the corresponding glyph code.
4901 REPERTORY specifies a repertory of characters supported by the font.
4902 If REPERTORY is a charset, all characters beloging to the charset are
4903 supported. If REPERTORY is a char-table, all characters who have a
4904 non-nil value in the table are supported. If REPERTORY is nil, Emacs
4905 gets the repertory information by an opened font and ENCODING. */);
4906 Vfont_encoding_alist
= Qnil
;
4908 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
4909 doc
: /* Vector of valid font weight values.
4910 Each element has the form:
4911 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
4912 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
4913 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
4915 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
4916 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
4917 See `font-weight-table' for the format of the vector. */);
4918 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
4920 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
4921 doc
: /* Alist of font width symbols vs the corresponding numeric values.
4922 See `font-weight-table' for the format of the vector. */);
4923 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
4925 staticpro (&font_style_table
);
4926 font_style_table
= Fmake_vector (make_number (3), Qnil
);
4927 ASET (font_style_table
, 0, Vfont_weight_table
);
4928 ASET (font_style_table
, 1, Vfont_slant_table
);
4929 ASET (font_style_table
, 2, Vfont_width_table
);
4931 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
4932 *Logging list of font related actions and results.
4933 The value t means to suppress the logging.
4934 The initial value is set to nil if the environment variable
4935 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
4938 #ifdef HAVE_WINDOW_SYSTEM
4939 #ifdef HAVE_FREETYPE
4941 #ifdef HAVE_X_WINDOWS
4946 #endif /* HAVE_XFT */
4947 #endif /* HAVE_X_WINDOWS */
4948 #else /* not HAVE_FREETYPE */
4949 #ifdef HAVE_X_WINDOWS
4951 #endif /* HAVE_X_WINDOWS */
4952 #endif /* not HAVE_FREETYPE */
4955 #endif /* HAVE_BDFFONT */
4958 #endif /* WINDOWSNT */
4962 #endif /* HAVE_WINDOW_SYSTEM */
4965 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
4966 (do not change this comment) */