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);
2120 /* This is to prefer the exact symbol style. */
2122 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2125 /* Score the size. Maximum difference is 127. */
2126 i
= FONT_SIZE_INDEX
;
2127 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
])
2128 && XINT (AREF (entity
, i
)) > 0)
2130 /* We use the higher 6-bit for the actual size difference. The
2131 lowest bit is set if the DPI is different. */
2132 int diff
= XINT (spec_prop
[i
]) - XINT (AREF (entity
, i
));
2137 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
2138 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
2140 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
2147 /* The comparison function for qsort. */
2150 font_compare (d1
, d2
)
2151 const void *d1
, *d2
;
2153 return (*(unsigned *) d1
- *(unsigned *) d2
);
2157 /* The structure for elements being sorted by qsort. */
2158 struct font_sort_data
2165 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2166 If PREFER specifies a point-size, calculate the corresponding
2167 pixel-size from QCdpi property of PREFER or from the Y-resolution
2168 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
2169 get the font-entities in VEC.
2171 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2172 return the sorted VEC. */
2175 font_sort_entites (vec
, prefer
, frame
, spec
, best_only
)
2176 Lisp_Object vec
, prefer
, frame
, spec
;
2179 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2181 struct font_sort_data
*data
;
2182 unsigned best_score
;
2183 Lisp_Object best_entity
, driver_type
;
2185 struct frame
*f
= XFRAME (frame
);
2186 struct font_driver_list
*list
;
2191 return best_only
? AREF (vec
, 0) : vec
;
2193 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2194 prefer_prop
[i
] = AREF (prefer
, i
);
2198 /* A font driver may return a font that has a property value
2199 different from the value specified in SPEC if the driver
2200 thinks they are the same. That happens, for instance, such a
2201 generic family name as "serif" is specified. So, to ignore
2202 such a difference, for all properties specified in SPEC, set
2203 the corresponding properties in PREFER_PROP to nil. */
2204 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2205 if (! NILP (AREF (spec
, i
)))
2206 prefer_prop
[i
] = Qnil
;
2209 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2210 prefer_prop
[FONT_SIZE_INDEX
]
2211 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2213 /* Scoring and sorting. */
2214 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2215 best_score
= 0xFFFFFFFF;
2216 /* We are sure that the length of VEC > 1. */
2217 driver_type
= AREF (AREF (vec
, 0), FONT_TYPE_INDEX
);
2218 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2219 driver_order
++, list
= list
->next
)
2220 if (EQ (driver_type
, list
->driver
->type
))
2222 best_entity
= data
[0].entity
= AREF (vec
, 0);
2223 best_score
= data
[0].score
2224 = font_score (data
[0].entity
, prefer_prop
) | driver_order
;
2225 for (i
= 0; i
< len
; i
++)
2227 if (!EQ (driver_type
, AREF (AREF (vec
, i
), FONT_TYPE_INDEX
)))
2228 for (driver_order
= 0, list
= f
->font_driver_list
; list
;
2229 driver_order
++, list
= list
->next
)
2230 if (EQ (driver_type
, list
->driver
->type
))
2232 data
[i
].entity
= AREF (vec
, i
);
2233 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
) | driver_order
;
2234 if (best_only
&& best_score
> data
[i
].score
)
2236 best_score
= data
[i
].score
;
2237 best_entity
= data
[i
].entity
;
2238 if (best_score
== 0)
2242 if (NILP (best_entity
))
2244 qsort (data
, len
, sizeof *data
, font_compare
);
2245 for (i
= 0; i
< len
; i
++)
2246 ASET (vec
, i
, data
[i
].entity
);
2252 font_add_log ("sort-by", prefer
, vec
);
2257 /* API of Font Service Layer. */
2259 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2260 sort_shift_bits. Finternal_set_font_selection_order calls this
2261 function with font_sort_order after setting up it. */
2264 font_update_sort_order (order
)
2269 for (i
= 0, shift_bits
= 23; i
< 4; i
++, shift_bits
-= 7)
2271 int xlfd_idx
= order
[i
];
2273 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2274 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2275 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2276 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2277 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2278 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2280 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2285 /* Check if ENTITY matches with the font specification SPEC. */
2288 font_match_p (spec
, entity
)
2289 Lisp_Object spec
, entity
;
2291 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2292 Lisp_Object alternate_families
= Qnil
;
2295 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2296 prefer_prop
[i
] = AREF (spec
, i
);
2297 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2298 prefer_prop
[FONT_SIZE_INDEX
]
2299 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2300 if (! NILP (prefer_prop
[FONT_FAMILY_INDEX
]))
2303 = Fassoc_string (prefer_prop
[FONT_FAMILY_INDEX
],
2304 Vface_alternative_font_family_alist
, Qt
);
2305 if (CONSP (alternate_families
))
2306 alternate_families
= XCDR (alternate_families
);
2309 return (font_score (entity
, prefer_prop
) == 0);
2313 /* CHeck a lispy font object corresponding to FONT. */
2316 font_check_object (font
)
2319 Lisp_Object tail
, elt
;
2321 for (tail
= font
->props
[FONT_OBJLIST_INDEX
]; CONSP (tail
);
2325 if (font
== XFONT_OBJECT (elt
))
2335 Each font backend has the callback function get_cache, and it
2336 returns a cons cell of which cdr part can be freely used for
2337 caching fonts. The cons cell may be shared by multiple frames
2338 and/or multiple font drivers. So, we arrange the cdr part as this:
2340 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2342 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2343 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2344 cons (FONT-SPEC FONT-ENTITY ...). */
2346 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2347 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2348 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2349 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2350 struct font_driver
*));
2353 font_prepare_cache (f
, driver
)
2355 struct font_driver
*driver
;
2357 Lisp_Object cache
, val
;
2359 cache
= driver
->get_cache (f
);
2361 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2365 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2366 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2370 val
= XCDR (XCAR (val
));
2371 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2377 font_finish_cache (f
, driver
)
2379 struct font_driver
*driver
;
2381 Lisp_Object cache
, val
, tmp
;
2384 cache
= driver
->get_cache (f
);
2386 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2387 cache
= val
, val
= XCDR (val
);
2388 font_assert (! NILP (val
));
2389 tmp
= XCDR (XCAR (val
));
2390 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2391 if (XINT (XCAR (tmp
)) == 0)
2393 font_clear_cache (f
, XCAR (val
), driver
);
2394 XSETCDR (cache
, XCDR (val
));
2400 font_get_cache (f
, driver
)
2402 struct font_driver
*driver
;
2404 Lisp_Object val
= driver
->get_cache (f
);
2405 Lisp_Object type
= driver
->type
;
2407 font_assert (CONSP (val
));
2408 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2409 font_assert (CONSP (val
));
2410 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2411 val
= XCDR (XCAR (val
));
2415 static int num_fonts
;
2418 font_clear_cache (f
, cache
, driver
)
2421 struct font_driver
*driver
;
2423 Lisp_Object tail
, elt
;
2425 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2426 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2429 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)) && VECTORP (XCDR (elt
)))
2431 Lisp_Object vec
= XCDR (elt
);
2434 for (i
= 0; i
< ASIZE (vec
); i
++)
2436 Lisp_Object entity
= AREF (vec
, i
);
2438 if (EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2440 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2442 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2444 Lisp_Object val
= XCAR (objlist
);
2445 struct font
*font
= XFONT_OBJECT (val
);
2447 font_assert (font
&& driver
== font
->driver
);
2448 driver
->close (f
, font
);
2451 if (driver
->free_entity
)
2452 driver
->free_entity (entity
);
2457 XSETCDR (cache
, Qnil
);
2461 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2464 font_delete_unmatched (list
, spec
, size
)
2465 Lisp_Object list
, spec
;
2468 Lisp_Object entity
, val
;
2469 enum font_property_index prop
;
2471 for (val
= Qnil
; CONSP (list
); list
= XCDR (list
))
2473 entity
= XCAR (list
);
2474 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2475 if (INTEGERP (AREF (spec
, prop
))
2476 && ((XINT (AREF (spec
, prop
)) >> 8)
2477 != (XINT (AREF (entity
, prop
)) >> 8)))
2478 prop
= FONT_SPEC_MAX
;
2479 if (prop
++ <= FONT_SIZE_INDEX
2481 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2483 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2486 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2487 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2488 prop
= FONT_SPEC_MAX
;
2490 if (prop
< FONT_SPEC_MAX
)
2491 val
= Fcons (entity
, val
);
2497 /* Return a vector of font-entities matching with SPEC on FRAME. */
2500 font_list_entities (frame
, spec
)
2501 Lisp_Object frame
, spec
;
2503 FRAME_PTR f
= XFRAME (frame
);
2504 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2505 Lisp_Object ftype
, val
;
2508 int need_filtering
= 0;
2511 font_assert (FONT_SPEC_P (spec
));
2513 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2514 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2515 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2516 size
= font_pixel_size (f
, spec
);
2520 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2521 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2522 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2523 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
2525 ASET (scratch_font_spec
, i
, Qnil
);
2526 if (! NILP (AREF (spec
, i
)))
2528 if (i
== FONT_DPI_INDEX
)
2529 /* Skip FONT_SPACING_INDEX */
2532 ASET (scratch_font_spec
, FONT_SPACING_INDEX
, AREF (spec
, FONT_SPACING_INDEX
));
2533 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2535 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2539 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2541 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2543 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2545 ASET (scratch_font_spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2546 val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2553 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2554 copy
= Fcopy_font_spec (scratch_font_spec
);
2555 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2556 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2558 if (! NILP (val
) && need_filtering
)
2559 val
= font_delete_unmatched (val
, spec
, size
);
2564 val
= (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2565 font_add_log ("list", spec
, val
);
2570 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2571 nil, is an array of face's attributes, which specifies preferred
2572 font-related attributes. */
2575 font_matching_entity (f
, attrs
, spec
)
2577 Lisp_Object
*attrs
, spec
;
2579 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2580 Lisp_Object ftype
, size
, entity
;
2583 XSETFRAME (frame
, f
);
2584 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2585 size
= AREF (spec
, FONT_SIZE_INDEX
);
2587 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2589 for (; driver_list
; driver_list
= driver_list
->next
)
2591 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2593 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2596 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2597 entity
= assoc_no_quit (spec
, XCDR (cache
));
2599 entity
= XCDR (entity
);
2602 entity
= driver_list
->driver
->match (frame
, spec
);
2603 copy
= Fcopy_font_spec (spec
);
2604 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2605 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2607 if (! NILP (entity
))
2610 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2611 ASET (spec
, FONT_SIZE_INDEX
, size
);
2612 font_add_log ("match", spec
, entity
);
2617 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2618 opened font object. */
2621 font_open_entity (f
, entity
, pixel_size
)
2626 struct font_driver_list
*driver_list
;
2627 Lisp_Object objlist
, size
, val
, font_object
;
2631 font_assert (FONT_ENTITY_P (entity
));
2632 size
= AREF (entity
, FONT_SIZE_INDEX
);
2633 if (XINT (size
) != 0)
2634 pixel_size
= XINT (size
);
2636 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2637 objlist
= XCDR (objlist
))
2638 if (XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2639 return XCAR (objlist
);
2641 val
= AREF (entity
, FONT_TYPE_INDEX
);
2642 for (driver_list
= f
->font_driver_list
;
2643 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2644 driver_list
= driver_list
->next
);
2648 font_object
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2649 font_add_log ("open", entity
, font_object
);
2650 if (NILP (font_object
))
2652 ASET (entity
, FONT_OBJLIST_INDEX
,
2653 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2654 ASET (font_object
, FONT_OBJLIST_INDEX
, AREF (entity
, FONT_OBJLIST_INDEX
));
2657 font
= XFONT_OBJECT (font_object
);
2658 min_width
= (font
->min_width
? font
->min_width
2659 : font
->average_width
? font
->average_width
2660 : font
->space_width
? font
->space_width
2662 #ifdef HAVE_WINDOW_SYSTEM
2663 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2664 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2666 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2667 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
;
2668 fonts_changed_p
= 1;
2672 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2673 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2674 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > font
->height
)
2675 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
, fonts_changed_p
= 1;
2683 /* Close FONT_OBJECT that is opened on frame F. */
2686 font_close_object (f
, font_object
)
2688 Lisp_Object font_object
;
2690 struct font
*font
= XFONT_OBJECT (font_object
);
2691 Lisp_Object objlist
;
2692 Lisp_Object tail
, prev
= Qnil
;
2694 objlist
= AREF (font_object
, FONT_OBJLIST_INDEX
);
2695 for (prev
= Qnil
, tail
= objlist
; CONSP (tail
);
2696 prev
= tail
, tail
= XCDR (tail
))
2697 if (EQ (font_object
, XCAR (tail
)))
2699 font_add_log ("close", font_object
, Qnil
);
2700 font
->driver
->close (f
, font
);
2701 #ifdef HAVE_WINDOW_SYSTEM
2702 font_assert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2703 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2706 ASET (font_object
, FONT_OBJLIST_INDEX
, XCDR (objlist
));
2708 XSETCDR (prev
, XCDR (objlist
));
2716 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2717 FONT is a font-entity and it must be opened to check. */
2720 font_has_char (f
, font
, c
)
2727 if (FONT_ENTITY_P (font
))
2729 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2730 struct font_driver_list
*driver_list
;
2732 for (driver_list
= f
->font_driver_list
;
2733 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2734 driver_list
= driver_list
->next
);
2737 if (! driver_list
->driver
->has_char
)
2739 return driver_list
->driver
->has_char (font
, c
);
2742 font_assert (FONT_OBJECT_P (font
));
2743 fontp
= XFONT_OBJECT (font
);
2744 if (fontp
->driver
->has_char
)
2746 int result
= fontp
->driver
->has_char (font
, c
);
2751 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2755 /* Return the glyph ID of FONT_OBJECT for character C. */
2758 font_encode_char (font_object
, c
)
2759 Lisp_Object font_object
;
2764 font_assert (FONT_OBJECT_P (font_object
));
2765 font
= XFONT_OBJECT (font_object
);
2766 return font
->driver
->encode_char (font
, c
);
2770 /* Return the name of FONT_OBJECT. */
2773 font_get_name (font_object
)
2774 Lisp_Object font_object
;
2776 font_assert (FONT_OBJECT_P (font_object
));
2777 return AREF (font_object
, FONT_NAME_INDEX
);
2781 /* Return the specification of FONT_OBJECT. */
2784 font_get_spec (font_object
)
2785 Lisp_Object font_object
;
2787 Lisp_Object spec
= font_make_spec ();
2790 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2791 ASET (spec
, i
, AREF (font_object
, i
));
2792 ASET (spec
, FONT_SIZE_INDEX
,
2793 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2798 font_spec_from_name (font_name
)
2799 Lisp_Object font_name
;
2801 Lisp_Object args
[2];
2804 args
[1] = font_name
;
2805 return Ffont_spec (2, args
);
2810 font_clear_prop (attrs
, prop
)
2812 enum font_property_index prop
;
2814 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2818 if (NILP (AREF (font
, prop
))
2819 && prop
!= FONT_FAMILY_INDEX
&& prop
!= FONT_FOUNDRY_INDEX
2820 && prop
!= FONT_SIZE_INDEX
)
2822 font
= Fcopy_font_spec (font
);
2823 ASET (font
, prop
, Qnil
);
2824 if (prop
== FONT_FAMILY_INDEX
|| prop
== FONT_FOUNDRY_INDEX
)
2826 if (prop
== FONT_FAMILY_INDEX
)
2827 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
2828 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
2829 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
2830 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
2831 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2832 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2833 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2835 else if (prop
== FONT_SIZE_INDEX
)
2837 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2838 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2839 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2841 attrs
[LFACE_FONT_INDEX
] = font
;
2845 font_update_lface (f
, attrs
)
2851 spec
= attrs
[LFACE_FONT_INDEX
];
2852 if (! FONT_SPEC_P (spec
))
2855 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
2856 attrs
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
));
2857 if (! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2858 attrs
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
));
2859 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
2860 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
2861 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
2862 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);;
2863 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
2864 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
2865 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
2869 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2874 val
= Ffont_get (spec
, QCdpi
);
2877 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
2880 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2881 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
2882 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
2887 /* Return a font-entity satisfying SPEC and best matching with face's
2888 font related attributes in ATTRS. C, if not negative, is a
2889 character that the entity must support. */
2892 font_find_for_lface (f
, attrs
, spec
, c
)
2899 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
2900 Lisp_Object size
, foundry
[3], *family
;
2904 if (c
>= 0 && ! NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
2906 struct charset
*encoding
, *repertory
;
2908 if (font_registry_charsets (AREF (spec
, FONT_REGISTRY_INDEX
),
2909 &encoding
, &repertory
) < 0)
2913 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
2915 /* Any font of this registry support C. So, let's
2916 suppress the further checking. */
2919 else if (c
> encoding
->max_char
)
2923 work
= Fcopy_font_spec (spec
);
2924 XSETFRAME (frame
, f
);
2925 size
= AREF (spec
, FONT_SIZE_INDEX
);
2926 pixel_size
= font_pixel_size (f
, spec
);
2927 if (pixel_size
== 0)
2929 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
2931 pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
2933 ASET (work
, FONT_SIZE_INDEX
, Qnil
);
2934 foundry
[0] = AREF (work
, FONT_FOUNDRY_INDEX
);
2935 if (! NILP (foundry
[0]))
2936 foundry
[1] = null_vector
;
2937 else if (STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]))
2939 foundry
[0] = font_intern_prop (SDATA (attrs
[LFACE_FOUNDRY_INDEX
]),
2940 SBYTES (attrs
[LFACE_FOUNDRY_INDEX
]), 1);
2942 foundry
[2] = null_vector
;
2945 foundry
[0] = Qnil
, foundry
[1] = null_vector
;
2947 val
= AREF (work
, FONT_FAMILY_INDEX
);
2948 if (NILP (val
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
2949 val
= font_intern_prop (SDATA (attrs
[LFACE_FAMILY_INDEX
]),
2950 SBYTES (attrs
[LFACE_FAMILY_INDEX
]), 1);
2953 family
= alloca ((sizeof family
[0]) * 2);
2955 family
[1] = null_vector
; /* terminator. */
2960 = Fassoc_string (val
, Vface_alternative_font_family_alist
, Qt
);
2962 if (! NILP (alters
))
2964 family
= alloca ((sizeof family
[0]) * (XINT (Flength (alters
)) + 2));
2965 for (i
= 0; CONSP (alters
); i
++, alters
= XCDR (alters
))
2966 family
[i
] = XCAR (alters
);
2967 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2969 family
[i
] = null_vector
;
2973 family
= alloca ((sizeof family
[0]) * 3);
2976 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2978 family
[i
] = null_vector
;
2982 for (j
= 0; SYMBOLP (family
[j
]); j
++)
2984 ASET (work
, FONT_FAMILY_INDEX
, family
[j
]);
2985 for (i
= 0; SYMBOLP (foundry
[i
]); i
++)
2987 ASET (work
, FONT_FOUNDRY_INDEX
, foundry
[i
]);
2988 entities
= font_list_entities (frame
, work
);
2989 if (ASIZE (entities
) > 0)
2992 if (ASIZE (entities
) > 0)
2995 if (ASIZE (entities
) == 0)
2997 if (ASIZE (entities
) == 1)
3000 return AREF (entities
, 0);
3004 /* Sort fonts by properties specified in LFACE. */
3005 Lisp_Object prefer
= scratch_font_prefer
;
3007 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3008 ASET (prefer
, i
, AREF (work
, i
));
3009 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
3011 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
3013 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3014 if (NILP (AREF (prefer
, i
)))
3015 ASET (prefer
, i
, AREF (face_font
, i
));
3017 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
3018 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
3019 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
3020 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
3021 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
3022 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
3023 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
3024 entities
= font_sort_entites (entities
, prefer
, frame
, work
, c
< 0);
3029 for (i
= 0; i
< ASIZE (entities
); i
++)
3033 val
= AREF (entities
, i
);
3036 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3037 if (! EQ (AREF (val
, j
), props
[j
]))
3039 if (j
> FONT_REGISTRY_INDEX
)
3042 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
3043 props
[j
] = AREF (val
, j
);
3044 result
= font_has_char (f
, val
, c
);
3049 val
= font_open_for_lface (f
, val
, attrs
, spec
);
3052 result
= font_has_char (f
, val
, c
);
3053 font_close_object (f
, val
);
3055 return AREF (entities
, i
);
3062 font_open_for_lface (f
, entity
, attrs
, spec
)
3070 if (INTEGERP (AREF (entity
, FONT_SIZE_INDEX
))
3071 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
3072 size
= XINT (AREF (entity
, FONT_SIZE_INDEX
));
3073 else if (FONT_SPEC_P (spec
) && ! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
3074 size
= font_pixel_size (f
, spec
);
3077 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
3080 size
= POINT_TO_PIXEL (pt
, f
->resy
);
3082 return font_open_entity (f
, entity
, size
);
3086 /* Find a font satisfying SPEC and best matching with face's
3087 attributes in ATTRS on FRAME, and return the opened
3091 font_load_for_lface (f
, attrs
, spec
)
3093 Lisp_Object
*attrs
, spec
;
3097 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
3100 /* No font is listed for SPEC, but each font-backend may have
3101 the different criteria about "font matching". So, try
3103 entity
= font_matching_entity (f
, attrs
, spec
);
3107 return font_open_for_lface (f
, entity
, attrs
, spec
);
3111 /* Make FACE on frame F ready to use the font opened for FACE. */
3114 font_prepare_for_face (f
, face
)
3118 if (face
->font
->driver
->prepare_face
)
3119 face
->font
->driver
->prepare_face (f
, face
);
3123 /* Make FACE on frame F stop using the font opened for FACE. */
3126 font_done_for_face (f
, face
)
3130 if (face
->font
->driver
->done_face
)
3131 face
->font
->driver
->done_face (f
, face
);
3136 /* Open a font best matching with NAME on frame F. If no proper font
3137 is found, return Qnil. */
3140 font_open_by_name (f
, name
)
3144 Lisp_Object args
[2];
3145 Lisp_Object spec
, attrs
[LFACE_VECTOR_SIZE
];
3148 args
[1] = make_unibyte_string (name
, strlen (name
));
3149 spec
= Ffont_spec (2, args
);
3150 /* We set up the default font-related attributes of a face to prefer
3152 attrs
[LFACE_FAMILY_INDEX
] = attrs
[LFACE_FOUNDRY_INDEX
] = Qnil
;
3153 attrs
[LFACE_SWIDTH_INDEX
] = attrs
[LFACE_WEIGHT_INDEX
]
3154 = attrs
[LFACE_SLANT_INDEX
] = Qnormal
;
3155 attrs
[LFACE_HEIGHT_INDEX
] = make_number (120);
3156 attrs
[LFACE_FONT_INDEX
] = Qnil
;
3158 return font_load_for_lface (f
, attrs
, spec
);
3162 /* Register font-driver DRIVER. This function is used in two ways.
3164 The first is with frame F non-NULL. In this case, make DRIVER
3165 available (but not yet activated) on F. All frame creaters
3166 (e.g. Fx_create_frame) must call this function at least once with
3167 an available font-driver.
3169 The second is with frame F NULL. In this case, DRIVER is globally
3170 registered in the variable `font_driver_list'. All font-driver
3171 implementations must call this function in its syms_of_XXXX
3172 (e.g. syms_of_xfont). */
3175 register_font_driver (driver
, f
)
3176 struct font_driver
*driver
;
3179 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3180 struct font_driver_list
*prev
, *list
;
3182 if (f
&& ! driver
->draw
)
3183 error ("Unusable font driver for a frame: %s",
3184 SDATA (SYMBOL_NAME (driver
->type
)));
3186 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3187 if (EQ (list
->driver
->type
, driver
->type
))
3188 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3190 list
= malloc (sizeof (struct font_driver_list
));
3192 list
->driver
= driver
;
3197 f
->font_driver_list
= list
;
3199 font_driver_list
= list
;
3205 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3206 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3207 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3209 A caller must free all realized faces if any in advance. The
3210 return value is a list of font backends actually made used on
3214 font_update_drivers (f
, new_drivers
)
3216 Lisp_Object new_drivers
;
3218 Lisp_Object active_drivers
= Qnil
;
3219 struct font_driver
*driver
;
3220 struct font_driver_list
*list
;
3222 /* At first, turn off non-requested drivers, and turn on requested
3224 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3226 driver
= list
->driver
;
3227 if ((EQ (new_drivers
, Qt
) || ! NILP (Fmemq (driver
->type
, new_drivers
)))
3232 if (driver
->end_for_frame
)
3233 driver
->end_for_frame (f
);
3234 font_finish_cache (f
, driver
);
3239 if (! driver
->start_for_frame
3240 || driver
->start_for_frame (f
) == 0)
3242 font_prepare_cache (f
, driver
);
3249 if (NILP (new_drivers
))
3252 if (! EQ (new_drivers
, Qt
))
3254 /* Re-order the driver list according to new_drivers. */
3255 struct font_driver_list
**list_table
, *list
;
3259 list_table
= alloca (sizeof list_table
[0] * (num_font_drivers
+ 1));
3260 for (i
= 0, tail
= new_drivers
; ! NILP (tail
); tail
= XCDR (tail
))
3262 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3263 if (list
->on
&& EQ (list
->driver
->type
, XCAR (tail
)))
3266 list_table
[i
++] = list
;
3268 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3270 list_table
[i
] = list
;
3271 list_table
[i
] = NULL
;
3273 f
->font_driver_list
= list
= NULL
;
3274 for (i
= 0; list_table
[i
]; i
++)
3277 list
->next
= list_table
[i
], list
= list
->next
;
3279 f
->font_driver_list
= list
= list_table
[i
];
3284 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3286 active_drivers
= nconc2 (active_drivers
,
3287 Fcons (list
->driver
->type
, Qnil
));
3288 return active_drivers
;
3292 font_put_frame_data (f
, driver
, data
)
3294 struct font_driver
*driver
;
3297 struct font_data_list
*list
, *prev
;
3299 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3300 prev
= list
, list
= list
->next
)
3301 if (list
->driver
== driver
)
3308 prev
->next
= list
->next
;
3310 f
->font_data_list
= list
->next
;
3318 list
= malloc (sizeof (struct font_data_list
));
3321 list
->driver
= driver
;
3322 list
->next
= f
->font_data_list
;
3323 f
->font_data_list
= list
;
3331 font_get_frame_data (f
, driver
)
3333 struct font_driver
*driver
;
3335 struct font_data_list
*list
;
3337 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3338 if (list
->driver
== driver
)
3346 /* Return the font used to draw character C by FACE at buffer position
3347 POS in window W. If STRING is non-nil, it is a string containing C
3348 at index POS. If C is negative, get C from the current buffer or
3352 font_at (c
, pos
, face
, w
, string
)
3361 Lisp_Object font_object
;
3367 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3370 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3372 c
= FETCH_CHAR (pos_byte
);
3375 c
= FETCH_BYTE (pos
);
3381 multibyte
= STRING_MULTIBYTE (string
);
3384 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3386 str
= SDATA (string
) + pos_byte
;
3387 c
= STRING_CHAR (str
, 0);
3390 c
= SDATA (string
)[pos
];
3394 f
= XFRAME (w
->frame
);
3395 if (! FRAME_WINDOW_P (f
))
3402 if (STRINGP (string
))
3403 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3404 DEFAULT_FACE_ID
, 0);
3406 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3408 face
= FACE_FROM_ID (f
, face_id
);
3412 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3413 face
= FACE_FROM_ID (f
, face_id
);
3418 font_assert (font_check_object ((struct font
*) face
->font
));
3419 XSETFONT (font_object
, face
->font
);
3424 /* Check how many characters after POS (at most to LIMIT) can be
3425 displayed by the same font. FACE is the face selected for the
3426 character as POS on frame F. STRING, if not nil, is the string to
3427 check instead of the current buffer.
3429 The return value is the position of the character that is displayed
3430 by the differnt font than that of the character as POS. */
3433 font_range (pos
, limit
, face
, f
, string
)
3434 EMACS_INT pos
, limit
;
3447 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3448 pos_byte
= CHAR_TO_BYTE (pos
);
3452 multibyte
= STRING_MULTIBYTE (string
);
3453 pos_byte
= string_char_to_byte (string
, pos
);
3457 /* All unibyte character are displayed by the same font. */
3465 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3467 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3468 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3469 face
= FACE_FROM_ID (f
, face_id
);
3476 else if (font
!= face
->font
)
3488 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3489 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3490 Return nil otherwise.
3491 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3492 which kind of font it is. It must be one of `font-spec', `font-entity',
3494 (object
, extra_type
)
3495 Lisp_Object object
, extra_type
;
3497 if (NILP (extra_type
))
3498 return (FONTP (object
) ? Qt
: Qnil
);
3499 if (EQ (extra_type
, Qfont_spec
))
3500 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3501 if (EQ (extra_type
, Qfont_entity
))
3502 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3503 if (EQ (extra_type
, Qfont_object
))
3504 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3505 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3508 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3509 doc
: /* Return a newly created font-spec with arguments as properties.
3511 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3512 valid font property name listed below:
3514 `:family', `:weight', `:slant', `:width'
3516 They are the same as face attributes of the same name. See
3517 `set-face-attribute'.
3521 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3525 VALUE must be a string or a symbol specifying the additional
3526 typographic style information of a font, e.g. ``sans''.
3530 VALUE must be a string or a symbol specifying the charset registry and
3531 encoding of a font, e.g. ``iso8859-1''.
3535 VALUE must be a non-negative integer or a floating point number
3536 specifying the font size. It specifies the font size in pixels
3537 (if VALUE is an integer), or in points (if VALUE is a float).
3538 usage: (font-spec ARGS ...) */)
3543 Lisp_Object spec
= font_make_spec ();
3546 for (i
= 0; i
< nargs
; i
+= 2)
3548 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3550 if (EQ (key
, QCname
))
3553 font_parse_name ((char *) SDATA (val
), spec
);
3554 font_put_extra (spec
, key
, val
);
3558 int idx
= get_font_prop_index (key
);
3562 val
= font_prop_validate (idx
, Qnil
, val
);
3563 if (idx
< FONT_EXTRA_INDEX
)
3564 ASET (spec
, idx
, val
);
3566 font_put_extra (spec
, key
, val
);
3569 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3575 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3576 doc
: /* Return a copy of FONT as a font-spec. */)
3580 Lisp_Object new_spec
, tail
, extra
;
3584 new_spec
= font_make_spec ();
3585 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3586 ASET (new_spec
, i
, AREF (font
, i
));
3588 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3590 if (! EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3591 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3593 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3597 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3598 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3599 Every specified properties in FROM override the corresponding
3600 properties in TO. */)
3602 Lisp_Object from
, to
;
3604 Lisp_Object extra
, tail
;
3609 to
= Fcopy_font_spec (to
);
3610 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3611 ASET (to
, i
, AREF (from
, i
));
3612 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3613 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3614 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3616 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3619 XSETCDR (slot
, XCDR (XCAR (tail
)));
3621 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3623 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3627 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3628 doc
: /* Return the value of FONT's property KEY.
3629 FONT is a font-spec, a font-entity, or a font-object. */)
3631 Lisp_Object font
, key
;
3638 idx
= get_font_prop_index (key
);
3639 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3640 return AREF (font
, idx
);
3641 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3645 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3646 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
3647 (font_spec
, prop
, val
)
3648 Lisp_Object font_spec
, prop
, val
;
3652 CHECK_FONT_SPEC (font_spec
);
3653 idx
= get_font_prop_index (prop
);
3654 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3655 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
3657 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
3661 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3662 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3663 Optional 2nd argument FRAME specifies the target frame.
3664 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3665 Optional 4th argument PREFER, if non-nil, is a font-spec to
3666 control the order of the returned list. Fonts are sorted by
3667 how close they are to PREFER. */)
3668 (font_spec
, frame
, num
, prefer
)
3669 Lisp_Object font_spec
, frame
, num
, prefer
;
3671 Lisp_Object vec
, list
, tail
;
3675 frame
= selected_frame
;
3676 CHECK_LIVE_FRAME (frame
);
3677 CHECK_FONT_SPEC (font_spec
);
3685 if (! NILP (prefer
))
3686 CHECK_FONT_SPEC (prefer
);
3688 vec
= font_list_entities (frame
, font_spec
);
3693 return Fcons (AREF (vec
, 0), Qnil
);
3695 if (! NILP (prefer
))
3696 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
, 0);
3698 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3699 if (n
== 0 || n
> len
)
3701 for (i
= 1; i
< n
; i
++)
3703 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3705 XSETCDR (tail
, val
);
3711 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
3712 doc
: /* List available font families on the current frame.
3713 Optional argument FRAME, if non-nil, specifies the target frame. */)
3718 struct font_driver_list
*driver_list
;
3722 frame
= selected_frame
;
3723 CHECK_LIVE_FRAME (frame
);
3726 for (driver_list
= f
->font_driver_list
; driver_list
;
3727 driver_list
= driver_list
->next
)
3728 if (driver_list
->driver
->list_family
)
3730 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3736 Lisp_Object tail
= list
;
3738 for (; CONSP (val
); val
= XCDR (val
))
3739 if (NILP (Fmemq (XCAR (val
), tail
)))
3740 list
= Fcons (XCAR (val
), list
);
3746 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3747 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3748 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3750 Lisp_Object font_spec
, frame
;
3752 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3759 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 2, 0,
3760 doc
: /* Return XLFD name of FONT.
3761 FONT is a font-spec, font-entity, or font-object.
3762 If the name is too long for XLFD (maximum 255 chars), return nil.
3763 If the 2nd optional arg FOLD-WILDCARDS is non-nil,
3764 the consecutive wildcards are folded to one. */)
3765 (font
, fold_wildcards
)
3766 Lisp_Object font
, fold_wildcards
;
3773 if (FONT_OBJECT_P (font
))
3775 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
3777 if (STRINGP (font_name
)
3778 && SDATA (font_name
)[0] == '-')
3780 if (NILP (fold_wildcards
))
3782 strcpy (name
, (char *) SDATA (font_name
));
3785 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
3787 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3790 if (! NILP (fold_wildcards
))
3792 char *p0
= name
, *p1
;
3794 while ((p1
= strstr (p0
, "-*-*")))
3796 strcpy (p1
, p1
+ 2);
3801 return build_string (name
);
3804 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3805 doc
: /* Clear font cache. */)
3808 Lisp_Object list
, frame
;
3810 FOR_EACH_FRAME (list
, frame
)
3812 FRAME_PTR f
= XFRAME (frame
);
3813 struct font_driver_list
*driver_list
= f
->font_driver_list
;
3815 for (; driver_list
; driver_list
= driver_list
->next
)
3816 if (driver_list
->on
)
3818 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
3823 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
3825 font_assert (! NILP (val
));
3826 val
= XCDR (XCAR (val
));
3827 if (XINT (XCAR (val
)) == 0)
3829 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
3830 XSETCDR (cache
, XCDR (val
));
3838 /* The following three functions are still experimental. */
3840 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
3841 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
3842 FONT-OBJECT may be nil if it is not yet known.
3844 G-string is sequence of glyphs of a specific font,
3845 and is a vector of this form:
3846 [ HEADER GLYPH ... ]
3847 HEADER is a vector of this form:
3848 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
3850 FONT-OBJECT is a font-object for all glyphs in the g-string,
3851 WIDTH thru DESCENT are the metrics (in pixels) of the whole G-string.
3852 GLYPH is a vector of this form:
3853 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
3854 [ [X-OFF Y-OFF WADJUST] | nil] ]
3856 FROM-IDX and TO-IDX are used internally and should not be touched.
3857 C is the character of the glyph.
3858 CODE is the glyph-code of C in FONT-OBJECT.
3859 WIDTH thru DESCENT are the metrics (in pixels) of the glyph.
3860 X-OFF and Y-OFF are offests to the base position for the glyph.
3861 WADJUST is the adjustment to the normal width of the glyph. */)
3863 Lisp_Object font_object
, num
;
3865 Lisp_Object gstring
, g
;
3869 if (! NILP (font_object
))
3870 CHECK_FONT_OBJECT (font_object
);
3873 len
= XINT (num
) + 1;
3874 gstring
= Fmake_vector (make_number (len
), Qnil
);
3875 g
= Fmake_vector (make_number (6), Qnil
);
3876 ASET (g
, 0, font_object
);
3877 ASET (gstring
, 0, g
);
3878 for (i
= 1; i
< len
; i
++)
3879 ASET (gstring
, i
, Fmake_vector (make_number (10), Qnil
));
3883 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
3884 doc
: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
3885 START and END specify the region to extract characters.
3886 If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
3887 where to extract characters.
3888 FONT-OBJECT may be nil if GSTRING already contains one. */)
3889 (gstring
, font_object
, start
, end
, object
)
3890 Lisp_Object gstring
, font_object
, start
, end
, object
;
3896 CHECK_VECTOR (gstring
);
3897 if (NILP (font_object
))
3898 font_object
= LGSTRING_FONT (gstring
);
3899 font
= XFONT_OBJECT (font_object
);
3901 if (STRINGP (object
))
3903 const unsigned char *p
;
3905 CHECK_NATNUM (start
);
3907 if (XINT (start
) > XINT (end
)
3908 || XINT (end
) > ASIZE (object
)
3909 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3910 args_out_of_range_3 (object
, start
, end
);
3912 len
= XINT (end
) - XINT (start
);
3913 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
3914 for (i
= 0; i
< len
; i
++)
3916 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3917 /* Shut up GCC warning in comparison with
3918 MOST_POSITIVE_FIXNUM below. */
3921 c
= STRING_CHAR_ADVANCE (p
);
3922 cod
= code
= font
->driver
->encode_char (font
, c
);
3923 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
3925 LGLYPH_SET_FROM (g
, i
);
3926 LGLYPH_SET_TO (g
, i
);
3927 LGLYPH_SET_CHAR (g
, c
);
3928 LGLYPH_SET_CODE (g
, code
);
3935 if (! NILP (object
))
3936 Fset_buffer (object
);
3937 validate_region (&start
, &end
);
3938 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3939 args_out_of_range (start
, end
);
3940 len
= XINT (end
) - XINT (start
);
3942 pos_byte
= CHAR_TO_BYTE (pos
);
3943 for (i
= 0; i
< len
; i
++)
3945 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3946 /* Shut up GCC warning in comparison with
3947 MOST_POSITIVE_FIXNUM below. */
3950 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
3951 cod
= code
= font
->driver
->encode_char (font
, c
);
3952 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
3954 LGLYPH_SET_FROM (g
, i
);
3955 LGLYPH_SET_TO (g
, i
);
3956 LGLYPH_SET_CHAR (g
, c
);
3957 LGLYPH_SET_CODE (g
, code
);
3960 for (; i
< LGSTRING_LENGTH (gstring
); i
++)
3961 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
3965 DEFUN ("font-shape-text", Ffont_shape_text
, Sfont_shape_text
, 3, 4, 0,
3966 doc
: /* Shape text between FROM and TO by FONT-OBJECT.
3967 If optional 4th argument STRING is non-nil, it is a string to shape,
3968 and FROM and TO are indices to the string.
3969 The value is the end position of the text that can be shaped by
3971 (from
, to
, font_object
, string
)
3972 Lisp_Object from
, to
, font_object
, string
;
3975 struct font_metrics metrics
;
3976 EMACS_INT start
, end
;
3977 Lisp_Object gstring
, n
;
3980 if (! FONT_OBJECT_P (font_object
))
3982 font
= XFONT_OBJECT (font_object
);
3983 if (! font
->driver
->shape
)
3988 validate_region (&from
, &to
);
3989 start
= XFASTINT (from
);
3990 end
= XFASTINT (to
);
3991 modify_region (current_buffer
, start
, end
, 0);
3995 CHECK_STRING (string
);
3996 start
= XINT (from
);
3998 if (start
< 0 || start
> end
|| end
> SCHARS (string
))
3999 args_out_of_range_3 (string
, from
, to
);
4003 gstring
= Ffont_make_gstring (font_object
, make_number (len
));
4004 Ffont_fill_gstring (gstring
, font_object
, from
, to
, string
);
4006 /* Try at most three times with larger gstring each time. */
4007 for (i
= 0; i
< 3; i
++)
4009 Lisp_Object args
[2];
4011 n
= font
->driver
->shape (gstring
);
4015 args
[1] = Fmake_vector (make_number (len
), Qnil
);
4016 gstring
= Fvconcat (2, args
);
4018 if (! INTEGERP (n
) || XINT (n
) == 0)
4022 for (i
= 0; i
< len
;)
4025 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4026 EMACS_INT this_from
= LGLYPH_FROM (g
);
4027 EMACS_INT this_to
= LGLYPH_TO (g
) + 1;
4029 int need_composition
= 0;
4031 metrics
.lbearing
= LGLYPH_LBEARING (g
);
4032 metrics
.rbearing
= LGLYPH_RBEARING (g
);
4033 metrics
.ascent
= LGLYPH_ASCENT (g
);
4034 metrics
.descent
= LGLYPH_DESCENT (g
);
4035 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4037 metrics
.width
= LGLYPH_WIDTH (g
);
4038 if (LGLYPH_CHAR (g
) == 0 || metrics
.width
== 0)
4039 need_composition
= 1;
4043 metrics
.width
= LGLYPH_WADJUST (g
);
4044 metrics
.lbearing
+= LGLYPH_XOFF (g
);
4045 metrics
.rbearing
+= LGLYPH_XOFF (g
);
4046 metrics
.ascent
-= LGLYPH_YOFF (g
);
4047 metrics
.descent
+= LGLYPH_YOFF (g
);
4048 need_composition
= 1;
4050 for (j
= i
+ 1; j
< len
; j
++)
4054 g
= LGSTRING_GLYPH (gstring
, j
);
4055 if (this_from
!= LGLYPH_FROM (g
))
4057 need_composition
= 1;
4058 x
= metrics
.width
+ LGLYPH_LBEARING (g
) + LGLYPH_XOFF (g
);
4059 if (metrics
.lbearing
> x
)
4060 metrics
.lbearing
= x
;
4061 x
= metrics
.width
+ LGLYPH_RBEARING (g
) + LGLYPH_XOFF (g
);
4062 if (metrics
.rbearing
< x
)
4063 metrics
.rbearing
= x
;
4064 x
= LGLYPH_ASCENT (g
) - LGLYPH_YOFF (g
);
4065 if (metrics
.ascent
< x
)
4067 x
= LGLYPH_DESCENT (g
) - LGLYPH_YOFF (g
);
4068 if (metrics
.descent
< x
)
4069 metrics
.descent
= x
;
4070 if (NILP (LGLYPH_ADJUSTMENT (g
)))
4071 metrics
.width
+= LGLYPH_WIDTH (g
);
4073 metrics
.width
+= LGLYPH_WADJUST (g
);
4076 if (need_composition
)
4078 gstr
= Ffont_make_gstring (font_object
, make_number (j
- i
));
4079 LGSTRING_SET_WIDTH (gstr
, metrics
.width
);
4080 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
4081 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
);
4082 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
4083 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
4084 for (k
= i
; i
< j
; i
++)
4086 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
4088 LGLYPH_SET_FROM (g
, LGLYPH_FROM (g
) - this_from
);
4089 LGLYPH_SET_TO (g
, LGLYPH_TO (g
) - this_from
);
4090 LGSTRING_SET_GLYPH (gstr
, i
- k
, LGSTRING_GLYPH (gstring
, i
));
4092 from
= make_number (start
+ this_from
);
4093 to
= make_number (start
+ this_to
);
4095 Fcompose_region_internal (from
, to
, gstr
, Qnil
);
4097 Fcompose_string_internal (string
, from
, to
, gstr
, Qnil
);
4108 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
4109 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
4110 OTF-FEATURES specifies which features to apply in this format:
4111 (SCRIPT LANGSYS GSUB GPOS)
4113 SCRIPT is a symbol specifying a script tag of OpenType,
4114 LANGSYS is a symbol specifying a langsys tag of OpenType,
4115 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
4117 If LANGYS is nil, the default langsys is selected.
4119 The features are applied in the order they appear in the list. The
4120 symbol `*' means to apply all available features not present in this
4121 list, and the remaining features are ignored. For instance, (vatu
4122 pstf * haln) is to apply vatu and pstf in this order, then to apply
4123 all available features other than vatu, pstf, and haln.
4125 The features are applied to the glyphs in the range FROM and TO of
4126 the glyph-string GSTRING-IN.
4128 If some feature is actually applicable, the resulting glyphs are
4129 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4130 this case, the value is the number of produced glyphs.
4132 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4135 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4136 produced in GSTRING-OUT, and the value is nil.
4138 See the documentation of `font-make-gstring' for the format of
4140 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4141 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4143 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4148 check_otf_features (otf_features
);
4149 CHECK_FONT_OBJECT (font_object
);
4150 font
= XFONT_OBJECT (font_object
);
4151 if (! font
->driver
->otf_drive
)
4152 error ("Font backend %s can't drive OpenType GSUB table",
4153 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4154 CHECK_CONS (otf_features
);
4155 CHECK_SYMBOL (XCAR (otf_features
));
4156 val
= XCDR (otf_features
);
4157 CHECK_SYMBOL (XCAR (val
));
4158 val
= XCDR (otf_features
);
4161 len
= check_gstring (gstring_in
);
4162 CHECK_VECTOR (gstring_out
);
4163 CHECK_NATNUM (from
);
4165 CHECK_NATNUM (index
);
4167 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4168 args_out_of_range_3 (from
, to
, make_number (len
));
4169 if (XINT (index
) >= ASIZE (gstring_out
))
4170 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4171 num
= font
->driver
->otf_drive (font
, otf_features
,
4172 gstring_in
, XINT (from
), XINT (to
),
4173 gstring_out
, XINT (index
), 0);
4176 return make_number (num
);
4179 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4181 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4182 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4184 (SCRIPT LANGSYS FEATURE ...)
4185 See the documentation of `font-drive-otf' for more detail.
4187 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4188 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4189 character code corresponding to the glyph or nil if there's no
4190 corresponding character. */)
4191 (font_object
, character
, otf_features
)
4192 Lisp_Object font_object
, character
, otf_features
;
4195 Lisp_Object gstring_in
, gstring_out
, g
;
4196 Lisp_Object alternates
;
4199 CHECK_FONT_GET_OBJECT (font_object
, font
);
4200 if (! font
->driver
->otf_drive
)
4201 error ("Font backend %s can't drive OpenType GSUB table",
4202 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4203 CHECK_CHARACTER (character
);
4204 CHECK_CONS (otf_features
);
4206 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4207 g
= LGSTRING_GLYPH (gstring_in
, 0);
4208 LGLYPH_SET_CHAR (g
, XINT (character
));
4209 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4210 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4211 gstring_out
, 0, 1)) < 0)
4212 gstring_out
= Ffont_make_gstring (font_object
,
4213 make_number (ASIZE (gstring_out
) * 2));
4215 for (i
= 0; i
< num
; i
++)
4217 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4218 int c
= LGLYPH_CHAR (g
);
4219 unsigned code
= LGLYPH_CODE (g
);
4221 alternates
= Fcons (Fcons (make_number (code
),
4222 c
> 0 ? make_number (c
) : Qnil
),
4225 return Fnreverse (alternates
);
4231 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4232 doc
: /* Open FONT-ENTITY. */)
4233 (font_entity
, size
, frame
)
4234 Lisp_Object font_entity
;
4240 CHECK_FONT_ENTITY (font_entity
);
4242 frame
= selected_frame
;
4243 CHECK_LIVE_FRAME (frame
);
4246 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4249 CHECK_NUMBER_OR_FLOAT (size
);
4251 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
4253 isize
= XINT (size
);
4257 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4260 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4261 doc
: /* Close FONT-OBJECT. */)
4262 (font_object
, frame
)
4263 Lisp_Object font_object
, frame
;
4265 CHECK_FONT_OBJECT (font_object
);
4267 frame
= selected_frame
;
4268 CHECK_LIVE_FRAME (frame
);
4269 font_close_object (XFRAME (frame
), font_object
);
4273 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4274 doc
: /* Return information about FONT-OBJECT.
4275 The value is a vector:
4276 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4279 NAME is a string of the font name (or nil if the font backend doesn't
4282 FILENAME is a string of the font file (or nil if the font backend
4283 doesn't provide a file name).
4285 PIXEL-SIZE is a pixel size by which the font is opened.
4287 SIZE is a maximum advance width of the font in pixels.
4289 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4292 CAPABILITY is a list whose first element is a symbol representing the
4293 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4294 remaining elements describe the details of the font capability.
4296 If the font is OpenType font, the form of the list is
4297 \(opentype GSUB GPOS)
4298 where GSUB shows which "GSUB" features the font supports, and GPOS
4299 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4300 lists of the format:
4301 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4303 If the font is not OpenType font, currently the length of the form is
4306 SCRIPT is a symbol representing OpenType script tag.
4308 LANGSYS is a symbol representing OpenType langsys tag, or nil
4309 representing the default langsys.
4311 FEATURE is a symbol representing OpenType feature tag.
4313 If the font is not OpenType font, CAPABILITY is nil. */)
4315 Lisp_Object font_object
;
4320 CHECK_FONT_GET_OBJECT (font_object
, font
);
4322 val
= Fmake_vector (make_number (9), Qnil
);
4323 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4324 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4325 ASET (val
, 2, make_number (font
->pixel_size
));
4326 ASET (val
, 3, make_number (font
->max_width
));
4327 ASET (val
, 4, make_number (font
->ascent
));
4328 ASET (val
, 5, make_number (font
->descent
));
4329 ASET (val
, 6, make_number (font
->space_width
));
4330 ASET (val
, 7, make_number (font
->average_width
));
4331 if (font
->driver
->otf_capability
)
4332 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4336 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4337 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4338 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4339 (font_object
, string
)
4340 Lisp_Object font_object
, string
;
4346 CHECK_FONT_GET_OBJECT (font_object
, font
);
4347 CHECK_STRING (string
);
4348 len
= SCHARS (string
);
4349 vec
= Fmake_vector (make_number (len
), Qnil
);
4350 for (i
= 0; i
< len
; i
++)
4352 Lisp_Object ch
= Faref (string
, make_number (i
));
4357 struct font_metrics metrics
;
4359 cod
= code
= font
->driver
->encode_char (font
, c
);
4360 if (code
== FONT_INVALID_CODE
)
4362 val
= Fmake_vector (make_number (6), Qnil
);
4363 if (cod
<= MOST_POSITIVE_FIXNUM
)
4364 ASET (val
, 0, make_number (code
));
4366 ASET (val
, 0, Fcons (make_number (code
>> 16),
4367 make_number (code
& 0xFFFF)));
4368 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4369 ASET (val
, 1, make_number (metrics
.lbearing
));
4370 ASET (val
, 2, make_number (metrics
.rbearing
));
4371 ASET (val
, 3, make_number (metrics
.width
));
4372 ASET (val
, 4, make_number (metrics
.ascent
));
4373 ASET (val
, 5, make_number (metrics
.descent
));
4379 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4380 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4381 FONT is a font-spec, font-entity, or font-object. */)
4383 Lisp_Object spec
, font
;
4385 CHECK_FONT_SPEC (spec
);
4388 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4391 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4392 doc
: /* Return a font-object for displaying a character at POSITION.
4393 Optional second arg WINDOW, if non-nil, is a window displaying
4394 the current buffer. It defaults to the currently selected window. */)
4395 (position
, window
, string
)
4396 Lisp_Object position
, window
, string
;
4403 CHECK_NUMBER_COERCE_MARKER (position
);
4404 pos
= XINT (position
);
4405 if (pos
< BEGV
|| pos
>= ZV
)
4406 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4410 CHECK_NUMBER (position
);
4411 CHECK_STRING (string
);
4412 pos
= XINT (position
);
4413 if (pos
< 0 || pos
>= SCHARS (string
))
4414 args_out_of_range (string
, position
);
4417 window
= selected_window
;
4418 CHECK_LIVE_WINDOW (window
);
4419 w
= XWINDOW (window
);
4421 return font_at (-1, pos
, NULL
, w
, string
);
4425 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4426 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4427 The value is a number of glyphs drawn.
4428 Type C-l to recover what previously shown. */)
4429 (font_object
, string
)
4430 Lisp_Object font_object
, string
;
4432 Lisp_Object frame
= selected_frame
;
4433 FRAME_PTR f
= XFRAME (frame
);
4439 CHECK_FONT_GET_OBJECT (font_object
, font
);
4440 CHECK_STRING (string
);
4441 len
= SCHARS (string
);
4442 code
= alloca (sizeof (unsigned) * len
);
4443 for (i
= 0; i
< len
; i
++)
4445 Lisp_Object ch
= Faref (string
, make_number (i
));
4449 code
[i
] = font
->driver
->encode_char (font
, c
);
4450 if (code
[i
] == FONT_INVALID_CODE
)
4453 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4455 if (font
->driver
->prepare_face
)
4456 font
->driver
->prepare_face (f
, face
);
4457 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4458 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4459 if (font
->driver
->done_face
)
4460 font
->driver
->done_face (f
, face
);
4462 return make_number (len
);
4466 #endif /* FONT_DEBUG */
4468 #ifdef HAVE_WINDOW_SYSTEM
4470 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
4471 doc
: /* Return information about a font named NAME on frame FRAME.
4472 If FRAME is omitted or nil, use the selected frame.
4473 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
4474 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
4476 OPENED-NAME is the name used for opening the font,
4477 FULL-NAME is the full name of the font,
4478 SIZE is the maximum bound width of the font,
4479 HEIGHT is the height of the font,
4480 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
4481 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
4482 how to compose characters.
4483 If the named font is not yet loaded, return nil. */)
4485 Lisp_Object name
, frame
;
4490 Lisp_Object font_object
;
4492 (*check_window_system_func
) ();
4495 CHECK_STRING (name
);
4497 frame
= selected_frame
;
4498 CHECK_LIVE_FRAME (frame
);
4503 int fontset
= fs_query_fontset (name
, 0);
4506 name
= fontset_ascii (fontset
);
4507 font_object
= font_open_by_name (f
, (char *) SDATA (name
));
4509 else if (FONT_OBJECT_P (name
))
4511 else if (FONT_ENTITY_P (name
))
4512 font_object
= font_open_entity (f
, name
, 0);
4515 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4516 Lisp_Object entity
= font_matching_entity (f
, face
->lface
, name
);
4518 font_object
= ! NILP (entity
) ? font_open_entity (f
, entity
, 0) : Qnil
;
4520 if (NILP (font_object
))
4522 font
= XFONT_OBJECT (font_object
);
4524 info
= Fmake_vector (make_number (7), Qnil
);
4525 XVECTOR (info
)->contents
[0] = AREF (font_object
, FONT_NAME_INDEX
);
4526 XVECTOR (info
)->contents
[1] = AREF (font_object
, FONT_NAME_INDEX
);
4527 XVECTOR (info
)->contents
[2] = make_number (font
->pixel_size
);
4528 XVECTOR (info
)->contents
[3] = make_number (font
->height
);
4529 XVECTOR (info
)->contents
[4] = make_number (font
->baseline_offset
);
4530 XVECTOR (info
)->contents
[5] = make_number (font
->relative_compose
);
4531 XVECTOR (info
)->contents
[6] = make_number (font
->default_ascent
);
4534 /* As font_object is still in FONT_OBJLIST of the entity, we can't
4535 close it now. Perhaps, we should manage font-objects
4536 by `reference-count'. */
4537 font_close_object (f
, font_object
);
4544 #define BUILD_STYLE_TABLE(TBL) \
4545 build_style_table ((TBL), sizeof TBL / sizeof (struct table_entry))
4548 build_style_table (entry
, nelement
)
4549 struct table_entry
*entry
;
4553 Lisp_Object table
, elt
;
4555 table
= Fmake_vector (make_number (nelement
), Qnil
);
4556 for (i
= 0; i
< nelement
; i
++)
4558 for (j
= 0; entry
[i
].names
[j
]; j
++);
4559 elt
= Fmake_vector (make_number (j
+ 1), Qnil
);
4560 ASET (elt
, 0, make_number (entry
[i
].numeric
));
4561 for (j
= 0; entry
[i
].names
[j
]; j
++)
4562 ASET (elt
, j
+ 1, intern (entry
[i
].names
[j
]));
4563 ASET (table
, i
, elt
);
4568 static Lisp_Object Vfont_log
;
4569 static int font_log_env_checked
;
4572 font_add_log (action
, arg
, result
)
4574 Lisp_Object arg
, result
;
4576 Lisp_Object tail
, val
;
4579 if (! font_log_env_checked
)
4581 Vfont_log
= egetenv ("EMACS_FONT_LOG") ? Qnil
: Qt
;
4582 font_log_env_checked
= 1;
4584 if (EQ (Vfont_log
, Qt
))
4587 arg
= Ffont_xlfd_name (arg
, Qt
);
4589 result
= Ffont_xlfd_name (result
, Qt
);
4590 else if (CONSP (result
))
4592 result
= Fcopy_sequence (result
);
4593 for (tail
= result
; CONSP (tail
); tail
= XCDR (tail
))
4597 val
= Ffont_xlfd_name (val
, Qt
);
4598 XSETCAR (tail
, val
);
4601 else if (VECTORP (result
))
4603 result
= Fcopy_sequence (result
);
4604 for (i
= 0; i
< ASIZE (result
); i
++)
4606 val
= AREF (result
, i
);
4608 val
= Ffont_xlfd_name (val
, Qt
);
4609 ASET (result
, i
, val
);
4612 Vfont_log
= Fcons (list3 (intern (action
), arg
, result
), Vfont_log
);
4615 extern void syms_of_ftfont
P_ (());
4616 extern void syms_of_xfont
P_ (());
4617 extern void syms_of_xftfont
P_ (());
4618 extern void syms_of_ftxfont
P_ (());
4619 extern void syms_of_bdffont
P_ (());
4620 extern void syms_of_w32font
P_ (());
4621 extern void syms_of_atmfont
P_ (());
4626 sort_shift_bits
[FONT_TYPE_INDEX
] = 0;
4627 sort_shift_bits
[FONT_SLANT_INDEX
] = 2;
4628 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 9;
4629 sort_shift_bits
[FONT_SIZE_INDEX
] = 16;
4630 sort_shift_bits
[FONT_WIDTH_INDEX
] = 23;
4631 /* Note that the other elements in sort_shift_bits are not used. */
4633 staticpro (&font_charset_alist
);
4634 font_charset_alist
= Qnil
;
4636 DEFSYM (Qfont_spec
, "font-spec");
4637 DEFSYM (Qfont_entity
, "font-entity");
4638 DEFSYM (Qfont_object
, "font-object");
4640 DEFSYM (Qopentype
, "opentype");
4642 DEFSYM (Qascii_0
, "ascii-0");
4643 DEFSYM (Qiso8859_1
, "iso8859-1");
4644 DEFSYM (Qiso10646_1
, "iso10646-1");
4645 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4646 DEFSYM (Qunicode_sip
, "unicode-sip");
4648 DEFSYM (QCotf
, ":otf");
4649 DEFSYM (QClang
, ":lang");
4650 DEFSYM (QCscript
, ":script");
4651 DEFSYM (QCantialias
, ":antialias");
4653 DEFSYM (QCfoundry
, ":foundry");
4654 DEFSYM (QCadstyle
, ":adstyle");
4655 DEFSYM (QCregistry
, ":registry");
4656 DEFSYM (QCspacing
, ":spacing");
4657 DEFSYM (QCdpi
, ":dpi");
4658 DEFSYM (QCscalable
, ":scalable");
4659 DEFSYM (QCavgwidth
, ":avgwidth");
4660 DEFSYM (QCfont_entity
, ":font-entity");
4661 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
4668 staticpro (&null_vector
);
4669 null_vector
= Fmake_vector (make_number (0), Qnil
);
4671 staticpro (&scratch_font_spec
);
4672 scratch_font_spec
= Ffont_spec (0, NULL
);
4673 staticpro (&scratch_font_prefer
);
4674 scratch_font_prefer
= Ffont_spec (0, NULL
);
4678 staticpro (&otf_list
);
4680 #endif /* HAVE_LIBOTF */
4684 defsubr (&Sfont_spec
);
4685 defsubr (&Sfont_get
);
4686 defsubr (&Sfont_put
);
4687 defsubr (&Slist_fonts
);
4688 defsubr (&Sfont_family_list
);
4689 defsubr (&Sfind_font
);
4690 defsubr (&Sfont_xlfd_name
);
4691 defsubr (&Sclear_font_cache
);
4692 defsubr (&Sfont_make_gstring
);
4693 defsubr (&Sfont_fill_gstring
);
4694 defsubr (&Sfont_shape_text
);
4696 defsubr (&Sfont_drive_otf
);
4697 defsubr (&Sfont_otf_alternates
);
4701 defsubr (&Sopen_font
);
4702 defsubr (&Sclose_font
);
4703 defsubr (&Squery_font
);
4704 defsubr (&Sget_font_glyphs
);
4705 defsubr (&Sfont_match_p
);
4706 defsubr (&Sfont_at
);
4708 defsubr (&Sdraw_string
);
4710 #endif /* FONT_DEBUG */
4711 #ifdef HAVE_WINDOW_SYSTEM
4712 defsubr (&Sfont_info
);
4715 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
4717 Alist of fontname patterns vs the corresponding encoding and repertory info.
4718 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
4719 where ENCODING is a charset or a char-table,
4720 and REPERTORY is a charset, a char-table, or nil.
4722 If ENCODING and REPERTORY are the same, the element can have the form
4723 \(REGEXP . ENCODING).
4725 ENCODING is for converting a character to a glyph code of the font.
4726 If ENCODING is a charset, encoding a character by the charset gives
4727 the corresponding glyph code. If ENCODING is a char-table, looking up
4728 the table by a character gives the corresponding glyph code.
4730 REPERTORY specifies a repertory of characters supported by the font.
4731 If REPERTORY is a charset, all characters beloging to the charset are
4732 supported. If REPERTORY is a char-table, all characters who have a
4733 non-nil value in the table are supported. If REPERTORY is nil, Emacs
4734 gets the repertory information by an opened font and ENCODING. */);
4735 Vfont_encoding_alist
= Qnil
;
4737 DEFVAR_LISP_NOPRO ("font-weight-table", &Vfont_weight_table
,
4738 doc
: /* Vector of valid font weight values.
4739 Each element has the form:
4740 [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
4741 NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symobls. */);
4742 Vfont_weight_table
= BUILD_STYLE_TABLE (weight_table
);
4744 DEFVAR_LISP_NOPRO ("font-slant-table", &Vfont_slant_table
,
4745 doc
: /* Vector of font slant symbols vs the corresponding numeric values.
4746 See `font-weight_table' for the format of the vector. */);
4747 Vfont_slant_table
= BUILD_STYLE_TABLE (slant_table
);
4749 DEFVAR_LISP_NOPRO ("font-width-table", &Vfont_width_table
,
4750 doc
: /* Alist of font width symbols vs the corresponding numeric values.
4751 See `font-weight_table' for the format of the vector. */);
4752 Vfont_width_table
= BUILD_STYLE_TABLE (width_table
);
4754 staticpro (&font_style_table
);
4755 font_style_table
= Fmake_vector (make_number (3), Qnil
);
4756 ASET (font_style_table
, 0, Vfont_weight_table
);
4757 ASET (font_style_table
, 1, Vfont_slant_table
);
4758 ASET (font_style_table
, 2, Vfont_width_table
);
4760 DEFVAR_LISP ("font-log", &Vfont_log
, doc
: /*
4761 *Logging list of font related actions and results.
4762 The value t means to suppress the logging.
4763 The initial value is set to nil if the environment variable
4764 EMACS_FONT_LOG is set. Otherwise, it is set to t. */);
4767 #ifdef HAVE_WINDOW_SYSTEM
4768 #ifdef HAVE_FREETYPE
4770 #ifdef HAVE_X_WINDOWS
4775 #endif /* HAVE_XFT */
4776 #endif /* HAVE_X_WINDOWS */
4777 #else /* not HAVE_FREETYPE */
4778 #ifdef HAVE_X_WINDOWS
4780 #endif /* HAVE_X_WINDOWS */
4781 #endif /* not HAVE_FREETYPE */
4784 #endif /* HAVE_BDFFONT */
4787 #endif /* WINDOWSNT */
4791 #endif /* HAVE_WINDOW_SYSTEM */
4794 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
4795 (do not change this comment) */