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
, QCsize
, QCname
;
130 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
;
131 /* Symbols representing keys of font extra info. */
132 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
133 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
134 /* Symbols representing values of font spacing property. */
135 Lisp_Object Qc
, Qm
, Qp
, Qd
;
137 Lisp_Object Vfont_encoding_alist
;
139 /* Alist of font registry symbol and the corresponding charsets
140 information. The information is retrieved from
141 Vfont_encoding_alist on demand.
143 Eash element has the form:
144 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
148 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
149 encodes a character code to a glyph code of a font, and
150 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
151 character is supported by a font.
153 The latter form means that the information for REGISTRY couldn't be
155 static Lisp_Object font_charset_alist
;
157 /* List of all font drivers. Each font-backend (XXXfont.c) calls
158 register_font_driver in syms_of_XXXfont to register its font-driver
160 static struct font_driver_list
*font_driver_list
;
164 /* Creaters of font-related Lisp object. */
169 Lisp_Object font_spec
;
170 struct font_spec
*spec
171 = ((struct font_spec
*)
172 allocate_pseudovector (VECSIZE (struct font_spec
),
173 FONT_SPEC_MAX
, PVEC_FONT
));
174 XSETFONT (font_spec
, spec
);
181 Lisp_Object font_entity
;
182 struct font_entity
*entity
183 = ((struct font_entity
*)
184 allocate_pseudovector (VECSIZE (struct font_entity
),
185 FONT_ENTITY_MAX
, PVEC_FONT
));
186 XSETFONT (font_entity
, entity
);
191 font_make_object (size
)
194 Lisp_Object font_object
;
196 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
197 XSETFONT (font_object
, font
);
204 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
205 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
206 static Lisp_Object font_matching_entity
P_ ((FRAME_PTR
, Lisp_Object
*,
209 /* Number of registered font drivers. */
210 static int num_font_drivers
;
213 /* Return a Lispy value of a font property value at STR and LEN bytes.
214 If STR is "*", it returns nil.
215 If FORCE_SYMBOL is zero and all characters in STR are digits, it
216 returns an integer. Otherwise, it returns a symbol interned from
220 font_intern_prop (str
, len
, force_symbol
)
229 if (len
== 1 && *str
== '*')
231 if (!force_symbol
&& len
>=1 && isdigit (*str
))
233 for (i
= 1; i
< len
; i
++)
234 if (! isdigit (str
[i
]))
237 return make_number (atoi (str
));
240 /* The following code is copied from the function intern (in lread.c). */
242 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
243 obarray
= check_obarray (obarray
);
244 tem
= oblookup (obarray
, str
, len
, len
);
247 return Fintern (make_unibyte_string (str
, len
), obarray
);
250 /* Return a pixel size of font-spec SPEC on frame F. */
253 font_pixel_size (f
, spec
)
257 #ifdef HAVE_WINDOW_SYSTEM
258 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
267 font_assert (FLOATP (size
));
268 point_size
= XFLOAT_DATA (size
);
269 val
= AREF (spec
, FONT_DPI_INDEX
);
274 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
282 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
283 font vector. If VAL is not valid (i.e. not registered in
284 font_style_table), return -1 if NOERROR is zero, and return a
285 proper index if NOERROR is nonzero. In that case, register VAL in
286 font_style_table if VAL is a symbol, and return a closest index if
287 VAL is an integer. */
290 font_style_to_value (prop
, val
, noerror
)
291 enum font_property_index prop
;
295 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
296 int len
= ASIZE (table
);
302 Lisp_Object args
[2], elt
;
304 /* At first try exact match. */
305 for (i
= 0; i
< len
; i
++)
306 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
307 if (EQ (val
, AREF (AREF (table
, i
), j
)))
308 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
309 | (i
<< 4) | (j
- 1));
310 /* Try also with case-folding match. */
311 s
= SDATA (SYMBOL_NAME (val
));
312 for (i
= 0; i
< len
; i
++)
313 for (j
= 1; j
< ASIZE (AREF (table
, i
)); j
++)
315 elt
= AREF (AREF (table
, i
), j
);
316 if (xstrcasecmp (s
, SDATA (SYMBOL_NAME (elt
))) == 0)
317 return ((XINT (AREF (AREF (table
, i
), 0)) << 8)
318 | (i
<< 4) | (j
- 1));
324 elt
= Fmake_vector (make_number (2), make_number (255));
327 args
[1] = Fmake_vector (make_number (1), elt
);
328 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
329 return (255 << 8) | (i
<< 4);
334 int numeric
= XINT (val
);
336 for (i
= 0, last_n
= -1; i
< len
; i
++)
338 int n
= XINT (AREF (AREF (table
, i
), 0));
341 return (n
<< 8) | (i
<< 4);
346 return ((i
== 0 || n
- numeric
< numeric
- last_n
)
347 ? (n
<< 8) | (i
<< 4): (last_n
<< 8 | ((i
- 1) << 4)));
353 return ((last_n
<< 8) | ((i
- 1) << 4));
358 font_style_symbolic (font
, prop
, for_face
)
360 enum font_property_index prop
;
363 Lisp_Object val
= AREF (font
, prop
);
364 Lisp_Object table
, elt
;
369 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
370 i
= XINT (val
) & 0xFF;
371 font_assert (((i
>> 4) & 0xF) < ASIZE (table
));
372 elt
= AREF (table
, ((i
>> 4) & 0xF));
373 font_assert ((i
& 0xF) + 1 < ASIZE (elt
));
374 return (for_face
? AREF (elt
, 1) : AREF (elt
, (i
& 0xF) + 1));
377 extern Lisp_Object Vface_alternative_font_family_alist
;
379 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
382 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
383 FONTNAME. ENCODING is a charset symbol that specifies the encoding
384 of the font. REPERTORY is a charset symbol or nil. */
387 find_font_encoding (fontname
)
388 Lisp_Object fontname
;
390 Lisp_Object tail
, elt
;
392 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
396 && STRINGP (XCAR (elt
))
397 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
398 && (SYMBOLP (XCDR (elt
))
399 ? CHARSETP (XCDR (elt
))
400 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
403 /* We don't know the encoding of this font. Let's assume `ascii'. */
407 /* Return encoding charset and repertory charset for REGISTRY in
408 ENCODING and REPERTORY correspondingly. If correct information for
409 REGISTRY is available, return 0. Otherwise return -1. */
412 font_registry_charsets (registry
, encoding
, repertory
)
413 Lisp_Object registry
;
414 struct charset
**encoding
, **repertory
;
417 int encoding_id
, repertory_id
;
419 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
425 encoding_id
= XINT (XCAR (val
));
426 repertory_id
= XINT (XCDR (val
));
430 val
= find_font_encoding (SYMBOL_NAME (registry
));
431 if (SYMBOLP (val
) && CHARSETP (val
))
433 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
435 else if (CONSP (val
))
437 if (! CHARSETP (XCAR (val
)))
439 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
440 if (NILP (XCDR (val
)))
444 if (! CHARSETP (XCDR (val
)))
446 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
451 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
453 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
457 *encoding
= CHARSET_FROM_ID (encoding_id
);
459 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
464 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
469 /* Font property value validaters. See the comment of
470 font_property_table for the meaning of the arguments. */
472 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
473 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
474 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
475 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
476 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
477 static int get_font_prop_index
P_ ((Lisp_Object
));
480 font_prop_validate_symbol (prop
, val
)
481 Lisp_Object prop
, val
;
484 val
= Fintern (val
, Qnil
);
487 else if (EQ (prop
, QCregistry
))
488 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
494 font_prop_validate_style (style
, val
)
495 Lisp_Object style
, val
;
497 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
498 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
505 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
509 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), (n
>> 4) & 0xF);
511 if ((n
& 0xF) + 1 >= ASIZE (elt
))
513 else if (XINT (AREF (elt
, 0)) != (n
>> 8))
517 else if (SYMBOLP (val
))
519 int n
= font_style_to_value (prop
, val
, 0);
521 val
= n
>= 0 ? make_number (n
) : Qerror
;
529 font_prop_validate_non_neg (prop
, val
)
530 Lisp_Object prop
, val
;
532 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
537 font_prop_validate_spacing (prop
, val
)
538 Lisp_Object prop
, val
;
540 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
542 if (SYMBOLP (val
) && SBYTES (SYMBOL_NAME (val
)) == 1)
544 char spacing
= SDATA (SYMBOL_NAME (val
))[0];
546 if (spacing
== 'c' || spacing
== 'C')
547 return make_number (FONT_SPACING_CHARCELL
);
548 if (spacing
== 'm' || spacing
== 'M')
549 return make_number (FONT_SPACING_MONO
);
550 if (spacing
== 'p' || spacing
== 'P')
551 return make_number (FONT_SPACING_PROPORTIONAL
);
552 if (spacing
== 'd' || spacing
== 'D')
553 return make_number (FONT_SPACING_DUAL
);
559 font_prop_validate_otf (prop
, val
)
560 Lisp_Object prop
, val
;
562 Lisp_Object tail
, tmp
;
565 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
566 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
567 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
570 if (! SYMBOLP (XCAR (val
)))
575 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
577 for (i
= 0; i
< 2; i
++)
584 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
585 if (! SYMBOLP (XCAR (tmp
)))
593 /* Structure of known font property keys and validater of the
597 /* Pointer to the key symbol. */
599 /* Function to validate PROP's value VAL, or NULL if any value is
600 ok. The value is VAL or its regularized value if VAL is valid,
601 and Qerror if not. */
602 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
603 } font_property_table
[] =
604 { { &QCtype
, font_prop_validate_symbol
},
605 { &QCfoundry
, font_prop_validate_symbol
},
606 { &QCfamily
, font_prop_validate_symbol
},
607 { &QCadstyle
, font_prop_validate_symbol
},
608 { &QCregistry
, font_prop_validate_symbol
},
609 { &QCweight
, font_prop_validate_style
},
610 { &QCslant
, font_prop_validate_style
},
611 { &QCwidth
, font_prop_validate_style
},
612 { &QCsize
, font_prop_validate_non_neg
},
613 { &QCdpi
, font_prop_validate_non_neg
},
614 { &QCspacing
, font_prop_validate_spacing
},
615 { &QCavgwidth
, font_prop_validate_non_neg
},
616 /* The order of the above entries must match with enum
617 font_property_index. */
618 { &QClang
, font_prop_validate_symbol
},
619 { &QCscript
, font_prop_validate_symbol
},
620 { &QCotf
, font_prop_validate_otf
}
623 /* Size (number of elements) of the above table. */
624 #define FONT_PROPERTY_TABLE_SIZE \
625 ((sizeof font_property_table) / (sizeof *font_property_table))
627 /* Return an index number of font property KEY or -1 if KEY is not an
628 already known property. */
631 get_font_prop_index (key
)
636 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
637 if (EQ (key
, *font_property_table
[i
].key
))
642 /* Validate the font property. The property key is specified by the
643 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
644 signal an error. The value is VAL or the regularized one. */
647 font_prop_validate (idx
, prop
, val
)
649 Lisp_Object prop
, val
;
651 Lisp_Object validated
;
656 prop
= *font_property_table
[idx
].key
;
659 idx
= get_font_prop_index (prop
);
663 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
664 if (EQ (validated
, Qerror
))
665 signal_error ("invalid font property", Fcons (prop
, val
));
670 /* Store VAL as a value of extra font property PROP in FONT while
671 keeping the sorting order. Don't check the validity of VAL. */
674 font_put_extra (font
, prop
, val
)
675 Lisp_Object font
, prop
, val
;
677 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
678 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
682 Lisp_Object prev
= Qnil
;
685 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
686 prev
= extra
, extra
= XCDR (extra
);
688 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
690 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
698 /* Font name parser and unparser */
700 static int parse_matrix
P_ ((char *));
701 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
702 static int font_parse_name
P_ ((char *, Lisp_Object
));
704 /* An enumerator for each field of an XLFD font name. */
705 enum xlfd_field_index
724 /* An enumerator for mask bit corresponding to each XLFD field. */
727 XLFD_FOUNDRY_MASK
= 0x0001,
728 XLFD_FAMILY_MASK
= 0x0002,
729 XLFD_WEIGHT_MASK
= 0x0004,
730 XLFD_SLANT_MASK
= 0x0008,
731 XLFD_SWIDTH_MASK
= 0x0010,
732 XLFD_ADSTYLE_MASK
= 0x0020,
733 XLFD_PIXEL_MASK
= 0x0040,
734 XLFD_POINT_MASK
= 0x0080,
735 XLFD_RESX_MASK
= 0x0100,
736 XLFD_RESY_MASK
= 0x0200,
737 XLFD_SPACING_MASK
= 0x0400,
738 XLFD_AVGWIDTH_MASK
= 0x0800,
739 XLFD_REGISTRY_MASK
= 0x1000,
740 XLFD_ENCODING_MASK
= 0x2000
744 /* Parse P pointing the pixel/point size field of the form
745 `[A B C D]' which specifies a transformation matrix:
751 by which all glyphs of the font are transformed. The spec says
752 that scalar value N for the pixel/point size is equivalent to:
753 A = N * resx/resy, B = C = 0, D = N.
755 Return the scalar value N if the form is valid. Otherwise return
766 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
769 matrix
[i
] = - strtod (p
+ 1, &end
);
771 matrix
[i
] = strtod (p
, &end
);
774 return (i
== 4 ? (int) matrix
[3] : -1);
777 /* Expand a wildcard field in FIELD (the first N fields are filled) to
778 multiple fields to fill in all 14 XLFD fields while restring a
779 field position by its contents. */
782 font_expand_wildcards (field
, n
)
783 Lisp_Object field
[XLFD_LAST_INDEX
];
787 Lisp_Object tmp
[XLFD_LAST_INDEX
];
788 /* Array of information about where this element can go. Nth
789 element is for Nth element of FIELD. */
791 /* Minimum possible field. */
793 /* Maxinum possible field. */
795 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
797 } range
[XLFD_LAST_INDEX
];
799 int range_from
, range_to
;
802 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
803 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
804 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
805 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
806 | XLFD_AVGWIDTH_MASK)
807 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
809 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
810 field. The value is shifted to left one bit by one in the
812 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
813 range_mask
= (range_mask
<< 1) | 1;
815 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
816 position-based retriction for FIELD[I]. */
817 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
818 i
++, range_from
++, range_to
++, range_mask
<<= 1)
820 Lisp_Object val
= field
[i
];
826 range
[i
].from
= range_from
;
827 range
[i
].to
= range_to
;
828 range
[i
].mask
= range_mask
;
832 /* The triplet FROM, TO, and MASK is a value-based
833 retriction for FIELD[I]. */
839 int numeric
= XINT (val
);
842 from
= to
= XLFD_ENCODING_INDEX
,
843 mask
= XLFD_ENCODING_MASK
;
844 else if (numeric
== 0)
845 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
846 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
847 else if (numeric
<= 48)
848 from
= to
= XLFD_PIXEL_INDEX
,
849 mask
= XLFD_PIXEL_MASK
;
851 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
852 mask
= XLFD_LARGENUM_MASK
;
854 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
855 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
856 mask
= XLFD_NULL_MASK
;
858 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
861 Lisp_Object name
= SYMBOL_NAME (val
);
863 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
864 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
865 mask
= XLFD_REGENC_MASK
;
867 from
= to
= XLFD_ENCODING_INDEX
,
868 mask
= XLFD_ENCODING_MASK
;
870 else if (range_from
<= XLFD_WEIGHT_INDEX
871 && range_to
>= XLFD_WEIGHT_INDEX
872 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
873 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
874 else if (range_from
<= XLFD_SLANT_INDEX
875 && range_to
>= XLFD_SLANT_INDEX
876 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
877 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
878 else if (range_from
<= XLFD_SWIDTH_INDEX
879 && range_to
>= XLFD_SWIDTH_INDEX
880 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
881 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
884 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
885 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
887 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
888 mask
= XLFD_SYMBOL_MASK
;
891 /* Merge position-based and value-based restrictions. */
893 while (from
< range_from
)
894 mask
&= ~(1 << from
++);
895 while (from
< 14 && ! (mask
& (1 << from
)))
897 while (to
> range_to
)
898 mask
&= ~(1 << to
--);
899 while (to
>= 0 && ! (mask
& (1 << to
)))
903 range
[i
].from
= from
;
905 range
[i
].mask
= mask
;
907 if (from
> range_from
|| to
< range_to
)
909 /* The range is narrowed by value-based restrictions.
910 Reflect it to the other fields. */
912 /* Following fields should be after FROM. */
914 /* Preceding fields should be before TO. */
915 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
917 /* Check FROM for non-wildcard field. */
918 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
920 while (range
[j
].from
< from
)
921 range
[j
].mask
&= ~(1 << range
[j
].from
++);
922 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
924 range
[j
].from
= from
;
927 from
= range
[j
].from
;
928 if (range
[j
].to
> to
)
930 while (range
[j
].to
> to
)
931 range
[j
].mask
&= ~(1 << range
[j
].to
--);
932 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
945 /* Decide all fileds from restrictions in RANGE. */
946 for (i
= j
= 0; i
< n
; i
++)
948 if (j
< range
[i
].from
)
950 if (i
== 0 || ! NILP (tmp
[i
- 1]))
951 /* None of TMP[X] corresponds to Jth field. */
953 for (; j
< range
[i
].from
; j
++)
958 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
960 for (; j
< XLFD_LAST_INDEX
; j
++)
962 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
963 field
[XLFD_ENCODING_INDEX
]
964 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
969 #ifdef ENABLE_CHECKING
970 /* Match a 14-field XLFD pattern against a full XLFD font name. */
972 font_match_xlfd (char *pattern
, char *name
)
974 while (*pattern
&& *name
)
976 if (*pattern
== *name
)
978 else if (*pattern
== '*')
979 if (*name
== pattern
[1])
990 /* Make sure the font object matches the XLFD font name. */
992 font_check_xlfd_parse (Lisp_Object font
, char *name
)
994 char name_check
[256];
995 font_unparse_xlfd (font
, 0, name_check
, 255);
996 return font_match_xlfd (name_check
, name
);
1002 /* Parse NAME (null terminated) as XLFD and store information in FONT
1003 (font-spec or font-entity). Size property of FONT is set as
1005 specified XLFD fields FONT property
1006 --------------------- -------------
1007 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
1008 POINT_SIZE and RESY calculated pixel size (Lisp integer)
1009 POINT_SIZE POINT_SIZE/10 (Lisp float)
1011 If NAME is successfully parsed, return 0. Otherwise return -1.
1013 FONT is usually a font-spec, but when this function is called from
1014 X font backend driver, it is a font-entity. In that case, NAME is
1015 a fully specified XLFD. */
1018 font_parse_xlfd (name
, font
)
1022 int len
= strlen (name
);
1024 char *f
[XLFD_LAST_INDEX
+ 1];
1029 /* Maximum XLFD name length is 255. */
1031 /* Accept "*-.." as a fully specified XLFD. */
1032 if (name
[0] == '*' && name
[1] == '-')
1033 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
1036 for (p
= name
+ i
; *p
; p
++)
1040 if (i
== XLFD_LAST_INDEX
)
1045 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 0)
1046 #define INTERN_FIELD_SYM(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N], 1)
1048 if (i
== XLFD_LAST_INDEX
)
1050 /* Fully specified XLFD. */
1053 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD_SYM (XLFD_FOUNDRY_INDEX
));
1054 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD_SYM (XLFD_FAMILY_INDEX
));
1055 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1056 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1058 val
= INTERN_FIELD_SYM (i
);
1061 if ((n
= font_style_to_value (j
, INTERN_FIELD_SYM (i
), 0)) < 0)
1063 ASET (font
, j
, make_number (n
));
1066 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX
));
1067 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1068 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1070 ASET (font
, FONT_REGISTRY_INDEX
,
1071 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1072 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
],
1074 p
= f
[XLFD_PIXEL_INDEX
];
1075 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1076 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1079 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1081 ASET (font
, FONT_SIZE_INDEX
, val
);
1084 double point_size
= -1;
1086 font_assert (FONT_SPEC_P (font
));
1087 p
= f
[XLFD_POINT_INDEX
];
1089 point_size
= parse_matrix (p
);
1090 else if (isdigit (*p
))
1091 point_size
= atoi (p
), point_size
/= 10;
1092 if (point_size
>= 0)
1093 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1097 ASET (font
, FONT_DPI_INDEX
, INTERN_FIELD (XLFD_RESY_INDEX
));
1098 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1101 val
= font_prop_validate_spacing (QCspacing
, val
);
1102 if (! INTEGERP (val
))
1104 ASET (font
, FONT_SPACING_INDEX
, val
);
1106 p
= f
[XLFD_AVGWIDTH_INDEX
];
1109 ASET (font
, FONT_AVGWIDTH_INDEX
,
1110 font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
, 1));
1114 int wild_card_found
= 0;
1115 Lisp_Object prop
[XLFD_LAST_INDEX
];
1117 if (FONT_ENTITY_P (font
))
1119 for (j
= 0; j
< i
; j
++)
1123 if (f
[j
][1] && f
[j
][1] != '-')
1126 wild_card_found
= 1;
1129 prop
[j
] = INTERN_FIELD (j
);
1131 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
], 0);
1133 if (! wild_card_found
)
1135 if (font_expand_wildcards (prop
, i
) < 0)
1138 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1139 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1140 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1141 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1142 if (! NILP (prop
[i
]))
1144 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1146 ASET (font
, j
, make_number (n
));
1148 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1149 val
= prop
[XLFD_REGISTRY_INDEX
];
1152 val
= prop
[XLFD_ENCODING_INDEX
];
1154 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1156 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1157 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1159 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1160 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1162 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1164 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1165 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1166 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1168 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1170 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1173 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1174 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1175 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1177 val
= font_prop_validate_spacing (QCspacing
,
1178 prop
[XLFD_SPACING_INDEX
]);
1179 if (! INTEGERP (val
))
1181 ASET (font
, FONT_SPACING_INDEX
, val
);
1183 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1184 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1190 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1191 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1192 0, use PIXEL_SIZE instead. */
1195 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1201 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1205 font_assert (FONTP (font
));
1207 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1210 if (i
== FONT_ADSTYLE_INDEX
)
1211 j
= XLFD_ADSTYLE_INDEX
;
1212 else if (i
== FONT_REGISTRY_INDEX
)
1213 j
= XLFD_REGISTRY_INDEX
;
1214 val
= AREF (font
, i
);
1217 if (j
== XLFD_REGISTRY_INDEX
)
1218 f
[j
] = "*-*", len
+= 4;
1220 f
[j
] = "*", len
+= 2;
1225 val
= SYMBOL_NAME (val
);
1226 if (j
== XLFD_REGISTRY_INDEX
1227 && ! strchr ((char *) SDATA (val
), '-'))
1229 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1230 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1232 f
[j
] = alloca (SBYTES (val
) + 3);
1233 sprintf (f
[j
], "%s-*", SDATA (val
));
1234 len
+= SBYTES (val
) + 3;
1238 f
[j
] = alloca (SBYTES (val
) + 4);
1239 sprintf (f
[j
], "%s*-*", SDATA (val
));
1240 len
+= SBYTES (val
) + 4;
1244 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1248 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1251 val
= font_style_symbolic (font
, i
, 0);
1253 f
[j
] = "*", len
+= 2;
1256 val
= SYMBOL_NAME (val
);
1257 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1261 val
= AREF (font
, FONT_SIZE_INDEX
);
1262 font_assert (NUMBERP (val
) || NILP (val
));
1270 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1271 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1274 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1276 else if (FLOATP (val
))
1278 i
= XFLOAT_DATA (val
) * 10;
1279 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1280 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1283 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1285 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1287 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1288 f
[XLFD_RESX_INDEX
] = alloca (22);
1289 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1293 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1294 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1296 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1298 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1299 : spacing
<= FONT_SPACING_DUAL
? "d"
1300 : spacing
<= FONT_SPACING_MONO
? "m"
1305 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1306 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1308 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1309 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
],
1310 "%d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1313 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1314 len
++; /* for terminating '\0'. */
1317 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1318 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1319 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1320 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1321 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1322 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1323 f
[XLFD_REGISTRY_INDEX
]);
1326 /* Parse NAME (null terminated) and store information in FONT
1327 (font-spec or font-entity). NAME is supplied in either the
1328 Fontconfig or GTK font name format. If NAME is successfully
1329 parsed, return 0. Otherwise return -1.
1331 The fontconfig format is
1333 FAMILY[-SIZE][:PROP1[=VAL1][:PROP2[=VAL2]...]]
1337 FAMILY [PROPS...] [SIZE]
1339 This function tries to guess which format it is. */
1342 font_parse_fcname (name
, font
)
1347 char *size_beg
= NULL
, *size_end
= NULL
;
1348 char *props_beg
= NULL
, *family_end
= NULL
;
1349 int len
= strlen (name
);
1354 for (p
= name
; *p
; p
++)
1356 if (*p
== '\\' && p
[1])
1367 for (q
= p
+ 1; *q
&& *q
!= ':'; q
++)
1368 if (! isdigit(*q
) && *q
!= '.')
1385 /* A fontconfig name with size and/or property data. */
1386 if (family_end
> name
)
1389 family
= font_intern_prop (name
, family_end
- name
, 1);
1390 ASET (font
, FONT_FAMILY_INDEX
, family
);
1394 double point_size
= strtod (size_beg
, &size_end
);
1395 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1396 if (*size_end
== ':' && size_end
[1])
1397 props_beg
= size_end
+ 1;
1401 /* Now parse ":KEY=VAL" patterns. Store known keys and values in
1402 extra, copy unknown ones to COPY. It is stored in extra slot by
1403 the key QCfc_unknown_spec. */
1406 name
= copy
= alloca (name
+ len
- props_beg
);
1416 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1418 for (q
= p
+ 1; *q
&& *q
!= '=' && *q
!= ':'; q
++);
1422 /* Must be an enumerated value. */
1423 val
= font_intern_prop (p
, q
- p
, 1);
1424 if (PROP_MATCH ("light", 5)
1425 || PROP_MATCH ("medium", 6)
1426 || PROP_MATCH ("demibold", 8)
1427 || PROP_MATCH ("bold", 4)
1428 || PROP_MATCH ("black", 5))
1429 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1430 else if (PROP_MATCH ("roman", 5)
1431 || PROP_MATCH ("italic", 6)
1432 || PROP_MATCH ("oblique", 7))
1433 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1434 else if (PROP_MATCH ("charcell", 8))
1435 ASET (font
, FONT_SPACING_INDEX
,
1436 make_number (FONT_SPACING_CHARCELL
));
1437 else if (PROP_MATCH ("mono", 4))
1438 ASET (font
, FONT_SPACING_INDEX
,
1439 make_number (FONT_SPACING_MONO
));
1440 else if (PROP_MATCH ("proportional", 12))
1441 ASET (font
, FONT_SPACING_INDEX
,
1442 make_number (FONT_SPACING_PROPORTIONAL
));
1446 bcopy (p
, copy
, word_len
);
1450 else /* KEY=VAL pairs */
1455 if (PROP_MATCH ("pixelsize=", 10))
1456 prop
= FONT_SIZE_INDEX
;
1459 key
= font_intern_prop (p
, q
- p
, 1);
1460 prop
= get_font_prop_index (key
);
1463 for (q
= p
; *q
&& *q
!= ':'; q
++);
1465 val
= font_intern_prop (p
, word_len
, 0);
1468 if (prop
>= FONT_FOUNDRY_INDEX
1469 && prop
< FONT_EXTRA_INDEX
)
1471 font_prop_validate (prop
, Qnil
, val
));
1473 Ffont_put (font
, key
, val
);
1475 bcopy (keyhead
, copy
, q
- keyhead
);
1476 copy
+= q
- keyhead
;
1483 font_put_extra (font
, QCfc_unknown_spec
,
1484 make_unibyte_string (name
, copy
- name
));
1489 /* Either a fontconfig-style name with no size and property
1490 data, or a GTK-style name. */
1492 int word_len
, prop_found
= 0;
1494 for (p
= name
; *p
; p
= *q
? q
+ 1 : q
)
1500 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1508 double point_size
= strtod (p
, &q
);
1509 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1514 for (q
= p
+ 1; *q
&& *q
!= ' '; q
++)
1515 if (*q
== '\\' && q
[1])
1519 #define PROP_MATCH(STR,N) ((word_len == N) && memcmp (p, STR, N) == 0)
1521 if (PROP_MATCH ("Ultra-Light", 11))
1524 prop
= font_intern_prop ("ultra-light", 11, 1);
1525 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1527 else if (PROP_MATCH ("Light", 5))
1530 prop
= font_intern_prop ("light", 5, 1);
1531 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1533 else if (PROP_MATCH ("Semi-Bold", 9))
1536 prop
= font_intern_prop ("semi-bold", 9, 1);
1537 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1539 else if (PROP_MATCH ("Bold", 4))
1542 prop
= font_intern_prop ("bold", 4, 1);
1543 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, prop
);
1545 else if (PROP_MATCH ("Italic", 6))
1548 prop
= font_intern_prop ("italic", 4, 1);
1549 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1551 else if (PROP_MATCH ("Oblique", 7))
1554 prop
= font_intern_prop ("oblique", 7, 1);
1555 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, prop
);
1559 return -1; /* Unknown property in GTK-style font name. */
1568 family
= font_intern_prop (name
, family_end
- name
, 1);
1569 ASET (font
, FONT_FAMILY_INDEX
, family
);
1576 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1577 NAME (NBYTES length), and return the name length. If
1578 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1581 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1587 Lisp_Object tail
, val
;
1592 Lisp_Object styles
[3];
1593 char *style_names
[3] = { "weight", "slant", "width" };
1596 val
= AREF (font
, FONT_FAMILY_INDEX
);
1598 len
+= SBYTES (val
);
1600 val
= AREF (font
, FONT_SIZE_INDEX
);
1603 if (XINT (val
) != 0)
1604 pixel_size
= XINT (val
);
1606 len
+= 21; /* for ":pixelsize=NUM" */
1608 else if (FLOATP (val
))
1611 point_size
= (int) XFLOAT_DATA (val
);
1612 len
+= 11; /* for "-NUM" */
1615 val
= AREF (font
, FONT_FOUNDRY_INDEX
);
1617 /* ":foundry=NAME" */
1618 len
+= 9 + SBYTES (val
);
1620 for (i
= 0; i
< 3; i
++)
1622 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1623 if (! NILP (styles
[i
]))
1624 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1625 SDATA (SYMBOL_NAME (styles
[i
])));
1628 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1629 len
+= sprintf (work
, ":dpi=%d", dpi
);
1630 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1631 len
+= strlen (":spacing=100");
1632 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1633 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1634 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1636 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1638 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1640 len
+= SBYTES (val
);
1641 else if (INTEGERP (val
))
1642 len
+= sprintf (work
, "%d", XINT (val
));
1643 else if (SYMBOLP (val
))
1644 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1650 if (! NILP (AREF (font
, FONT_FAMILY_INDEX
)))
1651 p
+= sprintf(p
, "%s", SDATA (SYMBOL_NAME (AREF (font
, FONT_FAMILY_INDEX
))));
1655 p
+= sprintf (p
, "%d", point_size
);
1657 p
+= sprintf (p
, "-%d", point_size
);
1659 else if (pixel_size
> 0)
1660 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1661 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1662 p
+= sprintf (p
, ":foundry=%s",
1663 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1664 for (i
= 0; i
< 3; i
++)
1665 if (! NILP (styles
[i
]))
1666 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1667 SDATA (SYMBOL_NAME (styles
[i
])));
1668 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1669 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1670 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1671 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1672 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1674 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1675 p
+= sprintf (p
, ":scalable=true");
1677 p
+= sprintf (p
, ":scalable=false");
1682 /* Parse NAME (null terminated) and store information in FONT
1683 (font-spec or font-entity). If NAME is successfully parsed, return
1684 0. Otherwise return -1. */
1687 font_parse_name (name
, font
)
1691 if (name
[0] == '-' || index (name
, '*'))
1692 return font_parse_xlfd (name
, font
);
1693 return font_parse_fcname (name
, font
);
1697 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1698 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1702 font_parse_family_registry (family
, registry
, font_spec
)
1703 Lisp_Object family
, registry
, font_spec
;
1709 && NILP (AREF (font_spec
, FONT_FAMILY_INDEX
)))
1711 CHECK_STRING (family
);
1712 len
= SBYTES (family
);
1713 p0
= (char *) SDATA (family
);
1714 p1
= index (p0
, '-');
1717 if ((*p0
!= '*' || p1
- p0
> 1)
1718 && NILP (AREF (font_spec
, FONT_FOUNDRY_INDEX
)))
1719 Ffont_put (font_spec
, QCfoundry
, font_intern_prop (p0
, p1
- p0
, 1));
1722 Ffont_put (font_spec
, QCfamily
, font_intern_prop (p1
, len
, 1));
1725 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1727 if (! NILP (registry
))
1729 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1730 CHECK_STRING (registry
);
1731 len
= SBYTES (registry
);
1732 p0
= (char *) SDATA (registry
);
1733 p1
= index (p0
, '-');
1736 if (SDATA (registry
)[len
- 1] == '*')
1737 registry
= concat2 (registry
, build_string ("-*"));
1739 registry
= concat2 (registry
, build_string ("*-*"));
1741 registry
= Fdowncase (registry
);
1742 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1747 /* This part (through the next ^L) is still experimental and not
1748 tested much. We may drastically change codes. */
1754 #define LGSTRING_HEADER_SIZE 6
1755 #define LGSTRING_GLYPH_SIZE 8
1758 check_gstring (gstring
)
1759 Lisp_Object gstring
;
1764 CHECK_VECTOR (gstring
);
1765 val
= AREF (gstring
, 0);
1767 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1769 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1770 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1771 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1772 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1773 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1774 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1775 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1776 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1777 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1778 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1779 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1781 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1783 val
= LGSTRING_GLYPH (gstring
, i
);
1785 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1787 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1789 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1790 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1791 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1792 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1793 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1794 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1795 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1796 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1798 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1800 if (ASIZE (val
) < 3)
1802 for (j
= 0; j
< 3; j
++)
1803 CHECK_NUMBER (AREF (val
, j
));
1808 error ("Invalid glyph-string format");
1813 check_otf_features (otf_features
)
1814 Lisp_Object otf_features
;
1818 CHECK_CONS (otf_features
);
1819 CHECK_SYMBOL (XCAR (otf_features
));
1820 otf_features
= XCDR (otf_features
);
1821 CHECK_CONS (otf_features
);
1822 CHECK_SYMBOL (XCAR (otf_features
));
1823 otf_features
= XCDR (otf_features
);
1824 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1826 CHECK_SYMBOL (Fcar (val
));
1827 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1828 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1830 otf_features
= XCDR (otf_features
);
1831 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1833 CHECK_SYMBOL (Fcar (val
));
1834 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1835 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1842 Lisp_Object otf_list
;
1845 otf_tag_symbol (tag
)
1850 OTF_tag_name (tag
, name
);
1851 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1858 Lisp_Object val
= Fassoc (file
, otf_list
);
1862 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1865 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1866 val
= make_save_value (otf
, 0);
1867 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1873 /* Return a list describing which scripts/languages FONT supports by
1874 which GSUB/GPOS features of OpenType tables. See the comment of
1875 (struct font_driver).otf_capability. */
1878 font_otf_capability (font
)
1882 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1885 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1888 for (i
= 0; i
< 2; i
++)
1890 OTF_GSUB_GPOS
*gsub_gpos
;
1891 Lisp_Object script_list
= Qnil
;
1894 if (OTF_get_features (otf
, i
== 0) < 0)
1896 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1897 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1899 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1900 Lisp_Object langsys_list
= Qnil
;
1901 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1904 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1906 OTF_LangSys
*langsys
;
1907 Lisp_Object feature_list
= Qnil
;
1908 Lisp_Object langsys_tag
;
1911 if (k
== script
->LangSysCount
)
1913 langsys
= &script
->DefaultLangSys
;
1918 langsys
= script
->LangSys
+ k
;
1920 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1922 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1924 OTF_Feature
*feature
1925 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1926 Lisp_Object feature_tag
1927 = otf_tag_symbol (feature
->FeatureTag
);
1929 feature_list
= Fcons (feature_tag
, feature_list
);
1931 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1934 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1939 XSETCAR (capability
, script_list
);
1941 XSETCDR (capability
, script_list
);
1947 /* Parse OTF features in SPEC and write a proper features spec string
1948 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1949 assured that the sufficient memory has already allocated for
1953 generate_otf_features (spec
, features
)
1963 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1969 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1974 else if (! asterisk
)
1976 val
= SYMBOL_NAME (val
);
1977 p
+= sprintf (p
, "%s", SDATA (val
));
1981 val
= SYMBOL_NAME (val
);
1982 p
+= sprintf (p
, "~%s", SDATA (val
));
1986 error ("OTF spec too long");
1990 font_otf_DeviceTable (device_table
)
1991 OTF_DeviceTable
*device_table
;
1993 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1995 return Fcons (make_number (len
),
1996 make_unibyte_string (device_table
->DeltaValue
, len
));
2000 font_otf_ValueRecord (value_format
, value_record
)
2002 OTF_ValueRecord
*value_record
;
2004 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
2006 if (value_format
& OTF_XPlacement
)
2007 ASET (val
, 0, make_number (value_record
->XPlacement
));
2008 if (value_format
& OTF_YPlacement
)
2009 ASET (val
, 1, make_number (value_record
->YPlacement
));
2010 if (value_format
& OTF_XAdvance
)
2011 ASET (val
, 2, make_number (value_record
->XAdvance
));
2012 if (value_format
& OTF_YAdvance
)
2013 ASET (val
, 3, make_number (value_record
->YAdvance
));
2014 if (value_format
& OTF_XPlaDevice
)
2015 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
2016 if (value_format
& OTF_YPlaDevice
)
2017 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
2018 if (value_format
& OTF_XAdvDevice
)
2019 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
2020 if (value_format
& OTF_YAdvDevice
)
2021 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
2026 font_otf_Anchor (anchor
)
2031 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
2032 ASET (val
, 0, make_number (anchor
->XCoordinate
));
2033 ASET (val
, 1, make_number (anchor
->YCoordinate
));
2034 if (anchor
->AnchorFormat
== 2)
2035 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
2038 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
2039 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
2043 #endif /* HAVE_LIBOTF */
2046 /* G-string (glyph string) handler */
2048 /* G-string is a vector of the form [HEADER GLYPH ...].
2049 See the docstring of `font-make-gstring' for more detail. */
2052 font_prepare_composition (cmp
, f
)
2053 struct composition
*cmp
;
2057 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
2058 cmp
->hash_index
* 2);
2060 cmp
->font
= XFONT_OBJECT (LGSTRING_FONT (gstring
));
2061 cmp
->glyph_len
= LGSTRING_LENGTH (gstring
);
2062 cmp
->pixel_width
= LGSTRING_WIDTH (gstring
);
2063 cmp
->lbearing
= LGSTRING_LBEARING (gstring
);
2064 cmp
->rbearing
= LGSTRING_RBEARING (gstring
);
2065 cmp
->ascent
= LGSTRING_ASCENT (gstring
);
2066 cmp
->descent
= LGSTRING_DESCENT (gstring
);
2067 cmp
->width
= cmp
->pixel_width
/ FRAME_COLUMN_WIDTH (f
);
2068 if (cmp
->width
== 0)
2077 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2078 static int font_compare
P_ ((const void *, const void *));
2079 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
2080 Lisp_Object
, Lisp_Object
,
2083 /* We sort fonts by scoring each of them against a specified
2084 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2085 the value is, the closer the font is to the font-spec.
2087 The lowest 2 bits of the score is used for driver type. The font
2088 available by the most preferred font driver is 0.
2090 Each 7-bit in the higher 28 bits are used for numeric properties
2091 WEIGHT, SLANT, WIDTH, and SIZE. */
2093 /* How many bits to shift to store the difference value of each font
2094 property in a score. Note that flots for FONT_TYPE_INDEX and
2095 FONT_REGISTRY_INDEX are not used. */
2096 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2098 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2099 The return value indicates how different ENTITY is compared with
2102 ALTERNATE_FAMILIES, if non-nil, is a pre-calculated list of
2103 alternate family names for AREF (SPEC_PROP, FONT_FAMILY_INDEX). */
2106 font_score (entity
, spec_prop
)
2107 Lisp_Object entity
, *spec_prop
;
2112 /* Score three style numeric fields. Maximum difference is 127. */
2113 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
2114 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
2116 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
2121 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2124 /* Score the size. Maximum difference is 127. */
2125 i
= FONT_SIZE_INDEX
;
2126 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
])
2127 && XINT (AREF (entity
, i
)) > 0)
2129 /* We use the higher 6-bit for the actual size difference. The
2130 lowest bit is set if the DPI is different. */
2131 int diff
= XINT (spec_prop
[i
]) - XINT (AREF (entity
, i
));
2136 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2137 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2139 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2146 /* The comparison function for qsort. */
2149 font_compare (d1
, d2
)
2150 const void *d1
, *d2
;
2152 return (*(unsigned *) d1
- *(unsigned *) d2
);
2156 /* The structure for elements being sorted by qsort. */
2157 struct font_sort_data
2164 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2165 If PREFER specifies a point-size, calculate the corresponding
2166 pixel-size from QCdpi property of PREFER or from the Y-resolution
2167 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
2168 get the font-entities in VEC.
2170 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2171 return the sorted VEC. */
2174 font_sort_entites (vec
, prefer
, frame
, spec
, best_only
)
2175 Lisp_Object vec
, prefer
, frame
, spec
;
2178 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2180 struct font_sort_data
*data
;
2181 unsigned best_score
;
2182 Lisp_Object best_entity
, driver_type
;
2184 struct frame
*f
= XFRAME (frame
);
2185 struct font_driver_list
*list
;
2190 return best_only
? AREF (vec
, 0) : vec
;
2192 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2193 prefer_prop
[i
] = AREF (prefer
, i
);
2197 /* A font driver may return a font that has a property value
2198 different from the value specified in SPEC if the driver
2199 thinks they are the same. That happens, for instance, such a
2200 generic family name as "serif" is specified. So, to ignore
2201 such a difference, for all properties specified in SPEC, set
2202 the corresponding properties in PREFER_PROP to nil. */
2203 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2204 if (! NILP (AREF (spec
, i
)))
2205 prefer_prop
[i
] = Qnil
;
2208 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2209 prefer_prop
[FONT_SIZE_INDEX
]
2210 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2212 /* Scoring and sorting. */
2213 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2214 best_score
= 0xFFFFFFFF;
2215 /* We are sure that the length of VEC > 1. */
2216 driver_type
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2217 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2218 driver_order
++, list
= list
->next
)
2219 if (EQ (driver_type
, list
->driver
->type
))
2221 best_entity
= data
[0].entity
= AREF (vec
, 0);
2222 best_score
= data
[0].score
2223 = font_score (data
[0].entity
, prefer_prop
) | driver_order
;
2224 for (i
= 0; i
< len
; i
++)
2226 if (!EQ (driver_type
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2227 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2228 driver_order
++, list
= list
->next
)
2229 if (EQ (driver_type
, list
->driver
->type
))
2231 data
[i
].entity
= AREF (vec
, i
);
2232 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
) | driver_order
;
2233 if (best_only
&& best_score
> data
[i
].score
)
2235 best_score
= data
[i
].score
;
2236 best_entity
= data
[i
].entity
;
2237 if (best_score
== 0)
2241 if (NILP (best_entity
))
2243 qsort (data
, len
, sizeof *data
, font_compare
);
2244 for (i
= 0; i
< len
; i
++)
2245 ASET (vec
, i
, data
[i
].entity
);
2251 font_add_log ("sort-by", prefer
, vec
);
2256 /* API of Font Service Layer. */
2258 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2259 sort_shift_bits. Finternal_set_font_selection_order calls this
2260 function with font_sort_order after setting up it. */
2263 font_update_sort_order (order
)
2268 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2270 int xlfd_idx
= order
[i
];
2272 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2273 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2274 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2275 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2276 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2277 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2279 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2284 /* Check if ENTITY matches with the font specification SPEC. */
2287 font_match_p (spec
, entity
)
2288 Lisp_Object spec
, entity
;
2290 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2291 Lisp_Object alternate_families
= Qnil
;
2294 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2295 prefer_prop
[i
] = AREF (spec
, i
);
2296 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2297 prefer_prop
[FONT_SIZE_INDEX
]
2298 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2299 if (! NILP (prefer_prop
[FONT_FAMILY_INDEX
]))
2302 = Fassoc_string (prefer_prop
[FONT_FAMILY_INDEX
],
2303 Vface_alternative_font_family_alist
, Qt
);
2304 if (CONSP (alternate_families
))
2305 alternate_families
= XCDR (alternate_families
);
2308 return (font_score (entity
, prefer_prop
) == 0);
2312 /* CHeck a lispy font object corresponding to FONT. */
2315 font_check_object (font
)
2318 Lisp_Object tail
, elt
;
2320 for (tail
= font
->props
[FONT_OBJLIST_INDEX
]; CONSP (tail
);
2324 if (font
== XFONT_OBJECT (elt
))
2334 Each font backend has the callback function get_cache, and it
2335 returns a cons cell of which cdr part can be freely used for
2336 caching fonts. The cons cell may be shared by multiple frames
2337 and/or multiple font drivers. So, we arrange the cdr part as this:
2339 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2341 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2342 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2343 cons (FONT-SPEC FONT-ENTITY ...). */
2345 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2346 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2347 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2348 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2349 struct font_driver
*));
2352 font_prepare_cache (f
, driver
)
2354 struct font_driver
*driver
;
2356 Lisp_Object cache
, val
;
2358 cache
= driver
->get_cache (f
);
2360 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2364 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2365 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2369 val
= XCDR (XCAR (val
));
2370 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2376 font_finish_cache (f
, driver
)
2378 struct font_driver
*driver
;
2380 Lisp_Object cache
, val
, tmp
;
2383 cache
= driver
->get_cache (f
);
2385 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2386 cache
= val
, val
= XCDR (val
);
2387 font_assert (! NILP (val
));
2388 tmp
= XCDR (XCAR (val
));
2389 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2390 if (XINT (XCAR (tmp
)) == 0)
2392 font_clear_cache (f
, XCAR (val
), driver
);
2393 XSETCDR (cache
, XCDR (val
));
2399 font_get_cache (f
, driver
)
2401 struct font_driver
*driver
;
2403 Lisp_Object val
= driver
->get_cache (f
);
2404 Lisp_Object type
= driver
->type
;
2406 font_assert (CONSP (val
));
2407 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2408 font_assert (CONSP (val
));
2409 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2410 val
= XCDR (XCAR (val
));
2414 static int num_fonts
;
2417 font_clear_cache (f
, cache
, driver
)
2420 struct font_driver
*driver
;
2422 Lisp_Object tail
, elt
;
2424 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2425 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2428 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)) && VECTORP (XCDR (elt
)))
2430 Lisp_Object vec
= XCDR (elt
);
2433 for (i
= 0; i
< ASIZE (vec
); i
++)
2435 Lisp_Object entity
= AREF (vec
, i
);
2437 if (EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2439 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2441 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2443 Lisp_Object val
= XCAR (objlist
);
2444 struct font
*font
= XFONT_OBJECT (val
);
2446 font_assert (font
&& driver
== font
->driver
);
2447 driver
->close (f
, font
);
2450 if (driver
->free_entity
)
2451 driver
->free_entity (entity
);
2456 XSETCDR (cache
, Qnil
);
2460 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2463 font_delete_unmatched (list
, spec
, size
)
2464 Lisp_Object list
, spec
;
2467 Lisp_Object entity
, val
;
2468 enum font_property_index prop
;
2470 for (val
= Qnil
; CONSP (list
); list
= XCDR (list
))
2472 entity
= XCAR (list
);
2473 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2474 if (INTEGERP (AREF (spec
, prop
))
2475 && ((XINT (AREF (spec
, prop
)) >> 8)
2476 != (XINT (AREF (entity
, prop
)) >> 8)))
2477 prop
= FONT_SPEC_MAX
;
2478 if (prop
++ <= FONT_SIZE_INDEX
2480 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2482 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2485 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2486 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2487 prop
= FONT_SPEC_MAX
;
2489 if (prop
< FONT_SPEC_MAX
)
2490 val
= Fcons (entity
, val
);
2496 /* Return a vector of font-entities matching with SPEC on FRAME. */
2499 font_list_entities (frame
, spec
)
2500 Lisp_Object frame
, spec
;
2502 FRAME_PTR f
= XFRAME (frame
);
2503 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2504 Lisp_Object ftype
, val
;
2507 int need_filtering
= 0;
2510 font_assert (FONT_SPEC_P (spec
));
2512 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2513 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2514 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2515 size
= font_pixel_size (f
, spec
);
2519 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2520 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2521 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2522 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2524 ASET (scratch_font_spec
, i
, Qnil
);
2525 if (! NILP (AREF (spec
, i
)))
2527 if (i
== FONT_DPI_INDEX
)
2528 /* Skip FONT_SPACING_INDEX */
2531 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2532 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2534 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2538 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2540 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2542 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2544 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2545 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2552 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2553 copy
= Fcopy_font_spec (scratch_font_spec
);
2554 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2555 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2557 if (! NILP (val
) && need_filtering
)
2558 val
= font_delete_unmatched (val
, spec
, size
);
2563 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2564 font_add_log ("list", spec
, val
);
2569 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2570 nil, is an array of face's attributes, which specifies preferred
2571 font-related attributes. */
2574 font_matching_entity (f
, attrs
, spec
)
2576 Lisp_Object
*attrs
, spec
;
2578 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2579 Lisp_Object ftype
, size
, entity
;
2582 XSETFRAME (frame
, f
);
2583 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2584 size
= AREF (spec
, FONT_SIZE_INDEX
);
2586 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2588 for (; driver_list
; driver_list
= driver_list
->next
)
2590 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2592 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2595 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2596 entity
= assoc_no_quit (spec
, XCDR (cache
));
2598 entity
= XCDR (entity
);
2601 entity
= driver_list
->driver
->match (frame
, spec
);
2602 copy
= Fcopy_font_spec (spec
);
2603 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2604 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2606 if (! NILP (entity
))
2609 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2610 ASET (spec
, FONT_SIZE_INDEX
, size
);
2611 font_add_log ("match", spec
, entity
);
2616 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2617 opened font object. */
2620 font_open_entity (f
, entity
, pixel_size
)
2625 struct font_driver_list
*driver_list
;
2626 Lisp_Object objlist
, size
, val
, font_object
;
2630 font_assert (FONT_ENTITY_P (entity
));
2631 size
= AREF (entity
, FONT_SIZE_INDEX
);
2632 if (XINT (size
) != 0)
2633 pixel_size
= XINT (size
);
2635 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2636 objlist
= XCDR (objlist
))
2637 if (XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2638 return XCAR (objlist
);
2640 val
= AREF (entity
, FONT_TYPE_INDEX
);
2641 for (driver_list
= f
->font_driver_list
;
2642 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2643 driver_list
= driver_list
->next
);
2647 font_object
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2648 font_add_log ("open", entity
, font_object
);
2649 if (NILP (font_object
))
2651 ASET (entity
, FONT_OBJLIST_INDEX
,
2652 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2653 ASET (font_object
, FONT_OBJLIST_INDEX
, AREF (entity
, FONT_OBJLIST_INDEX
));
2656 font
= XFONT_OBJECT (font_object
);
2657 min_width
= (font
->min_width
? font
->min_width
2658 : font
->average_width
? font
->average_width
2659 : font
->space_width
? font
->space_width
2661 #ifdef HAVE_WINDOW_SYSTEM
2662 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2663 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2665 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2666 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
;
2667 fonts_changed_p
= 1;
2671 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2672 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2673 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > font
->height
)
2674 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
, fonts_changed_p
= 1;
2682 /* Close FONT_OBJECT that is opened on frame F. */
2685 font_close_object (f
, font_object
)
2687 Lisp_Object font_object
;
2689 struct font
*font
= XFONT_OBJECT (font_object
);
2690 Lisp_Object objlist
;
2691 Lisp_Object tail
, prev
= Qnil
;
2693 objlist
= AREF (font_object
, FONT_OBJLIST_INDEX
);
2694 for (prev
= Qnil
, tail
= objlist
; CONSP (tail
);
2695 prev
= tail
, tail
= XCDR (tail
))
2696 if (EQ (font_object
, XCAR (tail
)))
2698 font_add_log ("close", font_object
, Qnil
);
2699 font
->driver
->close (f
, font
);
2700 #ifdef HAVE_WINDOW_SYSTEM
2701 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2702 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2705 ASET (font_object
, FONT_OBJLIST_INDEX
, XCDR (objlist
));
2707 XSETCDR (prev
, XCDR (objlist
));
2715 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2716 FONT is a font-entity and it must be opened to check. */
2719 font_has_char (f
, font
, c
)
2726 if (FONT_ENTITY_P (font
))
2728 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2729 struct font_driver_list
*driver_list
;
2731 for (driver_list
= f
->font_driver_list
;
2732 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2733 driver_list
= driver_list
->next
);
2736 if (! driver_list
->driver
->has_char
)
2738 return driver_list
->driver
->has_char (font
, c
);
2741 font_assert (FONT_OBJECT_P (font
));
2742 fontp
= XFONT_OBJECT (font
);
2743 if (fontp
->driver
->has_char
)
2745 int result
= fontp
->driver
->has_char (font
, c
);
2750 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2754 /* Return the glyph ID of FONT_OBJECT for character C. */
2757 font_encode_char (font_object
, c
)
2758 Lisp_Object font_object
;
2763 font_assert (FONT_OBJECT_P (font_object
));
2764 font
= XFONT_OBJECT (font_object
);
2765 return font
->driver
->encode_char (font
, c
);
2769 /* Return the name of FONT_OBJECT. */
2772 font_get_name (font_object
)
2773 Lisp_Object font_object
;
2775 font_assert (FONT_OBJECT_P (font_object
));
2776 return AREF (font_object
, FONT_NAME_INDEX
);
2780 /* Return the specification of FONT_OBJECT. */
2783 font_get_spec (font_object
)
2784 Lisp_Object font_object
;
2786 Lisp_Object spec
= font_make_spec ();
2789 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2790 ASET (spec
, i
, AREF (font_object
, i
));
2791 ASET (spec
, FONT_SIZE_INDEX
,
2792 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2797 font_spec_from_name (font_name
)
2798 Lisp_Object font_name
;
2800 Lisp_Object args
[2];
2803 args
[1] = font_name
;
2804 return Ffont_spec (2, args
);
2809 font_clear_prop (attrs
, prop
)
2811 enum font_property_index prop
;
2813 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2817 if (NILP (AREF (font
, prop
))
2818 && prop
!= FONT_FAMILY_INDEX
&& prop
!= FONT_FOUNDRY_INDEX
2819 && prop
!= FONT_SIZE_INDEX
)
2821 font
= Fcopy_font_spec (font
);
2822 ASET (font
, prop
, Qnil
);
2823 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
2825 if (prop
== FONT_FAMILY_INDEX
)
2826 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
2827 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
2828 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
2829 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
2830 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2831 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2832 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2834 else if (prop
== FONT_SIZE_INDEX
)
2836 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2837 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2838 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2840 attrs
[LFACE_FONT_INDEX
] = font
;
2844 font_update_lface (f
, attrs
)
2850 spec
= attrs
[LFACE_FONT_INDEX
];
2851 if (! FONT_SPEC_P (spec
))
2854 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
2855 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
2856 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2857 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
2858 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
2859 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
2860 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
2861 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);;
2862 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
2863 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
2864 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
2868 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2873 val
= Ffont_get (spec
, QCdpi
);
2876 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
2879 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2880 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
2881 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
2886 /* Return a font-entity satisfying SPEC and best matching with face's
2887 font related attributes in ATTRS. C, if not negative, is a
2888 character that the entity must support. */
2891 font_find_for_lface (f
, attrs
, spec
, c
)
2898 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
2899 Lisp_Object size
, foundry
[3], *family
, registry
[3];
2901 int i
, j
, k
, result
;
2903 registry
[0] = AREF (spec
, FONT_REGISTRY_INDEX
);
2904 if (NILP (registry
[0]))
2906 registry
[0] = Qiso8859_1
;
2907 registry
[1] = Qascii_0
;
2908 registry
[2] = null_vector
;
2911 registry
[1] = null_vector
;
2913 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
2915 struct charset
*encoding
, *repertory
;
2917 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
2918 &encoding
, &repertory
) < 0)
2922 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
2924 /* Any font of this registry support C. So, let's
2925 suppress the further checking. */
2928 else if (c
> encoding
->max_char
)
2932 work
= Fcopy_font_spec (spec
);
2933 XSETFRAME (frame
, f
);
2934 size
= AREF (spec
, FONT_SIZE_INDEX
);
2935 pixel_size
= font_pixel_size (f
, spec
);
2936 if (pixel_size
== 0)
2938 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
2940 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
2942 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
2943 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
2944 if (! NILP (foundry
[0]))
2945 foundry
[1] = null_vector
;
2946 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
2948 foundry
[0] = font_intern_prop (SDATA (attrs
[LFACE_FOUNDRY_INDEX
]),
2949 SBYTES (attrs
[LFACE_FOUNDRY_INDEX
]), 1);
2951 foundry
[2] = null_vector
;
2954 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
2956 val
= AREF (work
, FONT_FAMILY_INDEX
);
2957 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
2958 val
= font_intern_prop (SDATA (attrs
[LFACE_FAMILY_INDEX
]),
2959 SBYTES (attrs
[LFACE_FAMILY_INDEX
]), 1);
2962 family
= alloca ((sizeof family
[0]) * 2);
2964 family
[1] = null_vector
; /* terminator. */
2969 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
2971 if (! NILP (alters
))
2973 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
2974 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
2975 family
[i
] = XCAR (alters
);
2976 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2978 family
[i
] = null_vector
;
2982 family
= alloca ((sizeof family
[0]) * 3);
2985 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2987 family
[i
] = null_vector
;
2991 for (i
= 0; SYMBOLP (family
[i
]); i
++)
2993 ASET (work
, FONT_FAMILY_INDEX
, family
[i
]);
2994 for (j
= 0; SYMBOLP (foundry
[j
]); j
++)
2996 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[j
]);
2997 for (k
= 0; SYMBOLP (registry
[k
]); k
++)
2999 ASET (work
, FONT_REGISTRY_INDEX
, registry
[k
]);
3000 entities
= font_list_entities (frame
, work
);
3001 if (ASIZE (entities
) > 0)
3008 if (ASIZE (entities
) == 1)
3011 return AREF (entities
, 0);
3015 /* Sort fonts by properties specified in LFACE. */
3016 Lisp_Object prefer
= scratch_font_prefer
;
3018 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3019 ASET (prefer
, i
, AREF (work
, i
));
3020 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3022 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3024 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3025 if (NILP (AREF (prefer
, i
)))
3026 ASET (prefer
, i
, AREF (face_font
, i
));
3028 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3029 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3030 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3031 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3032 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3033 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3034 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3035 entities
= font_sort_entites (entities
, prefer
, frame
, work
, c
< 0);
3040 for (i
= 0; i
< ASIZE (entities
); i
++)
3044 val
= AREF (entities
, i
);
3047 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3048 if (! EQ (AREF (val
, j
), props
[j
]))
3050 if (j
> FONT_REGISTRY_INDEX
)
3053 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3054 props
[j
] = AREF (val
, j
);
3055 result
= font_has_char (f
, val
, c
);
3060 val
= font_open_for_lface (f
, val
, attrs
, spec
);
3063 result
= font_has_char (f
, val
, c
);
3064 font_close_object (f
, val
);
3066 return AREF (entities
, i
);
3073 font_open_for_lface (f
, entity
, attrs
, spec
)
3081 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3082 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3083 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3084 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3085 size
= font_pixel_size (f
, spec
);
3088 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3091 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3093 return font_open_entity (f
, entity
, size
);
3097 /* Find a font satisfying SPEC and best matching with face's
3098 attributes in ATTRS on FRAME, and return the opened
3102 font_load_for_lface (f
, attrs
, spec
)
3104 Lisp_Object
*attrs
, spec
;
3108 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3111 /* No font is listed for SPEC, but each font-backend may have
3112 the different criteria about "font matching". So, try
3114 entity
= font_matching_entity (f
, attrs
, spec
);
3118 return font_open_for_lface (f
, entity
, attrs
, spec
);
3122 /* Make FACE on frame F ready to use the font opened for FACE. */
3125 font_prepare_for_face (f
, face
)
3129 if (face
->font
->driver
->prepare_face
)
3130 face
->font
->driver
->prepare_face (f
, face
);
3134 /* Make FACE on frame F stop using the font opened for FACE. */
3137 font_done_for_face (f
, face
)
3141 if (face
->font
->driver
->done_face
)
3142 face
->font
->driver
->done_face (f
, face
);
3147 /* Open a font best matching with NAME on frame F. If no proper font
3148 is found, return Qnil. */
3151 font_open_by_name (f
, name
)
3155 Lisp_Object args
[2];
3156 Lisp_Object spec
, attrs
[LFACE_VECTOR_SIZE
];
3159 args
[1] = make_unibyte_string (name
, strlen (name
));
3160 spec
= Ffont_spec (2, args
);
3161 /* We set up the default font-related attributes of a face to prefer
3163 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3164 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3165 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3166 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3167 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3169 return font_load_for_lface (f
, attrs
, spec
);
3173 /* Register font-driver DRIVER. This function is used in two ways.
3175 The first is with frame F non-NULL. In this case, make DRIVER
3176 available (but not yet activated) on F. All frame creaters
3177 (e.g. Fx_create_frame) must call this function at least once with
3178 an available font-driver.
3180 The second is with frame F NULL. In this case, DRIVER is globally
3181 registered in the variable `font_driver_list'. All font-driver
3182 implementations must call this function in its syms_of_XXXX
3183 (e.g. syms_of_xfont). */
3186 register_font_driver (driver
, f
)
3187 struct font_driver
*driver
;
3190 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3191 struct font_driver_list
*prev
, *list
;
3193 if (f
&& ! driver
->draw
)
3194 error ("Unusable font driver for a frame: %s",
3195 SDATA (SYMBOL_NAME (driver
->type
)));
3197 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3198 if (EQ (list
->driver
->type
, driver
->type
))
3199 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3201 list
= malloc (sizeof (struct font_driver_list
));
3203 list
->driver
= driver
;
3208 f
->font_driver_list
= list
;
3210 font_driver_list
= list
;
3216 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3217 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3218 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3220 A caller must free all realized faces if any in advance. The
3221 return value is a list of font backends actually made used on
3225 font_update_drivers (f
, new_drivers
)
3227 Lisp_Object new_drivers
;
3229 Lisp_Object active_drivers
= Qnil
;
3230 struct font_driver
*driver
;
3231 struct font_driver_list
*list
;
3233 /* At first, turn off non-requested drivers, and turn on requested
3235 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3237 driver
= list
->driver
;
3238 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3243 if (driver
->end_for_frame
)
3244 driver
->end_for_frame (f
);
3245 font_finish_cache (f
, driver
);
3250 if (! driver
->start_for_frame
3251 || driver
->start_for_frame (f
) == 0)
3253 font_prepare_cache (f
, driver
);
3260 if (NILP (new_drivers
))
3263 if (! EQ (new_drivers
, Qt
))
3265 /* Re-order the driver list according to new_drivers. */
3266 struct font_driver_list
**list_table
, *list
;
3270 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3271 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3273 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3274 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3277 list_table
[i
++] = list
;
3279 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3281 list_table
[i
] = list
;
3282 list_table
[i
] = NULL
;
3284 f
->font_driver_list
= list
= NULL
;
3285 for (i
= 0; list_table
[i
]; i
++)
3288 list
->next
= list_table
[i
], list
= list
->next
;
3290 f
->font_driver_list
= list
= list_table
[i
];
3295 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3297 active_drivers
= nconc2 (active_drivers
,
3298 Fcons (list
->driver
->type
, Qnil
));
3299 return active_drivers
;
3303 font_put_frame_data (f
, driver
, data
)
3305 struct font_driver
*driver
;
3308 struct font_data_list
*list
, *prev
;
3310 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3311 prev
= list
, list
= list
->next
)
3312 if (list
->driver
== driver
)
3319 prev
->next
= list
->next
;
3321 f
->font_data_list
= list
->next
;
3329 list
= malloc (sizeof (struct font_data_list
));
3332 list
->driver
= driver
;
3333 list
->next
= f
->font_data_list
;
3334 f
->font_data_list
= list
;
3342 font_get_frame_data (f
, driver
)
3344 struct font_driver
*driver
;
3346 struct font_data_list
*list
;
3348 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3349 if (list
->driver
== driver
)
3357 /* Return the font used to draw character C by FACE at buffer position
3358 POS in window W. If STRING is non-nil, it is a string containing C
3359 at index POS. If C is negative, get C from the current buffer or
3363 font_at (c
, pos
, face
, w
, string
)
3372 Lisp_Object font_object
;
3378 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3381 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3383 c
= FETCH_CHAR (pos_byte
);
3386 c
= FETCH_BYTE (pos
);
3392 multibyte
= STRING_MULTIBYTE (string
);
3395 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3397 str
= SDATA (string
) + pos_byte
;
3398 c
= STRING_CHAR (str
, 0);
3401 c
= SDATA (string
)[pos
];
3405 f
= XFRAME (w
->frame
);
3406 if (! FRAME_WINDOW_P (f
))
3413 if (STRINGP (string
))
3414 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3415 DEFAULT_FACE_ID
, 0);
3417 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3419 face
= FACE_FROM_ID (f
, face_id
);
3423 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3424 face
= FACE_FROM_ID (f
, face_id
);
3429 font_assert (font_check_object ((struct font
*) face
->font
));
3430 XSETFONT (font_object
, face
->font
);
3435 /* Check how many characters after POS (at most to LIMIT) can be
3436 displayed by the same font. FACE is the face selected for the
3437 character as POS on frame F. STRING, if not nil, is the string to
3438 check instead of the current buffer.
3440 The return value is the position of the character that is displayed
3441 by the differnt font than that of the character as POS. */
3444 font_range (pos
, limit
, face
, f
, string
)
3445 EMACS_INT pos
, limit
;
3458 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3459 pos_byte
= CHAR_TO_BYTE (pos
);
3463 multibyte
= STRING_MULTIBYTE (string
);
3464 pos_byte
= string_char_to_byte (string
, pos
);
3468 /* All unibyte character are displayed by the same font. */
3476 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3478 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3479 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3480 face
= FACE_FROM_ID (f
, face_id
);
3487 else if (font
!= face
->font
)
3499 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3500 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3501 Return nil otherwise.
3502 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3503 which kind of font it is. It must be one of `font-spec', `font-entity',
3505 (object
, extra_type
)
3506 Lisp_Object object
, extra_type
;
3508 if (NILP (extra_type
))
3509 return (FONTP (object
) ? Qt
: Qnil
);
3510 if (EQ (extra_type
, Qfont_spec
))
3511 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3512 if (EQ (extra_type
, Qfont_entity
))
3513 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3514 if (EQ (extra_type
, Qfont_object
))
3515 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3516 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3519 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3520 doc
: /* Return a newly created font-spec with arguments as properties.
3522 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3523 valid font property name listed below:
3525 `:family', `:weight', `:slant', `:width'
3527 They are the same as face attributes of the same name. See
3528 `set-face-attribute'.
3532 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3536 VALUE must be a string or a symbol specifying the additional
3537 typographic style information of a font, e.g. ``sans''.
3541 VALUE must be a string or a symbol specifying the charset registry and
3542 encoding of a font, e.g. ``iso8859-1''.
3546 VALUE must be a non-negative integer or a floating point number
3547 specifying the font size. It specifies the font size in pixels
3548 (if VALUE is an integer), or in points (if VALUE is a float).
3549 usage: (font-spec ARGS ...) */)
3554 Lisp_Object spec
= font_make_spec ();
3557 for (i
= 0; i
< nargs
; i
+= 2)
3559 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3561 if (EQ (key
, QCname
))
3564 font_parse_name ((char *) SDATA (val
), spec
);
3565 font_put_extra (spec
, key
, val
);
3569 int idx
= get_font_prop_index (key
);
3573 val
= font_prop_validate (idx
, Qnil
, val
);
3574 if (idx
< FONT_EXTRA_INDEX
)
3575 ASET (spec
, idx
, val
);
3577 font_put_extra (spec
, key
, val
);
3580 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3586 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3587 doc
: /* Return a copy of FONT as a font-spec. */)
3591 Lisp_Object new_spec
, tail
, extra
;
3595 new_spec
= font_make_spec ();
3596 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3597 ASET (new_spec
, i
, AREF (font
, i
));
3599 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3601 if (! EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3602 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3604 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3608 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3609 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3610 Every specified properties in FROM override the corresponding
3611 properties in TO. */)
3613 Lisp_Object from
, to
;
3615 Lisp_Object extra
, tail
;
3620 to
= Fcopy_font_spec (to
);
3621 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3622 ASET (to
, i
, AREF (from
, i
));
3623 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3624 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3625 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3627 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3630 XSETCDR (slot
, XCDR (XCAR (tail
)));
3632 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3634 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3638 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3639 doc
: /* Return the value of FONT's property KEY.
3640 FONT is a font-spec, a font-entity, or a font-object. */)
3642 Lisp_Object font
, key
;
3649 idx
= get_font_prop_index (key
);
3650 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3651 return AREF (font
, idx
);
3652 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3656 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3657 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
3658 (font_spec
, prop
, val
)
3659 Lisp_Object font_spec
, prop
, val
;
3663 CHECK_FONT_SPEC (font_spec
);
3664 idx
= get_font_prop_index (prop
);
3665 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3666 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
3668 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
3672 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3673 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3674 Optional 2nd argument FRAME specifies the target frame.
3675 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3676 Optional 4th argument PREFER, if non-nil, is a font-spec to
3677 control the order of the returned list. Fonts are sorted by
3678 how close they are to PREFER. */)
3679 (font_spec
, frame
, num
, prefer
)
3680 Lisp_Object font_spec
, frame
, num
, prefer
;
3682 Lisp_Object vec
, list
, tail
;
3686 frame
= selected_frame
;
3687 CHECK_LIVE_FRAME (frame
);
3688 CHECK_FONT_SPEC (font_spec
);
3696 if (! NILP (prefer
))
3697 CHECK_FONT_SPEC (prefer
);
3699 vec
= font_list_entities (frame
, font_spec
);
3704 return Fcons (AREF (vec
, 0), Qnil
);
3706 if (! NILP (prefer
))
3707 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
, 0);
3709 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3710 if (n
== 0 || n
> len
)
3712 for (i
= 1; i
< n
; i
++)
3714 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3716 XSETCDR (tail
, val
);
3722 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
3723 doc
: /* List available font families on the current frame.
3724 Optional argument FRAME, if non-nil, specifies the target frame. */)
3729 struct font_driver_list
*driver_list
;
3733 frame
= selected_frame
;
3734 CHECK_LIVE_FRAME (frame
);
3737 for (driver_list
= f
->font_driver_list
; driver_list
;
3738 driver_list
= driver_list
->next
)
3739 if (driver_list
->driver
->list_family
)
3741 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3747 Lisp_Object tail
= list
;
3749 for (; CONSP (val
); val
= XCDR (val
))
3750 if (NILP (Fmemq (XCAR (val
), tail
)))
3751 list
= Fcons (XCAR (val
), list
);
3757 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3758 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3759 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3761 Lisp_Object font_spec
, frame
;
3763 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3770 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
3771 doc
: /* Return XLFD name of FONT.
3772 FONT is a font-spec, font-entity, or font-object.
3773 If the name is too long for XLFD (maximum 255 chars), return nil.
3774 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
3775 the consecutive wildcards are folded to one. */)
3776 (font
, fold_wildcards
)
3777 Lisp_Object font
, fold_wildcards
;
3784 if (FONT_OBJECT_P (font
))
3786 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
3788 if (STRINGP (font_name
)
3789 && SDATA (font_name
)[0] == '-')
3791 if (NILP (fold_wildcards
))
3793 strcpy (name
, (char *) SDATA (font_name
));
3796 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
3798 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3801 if (! NILP (fold_wildcards
))
3803 char *p0
= name
, *p1
;
3805 while ((p1
= strstr (p0
, "-*-*")))
3807 strcpy (p1
, p1
+ 2);
3812 return build_string (name
);
3815 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3816 doc
: /* Clear font cache. */)
3819 Lisp_Object list
, frame
;
3821 FOR_EACH_FRAME (list
, frame
)
3823 FRAME_PTR f
= XFRAME (frame
);
3824 struct font_driver_list
*driver_list
= f
->font_driver_list
;
3826 for (; driver_list
; driver_list
= driver_list
->next
)
3827 if (driver_list
->on
)
3829 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
3834 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
3836 font_assert (! NILP (val
));
3837 val
= XCDR (XCAR (val
));
3838 if (XINT (XCAR (val
)) == 0)
3840 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
3841 XSETCDR (cache
, XCDR (val
));
3849 /* The following three functions are still experimental. */
3851 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
3852 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
3853 FONT-OBJECT may be nil if it is not yet known.
3855 G-string is sequence of glyphs of a specific font,
3856 and is a vector of this form:
3857 [ HEADER GLYPH ... ]
3858 HEADER is a vector of this form:
3859 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
3861 FONT-OBJECT is a font-object for all glyphs in the g-string,
3862 WIDTH thru DESCENT are the metrics (in pixels) of the whole G-string.
3863 GLYPH is a vector of this form:
3864 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
3865 [ [X-OFF Y-OFF WADJUST] | nil] ]
3867 FROM-IDX and TO-IDX are used internally and should not be touched.
3868 C is the character of the glyph.
3869 CODE is the glyph-code of C in FONT-OBJECT.
3870 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
3871 X-OFF and Y-OFF are offests to the base position for the glyph.
3872 WADJUST is the adjustment to the normal width of the glyph. */)
3874 Lisp_Object font_object
, num
;
3876 Lisp_Object gstring
, g
;
3880 if (! NILP (font_object
))
3881 CHECK_FONT_OBJECT (font_object
);
3884 len
= XINT (num
) + 1;
3885 gstring
= Fmake_vector (make_number (len
), Qnil
);
3886 g
= Fmake_vector (make_number (6), Qnil
);
3887 ASET (g
, 0, font_object
);
3888 ASET (gstring
, 0, g
);
3889 for (i
= 1; i
< len
; i
++)
3890 ASET (gstring
, i
, Fmake_vector (make_number (10), Qnil
));
3894 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
3895 doc
: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
3896 START and END specify the region to extract characters.
3897 If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
3898 where to extract characters.
3899 FONT-OBJECT may be nil if GSTRING already contains one. */)
3900 (gstring
, font_object
, start
, end
, object
)
3901 Lisp_Object gstring
, font_object
, start
, end
, object
;
3907 CHECK_VECTOR (gstring
);
3908 if (NILP (font_object
))
3909 font_object
= LGSTRING_FONT (gstring
);
3910 font
= XFONT_OBJECT (font_object
);
3912 if (STRINGP (object
))
3914 const unsigned char *p
;
3916 CHECK_NATNUM (start
);
3918 if (XINT (start
) > XINT (end
)
3919 || XINT (end
) > ASIZE (object
)
3920 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3921 args_out_of_range_3 (object
, start
, end
);
3923 len
= XINT (end
) - XINT (start
);
3924 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
3925 for (i
= 0; i
< len
; i
++)
3927 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3928 /* Shut up GCC warning in comparison with
3929 MOST_POSITIVE_FIXNUM below. */
3932 c
= STRING_CHAR_ADVANCE (p
);
3933 cod
= code
= font
->driver
->encode_char (font
, c
);
3934 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
3936 LGLYPH_SET_FROM (g
, i
);
3937 LGLYPH_SET_TO (g
, i
);
3938 LGLYPH_SET_CHAR (g
, c
);
3939 LGLYPH_SET_CODE (g
, code
);
3946 if (! NILP (object
))
3947 Fset_buffer (object
);
3948 validate_region (&start
, &end
);
3949 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3950 args_out_of_range (start
, end
);
3951 len
= XINT (end
) - XINT (start
);
3953 pos_byte
= CHAR_TO_BYTE (pos
);
3954 for (i
= 0; i
< len
; i
++)
3956 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3957 /* Shut up GCC warning in comparison with
3958 MOST_POSITIVE_FIXNUM below. */
3961 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
3962 cod
= code
= font
->driver
->encode_char (font
, c
);
3963 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
3965 LGLYPH_SET_FROM (g
, i
);
3966 LGLYPH_SET_TO (g
, i
);
3967 LGLYPH_SET_CHAR (g
, c
);
3968 LGLYPH_SET_CODE (g
, code
);
3971 for (; i
< LGSTRING_LENGTH (gstring
); i
++)
3972 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
3976 DEFUN ("font-shape-text", Ffont_shape_text
, Sfont_shape_text
, 3, 4, 0,
3977 doc
: /* Shape text between FROM and TO by FONT-OBJECT.
3978 If optional 4th argument STRING is non-nil, it is a string to shape,
3979 and FROM and TO are indices to the string.
3980 The value is the end position of the text that can be shaped by
3982 (from
, to
, font_object
, string
)
3983 Lisp_Object from
, to
, font_object
, string
;
3986 struct font_metrics metrics
;
3987 EMACS_INT start
, end
;
3988 Lisp_Object gstring
, n
;
3991 if (! FONT_OBJECT_P (font_object
))
3993 font
= XFONT_OBJECT (font_object
);
3994 if (! font
->driver
->shape
)
3999 validate_region (&from
, &to
);
4000 start
= XFASTINT (from
);
4001 end
= XFASTINT (to
);
4002 modify_region (current_buffer
, start
, end
, 0);
4006 CHECK_STRING (string
);
4007 start
= XINT (from
);
4009 if (start
< 0 || start
> end
|| end
> SCHARS (string
))
4010 args_out_of_range_3 (string
, from
, to
);
4014 gstring
= Ffont_make_gstring (font_object
, make_number (len
));
4015 Ffont_fill_gstring (gstring
, font_object
, from
, to
, string
);
4017 /* Try at most three times with larger gstring each time. */
4018 for (i
= 0; i
< 3; i
++)
4020 Lisp_Object args
[2];
4022 n
= font
->driver
->shape (gstring
);
4026 args
[1] = Fmake_vector (make_number (len
), Qnil
);
4027 gstring
= Fvconcat (2, args
);
4029 if (! INTEGERP (n
) || XINT (n
) == 0)
4033 for (i
= 0; i
< len
;)
4036 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4037 EMACS_INT this_from
= LGLYPH_FROM (g
);
4038 EMACS_INT this_to
= LGLYPH_TO (g
) + 1;
4040 int need_composition
= 0;
4042 metrics
.lbearing
= LGLYPH_LBEARING (g
);
4043 metrics
.rbearing
= LGLYPH_RBEARING (g
);
4044 metrics
.ascent
= LGLYPH_ASCENT (g
);
4045 metrics
.descent
= LGLYPH_DESCENT (g
);
4046 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4048 metrics
.width
= LGLYPH_WIDTH (g
);
4049 if (LGLYPH_CHAR (g
) == 0 || metrics
.width
== 0)
4050 need_composition
= 1;
4054 metrics
.width
= LGLYPH_WADJUST (g
);
4055 metrics
.lbearing
+= LGLYPH_XOFF (g
);
4056 metrics
.rbearing
+= LGLYPH_XOFF (g
);
4057 metrics
.ascent
-= LGLYPH_YOFF (g
);
4058 metrics
.descent
+= LGLYPH_YOFF (g
);
4059 need_composition
= 1;
4061 for (j
= i
+ 1; j
< len
; j
++)
4065 g
= LGSTRING_GLYPH (gstring
, j
);
4066 if (this_from
!= LGLYPH_FROM (g
))
4068 need_composition
= 1;
4069 x
= metrics
.width
+ LGLYPH_LBEARING (g
) + LGLYPH_XOFF (g
);
4070 if (metrics
.lbearing
> x
)
4071 metrics
.lbearing
= x
;
4072 x
= metrics
.width
+ LGLYPH_RBEARING (g
) + LGLYPH_XOFF (g
);
4073 if (metrics
.rbearing
< x
)
4074 metrics
.rbearing
= x
;
4075 x
= LGLYPH_ASCENT (g
) - LGLYPH_YOFF (g
);
4076 if (metrics
.ascent
< x
)
4078 x
= LGLYPH_DESCENT (g
) - LGLYPH_YOFF (g
);
4079 if (metrics
.descent
< x
)
4080 metrics
.descent
= x
;
4081 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4082 metrics
.width
+= LGLYPH_WIDTH (g
);
4084 metrics
.width
+= LGLYPH_WADJUST (g
);
4087 if (need_composition
)
4089 gstr
= Ffont_make_gstring (font_object
, make_number (j
- i
));
4090 LGSTRING_SET_WIDTH (gstr
, metrics
.width
);
4091 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
4092 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
);
4093 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
4094 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
4095 for (k
= i
; i
< j
; i
++)
4097 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4099 LGLYPH_SET_FROM (g
, LGLYPH_FROM (g
) - this_from
);
4100 LGLYPH_SET_TO (g
, LGLYPH_TO (g
) - this_from
);
4101 LGSTRING_SET_GLYPH (gstr
, i
- k
, LGSTRING_GLYPH (gstring
, i
));
4103 from
= make_number (start
+ this_from
);
4104 to
= make_number (start
+ this_to
);
4106 Fcompose_region_internal (from
, to
, gstr
, Qnil
);
4108 Fcompose_string_internal (string
, from
, to
, gstr
, Qnil
);
4119 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4120 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4121 OTF-FEATURES specifies which features to apply in this format:
4122 (SCRIPT LANGSYS GSUB GPOS)
4124 SCRIPT is a symbol specifying a script tag of OpenType,
4125 LANGSYS is a symbol specifying a langsys tag of OpenType,
4126 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4128 If LANGYS is nil, the default langsys is selected.
4130 The features are applied in the order they appear in the list. The
4131 symbol `*' means to apply all available features not present in this
4132 list, and the remaining features are ignored. For instance, (vatu
4133 pstf * haln) is to apply vatu and pstf in this order, then to apply
4134 all available features other than vatu, pstf, and haln.
4136 The features are applied to the glyphs in the range FROM and TO of
4137 the glyph-string GSTRING-IN.
4139 If some feature is actually applicable, the resulting glyphs are
4140 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4141 this case, the value is the number of produced glyphs.
4143 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4146 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4147 produced in GSTRING-OUT, and the value is nil.
4149 See the documentation of `font-make-gstring' for the format of
4151 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4152 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4154 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4159 check_otf_features (otf_features
);
4160 CHECK_FONT_OBJECT (font_object
);
4161 font
= XFONT_OBJECT (font_object
);
4162 if (! font
->driver
->otf_drive
)
4163 error ("Font backend %s can't drive OpenType GSUB table",
4164 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4165 CHECK_CONS (otf_features
);
4166 CHECK_SYMBOL (XCAR (otf_features
));
4167 val
= XCDR (otf_features
);
4168 CHECK_SYMBOL (XCAR (val
));
4169 val
= XCDR (otf_features
);
4172 len
= check_gstring (gstring_in
);
4173 CHECK_VECTOR (gstring_out
);
4174 CHECK_NATNUM (from
);
4176 CHECK_NATNUM (index
);
4178 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4179 args_out_of_range_3 (from
, to
, make_number (len
));
4180 if (XINT (index
) >= ASIZE (gstring_out
))
4181 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4182 num
= font
->driver
->otf_drive (font
, otf_features
,
4183 gstring_in
, XINT (from
), XINT (to
),
4184 gstring_out
, XINT (index
), 0);
4187 return make_number (num
);
4190 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4192 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4193 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4195 (SCRIPT LANGSYS FEATURE ...)
4196 See the documentation of `font-drive-otf' for more detail.
4198 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4199 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4200 character code corresponding to the glyph or nil if there's no
4201 corresponding character. */)
4202 (font_object
, character
, otf_features
)
4203 Lisp_Object font_object
, character
, otf_features
;
4206 Lisp_Object gstring_in
, gstring_out
, g
;
4207 Lisp_Object alternates
;
4210 CHECK_FONT_GET_OBJECT (font_object
, font
);
4211 if (! font
->driver
->otf_drive
)
4212 error ("Font backend %s can't drive OpenType GSUB table",
4213 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4214 CHECK_CHARACTER (character
);
4215 CHECK_CONS (otf_features
);
4217 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4218 g
= LGSTRING_GLYPH (gstring_in
, 0);
4219 LGLYPH_SET_CHAR (g
, XINT (character
));
4220 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4221 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4222 gstring_out
, 0, 1)) < 0)
4223 gstring_out
= Ffont_make_gstring (font_object
,
4224 make_number (ASIZE (gstring_out
) * 2));
4226 for (i
= 0; i
< num
; i
++)
4228 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4229 int c
= LGLYPH_CHAR (g
);
4230 unsigned code
= LGLYPH_CODE (g
);
4232 alternates
= Fcons (Fcons (make_number (code
),
4233 c
> 0 ? make_number (c
) : Qnil
),
4236 return Fnreverse (alternates
);
4242 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4243 doc
: /* Open FONT-ENTITY. */)
4244 (font_entity
, size
, frame
)
4245 Lisp_Object font_entity
;
4251 CHECK_FONT_ENTITY (font_entity
);
4253 frame
= selected_frame
;
4254 CHECK_LIVE_FRAME (frame
);
4257 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4260 CHECK_NUMBER_OR_FLOAT (size
);
4262 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
4264 isize
= XINT (size
);
4268 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4271 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4272 doc
: /* Close FONT-OBJECT. */)
4273 (font_object
, frame
)
4274 Lisp_Object font_object
, frame
;
4276 CHECK_FONT_OBJECT (font_object
);
4278 frame
= selected_frame
;
4279 CHECK_LIVE_FRAME (frame
);
4280 font_close_object (XFRAME (frame
), font_object
);
4284 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4285 doc
: /* Return information about FONT-OBJECT.
4286 The value is a vector:
4287 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4290 NAME is a string of the font name (or nil if the font backend doesn't
4293 FILENAME is a string of the font file (or nil if the font backend
4294 doesn't provide a file name).
4296 PIXEL-SIZE is a pixel size by which the font is opened.
4298 SIZE is a maximum advance width of the font in pixels.
4300 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4303 CAPABILITY is a list whose first element is a symbol representing the
4304 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4305 remaining elements describe the details of the font capability.
4307 If the font is OpenType font, the form of the list is
4308 \(opentype GSUB GPOS)
4309 where GSUB shows which "GSUB" features the font supports, and GPOS
4310 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4311 lists of the format:
4312 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4314 If the font is not OpenType font, currently the length of the form is
4317 SCRIPT is a symbol representing OpenType script tag.
4319 LANGSYS is a symbol representing OpenType langsys tag, or nil
4320 representing the default langsys.
4322 FEATURE is a symbol representing OpenType feature tag.
4324 If the font is not OpenType font, CAPABILITY is nil. */)
4326 Lisp_Object font_object
;
4331 CHECK_FONT_GET_OBJECT (font_object
, font
);
4333 val
= Fmake_vector (make_number (9), Qnil
);
4334 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4335 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4336 ASET (val
, 2, make_number (font
->pixel_size
));
4337 ASET (val
, 3, make_number (font
->max_width
));
4338 ASET (val
, 4, make_number (font
->ascent
));
4339 ASET (val
, 5, make_number (font
->descent
));
4340 ASET (val
, 6, make_number (font
->space_width
));
4341 ASET (val
, 7, make_number (font
->average_width
));
4342 if (font
->driver
->otf_capability
)
4343 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4347 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4348 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4349 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4350 (font_object
, string
)
4351 Lisp_Object font_object
, string
;
4357 CHECK_FONT_GET_OBJECT (font_object
, font
);
4358 CHECK_STRING (string
);
4359 len
= SCHARS (string
);
4360 vec
= Fmake_vector (make_number (len
), Qnil
);
4361 for (i
= 0; i
< len
; i
++)
4363 Lisp_Object ch
= Faref (string
, make_number (i
));
4368 struct font_metrics metrics
;
4370 cod
= code
= font
->driver
->encode_char (font
, c
);
4371 if (code
== FONT_INVALID_CODE
)
4373 val
= Fmake_vector (make_number (6), Qnil
);
4374 if (cod
<= MOST_POSITIVE_FIXNUM
)
4375 ASET (val
, 0, make_number (code
));
4377 ASET (val
, 0, Fcons (make_number (code
>> 16),
4378 make_number (code
& 0xFFFF)));
4379 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4380 ASET (val
, 1, make_number (metrics
.lbearing
));
4381 ASET (val
, 2, make_number (metrics
.rbearing
));
4382 ASET (val
, 3, make_number (metrics
.width
));
4383 ASET (val
, 4, make_number (metrics
.ascent
));
4384 ASET (val
, 5, make_number (metrics
.descent
));
4390 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4391 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4392 FONT is a font-spec, font-entity, or font-object. */)
4394 Lisp_Object spec
, font
;
4396 CHECK_FONT_SPEC (spec
);
4399 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4402 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4403 doc
: /* Return a font-object for displaying a character at POSITION.
4404 Optional second arg WINDOW, if non-nil, is a window displaying
4405 the current buffer. It defaults to the currently selected window. */)
4406 (position
, window
, string
)
4407 Lisp_Object position
, window
, string
;
4414 CHECK_NUMBER_COERCE_MARKER (position
);
4415 pos
= XINT (position
);
4416 if (pos
< BEGV
|| pos
>= ZV
)
4417 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4421 CHECK_NUMBER (position
);
4422 CHECK_STRING (string
);
4423 pos
= XINT (position
);
4424 if (pos
< 0 || pos
>= SCHARS (string
))
4425 args_out_of_range (string
, position
);
4428 window
= selected_window
;
4429 CHECK_LIVE_WINDOW (window
);
4430 w
= XWINDOW (window
);
4432 return font_at (-1, pos
, NULL
, w
, string
);
4436 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4437 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4438 The value is a number of glyphs drawn.
4439 Type C-l to recover what previously shown. */)
4440 (font_object
, string
)
4441 Lisp_Object font_object
, string
;
4443 Lisp_Object frame
= selected_frame
;
4444 FRAME_PTR f
= XFRAME (frame
);
4450 CHECK_FONT_GET_OBJECT (font_object
, font
);
4451 CHECK_STRING (string
);
4452 len
= SCHARS (string
);
4453 code
= alloca (sizeof (unsigned) * len
);
4454 for (i
= 0; i
< len
; i
++)
4456 Lisp_Object ch
= Faref (string
, make_number (i
));
4460 code
[i
] = font
->driver
->encode_char (font
, c
);
4461 if (code
[i
] == FONT_INVALID_CODE
)
4464 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4466 if (font
->driver
->prepare_face
)
4467 font
->driver
->prepare_face (f
, face
);
4468 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4469 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4470 if (font
->driver
->done_face
)
4471 font
->driver
->done_face (f
, face
);
4473 return make_number (len
);
4477 #endif /* FONT_DEBUG */
4479 #ifdef HAVE_WINDOW_SYSTEM
4481 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4482 doc
: /* Return information about a font named NAME on frame FRAME.
4483 If FRAME is omitted or nil, use the selected frame.
4484 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4485 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4487 OPENED-NAME is the name used for opening the font,
4488 FULL-NAME is the full name of the font,
4489 SIZE is the maximum bound width of the font,
4490 HEIGHT is the height of the font,
4491 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4492 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4493 how to compose characters.
4494 If the named font is not yet loaded, return nil. */)
4496 Lisp_Object name
, frame
;
4501 Lisp_Object font_object
;
4503 (*check_window_system_func
) ();
4506 CHECK_STRING (name
);
4508 frame
= selected_frame
;
4509 CHECK_LIVE_FRAME (frame
);
4514 int fontset
= fs_query_fontset (name
, 0);
4517 name
= fontset_ascii (fontset
);
4518 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4520 else if (FONT_OBJECT_P (name
))
4522 else if (FONT_ENTITY_P (name
))
4523 font_object
= font_open_entity (f
, name
, 0);
4526 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4527 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4529 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4531 if (NILP (font_object
))
4533 font
= XFONT_OBJECT (font_object
);
4535 info
= Fmake_vector (make_number (7), Qnil
);
4536 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4537 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4538 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4539 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4540 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4541 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4542 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4545 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4546 close it now. Perhaps, we should manage font-objects
4547 by `reference-count'. */
4548 font_close_object (f
, font_object
);
4555 #define BUILD_STYLE_TABLE(TBL) \
4556 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4559 build_style_table (entry
, nelement
)
4560 struct table_entry
*entry
;
4564 Lisp_Object table
, elt
;
4566 table
= Fmake_vector (make_number (nelement
), Qnil
);
4567 for (i
= 0; i
< nelement
; i
++)
4569 for (j
= 0; entry
[i
].names
[j
]; j
++);
4570 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4571 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4572 for (j
= 0; entry
[i
].names
[j
]; j
++)
4573 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4574 ASET (table
, i
, elt
);
4579 static Lisp_Object Vfont_log
;
4580 static int font_log_env_checked
;
4583 font_add_log (action
, arg
, result
)
4585 Lisp_Object arg
, result
;
4587 Lisp_Object tail
, val
;
4590 if (! font_log_env_checked
)
4592 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
4593 font_log_env_checked
= 1;
4595 if (EQ (Vfont_log
, Qt
))
4598 arg
= Ffont_xlfd_name (arg
, Qt
);
4600 result
= Ffont_xlfd_name (result
, Qt
);
4601 else if (CONSP (result
))
4603 result
= Fcopy_sequence (result
);
4604 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4608 val
= Ffont_xlfd_name (val
, Qt
);
4609 XSETCAR (tail
, val
);
4612 else if (VECTORP (result
))
4614 result
= Fcopy_sequence (result
);
4615 for (i
= 0; i
< ASIZE (result
); i
++)
4617 val
= AREF (result
, i
);
4619 val
= Ffont_xlfd_name (val
, Qt
);
4620 ASET (result
, i
, val
);
4623 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4626 extern void syms_of_ftfont
P_ (());
4627 extern void syms_of_xfont
P_ (());
4628 extern void syms_of_xftfont
P_ (());
4629 extern void syms_of_ftxfont
P_ (());
4630 extern void syms_of_bdffont
P_ (());
4631 extern void syms_of_w32font
P_ (());
4632 extern void syms_of_atmfont
P_ (());
4637 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
4638 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
4639 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
4640 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
4641 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
4642 /* Note that the other elements in sort_shift_bits are not used. */
4644 staticpro (&font_charset_alist
);
4645 font_charset_alist
= Qnil
;
4647 DEFSYM (Qfont_spec
, "font-spec");
4648 DEFSYM (Qfont_entity
, "font-entity");
4649 DEFSYM (Qfont_object
, "font-object");
4651 DEFSYM (Qopentype
, "opentype");
4653 DEFSYM (Qascii_0
, "ascii-0");
4654 DEFSYM (Qiso8859_1
, "iso8859-1");
4655 DEFSYM (Qiso10646_1
, "iso10646-1");
4656 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4657 DEFSYM (Qunicode_sip
, "unicode-sip");
4659 DEFSYM (QCotf
, ":otf");
4660 DEFSYM (QClang
, ":lang");
4661 DEFSYM (QCscript
, ":script");
4662 DEFSYM (QCantialias
, ":antialias");
4664 DEFSYM (QCfoundry
, ":foundry");
4665 DEFSYM (QCadstyle
, ":adstyle");
4666 DEFSYM (QCregistry
, ":registry");
4667 DEFSYM (QCspacing
, ":spacing");
4668 DEFSYM (QCdpi
, ":dpi");
4669 DEFSYM (QCscalable
, ":scalable");
4670 DEFSYM (QCavgwidth
, ":avgwidth");
4671 DEFSYM (QCfont_entity
, ":font-entity");
4672 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
4679 staticpro (&null_vector
);
4680 null_vector
= Fmake_vector (make_number (0), Qnil
);
4682 staticpro (&scratch_font_spec
);
4683 scratch_font_spec
= Ffont_spec (0, NULL
);
4684 staticpro (&scratch_font_prefer
);
4685 scratch_font_prefer
= Ffont_spec (0, NULL
);
4689 staticpro (&otf_list
);
4691 #endif /* HAVE_LIBOTF */
4695 defsubr (&Sfont_spec
);
4696 defsubr (&Sfont_get
);
4697 defsubr (&Sfont_put
);
4698 defsubr (&Slist_fonts
);
4699 defsubr (&Sfont_family_list
);
4700 defsubr (&Sfind_font
);
4701 defsubr (&Sfont_xlfd_name
);
4702 defsubr (&Sclear_font_cache
);
4703 defsubr (&Sfont_make_gstring
);
4704 defsubr (&Sfont_fill_gstring
);
4705 defsubr (&Sfont_shape_text
);
4707 defsubr (&Sfont_drive_otf
);
4708 defsubr (&Sfont_otf_alternates
);
4712 defsubr (&Sopen_font
);
4713 defsubr (&Sclose_font
);
4714 defsubr (&Squery_font
);
4715 defsubr (&Sget_font_glyphs
);
4716 defsubr (&Sfont_match_p
);
4717 defsubr (&Sfont_at
);
4719 defsubr (&Sdraw_string
);
4721 #endif /* FONT_DEBUG */
4722 #ifdef HAVE_WINDOW_SYSTEM
4723 defsubr (&Sfont_info
);
4726 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
4728 Alist of fontname patterns vs the corresponding encoding and repertory info.
4729 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
4730 where ENCODING is a charset or a char-table,
4731 and REPERTORY is a charset, a char-table, or nil.
4733 If ENCODING and REPERTORY are the same, the element can have the form
4734 \(REGEXP . ENCODING).
4736 ENCODING is for converting a character to a glyph code of the font.
4737 If ENCODING is a charset, encoding a character by the charset gives
4738 the corresponding glyph code. If ENCODING is a char-table, looking up
4739 the table by a character gives the corresponding glyph code.
4741 REPERTORY specifies a repertory of characters supported by the font.
4742 If REPERTORY is a charset, all characters beloging to the charset are
4743 supported. If REPERTORY is a char-table, all characters who have a
4744 non-nil value in the table are supported. If REPERTORY is nil, Emacs
4745 gets the repertory information by an opened font and ENCODING. */);
4746 Vfont_encoding_alist
= Qnil
;
4748 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
4749 doc
: /* Vector of valid font weight values.
4750 Each element has the form:
4751 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
4752 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
4753 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
4755 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
4756 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
4757 See `font-weight-table' for the format of the vector. */);
4758 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
4760 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
4761 doc
: /* Alist of font width symbols vs the corresponding numeric values.
4762 See `font-weight-table' for the format of the vector. */);
4763 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
4765 staticpro (&font_style_table
);
4766 font_style_table
= Fmake_vector (make_number (3), Qnil
);
4767 ASET (font_style_table
, 0, Vfont_weight_table
);
4768 ASET (font_style_table
, 1, Vfont_slant_table
);
4769 ASET (font_style_table
, 2, Vfont_width_table
);
4771 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
4772 *Logging list of font related actions and results.
4773 The value t means to suppress the logging.
4774 The initial value is set to nil if the environment variable
4775 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
4778 #ifdef HAVE_WINDOW_SYSTEM
4779 #ifdef HAVE_FREETYPE
4781 #ifdef HAVE_X_WINDOWS
4786 #endif /* HAVE_XFT */
4787 #endif /* HAVE_X_WINDOWS */
4788 #else /* not HAVE_FREETYPE */
4789 #ifdef HAVE_X_WINDOWS
4791 #endif /* HAVE_X_WINDOWS */
4792 #endif /* not HAVE_FREETYPE */
4795 #endif /* HAVE_BDFFONT */
4798 #endif /* WINDOWSNT */
4802 #endif /* HAVE_WINDOW_SYSTEM */
4805 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
4806 (do not change this comment) */