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
;
2903 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
2905 struct charset
*encoding
, *repertory
;
2907 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
2908 &encoding
, &repertory
) < 0)
2912 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
2914 /* Any font of this registry support C. So, let's
2915 suppress the further checking. */
2918 else if (c
> encoding
->max_char
)
2922 work
= Fcopy_font_spec (spec
);
2923 XSETFRAME (frame
, f
);
2924 size
= AREF (spec
, FONT_SIZE_INDEX
);
2925 pixel_size
= font_pixel_size (f
, spec
);
2926 if (pixel_size
== 0)
2928 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
2930 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
2932 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
2933 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
2934 if (! NILP (foundry
[0]))
2935 foundry
[1] = null_vector
;
2936 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
2938 foundry
[0] = font_intern_prop (SDATA (attrs
[LFACE_FOUNDRY_INDEX
]),
2939 SBYTES (attrs
[LFACE_FOUNDRY_INDEX
]), 1);
2941 foundry
[2] = null_vector
;
2944 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
2946 val
= AREF (work
, FONT_FAMILY_INDEX
);
2947 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
2948 val
= font_intern_prop (SDATA (attrs
[LFACE_FAMILY_INDEX
]),
2949 SBYTES (attrs
[LFACE_FAMILY_INDEX
]), 1);
2952 family
= alloca ((sizeof family
[0]) * 2);
2954 family
[1] = null_vector
; /* terminator. */
2959 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
2961 if (! NILP (alters
))
2963 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
2964 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
2965 family
[i
] = XCAR (alters
);
2966 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2968 family
[i
] = null_vector
;
2972 family
= alloca ((sizeof family
[0]) * 3);
2975 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2977 family
[i
] = null_vector
;
2981 for (j
= 0; SYMBOLP (family
[j
]); j
++)
2983 ASET (work
, FONT_FAMILY_INDEX
, family
[j
]);
2984 for (i
= 0; SYMBOLP (foundry
[i
]); i
++)
2986 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[i
]);
2987 entities
= font_list_entities (frame
, work
);
2988 if (ASIZE (entities
) > 0)
2991 if (ASIZE (entities
) > 0)
2994 if (ASIZE (entities
) == 0)
2996 if (ASIZE (entities
) == 1)
2999 return AREF (entities
, 0);
3003 /* Sort fonts by properties specified in LFACE. */
3004 Lisp_Object prefer
= scratch_font_prefer
;
3006 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3007 ASET (prefer
, i
, AREF (work
, i
));
3008 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3010 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3012 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3013 if (NILP (AREF (prefer
, i
)))
3014 ASET (prefer
, i
, AREF (face_font
, i
));
3016 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3017 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3018 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3019 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3020 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3021 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3022 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3023 entities
= font_sort_entites (entities
, prefer
, frame
, work
, c
< 0);
3028 for (i
= 0; i
< ASIZE (entities
); i
++)
3032 val
= AREF (entities
, i
);
3035 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3036 if (! EQ (AREF (val
, j
), props
[j
]))
3038 if (j
> FONT_REGISTRY_INDEX
)
3041 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3042 props
[j
] = AREF (val
, j
);
3043 result
= font_has_char (f
, val
, c
);
3048 val
= font_open_for_lface (f
, val
, attrs
, spec
);
3051 result
= font_has_char (f
, val
, c
);
3052 font_close_object (f
, val
);
3054 return AREF (entities
, i
);
3061 font_open_for_lface (f
, entity
, attrs
, spec
)
3069 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3070 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3071 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3072 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3073 size
= font_pixel_size (f
, spec
);
3076 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3079 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3081 return font_open_entity (f
, entity
, size
);
3085 /* Find a font satisfying SPEC and best matching with face's
3086 attributes in ATTRS on FRAME, and return the opened
3090 font_load_for_lface (f
, attrs
, spec
)
3092 Lisp_Object
*attrs
, spec
;
3096 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3099 /* No font is listed for SPEC, but each font-backend may have
3100 the different criteria about "font matching". So, try
3102 entity
= font_matching_entity (f
, attrs
, spec
);
3106 return font_open_for_lface (f
, entity
, attrs
, spec
);
3110 /* Make FACE on frame F ready to use the font opened for FACE. */
3113 font_prepare_for_face (f
, face
)
3117 if (face
->font
->driver
->prepare_face
)
3118 face
->font
->driver
->prepare_face (f
, face
);
3122 /* Make FACE on frame F stop using the font opened for FACE. */
3125 font_done_for_face (f
, face
)
3129 if (face
->font
->driver
->done_face
)
3130 face
->font
->driver
->done_face (f
, face
);
3135 /* Open a font best matching with NAME on frame F. If no proper font
3136 is found, return Qnil. */
3139 font_open_by_name (f
, name
)
3143 Lisp_Object args
[2];
3144 Lisp_Object spec
, attrs
[LFACE_VECTOR_SIZE
];
3147 args
[1] = make_unibyte_string (name
, strlen (name
));
3148 spec
= Ffont_spec (2, args
);
3149 /* We set up the default font-related attributes of a face to prefer
3151 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3152 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3153 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3154 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3155 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3157 return font_load_for_lface (f
, attrs
, spec
);
3161 /* Register font-driver DRIVER. This function is used in two ways.
3163 The first is with frame F non-NULL. In this case, make DRIVER
3164 available (but not yet activated) on F. All frame creaters
3165 (e.g. Fx_create_frame) must call this function at least once with
3166 an available font-driver.
3168 The second is with frame F NULL. In this case, DRIVER is globally
3169 registered in the variable `font_driver_list'. All font-driver
3170 implementations must call this function in its syms_of_XXXX
3171 (e.g. syms_of_xfont). */
3174 register_font_driver (driver
, f
)
3175 struct font_driver
*driver
;
3178 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3179 struct font_driver_list
*prev
, *list
;
3181 if (f
&& ! driver
->draw
)
3182 error ("Unusable font driver for a frame: %s",
3183 SDATA (SYMBOL_NAME (driver
->type
)));
3185 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3186 if (EQ (list
->driver
->type
, driver
->type
))
3187 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3189 list
= malloc (sizeof (struct font_driver_list
));
3191 list
->driver
= driver
;
3196 f
->font_driver_list
= list
;
3198 font_driver_list
= list
;
3204 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3205 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3206 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3208 A caller must free all realized faces if any in advance. The
3209 return value is a list of font backends actually made used on
3213 font_update_drivers (f
, new_drivers
)
3215 Lisp_Object new_drivers
;
3217 Lisp_Object active_drivers
= Qnil
;
3218 struct font_driver
*driver
;
3219 struct font_driver_list
*list
;
3221 /* At first, turn off non-requested drivers, and turn on requested
3223 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3225 driver
= list
->driver
;
3226 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3231 if (driver
->end_for_frame
)
3232 driver
->end_for_frame (f
);
3233 font_finish_cache (f
, driver
);
3238 if (! driver
->start_for_frame
3239 || driver
->start_for_frame (f
) == 0)
3241 font_prepare_cache (f
, driver
);
3248 if (NILP (new_drivers
))
3251 if (! EQ (new_drivers
, Qt
))
3253 /* Re-order the driver list according to new_drivers. */
3254 struct font_driver_list
**list_table
, *list
;
3258 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3259 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3261 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3262 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3265 list_table
[i
++] = list
;
3267 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3269 list_table
[i
] = list
;
3270 list_table
[i
] = NULL
;
3272 f
->font_driver_list
= list
= NULL
;
3273 for (i
= 0; list_table
[i
]; i
++)
3276 list
->next
= list_table
[i
], list
= list
->next
;
3278 f
->font_driver_list
= list
= list_table
[i
];
3283 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3285 active_drivers
= nconc2 (active_drivers
,
3286 Fcons (list
->driver
->type
, Qnil
));
3287 return active_drivers
;
3291 font_put_frame_data (f
, driver
, data
)
3293 struct font_driver
*driver
;
3296 struct font_data_list
*list
, *prev
;
3298 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3299 prev
= list
, list
= list
->next
)
3300 if (list
->driver
== driver
)
3307 prev
->next
= list
->next
;
3309 f
->font_data_list
= list
->next
;
3317 list
= malloc (sizeof (struct font_data_list
));
3320 list
->driver
= driver
;
3321 list
->next
= f
->font_data_list
;
3322 f
->font_data_list
= list
;
3330 font_get_frame_data (f
, driver
)
3332 struct font_driver
*driver
;
3334 struct font_data_list
*list
;
3336 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3337 if (list
->driver
== driver
)
3345 /* Return the font used to draw character C by FACE at buffer position
3346 POS in window W. If STRING is non-nil, it is a string containing C
3347 at index POS. If C is negative, get C from the current buffer or
3351 font_at (c
, pos
, face
, w
, string
)
3360 Lisp_Object font_object
;
3366 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3369 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3371 c
= FETCH_CHAR (pos_byte
);
3374 c
= FETCH_BYTE (pos
);
3380 multibyte
= STRING_MULTIBYTE (string
);
3383 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3385 str
= SDATA (string
) + pos_byte
;
3386 c
= STRING_CHAR (str
, 0);
3389 c
= SDATA (string
)[pos
];
3393 f
= XFRAME (w
->frame
);
3394 if (! FRAME_WINDOW_P (f
))
3401 if (STRINGP (string
))
3402 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3403 DEFAULT_FACE_ID
, 0);
3405 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3407 face
= FACE_FROM_ID (f
, face_id
);
3411 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3412 face
= FACE_FROM_ID (f
, face_id
);
3417 font_assert (font_check_object ((struct font
*) face
->font
));
3418 XSETFONT (font_object
, face
->font
);
3423 /* Check how many characters after POS (at most to LIMIT) can be
3424 displayed by the same font. FACE is the face selected for the
3425 character as POS on frame F. STRING, if not nil, is the string to
3426 check instead of the current buffer.
3428 The return value is the position of the character that is displayed
3429 by the differnt font than that of the character as POS. */
3432 font_range (pos
, limit
, face
, f
, string
)
3433 EMACS_INT pos
, limit
;
3446 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3447 pos_byte
= CHAR_TO_BYTE (pos
);
3451 multibyte
= STRING_MULTIBYTE (string
);
3452 pos_byte
= string_char_to_byte (string
, pos
);
3456 /* All unibyte character are displayed by the same font. */
3464 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3466 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3467 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3468 face
= FACE_FROM_ID (f
, face_id
);
3475 else if (font
!= face
->font
)
3487 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3488 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3489 Return nil otherwise.
3490 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3491 which kind of font it is. It must be one of `font-spec', `font-entity',
3493 (object
, extra_type
)
3494 Lisp_Object object
, extra_type
;
3496 if (NILP (extra_type
))
3497 return (FONTP (object
) ? Qt
: Qnil
);
3498 if (EQ (extra_type
, Qfont_spec
))
3499 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3500 if (EQ (extra_type
, Qfont_entity
))
3501 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3502 if (EQ (extra_type
, Qfont_object
))
3503 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3504 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3507 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3508 doc
: /* Return a newly created font-spec with arguments as properties.
3510 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3511 valid font property name listed below:
3513 `:family', `:weight', `:slant', `:width'
3515 They are the same as face attributes of the same name. See
3516 `set-face-attribute'.
3520 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3524 VALUE must be a string or a symbol specifying the additional
3525 typographic style information of a font, e.g. ``sans''.
3529 VALUE must be a string or a symbol specifying the charset registry and
3530 encoding of a font, e.g. ``iso8859-1''.
3534 VALUE must be a non-negative integer or a floating point number
3535 specifying the font size. It specifies the font size in pixels
3536 (if VALUE is an integer), or in points (if VALUE is a float).
3537 usage: (font-spec ARGS ...) */)
3542 Lisp_Object spec
= font_make_spec ();
3545 for (i
= 0; i
< nargs
; i
+= 2)
3547 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3549 if (EQ (key
, QCname
))
3552 font_parse_name ((char *) SDATA (val
), spec
);
3553 font_put_extra (spec
, key
, val
);
3557 int idx
= get_font_prop_index (key
);
3561 val
= font_prop_validate (idx
, Qnil
, val
);
3562 if (idx
< FONT_EXTRA_INDEX
)
3563 ASET (spec
, idx
, val
);
3565 font_put_extra (spec
, key
, val
);
3568 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3574 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3575 doc
: /* Return a copy of FONT as a font-spec. */)
3579 Lisp_Object new_spec
, tail
, extra
;
3583 new_spec
= font_make_spec ();
3584 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3585 ASET (new_spec
, i
, AREF (font
, i
));
3587 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3589 if (! EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3590 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3592 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3596 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3597 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3598 Every specified properties in FROM override the corresponding
3599 properties in TO. */)
3601 Lisp_Object from
, to
;
3603 Lisp_Object extra
, tail
;
3608 to
= Fcopy_font_spec (to
);
3609 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3610 ASET (to
, i
, AREF (from
, i
));
3611 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3612 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3613 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3615 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3618 XSETCDR (slot
, XCDR (XCAR (tail
)));
3620 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3622 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3626 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3627 doc
: /* Return the value of FONT's property KEY.
3628 FONT is a font-spec, a font-entity, or a font-object. */)
3630 Lisp_Object font
, key
;
3637 idx
= get_font_prop_index (key
);
3638 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3639 return AREF (font
, idx
);
3640 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3644 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3645 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
3646 (font_spec
, prop
, val
)
3647 Lisp_Object font_spec
, prop
, val
;
3651 CHECK_FONT_SPEC (font_spec
);
3652 idx
= get_font_prop_index (prop
);
3653 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3654 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
3656 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
3660 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3661 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3662 Optional 2nd argument FRAME specifies the target frame.
3663 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3664 Optional 4th argument PREFER, if non-nil, is a font-spec to
3665 control the order of the returned list. Fonts are sorted by
3666 how close they are to PREFER. */)
3667 (font_spec
, frame
, num
, prefer
)
3668 Lisp_Object font_spec
, frame
, num
, prefer
;
3670 Lisp_Object vec
, list
, tail
;
3674 frame
= selected_frame
;
3675 CHECK_LIVE_FRAME (frame
);
3676 CHECK_FONT_SPEC (font_spec
);
3684 if (! NILP (prefer
))
3685 CHECK_FONT_SPEC (prefer
);
3687 vec
= font_list_entities (frame
, font_spec
);
3692 return Fcons (AREF (vec
, 0), Qnil
);
3694 if (! NILP (prefer
))
3695 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
, 0);
3697 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3698 if (n
== 0 || n
> len
)
3700 for (i
= 1; i
< n
; i
++)
3702 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3704 XSETCDR (tail
, val
);
3710 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
3711 doc
: /* List available font families on the current frame.
3712 Optional argument FRAME, if non-nil, specifies the target frame. */)
3717 struct font_driver_list
*driver_list
;
3721 frame
= selected_frame
;
3722 CHECK_LIVE_FRAME (frame
);
3725 for (driver_list
= f
->font_driver_list
; driver_list
;
3726 driver_list
= driver_list
->next
)
3727 if (driver_list
->driver
->list_family
)
3729 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3735 Lisp_Object tail
= list
;
3737 for (; CONSP (val
); val
= XCDR (val
))
3738 if (NILP (Fmemq (XCAR (val
), tail
)))
3739 list
= Fcons (XCAR (val
), list
);
3745 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3746 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3747 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3749 Lisp_Object font_spec
, frame
;
3751 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3758 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
3759 doc
: /* Return XLFD name of FONT.
3760 FONT is a font-spec, font-entity, or font-object.
3761 If the name is too long for XLFD (maximum 255 chars), return nil.
3762 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
3763 the consecutive wildcards are folded to one. */)
3764 (font
, fold_wildcards
)
3765 Lisp_Object font
, fold_wildcards
;
3772 if (FONT_OBJECT_P (font
))
3774 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
3776 if (STRINGP (font_name
)
3777 && SDATA (font_name
)[0] == '-')
3779 if (NILP (fold_wildcards
))
3781 strcpy (name
, (char *) SDATA (font_name
));
3784 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
3786 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3789 if (! NILP (fold_wildcards
))
3791 char *p0
= name
, *p1
;
3793 while ((p1
= strstr (p0
, "-*-*")))
3795 strcpy (p1
, p1
+ 2);
3800 return build_string (name
);
3803 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3804 doc
: /* Clear font cache. */)
3807 Lisp_Object list
, frame
;
3809 FOR_EACH_FRAME (list
, frame
)
3811 FRAME_PTR f
= XFRAME (frame
);
3812 struct font_driver_list
*driver_list
= f
->font_driver_list
;
3814 for (; driver_list
; driver_list
= driver_list
->next
)
3815 if (driver_list
->on
)
3817 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
3822 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
3824 font_assert (! NILP (val
));
3825 val
= XCDR (XCAR (val
));
3826 if (XINT (XCAR (val
)) == 0)
3828 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
3829 XSETCDR (cache
, XCDR (val
));
3837 /* The following three functions are still experimental. */
3839 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
3840 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
3841 FONT-OBJECT may be nil if it is not yet known.
3843 G-string is sequence of glyphs of a specific font,
3844 and is a vector of this form:
3845 [ HEADER GLYPH ... ]
3846 HEADER is a vector of this form:
3847 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
3849 FONT-OBJECT is a font-object for all glyphs in the g-string,
3850 WIDTH thru DESCENT are the metrics (in pixels) of the whole G-string.
3851 GLYPH is a vector of this form:
3852 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
3853 [ [X-OFF Y-OFF WADJUST] | nil] ]
3855 FROM-IDX and TO-IDX are used internally and should not be touched.
3856 C is the character of the glyph.
3857 CODE is the glyph-code of C in FONT-OBJECT.
3858 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
3859 X-OFF and Y-OFF are offests to the base position for the glyph.
3860 WADJUST is the adjustment to the normal width of the glyph. */)
3862 Lisp_Object font_object
, num
;
3864 Lisp_Object gstring
, g
;
3868 if (! NILP (font_object
))
3869 CHECK_FONT_OBJECT (font_object
);
3872 len
= XINT (num
) + 1;
3873 gstring
= Fmake_vector (make_number (len
), Qnil
);
3874 g
= Fmake_vector (make_number (6), Qnil
);
3875 ASET (g
, 0, font_object
);
3876 ASET (gstring
, 0, g
);
3877 for (i
= 1; i
< len
; i
++)
3878 ASET (gstring
, i
, Fmake_vector (make_number (10), Qnil
));
3882 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
3883 doc
: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
3884 START and END specify the region to extract characters.
3885 If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
3886 where to extract characters.
3887 FONT-OBJECT may be nil if GSTRING already contains one. */)
3888 (gstring
, font_object
, start
, end
, object
)
3889 Lisp_Object gstring
, font_object
, start
, end
, object
;
3895 CHECK_VECTOR (gstring
);
3896 if (NILP (font_object
))
3897 font_object
= LGSTRING_FONT (gstring
);
3898 font
= XFONT_OBJECT (font_object
);
3900 if (STRINGP (object
))
3902 const unsigned char *p
;
3904 CHECK_NATNUM (start
);
3906 if (XINT (start
) > XINT (end
)
3907 || XINT (end
) > ASIZE (object
)
3908 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3909 args_out_of_range_3 (object
, start
, end
);
3911 len
= XINT (end
) - XINT (start
);
3912 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
3913 for (i
= 0; i
< len
; i
++)
3915 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3916 /* Shut up GCC warning in comparison with
3917 MOST_POSITIVE_FIXNUM below. */
3920 c
= STRING_CHAR_ADVANCE (p
);
3921 cod
= code
= font
->driver
->encode_char (font
, c
);
3922 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
3924 LGLYPH_SET_FROM (g
, i
);
3925 LGLYPH_SET_TO (g
, i
);
3926 LGLYPH_SET_CHAR (g
, c
);
3927 LGLYPH_SET_CODE (g
, code
);
3934 if (! NILP (object
))
3935 Fset_buffer (object
);
3936 validate_region (&start
, &end
);
3937 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3938 args_out_of_range (start
, end
);
3939 len
= XINT (end
) - XINT (start
);
3941 pos_byte
= CHAR_TO_BYTE (pos
);
3942 for (i
= 0; i
< len
; i
++)
3944 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3945 /* Shut up GCC warning in comparison with
3946 MOST_POSITIVE_FIXNUM below. */
3949 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
3950 cod
= code
= font
->driver
->encode_char (font
, c
);
3951 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
3953 LGLYPH_SET_FROM (g
, i
);
3954 LGLYPH_SET_TO (g
, i
);
3955 LGLYPH_SET_CHAR (g
, c
);
3956 LGLYPH_SET_CODE (g
, code
);
3959 for (; i
< LGSTRING_LENGTH (gstring
); i
++)
3960 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
3964 DEFUN ("font-shape-text", Ffont_shape_text
, Sfont_shape_text
, 3, 4, 0,
3965 doc
: /* Shape text between FROM and TO by FONT-OBJECT.
3966 If optional 4th argument STRING is non-nil, it is a string to shape,
3967 and FROM and TO are indices to the string.
3968 The value is the end position of the text that can be shaped by
3970 (from
, to
, font_object
, string
)
3971 Lisp_Object from
, to
, font_object
, string
;
3974 struct font_metrics metrics
;
3975 EMACS_INT start
, end
;
3976 Lisp_Object gstring
, n
;
3979 if (! FONT_OBJECT_P (font_object
))
3981 font
= XFONT_OBJECT (font_object
);
3982 if (! font
->driver
->shape
)
3987 validate_region (&from
, &to
);
3988 start
= XFASTINT (from
);
3989 end
= XFASTINT (to
);
3990 modify_region (current_buffer
, start
, end
, 0);
3994 CHECK_STRING (string
);
3995 start
= XINT (from
);
3997 if (start
< 0 || start
> end
|| end
> SCHARS (string
))
3998 args_out_of_range_3 (string
, from
, to
);
4002 gstring
= Ffont_make_gstring (font_object
, make_number (len
));
4003 Ffont_fill_gstring (gstring
, font_object
, from
, to
, string
);
4005 /* Try at most three times with larger gstring each time. */
4006 for (i
= 0; i
< 3; i
++)
4008 Lisp_Object args
[2];
4010 n
= font
->driver
->shape (gstring
);
4014 args
[1] = Fmake_vector (make_number (len
), Qnil
);
4015 gstring
= Fvconcat (2, args
);
4017 if (! INTEGERP (n
) || XINT (n
) == 0)
4021 for (i
= 0; i
< len
;)
4024 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4025 EMACS_INT this_from
= LGLYPH_FROM (g
);
4026 EMACS_INT this_to
= LGLYPH_TO (g
) + 1;
4028 int need_composition
= 0;
4030 metrics
.lbearing
= LGLYPH_LBEARING (g
);
4031 metrics
.rbearing
= LGLYPH_RBEARING (g
);
4032 metrics
.ascent
= LGLYPH_ASCENT (g
);
4033 metrics
.descent
= LGLYPH_DESCENT (g
);
4034 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4036 metrics
.width
= LGLYPH_WIDTH (g
);
4037 if (LGLYPH_CHAR (g
) == 0 || metrics
.width
== 0)
4038 need_composition
= 1;
4042 metrics
.width
= LGLYPH_WADJUST (g
);
4043 metrics
.lbearing
+= LGLYPH_XOFF (g
);
4044 metrics
.rbearing
+= LGLYPH_XOFF (g
);
4045 metrics
.ascent
-= LGLYPH_YOFF (g
);
4046 metrics
.descent
+= LGLYPH_YOFF (g
);
4047 need_composition
= 1;
4049 for (j
= i
+ 1; j
< len
; j
++)
4053 g
= LGSTRING_GLYPH (gstring
, j
);
4054 if (this_from
!= LGLYPH_FROM (g
))
4056 need_composition
= 1;
4057 x
= metrics
.width
+ LGLYPH_LBEARING (g
) + LGLYPH_XOFF (g
);
4058 if (metrics
.lbearing
> x
)
4059 metrics
.lbearing
= x
;
4060 x
= metrics
.width
+ LGLYPH_RBEARING (g
) + LGLYPH_XOFF (g
);
4061 if (metrics
.rbearing
< x
)
4062 metrics
.rbearing
= x
;
4063 x
= LGLYPH_ASCENT (g
) - LGLYPH_YOFF (g
);
4064 if (metrics
.ascent
< x
)
4066 x
= LGLYPH_DESCENT (g
) - LGLYPH_YOFF (g
);
4067 if (metrics
.descent
< x
)
4068 metrics
.descent
= x
;
4069 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4070 metrics
.width
+= LGLYPH_WIDTH (g
);
4072 metrics
.width
+= LGLYPH_WADJUST (g
);
4075 if (need_composition
)
4077 gstr
= Ffont_make_gstring (font_object
, make_number (j
- i
));
4078 LGSTRING_SET_WIDTH (gstr
, metrics
.width
);
4079 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
4080 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
);
4081 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
4082 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
4083 for (k
= i
; i
< j
; i
++)
4085 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4087 LGLYPH_SET_FROM (g
, LGLYPH_FROM (g
) - this_from
);
4088 LGLYPH_SET_TO (g
, LGLYPH_TO (g
) - this_from
);
4089 LGSTRING_SET_GLYPH (gstr
, i
- k
, LGSTRING_GLYPH (gstring
, i
));
4091 from
= make_number (start
+ this_from
);
4092 to
= make_number (start
+ this_to
);
4094 Fcompose_region_internal (from
, to
, gstr
, Qnil
);
4096 Fcompose_string_internal (string
, from
, to
, gstr
, Qnil
);
4107 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4108 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4109 OTF-FEATURES specifies which features to apply in this format:
4110 (SCRIPT LANGSYS GSUB GPOS)
4112 SCRIPT is a symbol specifying a script tag of OpenType,
4113 LANGSYS is a symbol specifying a langsys tag of OpenType,
4114 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4116 If LANGYS is nil, the default langsys is selected.
4118 The features are applied in the order they appear in the list. The
4119 symbol `*' means to apply all available features not present in this
4120 list, and the remaining features are ignored. For instance, (vatu
4121 pstf * haln) is to apply vatu and pstf in this order, then to apply
4122 all available features other than vatu, pstf, and haln.
4124 The features are applied to the glyphs in the range FROM and TO of
4125 the glyph-string GSTRING-IN.
4127 If some feature is actually applicable, the resulting glyphs are
4128 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4129 this case, the value is the number of produced glyphs.
4131 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4134 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4135 produced in GSTRING-OUT, and the value is nil.
4137 See the documentation of `font-make-gstring' for the format of
4139 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4140 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4142 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4147 check_otf_features (otf_features
);
4148 CHECK_FONT_OBJECT (font_object
);
4149 font
= XFONT_OBJECT (font_object
);
4150 if (! font
->driver
->otf_drive
)
4151 error ("Font backend %s can't drive OpenType GSUB table",
4152 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4153 CHECK_CONS (otf_features
);
4154 CHECK_SYMBOL (XCAR (otf_features
));
4155 val
= XCDR (otf_features
);
4156 CHECK_SYMBOL (XCAR (val
));
4157 val
= XCDR (otf_features
);
4160 len
= check_gstring (gstring_in
);
4161 CHECK_VECTOR (gstring_out
);
4162 CHECK_NATNUM (from
);
4164 CHECK_NATNUM (index
);
4166 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4167 args_out_of_range_3 (from
, to
, make_number (len
));
4168 if (XINT (index
) >= ASIZE (gstring_out
))
4169 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4170 num
= font
->driver
->otf_drive (font
, otf_features
,
4171 gstring_in
, XINT (from
), XINT (to
),
4172 gstring_out
, XINT (index
), 0);
4175 return make_number (num
);
4178 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4180 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4181 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4183 (SCRIPT LANGSYS FEATURE ...)
4184 See the documentation of `font-drive-otf' for more detail.
4186 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4187 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4188 character code corresponding to the glyph or nil if there's no
4189 corresponding character. */)
4190 (font_object
, character
, otf_features
)
4191 Lisp_Object font_object
, character
, otf_features
;
4194 Lisp_Object gstring_in
, gstring_out
, g
;
4195 Lisp_Object alternates
;
4198 CHECK_FONT_GET_OBJECT (font_object
, font
);
4199 if (! font
->driver
->otf_drive
)
4200 error ("Font backend %s can't drive OpenType GSUB table",
4201 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4202 CHECK_CHARACTER (character
);
4203 CHECK_CONS (otf_features
);
4205 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4206 g
= LGSTRING_GLYPH (gstring_in
, 0);
4207 LGLYPH_SET_CHAR (g
, XINT (character
));
4208 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4209 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4210 gstring_out
, 0, 1)) < 0)
4211 gstring_out
= Ffont_make_gstring (font_object
,
4212 make_number (ASIZE (gstring_out
) * 2));
4214 for (i
= 0; i
< num
; i
++)
4216 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4217 int c
= LGLYPH_CHAR (g
);
4218 unsigned code
= LGLYPH_CODE (g
);
4220 alternates
= Fcons (Fcons (make_number (code
),
4221 c
> 0 ? make_number (c
) : Qnil
),
4224 return Fnreverse (alternates
);
4230 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4231 doc
: /* Open FONT-ENTITY. */)
4232 (font_entity
, size
, frame
)
4233 Lisp_Object font_entity
;
4239 CHECK_FONT_ENTITY (font_entity
);
4241 frame
= selected_frame
;
4242 CHECK_LIVE_FRAME (frame
);
4245 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4248 CHECK_NUMBER_OR_FLOAT (size
);
4250 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
4252 isize
= XINT (size
);
4256 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4259 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4260 doc
: /* Close FONT-OBJECT. */)
4261 (font_object
, frame
)
4262 Lisp_Object font_object
, frame
;
4264 CHECK_FONT_OBJECT (font_object
);
4266 frame
= selected_frame
;
4267 CHECK_LIVE_FRAME (frame
);
4268 font_close_object (XFRAME (frame
), font_object
);
4272 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4273 doc
: /* Return information about FONT-OBJECT.
4274 The value is a vector:
4275 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4278 NAME is a string of the font name (or nil if the font backend doesn't
4281 FILENAME is a string of the font file (or nil if the font backend
4282 doesn't provide a file name).
4284 PIXEL-SIZE is a pixel size by which the font is opened.
4286 SIZE is a maximum advance width of the font in pixels.
4288 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4291 CAPABILITY is a list whose first element is a symbol representing the
4292 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4293 remaining elements describe the details of the font capability.
4295 If the font is OpenType font, the form of the list is
4296 \(opentype GSUB GPOS)
4297 where GSUB shows which "GSUB" features the font supports, and GPOS
4298 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4299 lists of the format:
4300 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4302 If the font is not OpenType font, currently the length of the form is
4305 SCRIPT is a symbol representing OpenType script tag.
4307 LANGSYS is a symbol representing OpenType langsys tag, or nil
4308 representing the default langsys.
4310 FEATURE is a symbol representing OpenType feature tag.
4312 If the font is not OpenType font, CAPABILITY is nil. */)
4314 Lisp_Object font_object
;
4319 CHECK_FONT_GET_OBJECT (font_object
, font
);
4321 val
= Fmake_vector (make_number (9), Qnil
);
4322 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4323 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4324 ASET (val
, 2, make_number (font
->pixel_size
));
4325 ASET (val
, 3, make_number (font
->max_width
));
4326 ASET (val
, 4, make_number (font
->ascent
));
4327 ASET (val
, 5, make_number (font
->descent
));
4328 ASET (val
, 6, make_number (font
->space_width
));
4329 ASET (val
, 7, make_number (font
->average_width
));
4330 if (font
->driver
->otf_capability
)
4331 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4335 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4336 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4337 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4338 (font_object
, string
)
4339 Lisp_Object font_object
, string
;
4345 CHECK_FONT_GET_OBJECT (font_object
, font
);
4346 CHECK_STRING (string
);
4347 len
= SCHARS (string
);
4348 vec
= Fmake_vector (make_number (len
), Qnil
);
4349 for (i
= 0; i
< len
; i
++)
4351 Lisp_Object ch
= Faref (string
, make_number (i
));
4356 struct font_metrics metrics
;
4358 cod
= code
= font
->driver
->encode_char (font
, c
);
4359 if (code
== FONT_INVALID_CODE
)
4361 val
= Fmake_vector (make_number (6), Qnil
);
4362 if (cod
<= MOST_POSITIVE_FIXNUM
)
4363 ASET (val
, 0, make_number (code
));
4365 ASET (val
, 0, Fcons (make_number (code
>> 16),
4366 make_number (code
& 0xFFFF)));
4367 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4368 ASET (val
, 1, make_number (metrics
.lbearing
));
4369 ASET (val
, 2, make_number (metrics
.rbearing
));
4370 ASET (val
, 3, make_number (metrics
.width
));
4371 ASET (val
, 4, make_number (metrics
.ascent
));
4372 ASET (val
, 5, make_number (metrics
.descent
));
4378 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4379 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4380 FONT is a font-spec, font-entity, or font-object. */)
4382 Lisp_Object spec
, font
;
4384 CHECK_FONT_SPEC (spec
);
4387 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4390 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4391 doc
: /* Return a font-object for displaying a character at POSITION.
4392 Optional second arg WINDOW, if non-nil, is a window displaying
4393 the current buffer. It defaults to the currently selected window. */)
4394 (position
, window
, string
)
4395 Lisp_Object position
, window
, string
;
4402 CHECK_NUMBER_COERCE_MARKER (position
);
4403 pos
= XINT (position
);
4404 if (pos
< BEGV
|| pos
>= ZV
)
4405 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4409 CHECK_NUMBER (position
);
4410 CHECK_STRING (string
);
4411 pos
= XINT (position
);
4412 if (pos
< 0 || pos
>= SCHARS (string
))
4413 args_out_of_range (string
, position
);
4416 window
= selected_window
;
4417 CHECK_LIVE_WINDOW (window
);
4418 w
= XWINDOW (window
);
4420 return font_at (-1, pos
, NULL
, w
, string
);
4424 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4425 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4426 The value is a number of glyphs drawn.
4427 Type C-l to recover what previously shown. */)
4428 (font_object
, string
)
4429 Lisp_Object font_object
, string
;
4431 Lisp_Object frame
= selected_frame
;
4432 FRAME_PTR f
= XFRAME (frame
);
4438 CHECK_FONT_GET_OBJECT (font_object
, font
);
4439 CHECK_STRING (string
);
4440 len
= SCHARS (string
);
4441 code
= alloca (sizeof (unsigned) * len
);
4442 for (i
= 0; i
< len
; i
++)
4444 Lisp_Object ch
= Faref (string
, make_number (i
));
4448 code
[i
] = font
->driver
->encode_char (font
, c
);
4449 if (code
[i
] == FONT_INVALID_CODE
)
4452 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4454 if (font
->driver
->prepare_face
)
4455 font
->driver
->prepare_face (f
, face
);
4456 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4457 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4458 if (font
->driver
->done_face
)
4459 font
->driver
->done_face (f
, face
);
4461 return make_number (len
);
4465 #endif /* FONT_DEBUG */
4467 #ifdef HAVE_WINDOW_SYSTEM
4469 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4470 doc
: /* Return information about a font named NAME on frame FRAME.
4471 If FRAME is omitted or nil, use the selected frame.
4472 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4473 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4475 OPENED-NAME is the name used for opening the font,
4476 FULL-NAME is the full name of the font,
4477 SIZE is the maximum bound width of the font,
4478 HEIGHT is the height of the font,
4479 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4480 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4481 how to compose characters.
4482 If the named font is not yet loaded, return nil. */)
4484 Lisp_Object name
, frame
;
4489 Lisp_Object font_object
;
4491 (*check_window_system_func
) ();
4494 CHECK_STRING (name
);
4496 frame
= selected_frame
;
4497 CHECK_LIVE_FRAME (frame
);
4502 int fontset
= fs_query_fontset (name
, 0);
4505 name
= fontset_ascii (fontset
);
4506 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4508 else if (FONT_OBJECT_P (name
))
4510 else if (FONT_ENTITY_P (name
))
4511 font_object
= font_open_entity (f
, name
, 0);
4514 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4515 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4517 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4519 if (NILP (font_object
))
4521 font
= XFONT_OBJECT (font_object
);
4523 info
= Fmake_vector (make_number (7), Qnil
);
4524 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4525 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4526 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4527 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4528 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4529 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4530 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4533 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4534 close it now. Perhaps, we should manage font-objects
4535 by `reference-count'. */
4536 font_close_object (f
, font_object
);
4543 #define BUILD_STYLE_TABLE(TBL) \
4544 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4547 build_style_table (entry
, nelement
)
4548 struct table_entry
*entry
;
4552 Lisp_Object table
, elt
;
4554 table
= Fmake_vector (make_number (nelement
), Qnil
);
4555 for (i
= 0; i
< nelement
; i
++)
4557 for (j
= 0; entry
[i
].names
[j
]; j
++);
4558 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4559 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4560 for (j
= 0; entry
[i
].names
[j
]; j
++)
4561 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4562 ASET (table
, i
, elt
);
4567 static Lisp_Object Vfont_log
;
4568 static int font_log_env_checked
;
4571 font_add_log (action
, arg
, result
)
4573 Lisp_Object arg
, result
;
4575 Lisp_Object tail
, val
;
4578 if (! font_log_env_checked
)
4580 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
4581 font_log_env_checked
= 1;
4583 if (EQ (Vfont_log
, Qt
))
4586 arg
= Ffont_xlfd_name (arg
, Qt
);
4588 result
= Ffont_xlfd_name (result
, Qt
);
4589 else if (CONSP (result
))
4591 result
= Fcopy_sequence (result
);
4592 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4596 val
= Ffont_xlfd_name (val
, Qt
);
4597 XSETCAR (tail
, val
);
4600 else if (VECTORP (result
))
4602 result
= Fcopy_sequence (result
);
4603 for (i
= 0; i
< ASIZE (result
); i
++)
4605 val
= AREF (result
, i
);
4607 val
= Ffont_xlfd_name (val
, Qt
);
4608 ASET (result
, i
, val
);
4611 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4614 extern void syms_of_ftfont
P_ (());
4615 extern void syms_of_xfont
P_ (());
4616 extern void syms_of_xftfont
P_ (());
4617 extern void syms_of_ftxfont
P_ (());
4618 extern void syms_of_bdffont
P_ (());
4619 extern void syms_of_w32font
P_ (());
4620 extern void syms_of_atmfont
P_ (());
4625 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
4626 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
4627 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
4628 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
4629 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
4630 /* Note that the other elements in sort_shift_bits are not used. */
4632 staticpro (&font_charset_alist
);
4633 font_charset_alist
= Qnil
;
4635 DEFSYM (Qfont_spec
, "font-spec");
4636 DEFSYM (Qfont_entity
, "font-entity");
4637 DEFSYM (Qfont_object
, "font-object");
4639 DEFSYM (Qopentype
, "opentype");
4641 DEFSYM (Qascii_0
, "ascii-0");
4642 DEFSYM (Qiso8859_1
, "iso8859-1");
4643 DEFSYM (Qiso10646_1
, "iso10646-1");
4644 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4645 DEFSYM (Qunicode_sip
, "unicode-sip");
4647 DEFSYM (QCotf
, ":otf");
4648 DEFSYM (QClang
, ":lang");
4649 DEFSYM (QCscript
, ":script");
4650 DEFSYM (QCantialias
, ":antialias");
4652 DEFSYM (QCfoundry
, ":foundry");
4653 DEFSYM (QCadstyle
, ":adstyle");
4654 DEFSYM (QCregistry
, ":registry");
4655 DEFSYM (QCspacing
, ":spacing");
4656 DEFSYM (QCdpi
, ":dpi");
4657 DEFSYM (QCscalable
, ":scalable");
4658 DEFSYM (QCavgwidth
, ":avgwidth");
4659 DEFSYM (QCfont_entity
, ":font-entity");
4660 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
4667 staticpro (&null_vector
);
4668 null_vector
= Fmake_vector (make_number (0), Qnil
);
4670 staticpro (&scratch_font_spec
);
4671 scratch_font_spec
= Ffont_spec (0, NULL
);
4672 staticpro (&scratch_font_prefer
);
4673 scratch_font_prefer
= Ffont_spec (0, NULL
);
4677 staticpro (&otf_list
);
4679 #endif /* HAVE_LIBOTF */
4683 defsubr (&Sfont_spec
);
4684 defsubr (&Sfont_get
);
4685 defsubr (&Sfont_put
);
4686 defsubr (&Slist_fonts
);
4687 defsubr (&Sfont_family_list
);
4688 defsubr (&Sfind_font
);
4689 defsubr (&Sfont_xlfd_name
);
4690 defsubr (&Sclear_font_cache
);
4691 defsubr (&Sfont_make_gstring
);
4692 defsubr (&Sfont_fill_gstring
);
4693 defsubr (&Sfont_shape_text
);
4695 defsubr (&Sfont_drive_otf
);
4696 defsubr (&Sfont_otf_alternates
);
4700 defsubr (&Sopen_font
);
4701 defsubr (&Sclose_font
);
4702 defsubr (&Squery_font
);
4703 defsubr (&Sget_font_glyphs
);
4704 defsubr (&Sfont_match_p
);
4705 defsubr (&Sfont_at
);
4707 defsubr (&Sdraw_string
);
4709 #endif /* FONT_DEBUG */
4710 #ifdef HAVE_WINDOW_SYSTEM
4711 defsubr (&Sfont_info
);
4714 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
4716 Alist of fontname patterns vs the corresponding encoding and repertory info.
4717 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
4718 where ENCODING is a charset or a char-table,
4719 and REPERTORY is a charset, a char-table, or nil.
4721 If ENCODING and REPERTORY are the same, the element can have the form
4722 \(REGEXP . ENCODING).
4724 ENCODING is for converting a character to a glyph code of the font.
4725 If ENCODING is a charset, encoding a character by the charset gives
4726 the corresponding glyph code. If ENCODING is a char-table, looking up
4727 the table by a character gives the corresponding glyph code.
4729 REPERTORY specifies a repertory of characters supported by the font.
4730 If REPERTORY is a charset, all characters beloging to the charset are
4731 supported. If REPERTORY is a char-table, all characters who have a
4732 non-nil value in the table are supported. If REPERTORY is nil, Emacs
4733 gets the repertory information by an opened font and ENCODING. */);
4734 Vfont_encoding_alist
= Qnil
;
4736 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
4737 doc
: /* Vector of valid font weight values.
4738 Each element has the form:
4739 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
4740 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symobls. */);
4741 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
4743 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
4744 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
4745 See `font-weight_table' for the format of the vector. */);
4746 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
4748 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
4749 doc
: /* Alist of font width symbols vs the corresponding numeric values.
4750 See `font-weight_table' for the format of the vector. */);
4751 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
4753 staticpro (&font_style_table
);
4754 font_style_table
= Fmake_vector (make_number (3), Qnil
);
4755 ASET (font_style_table
, 0, Vfont_weight_table
);
4756 ASET (font_style_table
, 1, Vfont_slant_table
);
4757 ASET (font_style_table
, 2, Vfont_width_table
);
4759 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
4760 *Logging list of font related actions and results.
4761 The value t means to suppress the logging.
4762 The initial value is set to nil if the environment variable
4763 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
4766 #ifdef HAVE_WINDOW_SYSTEM
4767 #ifdef HAVE_FREETYPE
4769 #ifdef HAVE_X_WINDOWS
4774 #endif /* HAVE_XFT */
4775 #endif /* HAVE_X_WINDOWS */
4776 #else /* not HAVE_FREETYPE */
4777 #ifdef HAVE_X_WINDOWS
4779 #endif /* HAVE_X_WINDOWS */
4780 #endif /* not HAVE_FREETYPE */
4783 #endif /* HAVE_BDFFONT */
4786 #endif /* WINDOWSNT */
4790 #endif /* HAVE_WINDOW_SYSTEM */
4793 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
4794 (do not change this comment) */