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 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1433 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1437 /* Must be an enumerated value. */
1438 val
= font_intern_prop (p
, q
- p
, 1);
1439 if (PROP_MATCH ("light", 5)
1440 || PROP_MATCH ("medium", 6)
1441 || PROP_MATCH ("demibold", 8)
1442 || PROP_MATCH ("bold", 4)
1443 || PROP_MATCH ("black", 5))
1444 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1445 else if (PROP_MATCH ("roman", 5)
1446 || PROP_MATCH ("italic", 6)
1447 || PROP_MATCH ("oblique", 7))
1448 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1449 else if (PROP_MATCH ("charcell", 8))
1450 ASET (font
, FONT_SPACING_INDEX
,
1451 make_number (FONT_SPACING_CHARCELL
));
1452 else if (PROP_MATCH ("mono", 4))
1453 ASET (font
, FONT_SPACING_INDEX
,
1454 make_number (FONT_SPACING_MONO
));
1455 else if (PROP_MATCH ("proportional", 12))
1456 ASET (font
, FONT_SPACING_INDEX
,
1457 make_number (FONT_SPACING_PROPORTIONAL
));
1461 bcopy (p
, copy
, word_len
);
1465 else /* KEY=VAL pairs */
1470 if (PROP_MATCH ("pixelsize=", 10))
1471 prop
= FONT_SIZE_INDEX
;
1474 key
= font_intern_prop (p
, q
- p
, 1);
1475 prop
= get_font_prop_index (key
);
1478 for (q
= p
; *q
&& *q
!= ':'; q
++);
1480 val
= font_intern_prop (p
, word_len
, 0);
1483 if (prop
>= FONT_FOUNDRY_INDEX
1484 && prop
< FONT_EXTRA_INDEX
)
1486 font_prop_validate (prop
, Qnil
, val
));
1488 Ffont_put (font
, key
, val
);
1490 bcopy (keyhead
, copy
, q
- keyhead
);
1491 copy
+= q
- keyhead
;
1498 font_put_extra (font
, QCfc_unknown_spec
,
1499 make_unibyte_string (name
, copy
- name
));
1504 /* Either a fontconfig-style name with no size and property
1505 data, or a GTK-style name. */
1507 int word_len
, prop_found
= 0;
1509 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1515 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1523 double point_size
= strtod (p
, &q
);
1524 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1529 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1530 if (*q
== '\\' && q
[1])
1534 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1536 if (PROP_MATCH ("Ultra-Light", 11))
1539 prop
= font_intern_prop ("ultra-light", 11, 1);
1540 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1542 else if (PROP_MATCH ("Light", 5))
1545 prop
= font_intern_prop ("light", 5, 1);
1546 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1548 else if (PROP_MATCH ("Semi-Bold", 9))
1551 prop
= font_intern_prop ("semi-bold", 9, 1);
1552 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1554 else if (PROP_MATCH ("Bold", 4))
1557 prop
= font_intern_prop ("bold", 4, 1);
1558 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1560 else if (PROP_MATCH ("Italic", 6))
1563 prop
= font_intern_prop ("italic", 4, 1);
1564 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1566 else if (PROP_MATCH ("Oblique", 7))
1569 prop
= font_intern_prop ("oblique", 7, 1);
1570 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1574 return -1; /* Unknown property in GTK-style font name. */
1583 family
= font_intern_prop (name
, family_end
- name
, 1);
1584 ASET (font
, FONT_FAMILY_INDEX
, family
);
1591 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1592 NAME (NBYTES length), and return the name length. If
1593 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1596 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1602 Lisp_Object family
, foundry
;
1603 Lisp_Object tail
, val
;
1608 Lisp_Object styles
[3];
1609 char *style_names
[3] = { "weight", "slant", "width" };
1612 family
= AREF (font
, FONT_FAMILY_INDEX
);
1613 if (! NILP (family
))
1615 if (SYMBOLP (family
))
1617 family
= SYMBOL_NAME (family
);
1618 len
+= SBYTES (family
);
1624 val
= AREF (font
, FONT_SIZE_INDEX
);
1627 if (XINT (val
) != 0)
1628 pixel_size
= XINT (val
);
1630 len
+= 21; /* for ":pixelsize=NUM" */
1632 else if (FLOATP (val
))
1635 point_size
= (int) XFLOAT_DATA (val
);
1636 len
+= 11; /* for "-NUM" */
1639 foundry
= AREF (font
, FONT_FOUNDRY_INDEX
);
1640 if (! NILP (foundry
))
1642 if (SYMBOLP (foundry
))
1644 foundry
= SYMBOL_NAME (foundry
);
1645 len
+= 9 + SBYTES (foundry
); /* ":foundry=NAME" */
1651 for (i
= 0; i
< 3; i
++)
1653 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1654 if (! NILP (styles
[i
]))
1655 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1656 SDATA (SYMBOL_NAME (styles
[i
])));
1659 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1660 len
+= sprintf (work
, ":dpi=%d", dpi
);
1661 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1662 len
+= strlen (":spacing=100");
1663 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1664 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1665 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1667 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1669 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1671 len
+= SBYTES (val
);
1672 else if (INTEGERP (val
))
1673 len
+= sprintf (work
, "%d", XINT (val
));
1674 else if (SYMBOLP (val
))
1675 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1681 if (! NILP (family
))
1682 p
+= sprintf (p
, "%s", SDATA (family
));
1686 p
+= sprintf (p
, "%d", point_size
);
1688 p
+= sprintf (p
, "-%d", point_size
);
1690 else if (pixel_size
> 0)
1691 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1692 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1693 p
+= sprintf (p
, ":foundry=%s",
1694 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1695 for (i
= 0; i
< 3; i
++)
1696 if (! NILP (styles
[i
]))
1697 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1698 SDATA (SYMBOL_NAME (styles
[i
])));
1699 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1700 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1701 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1702 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1703 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1705 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1706 p
+= sprintf (p
, ":scalable=true");
1708 p
+= sprintf (p
, ":scalable=false");
1713 /* Store GTK-style font name of FONT (font-spec or font-entity) in
1714 NAME (NBYTES length), and return the name length. F is the frame
1715 on which the font is displayed; it is used to calculate the point
1719 font_unparse_gtkname (font
, f
, name
, nbytes
)
1727 Lisp_Object family
, weight
, slant
, size
;
1728 int point_size
= -1;
1730 family
= AREF (font
, FONT_FAMILY_INDEX
);
1731 if (! NILP (family
))
1733 if (! SYMBOLP (family
))
1735 family
= SYMBOL_NAME (family
);
1736 len
+= SBYTES (family
);
1739 weight
= font_style_symbolic (font
, FONT_WEIGHT_INDEX
, 0);
1740 if (weight
== Qnormal
)
1742 else if (! NILP (weight
))
1744 weight
= SYMBOL_NAME (weight
);
1745 len
+= SBYTES (weight
);
1748 slant
= font_style_symbolic (font
, FONT_SLANT_INDEX
, 0);
1749 if (slant
== Qnormal
)
1751 else if (! NILP (slant
))
1753 slant
= SYMBOL_NAME (slant
);
1754 len
+= SBYTES (slant
);
1757 size
= AREF (font
, FONT_SIZE_INDEX
);
1758 /* Convert pixel size to point size. */
1759 if (INTEGERP (size
))
1761 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
1763 if (INTEGERP (font_dpi
))
1764 dpi
= XINT (font_dpi
);
1767 point_size
= PIXEL_TO_POINT (XINT (size
), dpi
);
1770 else if (FLOATP (size
))
1772 point_size
= (int) XFLOAT_DATA (size
);
1779 p
= name
+ sprintf (name
, "%s", SDATA (family
));
1781 if (! NILP (weight
))
1784 p
+= sprintf (p
, " %s", SDATA (weight
));
1785 q
[1] = toupper (q
[1]);
1791 p
+= sprintf (p
, " %s", SDATA (slant
));
1792 q
[1] = toupper (q
[1]);
1796 p
+= sprintf (p
, " %d", point_size
);
1801 /* Parse NAME (null terminated) and store information in FONT
1802 (font-spec or font-entity). If NAME is successfully parsed, return
1803 0. Otherwise return -1. */
1806 font_parse_name (name
, font
)
1810 if (name
[0] == '-' || index (name
, '*'))
1811 return font_parse_xlfd (name
, font
);
1812 return font_parse_fcname (name
, font
);
1816 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1817 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1821 font_parse_family_registry (family
, registry
, font_spec
)
1822 Lisp_Object family
, registry
, font_spec
;
1828 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1830 CHECK_STRING (family
);
1831 len
= SBYTES (family
);
1832 p0
= (char *) SDATA (family
);
1833 p1
= index (p0
, '-');
1836 if ((*p0
!= '*' || p1
- p0
> 1)
1837 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1838 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1841 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1844 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1846 if (! NILP (registry
))
1848 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1849 CHECK_STRING (registry
);
1850 len
= SBYTES (registry
);
1851 p0
= (char *) SDATA (registry
);
1852 p1
= index (p0
, '-');
1855 if (SDATA (registry
)[len
- 1] == '*')
1856 registry
= concat2 (registry
, build_string ("-*"));
1858 registry
= concat2 (registry
, build_string ("*-*"));
1860 registry
= Fdowncase (registry
);
1861 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1866 /* This part (through the next ^L) is still experimental and not
1867 tested much. We may drastically change codes. */
1873 #define LGSTRING_HEADER_SIZE 6
1874 #define LGSTRING_GLYPH_SIZE 8
1877 check_gstring (gstring
)
1878 Lisp_Object gstring
;
1883 CHECK_VECTOR (gstring
);
1884 val
= AREF (gstring
, 0);
1886 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1888 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1889 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1890 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1891 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1892 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1893 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1894 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1895 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1896 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1897 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1898 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1900 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1902 val
= LGSTRING_GLYPH (gstring
, i
);
1904 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1906 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1908 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1909 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1910 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1911 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1912 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1913 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1914 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1915 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1917 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1919 if (ASIZE (val
) < 3)
1921 for (j
= 0; j
< 3; j
++)
1922 CHECK_NUMBER (AREF (val
, j
));
1927 error ("Invalid glyph-string format");
1932 check_otf_features (otf_features
)
1933 Lisp_Object otf_features
;
1937 CHECK_CONS (otf_features
);
1938 CHECK_SYMBOL (XCAR (otf_features
));
1939 otf_features
= XCDR (otf_features
);
1940 CHECK_CONS (otf_features
);
1941 CHECK_SYMBOL (XCAR (otf_features
));
1942 otf_features
= XCDR (otf_features
);
1943 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1945 CHECK_SYMBOL (Fcar (val
));
1946 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1947 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1949 otf_features
= XCDR (otf_features
);
1950 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1952 CHECK_SYMBOL (Fcar (val
));
1953 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1954 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1961 Lisp_Object otf_list
;
1964 otf_tag_symbol (tag
)
1969 OTF_tag_name (tag
, name
);
1970 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1977 Lisp_Object val
= Fassoc (file
, otf_list
);
1981 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1984 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1985 val
= make_save_value (otf
, 0);
1986 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1992 /* Return a list describing which scripts/languages FONT supports by
1993 which GSUB/GPOS features of OpenType tables. See the comment of
1994 (struct font_driver).otf_capability. */
1997 font_otf_capability (font
)
2001 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
2004 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
2007 for (i
= 0; i
< 2; i
++)
2009 OTF_GSUB_GPOS
*gsub_gpos
;
2010 Lisp_Object script_list
= Qnil
;
2013 if (OTF_get_features (otf
, i
== 0) < 0)
2015 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
2016 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
2018 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
2019 Lisp_Object langsys_list
= Qnil
;
2020 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
2023 for (k
= script
->LangSysCount
; k
>= 0; k
--)
2025 OTF_LangSys
*langsys
;
2026 Lisp_Object feature_list
= Qnil
;
2027 Lisp_Object langsys_tag
;
2030 if (k
== script
->LangSysCount
)
2032 langsys
= &script
->DefaultLangSys
;
2037 langsys
= script
->LangSys
+ k
;
2039 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
2041 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
2043 OTF_Feature
*feature
2044 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
2045 Lisp_Object feature_tag
2046 = otf_tag_symbol (feature
->FeatureTag
);
2048 feature_list
= Fcons (feature_tag
, feature_list
);
2050 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
2053 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
2058 XSETCAR (capability
, script_list
);
2060 XSETCDR (capability
, script_list
);
2066 /* Parse OTF features in SPEC and write a proper features spec string
2067 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
2068 assured that the sufficient memory has already allocated for
2072 generate_otf_features (spec
, features
)
2082 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
2088 if (SREF (SYMBOL_NAME (val
), 0) == '*')
2093 else if (! asterisk
)
2095 val
= SYMBOL_NAME (val
);
2096 p
+= sprintf (p
, "%s", SDATA (val
));
2100 val
= SYMBOL_NAME (val
);
2101 p
+= sprintf (p
, "~%s", SDATA (val
));
2105 error ("OTF spec too long");
2109 font_otf_DeviceTable (device_table
)
2110 OTF_DeviceTable
*device_table
;
2112 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
2114 return Fcons (make_number (len
),
2115 make_unibyte_string (device_table
->DeltaValue
, len
));
2119 font_otf_ValueRecord (value_format
, value_record
)
2121 OTF_ValueRecord
*value_record
;
2123 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2125 if (value_format
& OTF_XPlacement
)
2126 ASET (val
, 0, make_number (value_record
->XPlacement
));
2127 if (value_format
& OTF_YPlacement
)
2128 ASET (val
, 1, make_number (value_record
->YPlacement
));
2129 if (value_format
& OTF_XAdvance
)
2130 ASET (val
, 2, make_number (value_record
->XAdvance
));
2131 if (value_format
& OTF_YAdvance
)
2132 ASET (val
, 3, make_number (value_record
->YAdvance
));
2133 if (value_format
& OTF_XPlaDevice
)
2134 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2135 if (value_format
& OTF_YPlaDevice
)
2136 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2137 if (value_format
& OTF_XAdvDevice
)
2138 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2139 if (value_format
& OTF_YAdvDevice
)
2140 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2145 font_otf_Anchor (anchor
)
2150 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2151 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2152 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2153 if (anchor
->AnchorFormat
== 2)
2154 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2157 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2158 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2162 #endif /* HAVE_LIBOTF */
2165 /* G-string (glyph string) handler */
2167 /* G-string is a vector of the form [HEADER GLYPH ...].
2168 See the docstring of `font-make-gstring' for more detail. */
2171 font_prepare_composition (cmp
, f
)
2172 struct composition
*cmp
;
2176 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
2177 cmp
->hash_index
* 2);
2179 cmp
->font
= XFONT_OBJECT (LGSTRING_FONT (gstring
));
2180 cmp
->glyph_len
= LGSTRING_LENGTH (gstring
);
2181 cmp
->pixel_width
= LGSTRING_WIDTH (gstring
);
2182 cmp
->lbearing
= LGSTRING_LBEARING (gstring
);
2183 cmp
->rbearing
= LGSTRING_RBEARING (gstring
);
2184 cmp
->ascent
= LGSTRING_ASCENT (gstring
);
2185 cmp
->descent
= LGSTRING_DESCENT (gstring
);
2186 cmp
->width
= cmp
->pixel_width
/ FRAME_COLUMN_WIDTH (f
);
2187 if (cmp
->width
== 0)
2196 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2197 static int font_compare
P_ ((const void *, const void *));
2198 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
2199 Lisp_Object
, Lisp_Object
,
2202 /* We sort fonts by scoring each of them against a specified
2203 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2204 the value is, the closer the font is to the font-spec.
2206 The lowest 2 bits of the score is used for driver type. The font
2207 available by the most preferred font driver is 0.
2209 Each 7-bit in the higher 28 bits are used for numeric properties
2210 WEIGHT, SLANT, WIDTH, and SIZE. */
2212 /* How many bits to shift to store the difference value of each font
2213 property in a score. Note that flots for FONT_TYPE_INDEX and
2214 FONT_REGISTRY_INDEX are not used. */
2215 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2217 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2218 The return value indicates how different ENTITY is compared with
2221 ALTERNATE_FAMILIES, if non-nil, is a pre-calculated list of
2222 alternate family names for AREF (SPEC_PROP, FONT_FAMILY_INDEX). */
2225 font_score (entity
, spec_prop
)
2226 Lisp_Object entity
, *spec_prop
;
2231 /* Score three style numeric fields. Maximum difference is 127. */
2232 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2233 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2235 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2240 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2243 /* Score the size. Maximum difference is 127. */
2244 i
= FONT_SIZE_INDEX
;
2245 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
])
2246 && XINT (AREF (entity
, i
)) > 0)
2248 /* We use the higher 6-bit for the actual size difference. The
2249 lowest bit is set if the DPI is different. */
2250 int diff
= XINT (spec_prop
[i
]) - XINT (AREF (entity
, i
));
2255 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2256 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2258 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2265 /* The comparison function for qsort. */
2268 font_compare (d1
, d2
)
2269 const void *d1
, *d2
;
2271 return (*(unsigned *) d1
- *(unsigned *) d2
);
2275 /* The structure for elements being sorted by qsort. */
2276 struct font_sort_data
2283 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2284 If PREFER specifies a point-size, calculate the corresponding
2285 pixel-size from QCdpi property of PREFER or from the Y-resolution
2286 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
2287 get the font-entities in VEC.
2289 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2290 return the sorted VEC. */
2293 font_sort_entites (vec
, prefer
, frame
, spec
, best_only
)
2294 Lisp_Object vec
, prefer
, frame
, spec
;
2297 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2299 struct font_sort_data
*data
;
2300 unsigned best_score
;
2301 Lisp_Object best_entity
, driver_type
;
2303 struct frame
*f
= XFRAME (frame
);
2304 struct font_driver_list
*list
;
2309 return best_only
? AREF (vec
, 0) : vec
;
2311 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2312 prefer_prop
[i
] = AREF (prefer
, i
);
2316 /* A font driver may return a font that has a property value
2317 different from the value specified in SPEC if the driver
2318 thinks they are the same. That happens, for instance, such a
2319 generic family name as "serif" is specified. So, to ignore
2320 such a difference, for all properties specified in SPEC, set
2321 the corresponding properties in PREFER_PROP to nil. */
2322 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2323 if (! NILP (AREF (spec
, i
)))
2324 prefer_prop
[i
] = Qnil
;
2327 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2328 prefer_prop
[FONT_SIZE_INDEX
]
2329 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2331 /* Scoring and sorting. */
2332 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2333 best_score
= 0xFFFFFFFF;
2334 /* We are sure that the length of VEC > 1. */
2335 driver_type
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2336 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2337 driver_order
++, list
= list
->next
)
2338 if (EQ (driver_type
, list
->driver
->type
))
2340 best_entity
= data
[0].entity
= AREF (vec
, 0);
2341 best_score
= data
[0].score
2342 = font_score (data
[0].entity
, prefer_prop
) | driver_order
;
2343 for (i
= 0; i
< len
; i
++)
2345 if (!EQ (driver_type
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2346 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2347 driver_order
++, list
= list
->next
)
2348 if (EQ (driver_type
, list
->driver
->type
))
2350 data
[i
].entity
= AREF (vec
, i
);
2351 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
) | driver_order
;
2352 if (best_only
&& best_score
> data
[i
].score
)
2354 best_score
= data
[i
].score
;
2355 best_entity
= data
[i
].entity
;
2356 if (best_score
== 0)
2360 if (NILP (best_entity
))
2362 qsort (data
, len
, sizeof *data
, font_compare
);
2363 for (i
= 0; i
< len
; i
++)
2364 ASET (vec
, i
, data
[i
].entity
);
2370 font_add_log ("sort-by", prefer
, vec
);
2375 /* API of Font Service Layer. */
2377 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2378 sort_shift_bits. Finternal_set_font_selection_order calls this
2379 function with font_sort_order after setting up it. */
2382 font_update_sort_order (order
)
2387 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2389 int xlfd_idx
= order
[i
];
2391 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2392 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2393 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2394 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2395 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2396 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2398 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2403 /* Check if ENTITY matches with the font specification SPEC. */
2406 font_match_p (spec
, entity
)
2407 Lisp_Object spec
, entity
;
2409 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2410 Lisp_Object alternate_families
= Qnil
;
2413 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2414 prefer_prop
[i
] = AREF (spec
, i
);
2415 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2416 prefer_prop
[FONT_SIZE_INDEX
]
2417 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2418 if (! NILP (prefer_prop
[FONT_FAMILY_INDEX
]))
2421 = Fassoc_string (prefer_prop
[FONT_FAMILY_INDEX
],
2422 Vface_alternative_font_family_alist
, Qt
);
2423 if (CONSP (alternate_families
))
2424 alternate_families
= XCDR (alternate_families
);
2427 return (font_score (entity
, prefer_prop
) == 0);
2431 /* CHeck a lispy font object corresponding to FONT. */
2434 font_check_object (font
)
2437 Lisp_Object tail
, elt
;
2439 for (tail
= font
->props
[FONT_OBJLIST_INDEX
]; CONSP (tail
);
2443 if (font
== XFONT_OBJECT (elt
))
2453 Each font backend has the callback function get_cache, and it
2454 returns a cons cell of which cdr part can be freely used for
2455 caching fonts. The cons cell may be shared by multiple frames
2456 and/or multiple font drivers. So, we arrange the cdr part as this:
2458 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2460 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2461 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2462 cons (FONT-SPEC FONT-ENTITY ...). */
2464 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2465 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2466 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2467 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2468 struct font_driver
*));
2471 font_prepare_cache (f
, driver
)
2473 struct font_driver
*driver
;
2475 Lisp_Object cache
, val
;
2477 cache
= driver
->get_cache (f
);
2479 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2483 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2484 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2488 val
= XCDR (XCAR (val
));
2489 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2495 font_finish_cache (f
, driver
)
2497 struct font_driver
*driver
;
2499 Lisp_Object cache
, val
, tmp
;
2502 cache
= driver
->get_cache (f
);
2504 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2505 cache
= val
, val
= XCDR (val
);
2506 font_assert (! NILP (val
));
2507 tmp
= XCDR (XCAR (val
));
2508 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2509 if (XINT (XCAR (tmp
)) == 0)
2511 font_clear_cache (f
, XCAR (val
), driver
);
2512 XSETCDR (cache
, XCDR (val
));
2518 font_get_cache (f
, driver
)
2520 struct font_driver
*driver
;
2522 Lisp_Object val
= driver
->get_cache (f
);
2523 Lisp_Object type
= driver
->type
;
2525 font_assert (CONSP (val
));
2526 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2527 font_assert (CONSP (val
));
2528 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2529 val
= XCDR (XCAR (val
));
2533 static int num_fonts
;
2536 font_clear_cache (f
, cache
, driver
)
2539 struct font_driver
*driver
;
2541 Lisp_Object tail
, elt
;
2543 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2544 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2547 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)) && VECTORP (XCDR (elt
)))
2549 Lisp_Object vec
= XCDR (elt
);
2552 for (i
= 0; i
< ASIZE (vec
); i
++)
2554 Lisp_Object entity
= AREF (vec
, i
);
2556 if (EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2558 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2560 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2562 Lisp_Object val
= XCAR (objlist
);
2563 struct font
*font
= XFONT_OBJECT (val
);
2565 font_assert (font
&& driver
== font
->driver
);
2566 driver
->close (f
, font
);
2569 if (driver
->free_entity
)
2570 driver
->free_entity (entity
);
2575 XSETCDR (cache
, Qnil
);
2579 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2582 font_delete_unmatched (list
, spec
, size
)
2583 Lisp_Object list
, spec
;
2586 Lisp_Object entity
, val
;
2587 enum font_property_index prop
;
2589 for (val
= Qnil
; CONSP (list
); list
= XCDR (list
))
2591 entity
= XCAR (list
);
2592 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2593 if (INTEGERP (AREF (spec
, prop
))
2594 && ((XINT (AREF (spec
, prop
)) >> 8)
2595 != (XINT (AREF (entity
, prop
)) >> 8)))
2596 prop
= FONT_SPEC_MAX
;
2597 if (prop
++ <= FONT_SIZE_INDEX
2599 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2601 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2604 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2605 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2606 prop
= FONT_SPEC_MAX
;
2608 if (prop
< FONT_SPEC_MAX
)
2609 val
= Fcons (entity
, val
);
2615 /* Return a vector of font-entities matching with SPEC on FRAME. */
2618 font_list_entities (frame
, spec
)
2619 Lisp_Object frame
, spec
;
2621 FRAME_PTR f
= XFRAME (frame
);
2622 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2623 Lisp_Object ftype
, val
;
2626 int need_filtering
= 0;
2629 font_assert (FONT_SPEC_P (spec
));
2631 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2632 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2633 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2634 size
= font_pixel_size (f
, spec
);
2638 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2639 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2640 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2641 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2643 ASET (scratch_font_spec
, i
, Qnil
);
2644 if (! NILP (AREF (spec
, i
)))
2646 if (i
== FONT_DPI_INDEX
)
2647 /* Skip FONT_SPACING_INDEX */
2650 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2651 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2653 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2657 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2659 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2661 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2663 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2664 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2671 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2672 copy
= Fcopy_font_spec (scratch_font_spec
);
2673 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2674 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2676 if (! NILP (val
) && need_filtering
)
2677 val
= font_delete_unmatched (val
, spec
, size
);
2682 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2683 font_add_log ("list", spec
, val
);
2688 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2689 nil, is an array of face's attributes, which specifies preferred
2690 font-related attributes. */
2693 font_matching_entity (f
, attrs
, spec
)
2695 Lisp_Object
*attrs
, spec
;
2697 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2698 Lisp_Object ftype
, size
, entity
;
2701 XSETFRAME (frame
, f
);
2702 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2703 size
= AREF (spec
, FONT_SIZE_INDEX
);
2705 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2707 for (; driver_list
; driver_list
= driver_list
->next
)
2709 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2711 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2714 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2715 entity
= assoc_no_quit (spec
, XCDR (cache
));
2717 entity
= XCDR (entity
);
2720 entity
= driver_list
->driver
->match (frame
, spec
);
2721 copy
= Fcopy_font_spec (spec
);
2722 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2723 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2725 if (! NILP (entity
))
2728 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2729 ASET (spec
, FONT_SIZE_INDEX
, size
);
2730 font_add_log ("match", spec
, entity
);
2735 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2736 opened font object. */
2739 font_open_entity (f
, entity
, pixel_size
)
2744 struct font_driver_list
*driver_list
;
2745 Lisp_Object objlist
, size
, val
, font_object
;
2749 font_assert (FONT_ENTITY_P (entity
));
2750 size
= AREF (entity
, FONT_SIZE_INDEX
);
2751 if (XINT (size
) != 0)
2752 pixel_size
= XINT (size
);
2754 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2755 objlist
= XCDR (objlist
))
2756 if (XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2757 return XCAR (objlist
);
2759 val
= AREF (entity
, FONT_TYPE_INDEX
);
2760 for (driver_list
= f
->font_driver_list
;
2761 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2762 driver_list
= driver_list
->next
);
2766 font_object
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2767 font_add_log ("open", entity
, font_object
);
2768 if (NILP (font_object
))
2770 ASET (entity
, FONT_OBJLIST_INDEX
,
2771 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2772 ASET (font_object
, FONT_OBJLIST_INDEX
, AREF (entity
, FONT_OBJLIST_INDEX
));
2775 font
= XFONT_OBJECT (font_object
);
2776 min_width
= (font
->min_width
? font
->min_width
2777 : font
->average_width
? font
->average_width
2778 : font
->space_width
? font
->space_width
2780 #ifdef HAVE_WINDOW_SYSTEM
2781 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2782 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2784 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2785 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
;
2786 fonts_changed_p
= 1;
2790 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2791 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2792 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > font
->height
)
2793 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
, fonts_changed_p
= 1;
2801 /* Close FONT_OBJECT that is opened on frame F. */
2804 font_close_object (f
, font_object
)
2806 Lisp_Object font_object
;
2808 struct font
*font
= XFONT_OBJECT (font_object
);
2809 Lisp_Object objlist
;
2810 Lisp_Object tail
, prev
= Qnil
;
2812 objlist
= AREF (font_object
, FONT_OBJLIST_INDEX
);
2813 for (prev
= Qnil
, tail
= objlist
; CONSP (tail
);
2814 prev
= tail
, tail
= XCDR (tail
))
2815 if (EQ (font_object
, XCAR (tail
)))
2817 font_add_log ("close", font_object
, Qnil
);
2818 font
->driver
->close (f
, font
);
2819 #ifdef HAVE_WINDOW_SYSTEM
2820 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2821 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2824 ASET (font_object
, FONT_OBJLIST_INDEX
, XCDR (objlist
));
2826 XSETCDR (prev
, XCDR (objlist
));
2834 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2835 FONT is a font-entity and it must be opened to check. */
2838 font_has_char (f
, font
, c
)
2845 if (FONT_ENTITY_P (font
))
2847 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2848 struct font_driver_list
*driver_list
;
2850 for (driver_list
= f
->font_driver_list
;
2851 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2852 driver_list
= driver_list
->next
);
2855 if (! driver_list
->driver
->has_char
)
2857 return driver_list
->driver
->has_char (font
, c
);
2860 font_assert (FONT_OBJECT_P (font
));
2861 fontp
= XFONT_OBJECT (font
);
2862 if (fontp
->driver
->has_char
)
2864 int result
= fontp
->driver
->has_char (font
, c
);
2869 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2873 /* Return the glyph ID of FONT_OBJECT for character C. */
2876 font_encode_char (font_object
, c
)
2877 Lisp_Object font_object
;
2882 font_assert (FONT_OBJECT_P (font_object
));
2883 font
= XFONT_OBJECT (font_object
);
2884 return font
->driver
->encode_char (font
, c
);
2888 /* Return the name of FONT_OBJECT. */
2891 font_get_name (font_object
)
2892 Lisp_Object font_object
;
2894 font_assert (FONT_OBJECT_P (font_object
));
2895 return AREF (font_object
, FONT_NAME_INDEX
);
2899 /* Return the specification of FONT_OBJECT. */
2902 font_get_spec (font_object
)
2903 Lisp_Object font_object
;
2905 Lisp_Object spec
= font_make_spec ();
2908 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2909 ASET (spec
, i
, AREF (font_object
, i
));
2910 ASET (spec
, FONT_SIZE_INDEX
,
2911 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2916 font_spec_from_name (font_name
)
2917 Lisp_Object font_name
;
2919 Lisp_Object args
[2];
2922 args
[1] = font_name
;
2923 return Ffont_spec (2, args
);
2928 font_clear_prop (attrs
, prop
)
2930 enum font_property_index prop
;
2932 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2936 if (NILP (AREF (font
, prop
))
2937 && prop
!= FONT_FAMILY_INDEX
&& prop
!= FONT_FOUNDRY_INDEX
2938 && prop
!= FONT_SIZE_INDEX
)
2940 font
= Fcopy_font_spec (font
);
2941 ASET (font
, prop
, Qnil
);
2942 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
2944 if (prop
== FONT_FAMILY_INDEX
)
2945 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
2946 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
2947 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
2948 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
2949 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2950 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2951 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2953 else if (prop
== FONT_SIZE_INDEX
)
2955 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2956 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2957 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2959 attrs
[LFACE_FONT_INDEX
] = font
;
2963 font_update_lface (f
, attrs
)
2969 spec
= attrs
[LFACE_FONT_INDEX
];
2970 if (! FONT_SPEC_P (spec
))
2973 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
2974 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
2975 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2976 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
2977 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
2978 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
2979 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
2980 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);;
2981 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
2982 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
2983 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
2987 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2992 val
= Ffont_get (spec
, QCdpi
);
2995 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
2998 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2999 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
3000 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
3005 /* Return a font-entity satisfying SPEC and best matching with face's
3006 font related attributes in ATTRS. C, if not negative, is a
3007 character that the entity must support. */
3010 font_find_for_lface (f
, attrs
, spec
, c
)
3017 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
3018 Lisp_Object size
, foundry
[3], *family
, registry
[3];
3020 int i
, j
, k
, result
;
3022 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
3023 if (NILP (registry
[0]))
3025 registry
[0] = Qiso8859_1
;
3026 registry
[1] = Qascii_0
;
3027 registry
[2] = null_vector
;
3030 registry
[1] = null_vector
;
3032 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3034 struct charset
*encoding
, *repertory
;
3036 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
3037 &encoding
, &repertory
) < 0)
3041 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
3043 /* Any font of this registry support C. So, let's
3044 suppress the further checking. */
3047 else if (c
> encoding
->max_char
)
3051 work
= Fcopy_font_spec (spec
);
3052 XSETFRAME (frame
, f
);
3053 size
= AREF (spec
, FONT_SIZE_INDEX
);
3054 pixel_size
= font_pixel_size (f
, spec
);
3055 if (pixel_size
== 0)
3057 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3059 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
3061 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
3062 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
3063 if (! NILP (foundry
[0]))
3064 foundry
[1] = null_vector
;
3065 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
3067 foundry
[0] = font_intern_prop (SDATA (attrs
[LFACE_FOUNDRY_INDEX
]),
3068 SBYTES (attrs
[LFACE_FOUNDRY_INDEX
]), 1);
3070 foundry
[2] = null_vector
;
3073 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
3075 val
= AREF (work
, FONT_FAMILY_INDEX
);
3076 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
3077 val
= font_intern_prop (SDATA (attrs
[LFACE_FAMILY_INDEX
]),
3078 SBYTES (attrs
[LFACE_FAMILY_INDEX
]), 1);
3081 family
= alloca ((sizeof family
[0]) * 2);
3083 family
[1] = null_vector
; /* terminator. */
3088 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
3090 if (! NILP (alters
))
3092 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
3093 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
3094 family
[i
] = XCAR (alters
);
3095 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3097 family
[i
] = null_vector
;
3101 family
= alloca ((sizeof family
[0]) * 3);
3104 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
3106 family
[i
] = null_vector
;
3110 for (i
= 0; SYMBOLP (family
[i
]); i
++)
3112 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
3113 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
3115 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
3116 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
3118 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3119 entities
= font_list_entities (frame
, work
);
3120 if (ASIZE (entities
) > 0)
3127 if (ASIZE (entities
) == 1)
3130 return AREF (entities
, 0);
3134 /* Sort fonts by properties specified in LFACE. */
3135 Lisp_Object prefer
= scratch_font_prefer
;
3137 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3138 ASET (prefer
, i
, AREF (work
, i
));
3139 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3141 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3143 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3144 if (NILP (AREF (prefer
, i
)))
3145 ASET (prefer
, i
, AREF (face_font
, i
));
3147 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3148 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3149 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3150 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3151 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3152 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3153 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3154 entities
= font_sort_entites (entities
, prefer
, frame
, work
, c
< 0);
3159 for (i
= 0; i
< ASIZE (entities
); i
++)
3163 val
= AREF (entities
, i
);
3166 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3167 if (! EQ (AREF (val
, j
), props
[j
]))
3169 if (j
> FONT_REGISTRY_INDEX
)
3172 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3173 props
[j
] = AREF (val
, j
);
3174 result
= font_has_char (f
, val
, c
);
3179 val
= font_open_for_lface (f
, val
, attrs
, spec
);
3182 result
= font_has_char (f
, val
, c
);
3183 font_close_object (f
, val
);
3185 return AREF (entities
, i
);
3192 font_open_for_lface (f
, entity
, attrs
, spec
)
3200 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3201 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3202 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3203 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3204 size
= font_pixel_size (f
, spec
);
3207 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3210 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3212 return font_open_entity (f
, entity
, size
);
3216 /* Find a font satisfying SPEC and best matching with face's
3217 attributes in ATTRS on FRAME, and return the opened
3221 font_load_for_lface (f
, attrs
, spec
)
3223 Lisp_Object
*attrs
, spec
;
3227 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3230 /* No font is listed for SPEC, but each font-backend may have
3231 the different criteria about "font matching". So, try
3233 entity
= font_matching_entity (f
, attrs
, spec
);
3237 return font_open_for_lface (f
, entity
, attrs
, spec
);
3241 /* Make FACE on frame F ready to use the font opened for FACE. */
3244 font_prepare_for_face (f
, face
)
3248 if (face
->font
->driver
->prepare_face
)
3249 face
->font
->driver
->prepare_face (f
, face
);
3253 /* Make FACE on frame F stop using the font opened for FACE. */
3256 font_done_for_face (f
, face
)
3260 if (face
->font
->driver
->done_face
)
3261 face
->font
->driver
->done_face (f
, face
);
3266 /* Open a font best matching with NAME on frame F. If no proper font
3267 is found, return Qnil. */
3270 font_open_by_name (f
, name
)
3274 Lisp_Object args
[2];
3275 Lisp_Object spec
, attrs
[LFACE_VECTOR_SIZE
];
3278 args
[1] = make_unibyte_string (name
, strlen (name
));
3279 spec
= Ffont_spec (2, args
);
3280 /* We set up the default font-related attributes of a face to prefer
3282 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3283 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3284 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3285 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3286 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3288 return font_load_for_lface (f
, attrs
, spec
);
3292 /* Register font-driver DRIVER. This function is used in two ways.
3294 The first is with frame F non-NULL. In this case, make DRIVER
3295 available (but not yet activated) on F. All frame creaters
3296 (e.g. Fx_create_frame) must call this function at least once with
3297 an available font-driver.
3299 The second is with frame F NULL. In this case, DRIVER is globally
3300 registered in the variable `font_driver_list'. All font-driver
3301 implementations must call this function in its syms_of_XXXX
3302 (e.g. syms_of_xfont). */
3305 register_font_driver (driver
, f
)
3306 struct font_driver
*driver
;
3309 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3310 struct font_driver_list
*prev
, *list
;
3312 if (f
&& ! driver
->draw
)
3313 error ("Unusable font driver for a frame: %s",
3314 SDATA (SYMBOL_NAME (driver
->type
)));
3316 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3317 if (EQ (list
->driver
->type
, driver
->type
))
3318 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3320 list
= malloc (sizeof (struct font_driver_list
));
3322 list
->driver
= driver
;
3327 f
->font_driver_list
= list
;
3329 font_driver_list
= list
;
3335 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3336 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3337 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3339 A caller must free all realized faces if any in advance. The
3340 return value is a list of font backends actually made used on
3344 font_update_drivers (f
, new_drivers
)
3346 Lisp_Object new_drivers
;
3348 Lisp_Object active_drivers
= Qnil
;
3349 struct font_driver
*driver
;
3350 struct font_driver_list
*list
;
3352 /* At first, turn off non-requested drivers, and turn on requested
3354 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3356 driver
= list
->driver
;
3357 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3362 if (driver
->end_for_frame
)
3363 driver
->end_for_frame (f
);
3364 font_finish_cache (f
, driver
);
3369 if (! driver
->start_for_frame
3370 || driver
->start_for_frame (f
) == 0)
3372 font_prepare_cache (f
, driver
);
3379 if (NILP (new_drivers
))
3382 if (! EQ (new_drivers
, Qt
))
3384 /* Re-order the driver list according to new_drivers. */
3385 struct font_driver_list
**list_table
, **next
;
3389 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3390 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3392 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3393 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3396 list_table
[i
++] = list
;
3398 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3400 list_table
[i
] = list
;
3401 list_table
[i
] = NULL
;
3403 next
= &f
->font_driver_list
;
3404 for (i
= 0; list_table
[i
]; i
++)
3406 *next
= list_table
[i
];
3407 next
= &(*next
)->next
;
3412 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3414 active_drivers
= nconc2 (active_drivers
,
3415 Fcons (list
->driver
->type
, Qnil
));
3416 return active_drivers
;
3420 font_put_frame_data (f
, driver
, data
)
3422 struct font_driver
*driver
;
3425 struct font_data_list
*list
, *prev
;
3427 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3428 prev
= list
, list
= list
->next
)
3429 if (list
->driver
== driver
)
3436 prev
->next
= list
->next
;
3438 f
->font_data_list
= list
->next
;
3446 list
= malloc (sizeof (struct font_data_list
));
3449 list
->driver
= driver
;
3450 list
->next
= f
->font_data_list
;
3451 f
->font_data_list
= list
;
3459 font_get_frame_data (f
, driver
)
3461 struct font_driver
*driver
;
3463 struct font_data_list
*list
;
3465 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3466 if (list
->driver
== driver
)
3474 /* Return the font used to draw character C by FACE at buffer position
3475 POS in window W. If STRING is non-nil, it is a string containing C
3476 at index POS. If C is negative, get C from the current buffer or
3480 font_at (c
, pos
, face
, w
, string
)
3489 Lisp_Object font_object
;
3495 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3498 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3500 c
= FETCH_CHAR (pos_byte
);
3503 c
= FETCH_BYTE (pos
);
3509 multibyte
= STRING_MULTIBYTE (string
);
3512 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3514 str
= SDATA (string
) + pos_byte
;
3515 c
= STRING_CHAR (str
, 0);
3518 c
= SDATA (string
)[pos
];
3522 f
= XFRAME (w
->frame
);
3523 if (! FRAME_WINDOW_P (f
))
3530 if (STRINGP (string
))
3531 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3532 DEFAULT_FACE_ID
, 0);
3534 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3536 face
= FACE_FROM_ID (f
, face_id
);
3540 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3541 face
= FACE_FROM_ID (f
, face_id
);
3546 font_assert (font_check_object ((struct font
*) face
->font
));
3547 XSETFONT (font_object
, face
->font
);
3552 /* Check how many characters after POS (at most to LIMIT) can be
3553 displayed by the same font. FACE is the face selected for the
3554 character as POS on frame F. STRING, if not nil, is the string to
3555 check instead of the current buffer.
3557 The return value is the position of the character that is displayed
3558 by the differnt font than that of the character as POS. */
3561 font_range (pos
, limit
, face
, f
, string
)
3562 EMACS_INT pos
, limit
;
3575 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3576 pos_byte
= CHAR_TO_BYTE (pos
);
3580 multibyte
= STRING_MULTIBYTE (string
);
3581 pos_byte
= string_char_to_byte (string
, pos
);
3585 /* All unibyte character are displayed by the same font. */
3593 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3595 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3596 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3597 face
= FACE_FROM_ID (f
, face_id
);
3604 else if (font
!= face
->font
)
3616 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3617 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3618 Return nil otherwise.
3619 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3620 which kind of font it is. It must be one of `font-spec', `font-entity',
3622 (object
, extra_type
)
3623 Lisp_Object object
, extra_type
;
3625 if (NILP (extra_type
))
3626 return (FONTP (object
) ? Qt
: Qnil
);
3627 if (EQ (extra_type
, Qfont_spec
))
3628 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3629 if (EQ (extra_type
, Qfont_entity
))
3630 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3631 if (EQ (extra_type
, Qfont_object
))
3632 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3633 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3636 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3637 doc
: /* Return a newly created font-spec with arguments as properties.
3639 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3640 valid font property name listed below:
3642 `:family', `:weight', `:slant', `:width'
3644 They are the same as face attributes of the same name. See
3645 `set-face-attribute'.
3649 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3653 VALUE must be a string or a symbol specifying the additional
3654 typographic style information of a font, e.g. ``sans''.
3658 VALUE must be a string or a symbol specifying the charset registry and
3659 encoding of a font, e.g. ``iso8859-1''.
3663 VALUE must be a non-negative integer or a floating point number
3664 specifying the font size. It specifies the font size in pixels
3665 (if VALUE is an integer), or in points (if VALUE is a float).
3666 usage: (font-spec ARGS ...) */)
3671 Lisp_Object spec
= font_make_spec ();
3674 for (i
= 0; i
< nargs
; i
+= 2)
3676 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3678 if (EQ (key
, QCname
))
3681 font_parse_name ((char *) SDATA (val
), spec
);
3682 font_put_extra (spec
, key
, val
);
3686 int idx
= get_font_prop_index (key
);
3690 val
= font_prop_validate (idx
, Qnil
, val
);
3691 if (idx
< FONT_EXTRA_INDEX
)
3692 ASET (spec
, idx
, val
);
3694 font_put_extra (spec
, key
, val
);
3697 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3703 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3704 doc
: /* Return a copy of FONT as a font-spec. */)
3708 Lisp_Object new_spec
, tail
, extra
;
3712 new_spec
= font_make_spec ();
3713 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3714 ASET (new_spec
, i
, AREF (font
, i
));
3716 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3718 if (! EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3719 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3721 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3725 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3726 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3727 Every specified properties in FROM override the corresponding
3728 properties in TO. */)
3730 Lisp_Object from
, to
;
3732 Lisp_Object extra
, tail
;
3737 to
= Fcopy_font_spec (to
);
3738 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3739 ASET (to
, i
, AREF (from
, i
));
3740 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3741 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3742 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3744 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3747 XSETCDR (slot
, XCDR (XCAR (tail
)));
3749 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3751 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3755 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3756 doc
: /* Return the value of FONT's property KEY.
3757 FONT is a font-spec, a font-entity, or a font-object. */)
3759 Lisp_Object font
, key
;
3766 idx
= get_font_prop_index (key
);
3767 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3768 return AREF (font
, idx
);
3769 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3772 DEFUN ("font-face-attributes", Ffont_face_attributes
, Sfont_face_attributes
, 1, 2, 0,
3773 doc
: /* Return a plist of face attributes generated by FONT.
3774 FONT is a font name, a font-spec, a font-entity, or a font-object.
3775 The return value is a list of the form
3777 (:family FAMILY :height HEIGHT :weight WEIGHT :slant SLANT :width WIDTH)
3779 where FAMILY, FOUNDRY, HEIGHT, WEIGHT, SLANT, and WIDTH are face
3780 attribute values compatible with `set-face-attribute'.
3782 The optional argument FRAME specifies the frame that the face
3783 attributes are to be displayed on. If omitted, the selected frame is
3789 Lisp_Object plist
[10];
3793 frame
= selected_frame
;
3794 CHECK_LIVE_FRAME (frame
);
3799 int fontset
= fs_query_fontset (font
, 0);
3800 Lisp_Object name
= font
;
3802 font
= fontset_ascii (fontset
);
3803 font
= font_spec_from_name (name
);
3805 signal_error ("Invalid font name", name
);
3807 else if (! FONTP (font
))
3808 signal_error ("Invalid font object", font
);
3810 plist
[0] = QCfamily
;
3811 val
= AREF (font
, FONT_FAMILY_INDEX
);
3812 plist
[1] = NILP (val
) ? Qnil
: SYMBOL_NAME (val
);
3814 plist
[2] = QCheight
;
3815 val
= AREF (font
, FONT_SIZE_INDEX
);
3818 Lisp_Object font_dpi
= AREF (font
, FONT_DPI_INDEX
);
3819 int dpi
= INTEGERP (font_dpi
) ? XINT (font_dpi
) : f
->resy
;
3820 plist
[3] = make_number (10 * PIXEL_TO_POINT (XINT (val
), dpi
));
3822 else if (FLOATP (val
))
3823 plist
[3] = make_number (10 * (int) XFLOAT_DATA (val
));
3827 plist
[4] = QCweight
;
3828 val
= FONT_WEIGHT_FOR_FACE (font
);
3829 plist
[5] = NILP (val
) ? Qnormal
: val
;
3832 val
= FONT_SLANT_FOR_FACE (font
);
3833 plist
[7] = NILP (val
) ? Qnormal
: val
;
3836 val
= FONT_WIDTH_FOR_FACE (font
);
3837 plist
[9] = NILP (val
) ? Qnormal
: val
;
3839 return Flist (10, plist
);
3842 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3843 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
3844 (font_spec
, prop
, val
)
3845 Lisp_Object font_spec
, prop
, val
;
3849 CHECK_FONT_SPEC (font_spec
);
3850 idx
= get_font_prop_index (prop
);
3851 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3852 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
3854 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
3858 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3859 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3860 Optional 2nd argument FRAME specifies the target frame.
3861 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3862 Optional 4th argument PREFER, if non-nil, is a font-spec to
3863 control the order of the returned list. Fonts are sorted by
3864 how close they are to PREFER. */)
3865 (font_spec
, frame
, num
, prefer
)
3866 Lisp_Object font_spec
, frame
, num
, prefer
;
3868 Lisp_Object vec
, list
, tail
;
3872 frame
= selected_frame
;
3873 CHECK_LIVE_FRAME (frame
);
3874 CHECK_FONT_SPEC (font_spec
);
3882 if (! NILP (prefer
))
3883 CHECK_FONT_SPEC (prefer
);
3885 vec
= font_list_entities (frame
, font_spec
);
3890 return Fcons (AREF (vec
, 0), Qnil
);
3892 if (! NILP (prefer
))
3893 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
, 0);
3895 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3896 if (n
== 0 || n
> len
)
3898 for (i
= 1; i
< n
; i
++)
3900 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3902 XSETCDR (tail
, val
);
3908 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
3909 doc
: /* List available font families on the current frame.
3910 Optional argument FRAME, if non-nil, specifies the target frame. */)
3915 struct font_driver_list
*driver_list
;
3919 frame
= selected_frame
;
3920 CHECK_LIVE_FRAME (frame
);
3923 for (driver_list
= f
->font_driver_list
; driver_list
;
3924 driver_list
= driver_list
->next
)
3925 if (driver_list
->driver
->list_family
)
3927 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3933 Lisp_Object tail
= list
;
3935 for (; CONSP (val
); val
= XCDR (val
))
3936 if (NILP (Fmemq (XCAR (val
), tail
)))
3937 list
= Fcons (XCAR (val
), list
);
3943 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3944 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3945 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3947 Lisp_Object font_spec
, frame
;
3949 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3956 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
3957 doc
: /* Return XLFD name of FONT.
3958 FONT is a font-spec, font-entity, or font-object.
3959 If the name is too long for XLFD (maximum 255 chars), return nil.
3960 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
3961 the consecutive wildcards are folded to one. */)
3962 (font
, fold_wildcards
)
3963 Lisp_Object font
, fold_wildcards
;
3970 if (FONT_OBJECT_P (font
))
3972 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
3974 if (STRINGP (font_name
)
3975 && SDATA (font_name
)[0] == '-')
3977 if (NILP (fold_wildcards
))
3979 strcpy (name
, (char *) SDATA (font_name
));
3982 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
3984 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3987 if (! NILP (fold_wildcards
))
3989 char *p0
= name
, *p1
;
3991 while ((p1
= strstr (p0
, "-*-*")))
3993 strcpy (p1
, p1
+ 2);
3998 return build_string (name
);
4001 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
4002 doc
: /* Clear font cache. */)
4005 Lisp_Object list
, frame
;
4007 FOR_EACH_FRAME (list
, frame
)
4009 FRAME_PTR f
= XFRAME (frame
);
4010 struct font_driver_list
*driver_list
= f
->font_driver_list
;
4012 for (; driver_list
; driver_list
= driver_list
->next
)
4013 if (driver_list
->on
)
4015 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
4020 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
4022 font_assert (! NILP (val
));
4023 val
= XCDR (XCAR (val
));
4024 if (XINT (XCAR (val
)) == 0)
4026 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
4027 XSETCDR (cache
, XCDR (val
));
4035 /* The following three functions are still experimental. */
4037 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
4038 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
4039 FONT-OBJECT may be nil if it is not yet known.
4041 G-string is sequence of glyphs of a specific font,
4042 and is a vector of this form:
4043 [ HEADER GLYPH ... ]
4044 HEADER is a vector of this form:
4045 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
4047 FONT-OBJECT is a font-object for all glyphs in the g-string,
4048 WIDTH thru DESCENT are the metrics (in pixels) of the whole G-string.
4049 GLYPH is a vector of this form:
4050 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
4051 [ [X-OFF Y-OFF WADJUST] | nil] ]
4053 FROM-IDX and TO-IDX are used internally and should not be touched.
4054 C is the character of the glyph.
4055 CODE is the glyph-code of C in FONT-OBJECT.
4056 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
4057 X-OFF and Y-OFF are offests to the base position for the glyph.
4058 WADJUST is the adjustment to the normal width of the glyph. */)
4060 Lisp_Object font_object
, num
;
4062 Lisp_Object gstring
, g
;
4066 if (! NILP (font_object
))
4067 CHECK_FONT_OBJECT (font_object
);
4070 len
= XINT (num
) + 1;
4071 gstring
= Fmake_vector (make_number (len
), Qnil
);
4072 g
= Fmake_vector (make_number (6), Qnil
);
4073 ASET (g
, 0, font_object
);
4074 ASET (gstring
, 0, g
);
4075 for (i
= 1; i
< len
; i
++)
4076 ASET (gstring
, i
, Fmake_vector (make_number (10), Qnil
));
4080 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
4081 doc
: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
4082 START and END specify the region to extract characters.
4083 If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
4084 where to extract characters.
4085 FONT-OBJECT may be nil if GSTRING already contains one. */)
4086 (gstring
, font_object
, start
, end
, object
)
4087 Lisp_Object gstring
, font_object
, start
, end
, object
;
4093 CHECK_VECTOR (gstring
);
4094 if (NILP (font_object
))
4095 font_object
= LGSTRING_FONT (gstring
);
4096 font
= XFONT_OBJECT (font_object
);
4098 if (STRINGP (object
))
4100 const unsigned char *p
;
4102 CHECK_NATNUM (start
);
4104 if (XINT (start
) > XINT (end
)
4105 || XINT (end
) > ASIZE (object
)
4106 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
4107 args_out_of_range_3 (object
, start
, end
);
4109 len
= XINT (end
) - XINT (start
);
4110 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
4111 for (i
= 0; i
< len
; i
++)
4113 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4114 /* Shut up GCC warning in comparison with
4115 MOST_POSITIVE_FIXNUM below. */
4118 c
= STRING_CHAR_ADVANCE (p
);
4119 cod
= code
= font
->driver
->encode_char (font
, c
);
4120 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
4122 LGLYPH_SET_FROM (g
, i
);
4123 LGLYPH_SET_TO (g
, i
);
4124 LGLYPH_SET_CHAR (g
, c
);
4125 LGLYPH_SET_CODE (g
, code
);
4132 if (! NILP (object
))
4133 Fset_buffer (object
);
4134 validate_region (&start
, &end
);
4135 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
4136 args_out_of_range (start
, end
);
4137 len
= XINT (end
) - XINT (start
);
4139 pos_byte
= CHAR_TO_BYTE (pos
);
4140 for (i
= 0; i
< len
; i
++)
4142 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4143 /* Shut up GCC warning in comparison with
4144 MOST_POSITIVE_FIXNUM below. */
4147 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
4148 cod
= code
= font
->driver
->encode_char (font
, c
);
4149 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
4151 LGLYPH_SET_FROM (g
, i
);
4152 LGLYPH_SET_TO (g
, i
);
4153 LGLYPH_SET_CHAR (g
, c
);
4154 LGLYPH_SET_CODE (g
, code
);
4157 for (; i
< LGSTRING_LENGTH (gstring
); i
++)
4158 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
4162 DEFUN ("font-shape-text", Ffont_shape_text
, Sfont_shape_text
, 3, 4, 0,
4163 doc
: /* Shape text between FROM and TO by FONT-OBJECT.
4164 If optional 4th argument STRING is non-nil, it is a string to shape,
4165 and FROM and TO are indices to the string.
4166 The value is the end position of the text that can be shaped by
4168 (from
, to
, font_object
, string
)
4169 Lisp_Object from
, to
, font_object
, string
;
4172 struct font_metrics metrics
;
4173 EMACS_INT start
, end
;
4174 Lisp_Object gstring
, n
;
4177 if (! FONT_OBJECT_P (font_object
))
4179 font
= XFONT_OBJECT (font_object
);
4180 if (! font
->driver
->shape
)
4185 validate_region (&from
, &to
);
4186 start
= XFASTINT (from
);
4187 end
= XFASTINT (to
);
4188 modify_region (current_buffer
, start
, end
, 0);
4192 CHECK_STRING (string
);
4193 start
= XINT (from
);
4195 if (start
< 0 || start
> end
|| end
> SCHARS (string
))
4196 args_out_of_range_3 (string
, from
, to
);
4200 gstring
= Ffont_make_gstring (font_object
, make_number (len
));
4201 Ffont_fill_gstring (gstring
, font_object
, from
, to
, string
);
4203 /* Try at most three times with larger gstring each time. */
4204 for (i
= 0; i
< 3; i
++)
4206 Lisp_Object args
[2];
4208 n
= font
->driver
->shape (gstring
);
4212 args
[1] = Fmake_vector (make_number (len
), Qnil
);
4213 gstring
= Fvconcat (2, args
);
4215 if (! INTEGERP (n
) || XINT (n
) == 0)
4219 for (i
= 0; i
< len
;)
4222 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4223 EMACS_INT this_from
= LGLYPH_FROM (g
);
4224 EMACS_INT this_to
= LGLYPH_TO (g
) + 1;
4226 int need_composition
= 0;
4228 metrics
.lbearing
= LGLYPH_LBEARING (g
);
4229 metrics
.rbearing
= LGLYPH_RBEARING (g
);
4230 metrics
.ascent
= LGLYPH_ASCENT (g
);
4231 metrics
.descent
= LGLYPH_DESCENT (g
);
4232 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4234 metrics
.width
= LGLYPH_WIDTH (g
);
4235 if (LGLYPH_CHAR (g
) == 0 || metrics
.width
== 0)
4236 need_composition
= 1;
4240 metrics
.width
= LGLYPH_WADJUST (g
);
4241 metrics
.lbearing
+= LGLYPH_XOFF (g
);
4242 metrics
.rbearing
+= LGLYPH_XOFF (g
);
4243 metrics
.ascent
-= LGLYPH_YOFF (g
);
4244 metrics
.descent
+= LGLYPH_YOFF (g
);
4245 need_composition
= 1;
4247 for (j
= i
+ 1; j
< len
; j
++)
4251 g
= LGSTRING_GLYPH (gstring
, j
);
4252 if (this_from
!= LGLYPH_FROM (g
))
4254 need_composition
= 1;
4255 x
= metrics
.width
+ LGLYPH_LBEARING (g
) + LGLYPH_XOFF (g
);
4256 if (metrics
.lbearing
> x
)
4257 metrics
.lbearing
= x
;
4258 x
= metrics
.width
+ LGLYPH_RBEARING (g
) + LGLYPH_XOFF (g
);
4259 if (metrics
.rbearing
< x
)
4260 metrics
.rbearing
= x
;
4261 x
= LGLYPH_ASCENT (g
) - LGLYPH_YOFF (g
);
4262 if (metrics
.ascent
< x
)
4264 x
= LGLYPH_DESCENT (g
) - LGLYPH_YOFF (g
);
4265 if (metrics
.descent
< x
)
4266 metrics
.descent
= x
;
4267 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4268 metrics
.width
+= LGLYPH_WIDTH (g
);
4270 metrics
.width
+= LGLYPH_WADJUST (g
);
4273 if (need_composition
)
4275 gstr
= Ffont_make_gstring (font_object
, make_number (j
- i
));
4276 LGSTRING_SET_WIDTH (gstr
, metrics
.width
);
4277 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
4278 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
);
4279 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
4280 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
4281 for (k
= i
; i
< j
; i
++)
4283 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4285 LGLYPH_SET_FROM (g
, LGLYPH_FROM (g
) - this_from
);
4286 LGLYPH_SET_TO (g
, LGLYPH_TO (g
) - this_from
);
4287 LGSTRING_SET_GLYPH (gstr
, i
- k
, LGSTRING_GLYPH (gstring
, i
));
4289 from
= make_number (start
+ this_from
);
4290 to
= make_number (start
+ this_to
);
4292 Fcompose_region_internal (from
, to
, gstr
, Qnil
);
4294 Fcompose_string_internal (string
, from
, to
, gstr
, Qnil
);
4305 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4306 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4307 OTF-FEATURES specifies which features to apply in this format:
4308 (SCRIPT LANGSYS GSUB GPOS)
4310 SCRIPT is a symbol specifying a script tag of OpenType,
4311 LANGSYS is a symbol specifying a langsys tag of OpenType,
4312 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4314 If LANGYS is nil, the default langsys is selected.
4316 The features are applied in the order they appear in the list. The
4317 symbol `*' means to apply all available features not present in this
4318 list, and the remaining features are ignored. For instance, (vatu
4319 pstf * haln) is to apply vatu and pstf in this order, then to apply
4320 all available features other than vatu, pstf, and haln.
4322 The features are applied to the glyphs in the range FROM and TO of
4323 the glyph-string GSTRING-IN.
4325 If some feature is actually applicable, the resulting glyphs are
4326 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4327 this case, the value is the number of produced glyphs.
4329 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4332 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4333 produced in GSTRING-OUT, and the value is nil.
4335 See the documentation of `font-make-gstring' for the format of
4337 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4338 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4340 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4345 check_otf_features (otf_features
);
4346 CHECK_FONT_OBJECT (font_object
);
4347 font
= XFONT_OBJECT (font_object
);
4348 if (! font
->driver
->otf_drive
)
4349 error ("Font backend %s can't drive OpenType GSUB table",
4350 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4351 CHECK_CONS (otf_features
);
4352 CHECK_SYMBOL (XCAR (otf_features
));
4353 val
= XCDR (otf_features
);
4354 CHECK_SYMBOL (XCAR (val
));
4355 val
= XCDR (otf_features
);
4358 len
= check_gstring (gstring_in
);
4359 CHECK_VECTOR (gstring_out
);
4360 CHECK_NATNUM (from
);
4362 CHECK_NATNUM (index
);
4364 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4365 args_out_of_range_3 (from
, to
, make_number (len
));
4366 if (XINT (index
) >= ASIZE (gstring_out
))
4367 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4368 num
= font
->driver
->otf_drive (font
, otf_features
,
4369 gstring_in
, XINT (from
), XINT (to
),
4370 gstring_out
, XINT (index
), 0);
4373 return make_number (num
);
4376 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4378 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4379 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4381 (SCRIPT LANGSYS FEATURE ...)
4382 See the documentation of `font-drive-otf' for more detail.
4384 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4385 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4386 character code corresponding to the glyph or nil if there's no
4387 corresponding character. */)
4388 (font_object
, character
, otf_features
)
4389 Lisp_Object font_object
, character
, otf_features
;
4392 Lisp_Object gstring_in
, gstring_out
, g
;
4393 Lisp_Object alternates
;
4396 CHECK_FONT_GET_OBJECT (font_object
, font
);
4397 if (! font
->driver
->otf_drive
)
4398 error ("Font backend %s can't drive OpenType GSUB table",
4399 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4400 CHECK_CHARACTER (character
);
4401 CHECK_CONS (otf_features
);
4403 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4404 g
= LGSTRING_GLYPH (gstring_in
, 0);
4405 LGLYPH_SET_CHAR (g
, XINT (character
));
4406 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4407 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4408 gstring_out
, 0, 1)) < 0)
4409 gstring_out
= Ffont_make_gstring (font_object
,
4410 make_number (ASIZE (gstring_out
) * 2));
4412 for (i
= 0; i
< num
; i
++)
4414 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4415 int c
= LGLYPH_CHAR (g
);
4416 unsigned code
= LGLYPH_CODE (g
);
4418 alternates
= Fcons (Fcons (make_number (code
),
4419 c
> 0 ? make_number (c
) : Qnil
),
4422 return Fnreverse (alternates
);
4428 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4429 doc
: /* Open FONT-ENTITY. */)
4430 (font_entity
, size
, frame
)
4431 Lisp_Object font_entity
;
4437 CHECK_FONT_ENTITY (font_entity
);
4439 frame
= selected_frame
;
4440 CHECK_LIVE_FRAME (frame
);
4443 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4446 CHECK_NUMBER_OR_FLOAT (size
);
4448 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
4450 isize
= XINT (size
);
4454 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4457 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4458 doc
: /* Close FONT-OBJECT. */)
4459 (font_object
, frame
)
4460 Lisp_Object font_object
, frame
;
4462 CHECK_FONT_OBJECT (font_object
);
4464 frame
= selected_frame
;
4465 CHECK_LIVE_FRAME (frame
);
4466 font_close_object (XFRAME (frame
), font_object
);
4470 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4471 doc
: /* Return information about FONT-OBJECT.
4472 The value is a vector:
4473 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4476 NAME is a string of the font name (or nil if the font backend doesn't
4479 FILENAME is a string of the font file (or nil if the font backend
4480 doesn't provide a file name).
4482 PIXEL-SIZE is a pixel size by which the font is opened.
4484 SIZE is a maximum advance width of the font in pixels.
4486 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4489 CAPABILITY is a list whose first element is a symbol representing the
4490 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4491 remaining elements describe the details of the font capability.
4493 If the font is OpenType font, the form of the list is
4494 \(opentype GSUB GPOS)
4495 where GSUB shows which "GSUB" features the font supports, and GPOS
4496 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4497 lists of the format:
4498 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4500 If the font is not OpenType font, currently the length of the form is
4503 SCRIPT is a symbol representing OpenType script tag.
4505 LANGSYS is a symbol representing OpenType langsys tag, or nil
4506 representing the default langsys.
4508 FEATURE is a symbol representing OpenType feature tag.
4510 If the font is not OpenType font, CAPABILITY is nil. */)
4512 Lisp_Object font_object
;
4517 CHECK_FONT_GET_OBJECT (font_object
, font
);
4519 val
= Fmake_vector (make_number (9), Qnil
);
4520 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4521 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4522 ASET (val
, 2, make_number (font
->pixel_size
));
4523 ASET (val
, 3, make_number (font
->max_width
));
4524 ASET (val
, 4, make_number (font
->ascent
));
4525 ASET (val
, 5, make_number (font
->descent
));
4526 ASET (val
, 6, make_number (font
->space_width
));
4527 ASET (val
, 7, make_number (font
->average_width
));
4528 if (font
->driver
->otf_capability
)
4529 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4533 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4534 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4535 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4536 (font_object
, string
)
4537 Lisp_Object font_object
, string
;
4543 CHECK_FONT_GET_OBJECT (font_object
, font
);
4544 CHECK_STRING (string
);
4545 len
= SCHARS (string
);
4546 vec
= Fmake_vector (make_number (len
), Qnil
);
4547 for (i
= 0; i
< len
; i
++)
4549 Lisp_Object ch
= Faref (string
, make_number (i
));
4554 struct font_metrics metrics
;
4556 cod
= code
= font
->driver
->encode_char (font
, c
);
4557 if (code
== FONT_INVALID_CODE
)
4559 val
= Fmake_vector (make_number (6), Qnil
);
4560 if (cod
<= MOST_POSITIVE_FIXNUM
)
4561 ASET (val
, 0, make_number (code
));
4563 ASET (val
, 0, Fcons (make_number (code
>> 16),
4564 make_number (code
& 0xFFFF)));
4565 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4566 ASET (val
, 1, make_number (metrics
.lbearing
));
4567 ASET (val
, 2, make_number (metrics
.rbearing
));
4568 ASET (val
, 3, make_number (metrics
.width
));
4569 ASET (val
, 4, make_number (metrics
.ascent
));
4570 ASET (val
, 5, make_number (metrics
.descent
));
4576 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4577 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4578 FONT is a font-spec, font-entity, or font-object. */)
4580 Lisp_Object spec
, font
;
4582 CHECK_FONT_SPEC (spec
);
4585 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4588 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4589 doc
: /* Return a font-object for displaying a character at POSITION.
4590 Optional second arg WINDOW, if non-nil, is a window displaying
4591 the current buffer. It defaults to the currently selected window. */)
4592 (position
, window
, string
)
4593 Lisp_Object position
, window
, string
;
4600 CHECK_NUMBER_COERCE_MARKER (position
);
4601 pos
= XINT (position
);
4602 if (pos
< BEGV
|| pos
>= ZV
)
4603 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4607 CHECK_NUMBER (position
);
4608 CHECK_STRING (string
);
4609 pos
= XINT (position
);
4610 if (pos
< 0 || pos
>= SCHARS (string
))
4611 args_out_of_range (string
, position
);
4614 window
= selected_window
;
4615 CHECK_LIVE_WINDOW (window
);
4616 w
= XWINDOW (window
);
4618 return font_at (-1, pos
, NULL
, w
, string
);
4622 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4623 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4624 The value is a number of glyphs drawn.
4625 Type C-l to recover what previously shown. */)
4626 (font_object
, string
)
4627 Lisp_Object font_object
, string
;
4629 Lisp_Object frame
= selected_frame
;
4630 FRAME_PTR f
= XFRAME (frame
);
4636 CHECK_FONT_GET_OBJECT (font_object
, font
);
4637 CHECK_STRING (string
);
4638 len
= SCHARS (string
);
4639 code
= alloca (sizeof (unsigned) * len
);
4640 for (i
= 0; i
< len
; i
++)
4642 Lisp_Object ch
= Faref (string
, make_number (i
));
4646 code
[i
] = font
->driver
->encode_char (font
, c
);
4647 if (code
[i
] == FONT_INVALID_CODE
)
4650 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4652 if (font
->driver
->prepare_face
)
4653 font
->driver
->prepare_face (f
, face
);
4654 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4655 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4656 if (font
->driver
->done_face
)
4657 font
->driver
->done_face (f
, face
);
4659 return make_number (len
);
4663 #endif /* FONT_DEBUG */
4665 #ifdef HAVE_WINDOW_SYSTEM
4667 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4668 doc
: /* Return information about a font named NAME on frame FRAME.
4669 If FRAME is omitted or nil, use the selected frame.
4670 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4671 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4673 OPENED-NAME is the name used for opening the font,
4674 FULL-NAME is the full name of the font,
4675 SIZE is the maximum bound width of the font,
4676 HEIGHT is the height of the font,
4677 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4678 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4679 how to compose characters.
4680 If the named font is not yet loaded, return nil. */)
4682 Lisp_Object name
, frame
;
4687 Lisp_Object font_object
;
4689 (*check_window_system_func
) ();
4692 CHECK_STRING (name
);
4694 frame
= selected_frame
;
4695 CHECK_LIVE_FRAME (frame
);
4700 int fontset
= fs_query_fontset (name
, 0);
4703 name
= fontset_ascii (fontset
);
4704 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4706 else if (FONT_OBJECT_P (name
))
4708 else if (FONT_ENTITY_P (name
))
4709 font_object
= font_open_entity (f
, name
, 0);
4712 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4713 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4715 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4717 if (NILP (font_object
))
4719 font
= XFONT_OBJECT (font_object
);
4721 info
= Fmake_vector (make_number (7), Qnil
);
4722 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4723 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4724 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4725 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4726 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4727 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4728 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4731 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4732 close it now. Perhaps, we should manage font-objects
4733 by `reference-count'. */
4734 font_close_object (f
, font_object
);
4741 #define BUILD_STYLE_TABLE(TBL) \
4742 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4745 build_style_table (entry
, nelement
)
4746 struct table_entry
*entry
;
4750 Lisp_Object table
, elt
;
4752 table
= Fmake_vector (make_number (nelement
), Qnil
);
4753 for (i
= 0; i
< nelement
; i
++)
4755 for (j
= 0; entry
[i
].names
[j
]; j
++);
4756 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4757 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4758 for (j
= 0; entry
[i
].names
[j
]; j
++)
4759 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4760 ASET (table
, i
, elt
);
4765 static Lisp_Object Vfont_log
;
4766 static int font_log_env_checked
;
4769 font_add_log (action
, arg
, result
)
4771 Lisp_Object arg
, result
;
4773 Lisp_Object tail
, val
;
4776 if (! font_log_env_checked
)
4778 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
4779 font_log_env_checked
= 1;
4781 if (EQ (Vfont_log
, Qt
))
4784 arg
= Ffont_xlfd_name (arg
, Qt
);
4786 result
= Ffont_xlfd_name (result
, Qt
);
4787 else if (CONSP (result
))
4789 result
= Fcopy_sequence (result
);
4790 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4794 val
= Ffont_xlfd_name (val
, Qt
);
4795 XSETCAR (tail
, val
);
4798 else if (VECTORP (result
))
4800 result
= Fcopy_sequence (result
);
4801 for (i
= 0; i
< ASIZE (result
); i
++)
4803 val
= AREF (result
, i
);
4805 val
= Ffont_xlfd_name (val
, Qt
);
4806 ASET (result
, i
, val
);
4809 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4812 extern void syms_of_ftfont
P_ (());
4813 extern void syms_of_xfont
P_ (());
4814 extern void syms_of_xftfont
P_ (());
4815 extern void syms_of_ftxfont
P_ (());
4816 extern void syms_of_bdffont
P_ (());
4817 extern void syms_of_w32font
P_ (());
4818 extern void syms_of_atmfont
P_ (());
4823 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
4824 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
4825 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
4826 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
4827 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
4828 /* Note that the other elements in sort_shift_bits are not used. */
4830 staticpro (&font_charset_alist
);
4831 font_charset_alist
= Qnil
;
4833 DEFSYM (Qfont_spec
, "font-spec");
4834 DEFSYM (Qfont_entity
, "font-entity");
4835 DEFSYM (Qfont_object
, "font-object");
4837 DEFSYM (Qopentype
, "opentype");
4839 DEFSYM (Qascii_0
, "ascii-0");
4840 DEFSYM (Qiso8859_1
, "iso8859-1");
4841 DEFSYM (Qiso10646_1
, "iso10646-1");
4842 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4843 DEFSYM (Qunicode_sip
, "unicode-sip");
4845 DEFSYM (QCotf
, ":otf");
4846 DEFSYM (QClang
, ":lang");
4847 DEFSYM (QCscript
, ":script");
4848 DEFSYM (QCantialias
, ":antialias");
4850 DEFSYM (QCfoundry
, ":foundry");
4851 DEFSYM (QCadstyle
, ":adstyle");
4852 DEFSYM (QCregistry
, ":registry");
4853 DEFSYM (QCspacing
, ":spacing");
4854 DEFSYM (QCdpi
, ":dpi");
4855 DEFSYM (QCscalable
, ":scalable");
4856 DEFSYM (QCavgwidth
, ":avgwidth");
4857 DEFSYM (QCfont_entity
, ":font-entity");
4858 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
4865 staticpro (&null_vector
);
4866 null_vector
= Fmake_vector (make_number (0), Qnil
);
4868 staticpro (&scratch_font_spec
);
4869 scratch_font_spec
= Ffont_spec (0, NULL
);
4870 staticpro (&scratch_font_prefer
);
4871 scratch_font_prefer
= Ffont_spec (0, NULL
);
4875 staticpro (&otf_list
);
4877 #endif /* HAVE_LIBOTF */
4881 defsubr (&Sfont_spec
);
4882 defsubr (&Sfont_get
);
4883 defsubr (&Sfont_face_attributes
);
4884 defsubr (&Sfont_put
);
4885 defsubr (&Slist_fonts
);
4886 defsubr (&Sfont_family_list
);
4887 defsubr (&Sfind_font
);
4888 defsubr (&Sfont_xlfd_name
);
4889 defsubr (&Sclear_font_cache
);
4890 defsubr (&Sfont_make_gstring
);
4891 defsubr (&Sfont_fill_gstring
);
4892 defsubr (&Sfont_shape_text
);
4894 defsubr (&Sfont_drive_otf
);
4895 defsubr (&Sfont_otf_alternates
);
4899 defsubr (&Sopen_font
);
4900 defsubr (&Sclose_font
);
4901 defsubr (&Squery_font
);
4902 defsubr (&Sget_font_glyphs
);
4903 defsubr (&Sfont_match_p
);
4904 defsubr (&Sfont_at
);
4906 defsubr (&Sdraw_string
);
4908 #endif /* FONT_DEBUG */
4909 #ifdef HAVE_WINDOW_SYSTEM
4910 defsubr (&Sfont_info
);
4913 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
4915 Alist of fontname patterns vs the corresponding encoding and repertory info.
4916 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
4917 where ENCODING is a charset or a char-table,
4918 and REPERTORY is a charset, a char-table, or nil.
4920 If ENCODING and REPERTORY are the same, the element can have the form
4921 \(REGEXP . ENCODING).
4923 ENCODING is for converting a character to a glyph code of the font.
4924 If ENCODING is a charset, encoding a character by the charset gives
4925 the corresponding glyph code. If ENCODING is a char-table, looking up
4926 the table by a character gives the corresponding glyph code.
4928 REPERTORY specifies a repertory of characters supported by the font.
4929 If REPERTORY is a charset, all characters beloging to the charset are
4930 supported. If REPERTORY is a char-table, all characters who have a
4931 non-nil value in the table are supported. If REPERTORY is nil, Emacs
4932 gets the repertory information by an opened font and ENCODING. */);
4933 Vfont_encoding_alist
= Qnil
;
4935 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
4936 doc
: /* Vector of valid font weight values.
4937 Each element has the form:
4938 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
4939 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
4940 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
4942 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
4943 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
4944 See `font-weight-table' for the format of the vector. */);
4945 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
4947 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
4948 doc
: /* Alist of font width symbols vs the corresponding numeric values.
4949 See `font-weight-table' for the format of the vector. */);
4950 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
4952 staticpro (&font_style_table
);
4953 font_style_table
= Fmake_vector (make_number (3), Qnil
);
4954 ASET (font_style_table
, 0, Vfont_weight_table
);
4955 ASET (font_style_table
, 1, Vfont_slant_table
);
4956 ASET (font_style_table
, 2, Vfont_width_table
);
4958 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
4959 *Logging list of font related actions and results.
4960 The value t means to suppress the logging.
4961 The initial value is set to nil if the environment variable
4962 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
4965 #ifdef HAVE_WINDOW_SYSTEM
4966 #ifdef HAVE_FREETYPE
4968 #ifdef HAVE_X_WINDOWS
4973 #endif /* HAVE_XFT */
4974 #endif /* HAVE_X_WINDOWS */
4975 #else /* not HAVE_FREETYPE */
4976 #ifdef HAVE_X_WINDOWS
4978 #endif /* HAVE_X_WINDOWS */
4979 #endif /* not HAVE_FREETYPE */
4982 #endif /* HAVE_BDFFONT */
4985 #endif /* WINDOWSNT */
4989 #endif /* HAVE_WINDOW_SYSTEM */
4992 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
4993 (do not change this comment) */