1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006 Free Software Foundation, Inc.
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 2, or (at your option)
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; see the file COPYING. If not, write to
21 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22 Boston, MA 02110-1301, USA. */
36 #include "dispextern.h"
38 #include "character.h"
39 #include "composite.h"
49 #define xassert(X) do {if (!(X)) abort ();} while (0)
51 #define xassert(X) (void) 0
54 int enable_font_backend
;
56 Lisp_Object Qopentype
;
58 /* Important character set symbols. */
59 Lisp_Object Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
61 /* Like CHECK_FONT_SPEC but also validate properties of the font-spec,
62 and set X to the validated result. */
64 #define CHECK_VALIDATE_FONT_SPEC(x) \
66 if (! FONT_SPEC_P (x)) x = wrong_type_argument (Qfont, x); \
67 x = font_prop_validate (x); \
70 /* Number of pt per inch (from the TeXbook). */
71 #define PT_PER_INCH 72.27
73 /* Return a pixel size (integer) corresponding to POINT size (double)
75 #define POINT_TO_PIXEL(POINT, DPI) ((POINT) * (DPI) / PT_PER_INCH + 0.5)
77 /* Return a point size (double) corresponding to POINT size (integer)
79 #define PIXEL_TO_POINT(PIXEL, DPI) ((PIXEL) * PT_PER_INCH * 10 / (DPI) + 0.5)
81 /* Special string of zero length. It is used to specify a NULL name
82 in a font properties (e.g. adstyle). We don't use the symbol of
83 NULL name because it's confusing (Lisp printer prints nothing for
85 Lisp_Object null_string
;
87 /* Special vector of zero length. This is repeatedly used by (struct
88 font_driver *)->list when a specified font is not found. */
89 Lisp_Object null_vector
;
91 /* Vector of 3 elements. Each element is an alist for one of font
92 style properties (weight, slant, width). Each alist contains a
93 mapping between symbolic property values (e.g. `medium' for weight)
94 and numeric property values (e.g. 100). So, it looks like this:
95 [((thin . 0) ... (heavy . 210))
96 ((ro . 0) ... (ot . 210))
97 ((ultracondensed . 50) ... (wide . 200))] */
98 static Lisp_Object font_style_table
;
100 /* Alist of font family vs the corresponding aliases.
101 Each element has this form:
102 (FAMILY ALIAS1 ALIAS2 ...) */
104 static Lisp_Object font_family_alist
;
106 /* Symbols representing keys of normal font properties. */
107 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
, QCsize
, QCname
;
108 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
, QCextra
;
109 /* Symbols representing keys of font extra info. */
110 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClanguage
, QCscript
;
111 Lisp_Object QCantialias
;
112 /* Symbols representing values of font spacing property. */
113 Lisp_Object Qc
, Qm
, Qp
, Qd
;
115 /* Alist of font registry symbol and the corresponding charsets
116 information. The information is retrieved from
117 Vfont_encoding_alist on demand.
119 Eash element has the form:
120 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
124 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
125 encodes a character code to a glyph code of a font, and
126 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
127 character is supported by a font.
129 The latter form means that the information for REGISTRY couldn't be
131 static Lisp_Object font_charset_alist
;
133 /* List of all font drivers. Each font-backend (XXXfont.c) calls
134 register_font_driver in syms_of_XXXfont to register its font-driver
136 static struct font_driver_list
*font_driver_list
;
138 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
139 static Lisp_Object prop_name_to_numeric
P_ ((enum font_property_index
,
141 static Lisp_Object prop_numeric_to_name
P_ ((enum font_property_index
, int));
142 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
143 static void build_font_family_alist
P_ ((void));
145 /* Number of registered font drivers. */
146 static int num_font_drivers
;
148 /* Return a pixel size of font-spec SPEC on frame F. */
151 font_pixel_size (f
, spec
)
155 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
158 Lisp_Object extra
, val
;
164 point_size
= XFLOAT_DATA (size
);
165 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
166 val
= assq_no_quit (QCdpi
, extra
);
169 if (INTEGERP (XCDR (val
)))
170 dpi
= XINT (XCDR (val
));
172 dpi
= XFLOAT_DATA (XCDR (val
)) + 0.5;
176 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
180 /* Return a numeric value corresponding to PROP's NAME (symbol). If
181 NAME is not registered in font_style_table, return Qnil. PROP must
182 be one of FONT_{WEIGHT|SLANT|SWIDTH}_INDEX. */
185 prop_name_to_numeric (prop
, name
)
186 enum font_property_index prop
;
189 int table_index
= prop
- FONT_WEIGHT_INDEX
;
192 val
= assq_no_quit (name
, AREF (font_style_table
, table_index
));
193 return (NILP (val
) ? Qnil
: XCDR (val
));
197 /* Return a name (symbol) corresponding to PROP's NUMERIC value. If
198 no name is registered for NUMERIC in font_style_table, return a
199 symbol of integer name (e.g. `123'). PROP must be one of
200 FONT_{WEIGHT|SLANT|SWIDTH}_INDEX. */
203 prop_numeric_to_name (prop
, numeric
)
204 enum font_property_index prop
;
207 int table_index
= prop
- FONT_WEIGHT_INDEX
;
208 Lisp_Object table
= AREF (font_style_table
, table_index
);
211 while (! NILP (table
))
213 if (XINT (XCDR (XCAR (table
))) >= numeric
)
215 if (XINT (XCDR (XCAR (table
))) == numeric
)
216 return XCAR (XCAR (table
));
220 table
= XCDR (table
);
222 sprintf (buf
, "%d", numeric
);
227 /* Return a symbol whose name is STR (length LEN). If STR contains
228 uppercase letters, downcase them in advance. */
231 intern_downcase (str
, len
)
238 for (i
= 0; i
< len
; i
++)
239 if (isupper (str
[i
]))
242 return Fintern (make_unibyte_string (str
, len
), Qnil
);
245 return Fintern (null_string
, Qnil
);
246 bcopy (str
, buf
, len
);
248 if (isascii (buf
[i
]))
249 buf
[i
] = tolower (buf
[i
]);
250 return Fintern (make_unibyte_string (buf
, len
), Qnil
);
253 extern Lisp_Object Vface_alternative_font_family_alist
;
255 /* Setup font_family_alist of the form:
256 ((FAMILY-SYMBOL ALIAS-SYMBOL ...) ...)
257 from Vface_alternative_font_family_alist of the form:
258 ((FAMILY-STRING ALIAS-STRING ...) ...) */
261 build_font_family_alist ()
263 Lisp_Object alist
= Vface_alternative_font_family_alist
;
265 for (; CONSP (alist
); alist
= XCDR (alist
))
267 Lisp_Object tail
, elt
;
269 for (tail
= XCAR (alist
), elt
= Qnil
; CONSP (tail
); tail
= XCDR (tail
))
270 elt
= nconc2 (elt
, Fcons (Fintern (XCAR (tail
), Qnil
), Qnil
));
271 font_family_alist
= Fcons (elt
, font_family_alist
);
275 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
277 /* Return encoding charset and repertory charset for REGISTRY in
278 ENCODING and REPERTORY correspondingly. If correct information for
279 REGISTRY is available, return 0. Otherwise return -1. */
282 font_registry_charsets (registry
, encoding
, repertory
)
283 Lisp_Object registry
;
284 struct charset
**encoding
, **repertory
;
287 int encoding_id
, repertory_id
;
289 val
= assq_no_quit (registry
, font_charset_alist
);
295 encoding_id
= XINT (XCAR (val
));
296 repertory_id
= XINT (XCDR (val
));
300 val
= find_font_encoding (SYMBOL_NAME (registry
));
301 if (SYMBOLP (val
) && CHARSETP (val
))
303 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
305 else if (CONSP (val
))
307 if (! CHARSETP (XCAR (val
)))
309 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
310 if (NILP (XCDR (val
)))
314 if (! CHARSETP (XCDR (val
)))
316 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
321 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
323 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
327 *encoding
= CHARSET_FROM_ID (encoding_id
);
329 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
334 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
339 /* Font property value validaters. See the comment of
340 font_property_table for the meaning of the arguments. */
342 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
343 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
344 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
345 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
346 static int get_font_prop_index
P_ ((Lisp_Object
, int));
347 static Lisp_Object font_prop_validate
P_ ((Lisp_Object
));
350 font_prop_validate_symbol (prop
, val
)
351 Lisp_Object prop
, val
;
353 if (EQ (prop
, QCotf
))
354 return (SYMBOLP (val
) ? val
: Qerror
);
356 val
= (SCHARS (val
) == 0 ? null_string
357 : intern_downcase ((char *) SDATA (val
), SBYTES (val
)));
358 else if (SYMBOLP (val
))
360 if (SCHARS (SYMBOL_NAME (val
)) == 0)
369 font_prop_validate_style (prop
, val
)
370 Lisp_Object prop
, val
;
372 if (! INTEGERP (val
))
375 val
= intern_downcase ((char *) SDATA (val
), SBYTES (val
));
380 enum font_property_index prop_index
381 = (EQ (prop
, QCweight
) ? FONT_WEIGHT_INDEX
382 : EQ (prop
, QCslant
) ? FONT_SLANT_INDEX
385 val
= prop_name_to_numeric (prop_index
, val
);
394 font_prop_validate_non_neg (prop
, val
)
395 Lisp_Object prop
, val
;
397 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
402 font_prop_validate_spacing (prop
, val
)
403 Lisp_Object prop
, val
;
405 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
408 return make_number (FONT_SPACING_CHARCELL
);
410 return make_number (FONT_SPACING_MONO
);
412 return make_number (FONT_SPACING_PROPORTIONAL
);
417 font_prop_validate_otf (prop
, val
)
418 Lisp_Object prop
, val
;
420 Lisp_Object tail
, tmp
;
423 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
424 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
425 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
428 if (! SYMBOLP (XCAR (val
)))
433 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
435 for (i
= 0; i
< 2; i
++)
442 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
443 if (! SYMBOLP (XCAR (tmp
)))
451 /* Structure of known font property keys and validater of the
455 /* Pointer to the key symbol. */
457 /* Function to validate PROP's value VAL, or NULL if any value is
458 ok. The value is VAL or its regularized value if VAL is valid,
459 and Qerror if not. */
460 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
461 } font_property_table
[] =
462 { { &QCtype
, font_prop_validate_symbol
},
463 { &QCfoundry
, font_prop_validate_symbol
},
464 { &QCfamily
, font_prop_validate_symbol
},
465 { &QCadstyle
, font_prop_validate_symbol
},
466 { &QCregistry
, font_prop_validate_symbol
},
467 { &QCweight
, font_prop_validate_style
},
468 { &QCslant
, font_prop_validate_style
},
469 { &QCwidth
, font_prop_validate_style
},
470 { &QCsize
, font_prop_validate_non_neg
},
471 { &QClanguage
, font_prop_validate_symbol
},
472 { &QCscript
, font_prop_validate_symbol
},
473 { &QCdpi
, font_prop_validate_non_neg
},
474 { &QCspacing
, font_prop_validate_spacing
},
475 { &QCscalable
, NULL
},
476 { &QCotf
, font_prop_validate_otf
},
477 { &QCantialias
, font_prop_validate_symbol
}
480 /* Size (number of elements) of the above table. */
481 #define FONT_PROPERTY_TABLE_SIZE \
482 ((sizeof font_property_table) / (sizeof *font_property_table))
484 /* Return an index number of font property KEY or -1 if KEY is not an
485 already known property. Start searching font_property_table from
486 index FROM (which is 0 or FONT_EXTRA_INDEX). */
489 get_font_prop_index (key
, from
)
493 for (; from
< FONT_PROPERTY_TABLE_SIZE
; from
++)
494 if (EQ (key
, *font_property_table
[from
].key
))
499 /* Validate font properties in SPEC (vector) while updating elements
500 to regularized values. Signal an error if an invalid property is
504 font_prop_validate (spec
)
508 Lisp_Object prop
, val
, extra
;
510 for (i
= FONT_TYPE_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
512 if (! NILP (AREF (spec
, i
)))
514 prop
= *font_property_table
[i
].key
;
515 val
= (font_property_table
[i
].validater
) (prop
, AREF (spec
, i
));
516 if (EQ (val
, Qerror
))
517 Fsignal (Qfont
, list2 (build_string ("invalid font property"),
518 Fcons (prop
, AREF (spec
, i
))));
522 for (extra
= AREF (spec
, FONT_EXTRA_INDEX
);
523 CONSP (extra
); extra
= XCDR (extra
))
525 Lisp_Object elt
= XCAR (extra
);
528 i
= get_font_prop_index (prop
, FONT_EXTRA_INDEX
);
530 && font_property_table
[i
].validater
)
532 val
= (font_property_table
[i
].validater
) (prop
, XCDR (elt
));
533 if (EQ (val
, Qerror
))
534 Fsignal (Qfont
, list2 (build_string ("invalid font property"),
542 /* Store VAL as a value of extra font property PROP in FONT. */
545 font_put_extra (font
, prop
, val
)
546 Lisp_Object font
, prop
, val
;
548 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
549 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
553 extra
= Fcons (Fcons (prop
, val
), extra
);
554 ASET (font
, FONT_EXTRA_INDEX
, extra
);
562 /* Font name parser and unparser */
564 static Lisp_Object intern_font_field
P_ ((char *, int));
565 static int parse_matrix
P_ ((char *));
566 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
567 static int font_parse_name
P_ ((char *, Lisp_Object
));
569 /* An enumerator for each field of an XLFD font name. */
570 enum xlfd_field_index
589 /* An enumerator for mask bit corresponding to each XLFD field. */
592 XLFD_FOUNDRY_MASK
= 0x0001,
593 XLFD_FAMILY_MASK
= 0x0002,
594 XLFD_WEIGHT_MASK
= 0x0004,
595 XLFD_SLANT_MASK
= 0x0008,
596 XLFD_SWIDTH_MASK
= 0x0010,
597 XLFD_ADSTYLE_MASK
= 0x0020,
598 XLFD_PIXEL_MASK
= 0x0040,
599 XLFD_POINT_MASK
= 0x0080,
600 XLFD_RESX_MASK
= 0x0100,
601 XLFD_RESY_MASK
= 0x0200,
602 XLFD_SPACING_MASK
= 0x0400,
603 XLFD_AVGWIDTH_MASK
= 0x0800,
604 XLFD_REGISTRY_MASK
= 0x1000,
605 XLFD_ENCODING_MASK
= 0x2000
609 /* Return a Lispy value of a XLFD font field at STR and LEN bytes.
610 If LEN is zero, it returns `null_string'.
611 If STR is "*", it returns nil.
612 If all characters in STR are digits, it returns an integer.
613 Otherwise, it returns a symbol interned from downcased STR. */
616 intern_font_field (str
, len
)
624 if (*str
== '*' && len
== 1)
628 for (i
= 1; i
< len
; i
++)
629 if (! isdigit (str
[i
]))
632 return make_number (atoi (str
));
634 return intern_downcase (str
, len
);
637 /* Parse P pointing the pixel/point size field of the form
638 `[A B C D]' which specifies a transformation matrix:
644 by which all glyphs of the font are transformed. The spec says
645 that scalar value N for the pixel/point size is equivalent to:
646 A = N * resx/resy, B = C = 0, D = N.
648 Return the scalar value N if the form is valid. Otherwise return
659 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
662 matrix
[i
] = - strtod (p
+ 1, &end
);
664 matrix
[i
] = strtod (p
, &end
);
667 return (i
== 4 ? (int) matrix
[3] : -1);
670 /* Expand a wildcard field in FIELD (the first N fields are filled) to
671 multiple fields to fill in all 14 XLFD fields while restring a
672 field position by its contents. */
675 font_expand_wildcards (field
, n
)
676 Lisp_Object field
[XLFD_LAST_INDEX
];
680 Lisp_Object tmp
[XLFD_LAST_INDEX
];
681 /* Array of information about where this element can go. Nth
682 element is for Nth element of FIELD. */
684 /* Minimum possible field. */
686 /* Maxinum possible field. */
688 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
690 } range
[XLFD_LAST_INDEX
];
692 int range_from
, range_to
;
695 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
696 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
697 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
698 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
699 | XLFD_AVGWIDTH_MASK)
700 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
702 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
703 field. The value is shifted to left one bit by one in the
705 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
706 range_mask
= (range_mask
<< 1) | 1;
708 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
709 position-based retriction for FIELD[I]. */
710 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
711 i
++, range_from
++, range_to
++, range_mask
<<= 1)
713 Lisp_Object val
= field
[i
];
719 range
[i
].from
= range_from
;
720 range
[i
].to
= range_to
;
721 range
[i
].mask
= range_mask
;
725 /* The triplet FROM, TO, and MASK is a value-based
726 retriction for FIELD[I]. */
732 int numeric
= XINT (val
);
735 from
= to
= XLFD_ENCODING_INDEX
,
736 mask
= XLFD_ENCODING_MASK
;
737 else if (numeric
== 0)
738 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
739 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
740 else if (numeric
<= 48)
741 from
= to
= XLFD_PIXEL_INDEX
,
742 mask
= XLFD_PIXEL_MASK
;
744 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
745 mask
= XLFD_LARGENUM_MASK
;
747 else if (EQ (val
, null_string
))
748 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
749 mask
= XLFD_NULL_MASK
;
751 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
754 Lisp_Object name
= SYMBOL_NAME (val
);
756 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
757 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
758 mask
= XLFD_REGENC_MASK
;
760 from
= to
= XLFD_ENCODING_INDEX
,
761 mask
= XLFD_ENCODING_MASK
;
763 else if (range_from
<= XLFD_WEIGHT_INDEX
764 && range_to
>= XLFD_WEIGHT_INDEX
765 && !NILP (prop_name_to_numeric (FONT_WEIGHT_INDEX
, val
)))
766 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
767 else if (range_from
<= XLFD_SLANT_INDEX
768 && range_to
>= XLFD_SLANT_INDEX
769 && !NILP (prop_name_to_numeric (FONT_SLANT_INDEX
, val
)))
770 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
771 else if (range_from
<= XLFD_SWIDTH_INDEX
772 && range_to
>= XLFD_SWIDTH_INDEX
773 && !NILP (prop_name_to_numeric (FONT_WIDTH_INDEX
, val
)))
774 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
777 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
778 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
780 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
781 mask
= XLFD_SYMBOL_MASK
;
784 /* Merge position-based and value-based restrictions. */
786 while (from
< range_from
)
787 mask
&= ~(1 << from
++);
788 while (from
< 14 && ! (mask
& (1 << from
)))
790 while (to
> range_to
)
791 mask
&= ~(1 << to
--);
792 while (to
>= 0 && ! (mask
& (1 << to
)))
796 range
[i
].from
= from
;
798 range
[i
].mask
= mask
;
800 if (from
> range_from
|| to
< range_to
)
802 /* The range is narrowed by value-based restrictions.
803 Reflect it to the other fields. */
805 /* Following fields should be after FROM. */
807 /* Preceding fields should be before TO. */
808 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
810 /* Check FROM for non-wildcard field. */
811 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
813 while (range
[j
].from
< from
)
814 range
[j
].mask
&= ~(1 << range
[j
].from
++);
815 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
817 range
[j
].from
= from
;
820 from
= range
[j
].from
;
821 if (range
[j
].to
> to
)
823 while (range
[j
].to
> to
)
824 range
[j
].mask
&= ~(1 << range
[j
].to
--);
825 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
838 /* Decide all fileds from restrictions in RANGE. */
839 for (i
= j
= 0; i
< n
; i
++)
841 if (j
< range
[i
].from
)
843 if (i
== 0 || ! NILP (tmp
[i
- 1]))
844 /* None of TMP[X] corresponds to Jth field. */
846 for (; j
< range
[i
].from
; j
++)
851 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
853 for (; j
< XLFD_LAST_INDEX
; j
++)
855 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
856 field
[XLFD_ENCODING_INDEX
]
857 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
861 /* Parse NAME (null terminated) as XLFD and store information in FONT
862 (font-spec or font-entity). Size property of FONT is set as
864 specified XLFD fields FONT property
865 --------------------- -------------
866 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
867 POINT_SIZE and RESY calculated pixel size (Lisp integer)
868 POINT_SIZE POINT_SIZE/10 (Lisp float)
870 If NAME is successfully parsed, return 0. Otherwise return -1.
872 FONT is usually a font-spec, but when this function is called from
873 X font backend driver, it is a font-entity. In that case, NAME is
874 a fully specified XLFD, and we set FONT_EXTRA_INDEX of FONT to a
875 symbol RESX-RESY-SPACING-AVGWIDTH.
879 font_parse_xlfd (name
, font
)
883 int len
= strlen (name
);
885 Lisp_Object dpi
, spacing
;
887 char *f
[XLFD_LAST_INDEX
+ 1];
892 /* Maximum XLFD name length is 255. */
894 /* Accept "*-.." as a fully specified XLFD. */
895 if (name
[0] == '*' && name
[1] == '-')
896 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
899 for (p
= name
+ i
; *p
; p
++)
900 if (*p
== '-' && i
< XLFD_LAST_INDEX
)
904 dpi
= spacing
= Qnil
;
907 if (i
== XLFD_LAST_INDEX
)
911 /* Fully specified XLFD. */
912 for (i
= 0, j
= FONT_FOUNDRY_INDEX
; i
< XLFD_WEIGHT_INDEX
; i
++, j
++)
914 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
918 for (j
= FONT_WEIGHT_INDEX
; i
< XLFD_ADSTYLE_INDEX
; i
++, j
++)
920 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
923 Lisp_Object numeric
= prop_name_to_numeric (j
, val
);
925 if (INTEGERP (numeric
))
930 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
932 ASET (font
, FONT_ADSTYLE_INDEX
, val
);
933 i
= XLFD_REGISTRY_INDEX
;
934 val
= intern_font_field (f
[i
], f
[i
+ 2] - f
[i
]);
936 ASET (font
, FONT_REGISTRY_INDEX
, val
);
938 p
= f
[XLFD_PIXEL_INDEX
];
939 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
940 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
943 i
= XLFD_PIXEL_INDEX
;
944 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
946 ASET (font
, FONT_SIZE_INDEX
, val
);
949 double point_size
= -1;
951 xassert (FONT_SPEC_P (font
));
952 p
= f
[XLFD_POINT_INDEX
];
954 point_size
= parse_matrix (p
);
955 else if (isdigit (*p
))
956 point_size
= atoi (p
), point_size
/= 10;
958 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
961 i
= XLFD_PIXEL_INDEX
;
962 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
964 ASET (font
, FONT_SIZE_INDEX
, val
);
969 /* Parse RESX, RESY, SPACING, and AVGWIDTH. */
970 if (FONT_ENTITY_P (font
))
973 ASET (font
, FONT_EXTRA_INDEX
,
974 intern_font_field (f
[i
], f
[XLFD_REGISTRY_INDEX
] - 1 - f
[i
]));
978 /* Here we just setup DPI, SPACING, and AVGWIDTH. They are set
979 in FONT_EXTRA_INDEX later. */
981 dpi
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
982 i
= XLFD_SPACING_INDEX
;
983 spacing
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
984 p
= f
[XLFD_AVGWIDTH_INDEX
];
992 int wild_card_found
= 0;
993 Lisp_Object prop
[XLFD_LAST_INDEX
];
995 for (j
= 0; j
< i
; j
++)
999 if (f
[j
][1] && f
[j
][1] != '-')
1002 wild_card_found
= 1;
1004 else if (isdigit (*f
[j
]))
1006 for (p
= f
[j
] + 1; isdigit (*p
); p
++);
1007 if (*p
&& *p
!= '-')
1008 prop
[j
] = intern_downcase (f
[j
], p
- f
[j
]);
1010 prop
[j
] = make_number (atoi (f
[j
]));
1013 prop
[j
] = intern_font_field (f
[j
], f
[j
+ 1] - 1 - f
[j
]);
1015 prop
[j
] = intern_font_field (f
[j
], f
[i
] - f
[j
]);
1017 if (! wild_card_found
)
1019 if (font_expand_wildcards (prop
, i
) < 0)
1022 for (i
= 0, j
= FONT_FOUNDRY_INDEX
; i
< XLFD_WEIGHT_INDEX
; i
++, j
++)
1023 if (! NILP (prop
[i
]))
1024 ASET (font
, j
, prop
[i
]);
1025 for (j
= FONT_WEIGHT_INDEX
; i
< XLFD_ADSTYLE_INDEX
; i
++, j
++)
1026 if (! NILP (prop
[i
]))
1027 ASET (font
, j
, prop
[i
]);
1028 if (! NILP (prop
[XLFD_ADSTYLE_INDEX
]))
1029 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1030 val
= prop
[XLFD_REGISTRY_INDEX
];
1033 val
= prop
[XLFD_ENCODING_INDEX
];
1035 val
= Fintern (concat2 (build_string ("*-"), SYMBOL_NAME (val
)),
1038 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1039 val
= Fintern (concat2 (SYMBOL_NAME (val
), build_string ("-*")),
1042 val
= Fintern (concat3 (SYMBOL_NAME (val
), build_string ("-"),
1043 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
])),
1046 ASET (font
, FONT_REGISTRY_INDEX
, val
);
1048 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1049 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1050 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1052 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1054 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1057 dpi
= prop
[XLFD_RESX_INDEX
];
1058 spacing
= prop
[XLFD_SPACING_INDEX
];
1059 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1060 avgwidth
= XINT (prop
[XLFD_AVGWIDTH_INDEX
]);
1064 font_put_extra (font
, QCdpi
, dpi
);
1065 if (! NILP (spacing
))
1066 font_put_extra (font
, QCspacing
, spacing
);
1068 font_put_extra (font
, QCscalable
, avgwidth
== 0 ? Qt
: Qnil
);
1073 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1074 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1075 0, use PIXEL_SIZE instead. */
1078 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1084 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1088 xassert (FONTP (font
));
1090 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1093 if (i
== FONT_ADSTYLE_INDEX
)
1094 j
= XLFD_ADSTYLE_INDEX
;
1095 else if (i
== FONT_REGISTRY_INDEX
)
1096 j
= XLFD_REGISTRY_INDEX
;
1097 val
= AREF (font
, i
);
1100 if (j
== XLFD_REGISTRY_INDEX
)
1101 f
[j
] = "*-*", len
+= 4;
1103 f
[j
] = "*", len
+= 2;
1108 val
= SYMBOL_NAME (val
);
1109 if (j
== XLFD_REGISTRY_INDEX
1110 && ! strchr ((char *) SDATA (val
), '-'))
1112 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1113 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1115 f
[j
] = alloca (SBYTES (val
) + 3);
1116 sprintf (f
[j
], "%s-*", SDATA (val
));
1117 len
+= SBYTES (val
) + 3;
1121 f
[j
] = alloca (SBYTES (val
) + 4);
1122 sprintf (f
[j
], "%s*-*", SDATA (val
));
1123 len
+= SBYTES (val
) + 4;
1127 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1131 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1134 val
= AREF (font
, i
);
1136 f
[j
] = "*", len
+= 2;
1140 val
= prop_numeric_to_name (i
, XINT (val
));
1142 val
= SYMBOL_NAME (val
);
1143 xassert (STRINGP (val
));
1144 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1148 val
= AREF (font
, FONT_SIZE_INDEX
);
1149 xassert (NUMBERP (val
) || NILP (val
));
1152 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1155 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1156 else if (pixel_size
> 0)
1157 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", pixel_size
) + 1;
1158 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1160 else if (FLOATP (val
))
1162 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1163 i
= XFLOAT_DATA (val
) * 10;
1164 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1167 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1169 val
= AREF (font
, FONT_EXTRA_INDEX
);
1171 if (FONT_ENTITY_P (font
)
1172 && EQ (AREF (font
, FONT_TYPE_INDEX
), Qx
))
1174 /* Setup names for RESX-RESY-SPACING-AVWIDTH. */
1175 if (SYMBOLP (val
) && ! NILP (val
))
1177 val
= SYMBOL_NAME (val
);
1178 f
[XLFD_RESX_INDEX
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1181 f
[XLFD_RESX_INDEX
] = "*-*-*-*", len
+= 6;
1185 Lisp_Object dpi
= assq_no_quit (QCdpi
, val
);
1186 Lisp_Object spacing
= assq_no_quit (QCspacing
, val
);
1187 Lisp_Object scalable
= assq_no_quit (QCscalable
, val
);
1189 if (CONSP (dpi
) || CONSP (spacing
) || CONSP (scalable
))
1191 char *str
= alloca (24);
1194 if (CONSP (dpi
) && INTEGERP (XCDR (dpi
)))
1195 this_len
= sprintf (str
, "%d-%d",
1196 XINT (XCDR (dpi
)), XINT (XCDR (dpi
)));
1198 this_len
= sprintf (str
, "*-*");
1199 if (CONSP (spacing
) && ! NILP (XCDR (spacing
)))
1201 val
= XCDR (spacing
);
1204 if (XINT (val
) < FONT_SPACING_MONO
)
1206 else if (XINT (val
) < FONT_SPACING_CHARCELL
)
1211 xassert (SYMBOLP (val
));
1212 this_len
+= sprintf (str
+ this_len
, "-%c",
1213 SDATA (SYMBOL_NAME (val
))[0]);
1216 this_len
+= sprintf (str
+ this_len
, "-*");
1217 if (CONSP (scalable
) && ! NILP (XCDR (spacing
)))
1218 this_len
+= sprintf (str
+ this_len
, "-0");
1220 this_len
+= sprintf (str
+ this_len
, "-*");
1221 f
[XLFD_RESX_INDEX
] = str
;
1225 f
[XLFD_RESX_INDEX
] = "*-*-*-*", len
+= 8;
1228 len
++; /* for terminating '\0'. */
1231 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1232 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1233 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1234 f
[XLFD_SWIDTH_INDEX
],
1235 f
[XLFD_ADSTYLE_INDEX
], f
[XLFD_PIXEL_INDEX
],
1236 f
[XLFD_RESX_INDEX
], f
[XLFD_REGISTRY_INDEX
]);
1239 /* Parse NAME (null terminated) as Fonconfig's name format and store
1240 information in FONT (font-spec or font-entity). If NAME is
1241 successfully parsed, return 0. Otherwise return -1. */
1244 font_parse_fcname (name
, font
)
1249 int len
= strlen (name
);
1256 /* It is assured that (name[0] && name[0] != '-'). */
1264 for (p0
= name
+ 1; *p0
&& (*p0
!= '-' && *p0
!= ':'); p0
++)
1265 if (*p0
== '\\' && p0
[1])
1267 family
= intern_font_field (name
, p0
- name
);
1270 if (! isdigit (p0
[1]))
1272 point_size
= strtod (p0
+ 1, &p1
);
1273 if (*p1
&& *p1
!= ':')
1275 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1278 ASET (font
, FONT_FAMILY_INDEX
, family
);
1282 copy
= alloca (len
+ 1);
1287 /* Now parse ":KEY=VAL" patterns. Store known keys and values in
1288 extra, copy unknown ones to COPY. */
1291 Lisp_Object key
, val
;
1294 for (p1
= p0
+ 1; *p1
&& *p1
!= '=' && *p1
!= ':'; p1
++);
1297 /* Must be an enumerated value. */
1298 val
= intern_font_field (p0
+ 1, p1
- p0
- 1);
1299 if (memcmp (p0
+ 1, "light", 5) == 0
1300 || memcmp (p0
+ 1, "medium", 6) == 0
1301 || memcmp (p0
+ 1, "demibold", 8) == 0
1302 || memcmp (p0
+ 1, "bold", 4) == 0
1303 || memcmp (p0
+ 1, "black", 5) == 0)
1305 ASET (font
, FONT_WEIGHT_INDEX
, val
);
1308 else if (memcmp (p0
+ 1, "roman", 5) == 0
1309 || memcmp (p0
+ 1, "italic", 6) == 0
1310 || memcmp (p0
+ 1, "oblique", 7) == 0)
1312 ASET (font
, FONT_SLANT_INDEX
, val
);
1315 else if (memcmp (p0
+ 1, "charcell", 8) == 0
1316 || memcmp (p0
+ 1, "mono", 4) == 0
1317 || memcmp (p0
+ 1, "proportional", 12) == 0)
1319 font_put_extra (font
, QCspacing
,
1320 (p0
[1] == 'c' ? Qc
: p0
[1] == 'm' ? Qm
: Qp
));
1325 bcopy (p0
, copy
, p1
- p0
);
1331 if (memcmp (p0
+ 1, "pixelsize=", 10) == 0)
1332 prop
= FONT_SIZE_INDEX
;
1335 key
= intern_font_field (p0
, p1
- p0
);
1336 prop
= get_font_prop_index (key
, 0);
1339 for (p1
= p0
; *p1
&& *p1
!= ':'; p1
++);
1340 val
= intern_font_field (p0
, p1
- p0
);
1343 if (prop
>= 0 && prop
< FONT_EXTRA_INDEX
)
1345 if (prop
== FONT_WEIGHT_INDEX
)
1347 else if (prop
== FONT_SLANT_INDEX
)
1350 ASET (font
, prop
, val
);
1353 font_put_extra (font
, key
, val
);
1360 ASET (font
, FONT_WEIGHT_INDEX
, build_string ("normal"));
1362 ASET (font
, FONT_SLANT_INDEX
, build_string ("normal"));
1367 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1368 NAME (NBYTES length), and return the name length. If
1369 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1372 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1380 int dpi
, spacing
, scalable
;
1383 Lisp_Object styles
[3];
1384 char *style_names
[3] = { "weight", "slant", "width" };
1386 val
= AREF (font
, FONT_FAMILY_INDEX
);
1387 if (SYMBOLP (val
) && ! NILP (val
))
1388 len
+= SBYTES (SYMBOL_NAME (val
));
1390 val
= AREF (font
, FONT_SIZE_INDEX
);
1393 if (XINT (val
) != 0)
1394 pixel_size
= XINT (val
);
1396 len
+= 21; /* for ":pixelsize=NUM" */
1398 else if (FLOATP (val
))
1401 point_size
= (int) XFLOAT_DATA (val
);
1402 len
+= 11; /* for "-NUM" */
1405 val
= AREF (font
, FONT_FOUNDRY_INDEX
);
1406 if (SYMBOLP (val
) && ! NILP (val
))
1407 /* ":foundry=NAME" */
1408 len
+= 9 + SBYTES (SYMBOL_NAME (val
));
1410 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
1412 val
= AREF (font
, i
);
1415 val
= prop_numeric_to_name (i
, XINT (val
));
1416 len
+= (strlen (style_names
[i
- FONT_WEIGHT_INDEX
])
1417 + 2 + SBYTES (SYMBOL_NAME (val
))); /* :xxx=NAME */
1419 styles
[i
- FONT_WEIGHT_INDEX
] = val
;
1422 val
= AREF (font
, FONT_EXTRA_INDEX
);
1423 if (FONT_ENTITY_P (font
)
1424 && EQ (AREF (font
, FONT_TYPE_INDEX
), Qx
))
1428 /* VAL is a symbol of name `RESX-RESY-SPACING-AVWIDTH'. */
1429 p
= (char *) SDATA (SYMBOL_NAME (val
));
1431 for (p
++; *p
!= '-'; p
++); /* skip RESX */
1432 for (p
++; *p
!= '-'; p
++); /* skip RESY */
1433 spacing
= (*p
== 'c' ? FONT_SPACING_CHARCELL
1434 : *p
== 'm' ? FONT_SPACING_MONO
1435 : FONT_SPACING_PROPORTIONAL
);
1436 for (p
++; *p
!= '-'; p
++); /* skip SPACING */
1437 scalable
= (atoi (p
) == 0);
1438 /* The longest pattern is ":dpi=NUM:scalable=False:spacing=100" */
1445 dpi
= spacing
= scalable
= -1;
1446 elt
= assq_no_quit (QCdpi
, val
);
1448 dpi
= XINT (XCDR (elt
)), len
+= 15; /* for ":dpi=NUM" */
1449 elt
= assq_no_quit (QCspacing
, val
);
1451 spacing
= XINT (XCDR (elt
)), len
+= 12; /* for ":spacing=100" */
1452 elt
= assq_no_quit (QCscalable
, val
);
1454 scalable
= ! NILP (XCDR (elt
)), len
+= 15; /* for ":scalable=False" */
1460 if (! NILP (AREF (font
, FONT_FAMILY_INDEX
)))
1461 p
+= sprintf(p
, "%s",
1462 SDATA (SYMBOL_NAME (AREF (font
, FONT_FAMILY_INDEX
))));
1466 p
+= sprintf (p
, "%d", point_size
);
1468 p
+= sprintf (p
, "-%d", point_size
);
1470 else if (pixel_size
> 0)
1471 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1472 if (SYMBOLP (AREF (font
, FONT_FOUNDRY_INDEX
))
1473 && ! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1474 p
+= sprintf (p
, ":foundry=%s",
1475 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1476 for (i
= 0; i
< 3; i
++)
1477 if (SYMBOLP (styles
[i
]) && ! NILP (styles
[i
]))
1478 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1479 SDATA (SYMBOL_NAME (styles
[i
])));
1481 p
+= sprintf (p
, ":dpi=%d", dpi
);
1483 p
+= sprintf (p
, ":spacing=%d", spacing
);
1485 p
+= sprintf (p
, ":scalable=True");
1486 else if (scalable
== 0)
1487 p
+= sprintf (p
, ":scalable=False");
1491 /* Parse NAME (null terminated) and store information in FONT
1492 (font-spec or font-entity). If NAME is successfully parsed, return
1493 0. Otherwise return -1.
1495 If NAME is XLFD and FONT is a font-entity, store
1496 RESX-RESY-SPACING-AVWIDTH information as a symbol in
1497 FONT_EXTRA_INDEX. */
1500 font_parse_name (name
, font
)
1504 if (name
[0] == '-' || index (name
, '*'))
1505 return font_parse_xlfd (name
, font
);
1506 return font_parse_fcname (name
, font
);
1509 /* Merge old style font specification (either a font name NAME or a
1510 combination of a family name FAMILY and a registry name REGISTRY
1511 into the font specification SPEC. */
1514 font_merge_old_spec (name
, family
, registry
, spec
)
1515 Lisp_Object name
, family
, registry
, spec
;
1519 if (font_parse_xlfd ((char *) SDATA (name
), spec
) < 0)
1521 Lisp_Object extra
= Fcons (Fcons (QCname
, name
), Qnil
);
1523 ASET (spec
, FONT_EXTRA_INDEX
, extra
);
1528 if (! NILP (family
))
1533 xassert (STRINGP (family
));
1534 len
= SBYTES (family
);
1535 p0
= (char *) SDATA (family
);
1536 p1
= index (p0
, '-');
1539 if ((*p0
!= '*' || p1
- p0
> 1)
1540 && NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
1541 ASET (spec
, FONT_FOUNDRY_INDEX
,
1542 intern_downcase (p0
, p1
- p0
));
1543 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
1544 ASET (spec
, FONT_FAMILY_INDEX
,
1545 intern_downcase (p1
+ 1, len
- (p1
+ 1 - p0
)));
1547 else if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
1548 ASET (spec
, FONT_FAMILY_INDEX
, intern_downcase (p0
, len
));
1550 if (! NILP (registry
)
1551 && NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
1552 ASET (spec
, FONT_REGISTRY_INDEX
,
1553 intern_downcase ((char *) SDATA (registry
), SBYTES (registry
)));
1558 /* This part (through the next ^L) is still experimental and never
1559 tested. We may drastically change codes. */
1563 #define LGSTRING_HEADER_SIZE 6
1564 #define LGSTRING_GLYPH_SIZE 8
1567 check_gstring (gstring
)
1568 Lisp_Object gstring
;
1573 CHECK_VECTOR (gstring
);
1574 val
= AREF (gstring
, 0);
1576 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1578 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1579 if (! NILP (LGSTRING_LBEARING (gstring
)))
1580 CHECK_NUMBER (LGSTRING_LBEARING (gstring
));
1581 if (! NILP (LGSTRING_RBEARING (gstring
)))
1582 CHECK_NUMBER (LGSTRING_RBEARING (gstring
));
1583 if (! NILP (LGSTRING_WIDTH (gstring
)))
1584 CHECK_NATNUM (LGSTRING_WIDTH (gstring
));
1585 if (! NILP (LGSTRING_ASCENT (gstring
)))
1586 CHECK_NUMBER (LGSTRING_ASCENT (gstring
));
1587 if (! NILP (LGSTRING_DESCENT (gstring
)))
1588 CHECK_NUMBER (LGSTRING_DESCENT(gstring
));
1590 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1592 val
= LGSTRING_GLYPH (gstring
, i
);
1594 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1596 if (NILP (LGLYPH_CHAR (val
)))
1598 CHECK_NATNUM (LGLYPH_FROM (val
));
1599 CHECK_NATNUM (LGLYPH_TO (val
));
1600 CHECK_CHARACTER (LGLYPH_CHAR (val
));
1601 if (! NILP (LGLYPH_CODE (val
)))
1602 CHECK_NATNUM (LGLYPH_CODE (val
));
1603 if (! NILP (LGLYPH_WIDTH (val
)))
1604 CHECK_NATNUM (LGLYPH_WIDTH (val
));
1605 if (! NILP (LGLYPH_ADJUSTMENT (val
)))
1607 val
= LGLYPH_ADJUSTMENT (val
);
1609 if (ASIZE (val
) < 3)
1611 for (j
= 0; j
< 3; j
++)
1612 CHECK_NUMBER (AREF (val
, j
));
1617 error ("Invalid glyph-string format");
1622 check_otf_features (otf_features
)
1623 Lisp_Object otf_features
;
1625 Lisp_Object val
, elt
;
1627 CHECK_CONS (otf_features
);
1628 CHECK_SYMBOL (XCAR (otf_features
));
1629 otf_features
= XCDR (otf_features
);
1630 CHECK_CONS (otf_features
);
1631 CHECK_SYMBOL (XCAR (otf_features
));
1632 otf_features
= XCDR (otf_features
);
1633 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1635 CHECK_SYMBOL (Fcar (val
));
1636 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1637 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1639 otf_features
= XCDR (otf_features
);
1640 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1642 CHECK_SYMBOL (Fcar (val
));
1643 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1644 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1651 Lisp_Object otf_list
;
1654 otf_tag_symbol (tag
)
1659 OTF_tag_name (tag
, name
);
1660 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1664 otf_open (entity
, file
)
1668 Lisp_Object val
= Fassoc (entity
, otf_list
);
1672 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1675 otf
= file
? OTF_open (file
) : NULL
;
1676 val
= make_save_value (otf
, 0);
1677 otf_list
= Fcons (Fcons (entity
, val
), otf_list
);
1683 /* Return a list describing which scripts/languages FONT supports by
1684 which GSUB/GPOS features of OpenType tables. See the comment of
1685 (sturct font_driver).otf_capability. */
1688 font_otf_capability (font
)
1692 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1695 otf
= otf_open (font
->entity
, font
->file_name
);
1698 for (i
= 0; i
< 2; i
++)
1700 OTF_GSUB_GPOS
*gsub_gpos
;
1701 Lisp_Object script_list
= Qnil
;
1704 if (OTF_get_features (otf
, i
== 0) < 0)
1706 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1707 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1709 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1710 Lisp_Object langsys_list
= Qnil
;
1711 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1714 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1716 OTF_LangSys
*langsys
;
1717 Lisp_Object feature_list
= Qnil
;
1718 Lisp_Object langsys_tag
;
1721 if (k
== script
->LangSysCount
)
1723 langsys
= &script
->DefaultLangSys
;
1728 langsys
= script
->LangSys
+ k
;
1730 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1732 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1734 OTF_Feature
*feature
1735 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1736 Lisp_Object feature_tag
1737 = otf_tag_symbol (feature
->FeatureTag
);
1739 feature_list
= Fcons (feature_tag
, feature_list
);
1741 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1744 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1749 XSETCAR (capability
, script_list
);
1751 XSETCDR (capability
, script_list
);
1757 /* Parse OTF features in SPEC and write a proper features spec string
1758 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1759 assured that the sufficient memory has already allocated for
1763 generate_otf_features (spec
, features
)
1773 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1779 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1784 else if (! asterisk
)
1786 val
= SYMBOL_NAME (val
);
1787 p
+= sprintf (p
, "%s", SDATA (val
));
1791 val
= SYMBOL_NAME (val
);
1792 p
+= sprintf (p
, "~%s", SDATA (val
));
1796 error ("OTF spec too long");
1801 font_otf_DeviceTable (device_table
)
1802 OTF_DeviceTable
*device_table
;
1804 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1806 return Fcons (make_number (len
),
1807 make_unibyte_string (device_table
->DeltaValue
, len
));
1811 font_otf_ValueRecord (value_format
, value_record
)
1813 OTF_ValueRecord
*value_record
;
1815 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1817 if (value_format
& OTF_XPlacement
)
1818 ASET (val
, 0, value_record
->XPlacement
);
1819 if (value_format
& OTF_YPlacement
)
1820 ASET (val
, 1, value_record
->YPlacement
);
1821 if (value_format
& OTF_XAdvance
)
1822 ASET (val
, 2, value_record
->XAdvance
);
1823 if (value_format
& OTF_YAdvance
)
1824 ASET (val
, 3, value_record
->YAdvance
);
1825 if (value_format
& OTF_XPlaDevice
)
1826 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1827 if (value_format
& OTF_YPlaDevice
)
1828 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1829 if (value_format
& OTF_XAdvDevice
)
1830 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
1831 if (value_format
& OTF_YAdvDevice
)
1832 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
1837 font_otf_Anchor (anchor
)
1842 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
1843 ASET (val
, 0, make_number (anchor
->XCoordinate
));
1844 ASET (val
, 1, make_number (anchor
->YCoordinate
));
1845 if (anchor
->AnchorFormat
== 2)
1846 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
1849 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
1850 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
1855 #endif /* HAVE_LIBOTF */
1857 /* G-string (glyph string) handler */
1859 /* G-string is a vector of the form [HEADER GLYPH ...].
1860 See the docstring of `font-make-gstring' for more detail. */
1863 font_prepare_composition (cmp
, f
)
1864 struct composition
*cmp
;
1868 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
1869 cmp
->hash_index
* 2);
1871 cmp
->font
= XSAVE_VALUE (LGSTRING_FONT (gstring
))->pointer
;
1872 cmp
->glyph_len
= LGSTRING_LENGTH (gstring
);
1873 cmp
->pixel_width
= LGSTRING_WIDTH (gstring
);
1874 cmp
->lbearing
= LGSTRING_LBEARING (gstring
);
1875 cmp
->rbearing
= LGSTRING_RBEARING (gstring
);
1876 cmp
->ascent
= LGSTRING_ASCENT (gstring
);
1877 cmp
->descent
= LGSTRING_DESCENT (gstring
);
1878 cmp
->width
= cmp
->pixel_width
/ FRAME_COLUMN_WIDTH (f
);
1879 if (cmp
->width
== 0)
1888 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
1889 static int font_compare
P_ ((const void *, const void *));
1890 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
1891 Lisp_Object
, Lisp_Object
));
1893 /* We sort fonts by scoring each of them against a specified
1894 font-spec. The score value is 32 bit (`unsigned'), and the smaller
1895 the value is, the closer the font is to the font-spec.
1897 Each 1-bit of the highest 4 bits of the score is used for atomic
1898 properties FOUNDRY, FAMILY, ADSTYLE, and REGISTRY.
1900 Each 7-bit in the lowest 28 bits are used for numeric properties
1901 WEIGHT, SLANT, WIDTH, and SIZE. */
1903 /* How many bits to shift to store the difference value of each font
1904 property in a score. */
1905 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
1907 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
1908 The return value indicates how different ENTITY is compared with
1912 font_score (entity
, spec_prop
)
1913 Lisp_Object entity
, *spec_prop
;
1917 /* Score four atomic fields. Maximum difference is 1. */
1918 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
1919 if (! NILP (spec_prop
[i
])
1920 && ! EQ (spec_prop
[i
], AREF (entity
, i
)))
1921 score
|= 1 << sort_shift_bits
[i
];
1923 /* Score four numeric fields. Maximum difference is 127. */
1924 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
1926 Lisp_Object entity_val
= AREF (entity
, i
);
1927 Lisp_Object spec_val
= spec_prop
[i
];
1929 /* If weight and slant are unspecified, score normal lower (low wins). */
1930 if (NILP (spec_val
))
1932 if (i
== FONT_WEIGHT_INDEX
|| i
== FONT_SLANT_INDEX
)
1933 spec_val
= prop_name_to_numeric (i
, build_string ("normal"));
1936 if (! NILP (spec_val
) && ! EQ (spec_val
, entity_val
))
1938 if (! INTEGERP (entity_val
))
1939 score
|= 127 << sort_shift_bits
[i
];
1942 int diff
= XINT (entity_val
) - XINT (spec_val
);
1946 if (i
== FONT_SIZE_INDEX
)
1948 if (XINT (entity_val
) > 0
1949 && diff
> FONT_PIXEL_SIZE_QUANTUM
)
1950 score
|= min (diff
, 127) << sort_shift_bits
[i
];
1953 else if (i
== FONT_WEIGHT_INDEX
)
1955 /* Windows uses a much wider range for weight (100-900)
1956 compared with freetype (0-210), so scale down the
1957 difference. A more general way of doing this
1958 would be to look up the values of regular and bold
1959 and/or light and calculate the scale factor from them,
1960 but the lookup would be expensive, and if only Windows
1961 needs it, not worth the effort. */
1962 score
|= min (diff
/ 4, 127) << sort_shift_bits
[i
];
1966 score
|= min (diff
, 127) << sort_shift_bits
[i
];
1975 /* The comparison function for qsort. */
1978 font_compare (d1
, d2
)
1979 const void *d1
, *d2
;
1981 return (*(unsigned *) d1
< *(unsigned *) d2
1982 ? -1 : *(unsigned *) d1
> *(unsigned *) d2
);
1986 /* The structure for elements being sorted by qsort. */
1987 struct font_sort_data
1994 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
1995 If PREFER specifies a point-size, calculate the corresponding
1996 pixel-size from QCdpi property of PREFER or from the Y-resolution
1997 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
1998 get the font-entities in VEC. */
2001 font_sort_entites (vec
, prefer
, frame
, spec
)
2002 Lisp_Object vec
, prefer
, frame
, spec
;
2004 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2006 struct font_sort_data
*data
;
2013 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2014 prefer_prop
[i
] = AREF (prefer
, i
);
2018 /* As it is assured that all fonts in VEC match with SPEC, we
2019 should ignore properties specified in SPEC. So, set the
2020 corresponding properties in PREFER_PROP to nil. */
2021 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2022 if (! NILP (AREF (spec
, i
)))
2023 prefer_prop
[i
++] = Qnil
;
2026 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2027 prefer_prop
[FONT_SIZE_INDEX
]
2028 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2030 /* Scoring and sorting. */
2031 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2032 for (i
= 0; i
< len
; i
++)
2034 data
[i
].entity
= AREF (vec
, i
);
2035 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
);
2037 qsort (data
, len
, sizeof *data
, font_compare
);
2038 for (i
= 0; i
< len
; i
++)
2039 ASET (vec
, i
, data
[i
].entity
);
2046 /* API of Font Service Layer. */
2048 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2049 sort_shift_bits. Finternal_set_font_selection_order calls this
2050 function with font_sort_order after setting up it. */
2053 font_update_sort_order (order
)
2056 int i
, shift_bits
= 21;
2058 for (i
= 0; i
< 4; i
++, shift_bits
-= 7)
2060 int xlfd_idx
= order
[i
];
2062 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2063 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2064 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2065 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2066 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2067 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2069 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2074 /* Return weight property of FONT as symbol. */
2077 font_symbolic_weight (font
)
2080 Lisp_Object weight
= AREF (font
, FONT_WEIGHT_INDEX
);
2082 if (INTEGERP (weight
))
2083 weight
= prop_numeric_to_name (FONT_WEIGHT_INDEX
, XINT (weight
));
2088 /* Return slant property of FONT as symbol. */
2091 font_symbolic_slant (font
)
2094 Lisp_Object slant
= AREF (font
, FONT_SLANT_INDEX
);
2096 if (INTEGERP (slant
))
2097 slant
= prop_numeric_to_name (FONT_SLANT_INDEX
, XINT (slant
));
2102 /* Return width property of FONT as symbol. */
2105 font_symbolic_width (font
)
2108 Lisp_Object width
= AREF (font
, FONT_WIDTH_INDEX
);
2110 if (INTEGERP (width
))
2111 width
= prop_numeric_to_name (FONT_WIDTH_INDEX
, XINT (width
));
2116 /* Check if ENTITY matches with the font specification SPEC. */
2119 font_match_p (spec
, entity
)
2120 Lisp_Object spec
, entity
;
2124 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2125 if (! NILP (AREF (spec
, i
))
2126 && ! EQ (AREF (spec
, i
), AREF (entity
, i
)))
2128 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
))
2129 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0
2130 && (XINT (AREF (spec
, FONT_SIZE_INDEX
))
2131 != XINT (AREF (entity
, FONT_SIZE_INDEX
))))
2137 /* Return a lispy font object corresponding to FONT. */
2140 font_find_object (font
)
2143 Lisp_Object tail
, elt
;
2145 for (tail
= AREF (font
->entity
, FONT_OBJLIST_INDEX
); CONSP (tail
);
2149 if (font
== XSAVE_VALUE (elt
)->pointer
2150 && XSAVE_VALUE (elt
)->integer
> 0)
2160 Each font backend has the callback function get_cache, and it
2161 returns a cons cell of which cdr part can be freely used for
2162 caching fonts. The cons cell may be shared by multiple frames
2163 and/or multiple font drivers. So, we arrange the cdr part as this:
2165 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2167 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2168 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2169 cons (FONT-SPEC FONT-ENTITY ...). */
2171 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2172 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2173 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2174 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2175 struct font_driver
*));
2178 font_prepare_cache (f
, driver
)
2180 struct font_driver
*driver
;
2182 Lisp_Object cache
, val
;
2184 cache
= driver
->get_cache (f
);
2186 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2190 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2191 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2195 val
= XCDR (XCAR (val
));
2196 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2201 font_finish_cache (f
, driver
)
2203 struct font_driver
*driver
;
2205 Lisp_Object cache
, val
, tmp
;
2208 cache
= driver
->get_cache (f
);
2210 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2211 cache
= val
, val
= XCDR (val
);
2212 xassert (! NILP (val
));
2213 tmp
= XCDR (XCAR (val
));
2214 if (XINT (XCAR (tmp
)) == 0)
2216 font_clear_cache (f
, XCAR (val
), driver
);
2217 XSETCDR (cache
, XCDR (val
));
2221 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2226 font_get_cache (f
, driver
)
2228 struct font_driver
*driver
;
2230 Lisp_Object val
= driver
->get_cache (f
);
2231 Lisp_Object type
= driver
->type
;
2233 xassert (CONSP (val
));
2234 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2235 xassert (CONSP (val
));
2236 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2237 val
= XCDR (XCAR (val
));
2242 font_clear_cache (f
, cache
, driver
)
2245 struct font_driver
*driver
;
2247 Lisp_Object tail
, elt
;
2249 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2250 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2253 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2255 Lisp_Object vec
= XCDR (elt
);
2258 for (i
= 0; i
< ASIZE (vec
); i
++)
2260 Lisp_Object entity
= AREF (vec
, i
);
2262 if (EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2264 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2266 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2268 Lisp_Object val
= XCAR (objlist
);
2269 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
2270 struct font
*font
= p
->pointer
;
2272 xassert (font
&& driver
== font
->driver
);
2273 driver
->close (f
, font
);
2277 if (driver
->free_entity
)
2278 driver
->free_entity (entity
);
2283 XSETCDR (cache
, Qnil
);
2287 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2290 /* Return a vector of font-entities matching with SPEC on frame F. */
2293 font_list_entities (frame
, spec
)
2294 Lisp_Object frame
, spec
;
2296 FRAME_PTR f
= XFRAME (frame
);
2297 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2298 Lisp_Object ftype
, family
, size
, alternate_familes
;
2299 Lisp_Object
*vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2305 family
= AREF (spec
, FONT_FAMILY_INDEX
);
2307 alternate_familes
= Qnil
;
2310 if (NILP (font_family_alist
)
2311 && !NILP (Vface_alternative_font_family_alist
))
2312 build_font_family_alist ();
2313 alternate_familes
= assq_no_quit (family
, font_family_alist
);
2314 if (! NILP (alternate_familes
))
2315 alternate_familes
= XCDR (alternate_familes
);
2317 size
= AREF (spec
, FONT_SIZE_INDEX
);
2319 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2321 xassert (ASIZE (spec
) == FONT_SPEC_MAX
);
2322 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2324 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2326 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2328 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2329 Lisp_Object tail
= alternate_familes
;
2331 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2332 ASET (spec
, FONT_FAMILY_INDEX
, family
);
2336 Lisp_Object val
= assoc_no_quit (spec
, XCDR (cache
));
2342 val
= driver_list
->driver
->list (frame
, spec
);
2344 XSETCDR (cache
, Fcons (Fcons (Fcopy_sequence (spec
), val
),
2347 if (VECTORP (val
) && ASIZE (val
) > 0)
2354 ASET (spec
, FONT_FAMILY_INDEX
, XCAR (tail
));
2358 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2359 ASET (spec
, FONT_FAMILY_INDEX
, family
);
2360 ASET (spec
, FONT_SIZE_INDEX
, size
);
2361 return (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2365 /* Return a font entity matching with SPEC on FRAME. */
2368 font_matching_entity (frame
, spec
)
2369 Lisp_Object frame
, spec
;
2371 FRAME_PTR f
= XFRAME (frame
);
2372 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2373 Lisp_Object ftype
, size
, entity
;
2375 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2376 size
= AREF (spec
, FONT_SIZE_INDEX
);
2378 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2380 for (; driver_list
; driver_list
= driver_list
->next
)
2382 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2384 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2387 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2388 key
= Fcons (spec
, Qnil
);
2389 entity
= assoc_no_quit (key
, XCDR (cache
));
2391 entity
= XCDR (entity
);
2394 entity
= driver_list
->driver
->match (frame
, spec
);
2395 if (! NILP (entity
))
2397 XSETCAR (key
, Fcopy_sequence (spec
));
2398 XSETCDR (cache
, Fcons (Fcons (key
, entity
), XCDR (cache
)));
2401 if (! NILP (entity
))
2404 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2405 ASET (spec
, FONT_SIZE_INDEX
, size
);
2409 static int num_fonts
;
2412 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2413 opened font object. */
2416 font_open_entity (f
, entity
, pixel_size
)
2421 struct font_driver_list
*driver_list
;
2422 Lisp_Object objlist
, size
, val
;
2425 size
= AREF (entity
, FONT_SIZE_INDEX
);
2426 xassert (NATNUMP (size
));
2427 if (XINT (size
) != 0)
2428 pixel_size
= XINT (size
);
2430 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2431 objlist
= XCDR (objlist
))
2433 font
= XSAVE_VALUE (XCAR (objlist
))->pointer
;
2434 if (font
->pixel_size
== pixel_size
)
2436 XSAVE_VALUE (XCAR (objlist
))->integer
++;
2437 return XCAR (objlist
);
2441 xassert (FONT_ENTITY_P (entity
));
2442 val
= AREF (entity
, FONT_TYPE_INDEX
);
2443 for (driver_list
= f
->font_driver_list
;
2444 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2445 driver_list
= driver_list
->next
);
2449 font
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2452 font
->scalable
= XINT (size
) == 0;
2454 val
= make_save_value (font
, 1);
2455 ASET (entity
, FONT_OBJLIST_INDEX
,
2456 Fcons (val
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2462 /* Close FONT_OBJECT that is opened on frame F. */
2465 font_close_object (f
, font_object
)
2467 Lisp_Object font_object
;
2469 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2470 Lisp_Object objlist
;
2471 Lisp_Object tail
, prev
= Qnil
;
2473 XSAVE_VALUE (font_object
)->integer
--;
2474 xassert (XSAVE_VALUE (font_object
)->integer
>= 0);
2475 if (XSAVE_VALUE (font_object
)->integer
> 0)
2478 objlist
= AREF (font
->entity
, FONT_OBJLIST_INDEX
);
2479 for (prev
= Qnil
, tail
= objlist
; CONSP (tail
);
2480 prev
= tail
, tail
= XCDR (tail
))
2481 if (EQ (font_object
, XCAR (tail
)))
2483 if (font
->driver
->close
)
2484 font
->driver
->close (f
, font
);
2485 XSAVE_VALUE (font_object
)->pointer
= NULL
;
2487 ASET (font
->entity
, FONT_OBJLIST_INDEX
, XCDR (objlist
));
2489 XSETCDR (prev
, XCDR (objlist
));
2496 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2497 FONT is a font-entity and it must be opened to check. */
2500 font_has_char (f
, font
, c
)
2507 if (FONT_ENTITY_P (font
))
2509 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2510 struct font_driver_list
*driver_list
;
2512 for (driver_list
= f
->font_driver_list
;
2513 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2514 driver_list
= driver_list
->next
);
2517 if (! driver_list
->driver
->has_char
)
2519 return driver_list
->driver
->has_char (font
, c
);
2522 xassert (FONT_OBJECT_P (font
));
2523 fontp
= XSAVE_VALUE (font
)->pointer
;
2525 if (fontp
->driver
->has_char
)
2527 int result
= fontp
->driver
->has_char (fontp
->entity
, c
);
2532 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2536 /* Return the glyph ID of FONT_OBJECT for character C. */
2539 font_encode_char (font_object
, c
)
2540 Lisp_Object font_object
;
2543 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2545 return font
->driver
->encode_char (font
, c
);
2549 /* Return the name of FONT_OBJECT. */
2552 font_get_name (font_object
)
2553 Lisp_Object font_object
;
2555 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2556 char *name
= (font
->font
.full_name
? font
->font
.full_name
2557 : font
->font
.name
? font
->font
.name
2560 return (name
? make_unibyte_string (name
, strlen (name
)) : null_string
);
2564 /* Return the specification of FONT_OBJECT. */
2567 font_get_spec (font_object
)
2568 Lisp_Object font_object
;
2570 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2571 Lisp_Object spec
= Ffont_spec (0, NULL
);
2574 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2575 ASET (spec
, i
, AREF (font
->entity
, i
));
2576 ASET (spec
, FONT_SIZE_INDEX
, make_number (font
->pixel_size
));
2581 /* Return the frame on which FONT exists. FONT is a font object or a
2585 font_get_frame (font
)
2588 if (FONT_OBJECT_P (font
))
2589 font
= ((struct font
*) XSAVE_VALUE (font
)->pointer
)->entity
;
2590 xassert (FONT_ENTITY_P (font
));
2591 return AREF (font
, FONT_FRAME_INDEX
);
2595 /* Find a font entity best matching with LFACE. If SPEC is non-nil,
2596 the font must exactly match with it. C, if not negative, is a
2597 character that the entity must support. */
2600 font_find_for_lface (f
, lface
, spec
, c
)
2606 Lisp_Object frame
, entities
;
2609 XSETFRAME (frame
, f
);
2615 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2616 ASET (scratch_font_spec
, i
, Qnil
);
2617 ASET (scratch_font_spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2619 if (! NILP (lface
[LFACE_FAMILY_INDEX
]))
2620 font_merge_old_spec (Qnil
, lface
[LFACE_FAMILY_INDEX
], Qnil
,
2622 entities
= font_list_entities (frame
, scratch_font_spec
);
2623 while (ASIZE (entities
) == 0)
2625 /* Try without FOUNDRY or FAMILY. */
2626 if (! NILP (AREF (scratch_font_spec
, FONT_FOUNDRY_INDEX
)))
2628 ASET (scratch_font_spec
, FONT_FOUNDRY_INDEX
, Qnil
);
2629 entities
= font_list_entities (frame
, scratch_font_spec
);
2631 else if (! NILP (AREF (scratch_font_spec
, FONT_FAMILY_INDEX
)))
2633 ASET (scratch_font_spec
, FONT_FAMILY_INDEX
, Qnil
);
2634 entities
= font_list_entities (frame
, scratch_font_spec
);
2642 Lisp_Object registry
= AREF (spec
, FONT_REGISTRY_INDEX
);
2644 if (NILP (registry
))
2645 registry
= Qiso8859_1
;
2649 struct charset
*repertory
;
2651 if (font_registry_charsets (registry
, NULL
, &repertory
) < 0)
2655 if (ENCODE_CHAR (repertory
, c
)
2656 == CHARSET_INVALID_CODE (repertory
))
2658 /* Any font of this registry support C. So, let's
2659 suppress the further checking. */
2662 else if (c
> MAX_UNICODE_CHAR
)
2665 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2666 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2667 ASET (scratch_font_spec
, FONT_REGISTRY_INDEX
, registry
);
2668 entities
= font_list_entities (frame
, scratch_font_spec
);
2671 if (ASIZE (entities
) == 0)
2673 if (ASIZE (entities
) > 1)
2675 /* Sort fonts by properties specified in LFACE. */
2676 Lisp_Object prefer
= scratch_font_prefer
;
2679 if (! NILP (lface
[LFACE_FAMILY_INDEX
]))
2680 font_merge_old_spec (Qnil
, lface
[LFACE_FAMILY_INDEX
], Qnil
, prefer
);
2681 ASET (prefer
, FONT_WEIGHT_INDEX
,
2682 font_prop_validate_style (QCweight
, lface
[LFACE_WEIGHT_INDEX
]));
2683 ASET (prefer
, FONT_SLANT_INDEX
,
2684 font_prop_validate_style (QCslant
, lface
[LFACE_SLANT_INDEX
]));
2685 ASET (prefer
, FONT_WIDTH_INDEX
,
2686 font_prop_validate_style (QCwidth
, lface
[LFACE_SWIDTH_INDEX
]));
2687 pt
= XINT (lface
[LFACE_HEIGHT_INDEX
]);
2688 ASET (prefer
, FONT_SIZE_INDEX
, make_float (pt
/ 10));
2690 font_sort_entites (entities
, prefer
, frame
, spec
);
2694 return AREF (entities
, 0);
2695 for (i
= 0; i
< ASIZE (entities
); i
++)
2697 int result
= font_has_char (f
, AREF (entities
, i
), c
);
2698 Lisp_Object font_object
;
2701 return AREF (entities
, i
);
2704 font_object
= font_open_for_lface (f
, AREF (entities
, i
), lface
, spec
);
2705 if (NILP (font_object
))
2707 result
= font_has_char (f
, font_object
, c
);
2708 font_close_object (f
, font_object
);
2710 return AREF (entities
, i
);
2717 font_open_for_lface (f
, entity
, lface
, spec
)
2725 if (FONT_SPEC_P (spec
) && INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2726 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2729 double pt
= XINT (lface
[LFACE_HEIGHT_INDEX
]);
2732 size
= POINT_TO_PIXEL (pt
, f
->resy
);
2734 return font_open_entity (f
, entity
, size
);
2738 /* Load a font best matching with FACE's font-related properties into
2739 FACE on frame F. If no proper font is found, record that FACE has
2743 font_load_for_face (f
, face
)
2747 Lisp_Object font_object
= face
->lface
[LFACE_FONT_INDEX
];
2749 if (NILP (font_object
))
2751 Lisp_Object entity
= font_find_for_lface (f
, face
->lface
, Qnil
, -1);
2753 if (! NILP (entity
))
2754 font_object
= font_open_for_lface (f
, entity
, face
->lface
, Qnil
);
2757 if (! NILP (font_object
))
2759 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2761 face
->font
= font
->font
.font
;
2762 face
->font_info
= (struct font_info
*) font
;
2763 face
->font_info_id
= 0;
2764 face
->font_name
= font
->font
.full_name
;
2769 face
->font_info
= NULL
;
2770 face
->font_info_id
= -1;
2771 face
->font_name
= NULL
;
2772 add_to_log ("Unable to load font for a face%s", null_string
, Qnil
);
2777 /* Make FACE on frame F ready to use the font opened for FACE. */
2780 font_prepare_for_face (f
, face
)
2784 struct font
*font
= (struct font
*) face
->font_info
;
2786 if (font
->driver
->prepare_face
)
2787 font
->driver
->prepare_face (f
, face
);
2791 /* Make FACE on frame F stop using the font opened for FACE. */
2794 font_done_for_face (f
, face
)
2798 struct font
*font
= (struct font
*) face
->font_info
;
2800 if (font
->driver
->done_face
)
2801 font
->driver
->done_face (f
, face
);
2806 /* Open a font best matching with NAME on frame F. If no proper font
2807 is found, return Qnil. */
2810 font_open_by_name (f
, name
)
2814 Lisp_Object args
[2];
2815 Lisp_Object spec
, prefer
, size
, entity
, entity_list
;
2820 XSETFRAME (frame
, f
);
2823 args
[1] = make_unibyte_string (name
, strlen (name
));
2824 spec
= Ffont_spec (2, args
);
2825 prefer
= scratch_font_prefer
;
2826 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2827 if (NILP (AREF (spec
, i
)))
2828 ASET (prefer
, i
, make_number (100));
2829 size
= AREF (spec
, FONT_SIZE_INDEX
);
2832 else if (INTEGERP (size
))
2833 pixel_size
= XINT (size
);
2834 else /* FLOATP (size) */
2836 double pt
= XFLOAT_DATA (size
);
2838 pixel_size
= POINT_TO_PIXEL (pt
, f
->resy
);
2839 size
= make_number (pixel_size
);
2840 ASET (spec
, FONT_SIZE_INDEX
, size
);
2842 if (pixel_size
== 0)
2844 pixel_size
= POINT_TO_PIXEL (12.0, f
->resy
);
2845 size
= make_number (pixel_size
);
2847 ASET (prefer
, FONT_SIZE_INDEX
, size
);
2848 if (NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
2849 ASET (spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2851 entity_list
= Flist_fonts (spec
, frame
, make_number (1), prefer
);
2852 if (NILP (entity_list
))
2853 entity
= font_matching_entity (frame
, spec
);
2855 entity
= XCAR (entity_list
);
2856 return (NILP (entity
)
2858 : font_open_entity (f
, entity
, pixel_size
));
2862 /* Register font-driver DRIVER. This function is used in two ways.
2864 The first is with frame F non-NULL. In this case, make DRIVER
2865 available (but not yet activated) on F. All frame creaters
2866 (e.g. Fx_create_frame) must call this function at least once with
2867 an available font-driver.
2869 The second is with frame F NULL. In this case, DRIVER is globally
2870 registered in the variable `font_driver_list'. All font-driver
2871 implementations must call this function in its syms_of_XXXX
2872 (e.g. syms_of_xfont). */
2875 register_font_driver (driver
, f
)
2876 struct font_driver
*driver
;
2879 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
2880 struct font_driver_list
*prev
, *list
;
2882 if (f
&& ! driver
->draw
)
2883 error ("Unsable font driver for a frame: %s",
2884 SDATA (SYMBOL_NAME (driver
->type
)));
2886 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
2887 if (EQ (list
->driver
->type
, driver
->type
))
2888 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
2890 list
= malloc (sizeof (struct font_driver_list
));
2892 list
->driver
= driver
;
2897 f
->font_driver_list
= list
;
2899 font_driver_list
= list
;
2904 /* Free font-driver list on frame F. It doesn't free font-drivers
2908 free_font_driver_list (f
)
2911 while (f
->font_driver_list
)
2913 struct font_driver_list
*next
= f
->font_driver_list
->next
;
2915 free (f
->font_driver_list
);
2916 f
->font_driver_list
= next
;
2921 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
2922 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
2923 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
2925 A caller must free all realized faces if any in advance. The
2926 return value is a list of font backends actually made used on
2930 font_update_drivers (f
, new_drivers
)
2932 Lisp_Object new_drivers
;
2934 Lisp_Object active_drivers
= Qnil
;
2935 struct font_driver_list
*list
;
2937 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
2940 if (! EQ (new_drivers
, Qt
)
2941 && NILP (Fmemq (list
->driver
->type
, new_drivers
)))
2943 if (list
->driver
->end_for_frame
)
2944 list
->driver
->end_for_frame (f
);
2945 font_finish_cache (f
, list
->driver
);
2951 if (EQ (new_drivers
, Qt
)
2952 || ! NILP (Fmemq (list
->driver
->type
, new_drivers
)))
2954 if (! list
->driver
->start_for_frame
2955 || list
->driver
->start_for_frame (f
) == 0)
2957 font_prepare_cache (f
, list
->driver
);
2959 active_drivers
= nconc2 (active_drivers
,
2960 Fcons (list
->driver
->type
, Qnil
));
2965 return active_drivers
;
2969 font_put_frame_data (f
, driver
, data
)
2971 struct font_driver
*driver
;
2974 struct font_data_list
*list
, *prev
;
2976 for (prev
= NULL
, list
= f
->font_data_list
; list
;
2977 prev
= list
, list
= list
->next
)
2978 if (list
->driver
== driver
)
2985 prev
->next
= list
->next
;
2987 f
->font_data_list
= list
->next
;
2995 list
= malloc (sizeof (struct font_data_list
));
2998 list
->driver
= driver
;
2999 list
->next
= f
->font_data_list
;
3000 f
->font_data_list
= list
;
3008 font_get_frame_data (f
, driver
)
3010 struct font_driver
*driver
;
3012 struct font_data_list
*list
;
3014 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3015 if (list
->driver
== driver
)
3023 /* Return the font used to draw character C by FACE at buffer position
3024 POS in window W. If STRING is non-nil, it is a string containing C
3025 at index POS. If C is negative, get C from the current buffer or
3029 font_at (c
, pos
, face
, w
, string
)
3043 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3046 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3048 c
= FETCH_CHAR (pos_byte
);
3051 c
= FETCH_BYTE (pos
);
3057 multibyte
= STRING_MULTIBYTE (string
);
3060 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3062 str
= SDATA (string
) + pos_byte
;
3063 c
= STRING_CHAR (str
, 0);
3066 c
= SDATA (string
)[pos
];
3070 f
= XFRAME (w
->frame
);
3071 if (! FRAME_WINDOW_P (f
))
3078 if (STRINGP (string
))
3079 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3080 DEFAULT_FACE_ID
, 0);
3082 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3084 face
= FACE_FROM_ID (f
, face_id
);
3088 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3089 face
= FACE_FROM_ID (f
, face_id
);
3091 if (! face
->font_info
)
3093 return font_find_object ((struct font
*) face
->font_info
);
3099 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 1, 0,
3100 doc
: /* Return t if OBJECT is a font-spec or font-entity.
3101 Return nil otherwise. */)
3105 return (FONTP (object
) ? Qt
: Qnil
);
3108 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3109 doc
: /* Return a newly created font-spec with arguments as properties.
3111 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3112 valid font property name listed below:
3114 `:family', `:weight', `:slant', `:width'
3116 They are the same as face attributes of the same name. See
3117 `set-face-attribute.
3121 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3125 VALUE must be a string or a symbol specifying the additional
3126 typographic style information of a font, e.g. ``sans''. Usually null.
3130 VALUE must be a string or a symbol specifying the charset registry and
3131 encoding of a font, e.g. ``iso8859-1''.
3135 VALUE must be a non-negative integer or a floating point number
3136 specifying the font size. It specifies the font size in 1/10 pixels
3137 (if VALUE is an integer), or in points (if VALUE is a float).
3138 usage: (font-spec ARGS ...) */)
3143 Lisp_Object spec
= Fmake_vector (make_number (FONT_SPEC_MAX
), Qnil
);
3146 for (i
= 0; i
< nargs
; i
+= 2)
3148 enum font_property_index prop
;
3149 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3151 prop
= get_font_prop_index (key
, 0);
3152 if (prop
< FONT_EXTRA_INDEX
)
3153 ASET (spec
, prop
, val
);
3156 if (EQ (key
, QCname
))
3159 font_parse_name ((char *) SDATA (val
), spec
);
3161 font_put_extra (spec
, key
, val
);
3164 CHECK_VALIDATE_FONT_SPEC (spec
);
3169 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3170 doc
: /* Return the value of FONT's property KEY.
3171 FONT is a font-spec, a font-entity, or a font-object. */)
3173 Lisp_Object font
, key
;
3175 enum font_property_index idx
;
3177 if (FONT_OBJECT_P (font
))
3179 struct font
*fontp
= XSAVE_VALUE (font
)->pointer
;
3181 if (EQ (key
, QCotf
))
3183 if (fontp
->driver
->otf_capability
)
3184 return fontp
->driver
->otf_capability (fontp
);
3188 font
= fontp
->entity
;
3192 idx
= get_font_prop_index (key
, 0);
3193 if (idx
< FONT_EXTRA_INDEX
)
3194 return AREF (font
, idx
);
3195 if (FONT_ENTITY_P (font
))
3197 return Fcdr (Fassoc (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3201 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3202 doc
: /* Set one property of FONT-SPEC: give property KEY value VALUE. */)
3203 (font_spec
, prop
, val
)
3204 Lisp_Object font_spec
, prop
, val
;
3206 enum font_property_index idx
;
3207 Lisp_Object extra
, slot
;
3209 CHECK_FONT_SPEC (font_spec
);
3210 idx
= get_font_prop_index (prop
, 0);
3211 if (idx
< FONT_EXTRA_INDEX
)
3212 return ASET (font_spec
, idx
, val
);
3213 extra
= AREF (font_spec
, FONT_EXTRA_INDEX
);
3214 slot
= Fassoc (extra
, prop
);
3216 extra
= Fcons (Fcons (prop
, val
), extra
);
3218 Fsetcdr (slot
, val
);
3222 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3223 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3224 Optional 2nd argument FRAME specifies the target frame.
3225 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3226 Optional 4th argument PREFER, if non-nil, is a font-spec to
3227 control the order of the returned list. Fonts are sorted by
3228 how they are close to PREFER. */)
3229 (font_spec
, frame
, num
, prefer
)
3230 Lisp_Object font_spec
, frame
, num
, prefer
;
3232 Lisp_Object vec
, list
, tail
;
3236 frame
= selected_frame
;
3237 CHECK_LIVE_FRAME (frame
);
3238 CHECK_VALIDATE_FONT_SPEC (font_spec
);
3246 if (! NILP (prefer
))
3247 CHECK_FONT (prefer
);
3249 vec
= font_list_entities (frame
, font_spec
);
3254 return Fcons (AREF (vec
, 0), Qnil
);
3256 if (! NILP (prefer
))
3257 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
);
3259 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3260 if (n
== 0 || n
> len
)
3262 for (i
= 1; i
< n
; i
++)
3264 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3266 XSETCDR (tail
, val
);
3272 DEFUN ("list-families", Flist_families
, Slist_families
, 0, 1, 0,
3273 doc
: /* List available font families on the current frame.
3274 Optional 2nd argument FRAME specifies the target frame. */)
3279 struct font_driver_list
*driver_list
;
3283 frame
= selected_frame
;
3284 CHECK_LIVE_FRAME (frame
);
3287 for (driver_list
= f
->font_driver_list
; driver_list
;
3288 driver_list
= driver_list
->next
)
3289 if (driver_list
->driver
->list_family
)
3291 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3297 Lisp_Object tail
= list
;
3299 for (; CONSP (val
); val
= XCDR (val
))
3300 if (NILP (Fmemq (XCAR (val
), tail
)))
3301 list
= Fcons (XCAR (val
), list
);
3307 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3308 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3309 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3311 Lisp_Object font_spec
, frame
;
3313 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3320 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 1, 0,
3321 doc
: /* Return XLFD name of FONT.
3322 FONT is a font-spec, font-entity, or font-object.
3323 If the name is too long for XLFD (maximum 255 chars), return nil. */)
3330 if (FONT_SPEC_P (font
))
3331 CHECK_VALIDATE_FONT_SPEC (font
);
3332 else if (FONT_ENTITY_P (font
))
3338 CHECK_FONT_GET_OBJECT (font
, fontp
);
3339 font
= fontp
->entity
;
3340 pixel_size
= fontp
->pixel_size
;
3343 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3345 return build_string (name
);
3348 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3349 doc
: /* Clear font cache. */)
3352 Lisp_Object list
, frame
;
3354 FOR_EACH_FRAME (list
, frame
)
3356 FRAME_PTR f
= XFRAME (frame
);
3357 struct font_driver_list
*driver_list
= f
->font_driver_list
;
3359 for (; driver_list
; driver_list
= driver_list
->next
)
3360 if (driver_list
->on
)
3362 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
3366 while (! EQ (XCAR (val
), driver_list
->driver
->type
))
3368 val
= XCDR (XCAR (val
));
3369 if (XINT (XCAR (val
)) == 0)
3371 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
3372 XSETCDR (cache
, XCDR (val
));
3380 DEFUN ("internal-set-font-style-table", Finternal_set_font_style_table
,
3381 Sinternal_set_font_style_table
, 2, 2, 0,
3382 doc
: /* Set font style table for PROP to TABLE.
3383 PROP must be `:weight', `:slant', or `:width'.
3384 TABLE must be an alist of symbols vs the corresponding numeric values
3385 sorted by numeric values. */)
3387 Lisp_Object prop
, table
;
3391 Lisp_Object tail
, val
;
3393 CHECK_SYMBOL (prop
);
3394 table_index
= (EQ (prop
, QCweight
) ? 0
3395 : EQ (prop
, QCslant
) ? 1
3396 : EQ (prop
, QCwidth
) ? 2
3398 if (table_index
>= ASIZE (font_style_table
))
3399 error ("Invalid font style property: %s", SDATA (SYMBOL_NAME (prop
)));
3400 table
= Fcopy_sequence (table
);
3402 for (tail
= table
; ! NILP (tail
); tail
= Fcdr (tail
))
3404 prop
= Fcar (Fcar (tail
));
3405 val
= Fcdr (Fcar (tail
));
3406 CHECK_SYMBOL (prop
);
3408 if (numeric
> XINT (val
))
3409 error ("Numeric values not sorted for %s", SDATA (SYMBOL_NAME (prop
)));
3410 numeric
= XINT (val
);
3411 XSETCAR (tail
, Fcons (prop
, val
));
3413 ASET (font_style_table
, table_index
, table
);
3417 /* The following three functions are still expremental. */
3419 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
3420 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
3421 FONT-OBJECT may be nil if it is not yet known.
3423 G-string is sequence of glyphs of a specific font,
3424 and is a vector of this form:
3425 [ HEADER GLYPH ... ]
3426 HEADER is a vector of this form:
3427 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
3429 FONT-OBJECT is a font-object for all glyphs in the g-string,
3430 WIDTH thry DESCENT are the metrics (in pixels) of the whole G-string.
3431 GLYPH is a vector of this form:
3432 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
3433 [ [X-OFF Y-OFF WADJUST] | nil] ]
3435 FROM-IDX and TO-IDX are used internally and should not be touched.
3436 C is the character of the glyph.
3437 CODE is the glyph-code of C in FONT-OBJECT.
3438 WIDTH thry DESCENT are the metrics (in pixels) of the glyph.
3439 X-OFF and Y-OFF are offests to the base position for the glyph.
3440 WADJUST is the adjustment to the normal width of the glyph. */)
3442 Lisp_Object font_object
, num
;
3444 Lisp_Object gstring
, g
;
3448 if (! NILP (font_object
))
3449 CHECK_FONT_OBJECT (font_object
);
3452 len
= XINT (num
) + 1;
3453 gstring
= Fmake_vector (make_number (len
), Qnil
);
3454 g
= Fmake_vector (make_number (6), Qnil
);
3455 ASET (g
, 0, font_object
);
3456 ASET (gstring
, 0, g
);
3457 for (i
= 1; i
< len
; i
++)
3458 ASET (gstring
, i
, Fmake_vector (make_number (10), Qnil
));
3462 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
3463 doc
: /* Fillin glyph-string GSTRING by characters for FONT-OBJECT.
3464 START and END specifies the region to extract characters.
3465 If optional 3rd argument OBJECT is non-nil, it is a buffer or a string from
3466 where to extract characters.
3467 FONT-OBJECT may be nil if GSTRING already already contains one. */)
3468 (gstring
, font_object
, start
, end
, object
)
3469 Lisp_Object gstring
, font_object
, start
, end
, object
;
3475 CHECK_VECTOR (gstring
);
3476 if (NILP (font_object
))
3477 font_object
= LGSTRING_FONT (gstring
);
3478 CHECK_FONT_GET_OBJECT (font_object
, font
);
3480 if (STRINGP (object
))
3482 const unsigned char *p
;
3484 CHECK_NATNUM (start
);
3486 if (XINT (start
) > XINT (end
)
3487 || XINT (end
) > ASIZE (object
)
3488 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3489 args_out_of_range_3 (object
, start
, end
);
3491 len
= XINT (end
) - XINT (start
);
3492 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
3493 for (i
= 0; i
< len
; i
++)
3495 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3497 c
= STRING_CHAR_ADVANCE (p
);
3498 code
= font
->driver
->encode_char (font
, c
);
3499 if (code
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
3501 LGLYPH_SET_FROM (g
, i
);
3502 LGLYPH_SET_TO (g
, i
);
3503 LGLYPH_SET_CHAR (g
, c
);
3504 LGLYPH_SET_CODE (g
, code
);
3511 if (! NILP (object
))
3512 Fset_buffer (object
);
3513 validate_region (&start
, &end
);
3514 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3515 args_out_of_range (start
, end
);
3516 len
= XINT (end
) - XINT (start
);
3518 pos_byte
= CHAR_TO_BYTE (pos
);
3519 for (i
= 0; i
< len
; i
++)
3521 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3523 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
3524 code
= font
->driver
->encode_char (font
, c
);
3525 if (code
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
3527 LGLYPH_SET_FROM (g
, i
);
3528 LGLYPH_SET_TO (g
, i
);
3529 LGLYPH_SET_CHAR (g
, c
);
3530 LGLYPH_SET_CODE (g
, code
);
3533 for (; i
< LGSTRING_LENGTH (gstring
); i
++)
3534 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
3538 DEFUN ("font-shape-text", Ffont_shape_text
, Sfont_shape_text
, 3, 4, 0,
3539 doc
: /* Shape text between FROM and TO by FONT-OBJECT.
3540 If optional 4th argument STRING is non-nil, it is a string to shape,
3541 and FROM and TO are indices to the string.
3542 The value is the end position of the text that can be shaped by
3544 (from
, to
, font_object
, string
)
3545 Lisp_Object from
, to
, font_object
, string
;
3548 struct font_metrics metrics
;
3549 EMACS_INT start
, end
;
3550 Lisp_Object gstring
, n
;
3555 validate_region (&from
, &to
);
3556 start
= XFASTINT (from
);
3557 end
= XFASTINT (to
);
3558 modify_region (current_buffer
, start
, end
, 0);
3562 CHECK_STRING (string
);
3563 start
= XINT (from
);
3565 if (start
< 0 || start
> end
|| end
> SCHARS (string
))
3566 args_out_of_range_3 (string
, from
, to
);
3569 CHECK_FONT_GET_OBJECT (font_object
, font
);
3571 gstring
= Ffont_make_gstring (font_object
, make_number (len
));
3572 Ffont_fill_gstring (gstring
, font_object
, from
, to
, string
);
3573 if (! font
->driver
->shape
)
3575 /* Make zero-width glyphs to have one pixel width to make the
3576 display routine not lose the cursor. */
3577 for (i
= 0; i
< len
; i
++)
3579 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3580 unsigned code
= LGLYPH_CODE (g
);
3581 struct font_metrics metrics
;
3583 if (font
->driver
->text_extents (font
, &code
, 1, &metrics
) == 0)
3585 Lisp_Object gstr
= Ffont_make_gstring (font_object
,
3587 LGSTRING_SET_WIDTH (gstr
, 1);
3588 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
3589 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
+ 1);
3590 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
3591 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
3592 LGLYPH_SET_FROM (g
, 0);
3593 LGLYPH_SET_TO (g
, 1);
3594 LGSTRING_SET_GLYPH (gstr
, 0, g
);
3595 from
= make_number (start
+ i
);
3596 to
= make_number (start
+ i
+ 1);
3598 Fcompose_region_internal (from
, to
, gstr
, Qnil
);
3600 Fcompose_region_internal (string
, from
, to
, gstr
, Qnil
);
3603 return make_number (end
);
3607 /* Try at most three times with larger gstring each time. */
3608 for (i
= 0; i
< 3; i
++)
3610 Lisp_Object args
[2];
3612 n
= font
->driver
->shape (gstring
);
3616 args
[1] = Fmake_vector (make_number (len
), Qnil
);
3617 gstring
= Fvconcat (2, args
);
3619 if (! INTEGERP (n
) || XINT (n
) == 0)
3623 for (i
= 0; i
< len
;)
3626 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3627 EMACS_INT this_from
= LGLYPH_FROM (g
);
3628 EMACS_INT this_to
= LGLYPH_TO (g
) + 1;
3630 int need_composition
= 0;
3632 metrics
.lbearing
= LGLYPH_LBEARING (g
);
3633 metrics
.rbearing
= LGLYPH_RBEARING (g
);
3634 metrics
.ascent
= LGLYPH_ASCENT (g
);
3635 metrics
.descent
= LGLYPH_DESCENT (g
);
3636 if (NILP (LGLYPH_ADJUSTMENT (g
)))
3638 metrics
.width
= LGLYPH_WIDTH (g
);
3639 if (XINT (LGLYPH_CHAR (g
)) == 0 || metrics
.width
== 0)
3640 need_composition
= 1;
3644 metrics
.width
= LGLYPH_WADJUST (g
);
3645 metrics
.lbearing
+= LGLYPH_XOFF (g
);
3646 metrics
.rbearing
+= LGLYPH_XOFF (g
);
3647 metrics
.ascent
-= LGLYPH_YOFF (g
);
3648 metrics
.descent
+= LGLYPH_YOFF (g
);
3649 need_composition
= 1;
3651 for (j
= i
+ 1; j
< len
; j
++)
3655 g
= LGSTRING_GLYPH (gstring
, j
);
3656 if (this_from
!= LGLYPH_FROM (g
))
3658 need_composition
= 1;
3659 x
= metrics
.width
+ LGLYPH_LBEARING (g
) + LGLYPH_XOFF (g
);
3660 if (metrics
.lbearing
> x
)
3661 metrics
.lbearing
= x
;
3662 x
= metrics
.width
+ LGLYPH_RBEARING (g
) + LGLYPH_XOFF (g
);
3663 if (metrics
.rbearing
< x
)
3664 metrics
.rbearing
= x
;
3665 x
= LGLYPH_ASCENT (g
) - LGLYPH_YOFF (g
);
3666 if (metrics
.ascent
< x
)
3668 x
= LGLYPH_DESCENT (g
) - LGLYPH_YOFF (g
);
3669 if (metrics
.descent
< x
)
3670 metrics
.descent
= x
;
3671 if (NILP (LGLYPH_ADJUSTMENT (g
)))
3672 metrics
.width
+= LGLYPH_WIDTH (g
);
3674 metrics
.width
+= LGLYPH_WADJUST (g
);
3677 if (need_composition
)
3679 gstr
= Ffont_make_gstring (font_object
, make_number (j
- i
));
3680 LGSTRING_SET_WIDTH (gstr
, metrics
.width
);
3681 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
3682 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
);
3683 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
3684 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
3685 for (k
= i
; i
< j
; i
++)
3687 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3689 LGLYPH_SET_FROM (g
, LGLYPH_FROM (g
) - this_from
);
3690 LGLYPH_SET_TO (g
, LGLYPH_TO (g
) - this_from
);
3691 LGSTRING_SET_GLYPH (gstr
, i
- k
, LGSTRING_GLYPH (gstring
, i
));
3693 from
= make_number (start
+ this_from
);
3694 to
= make_number (start
+ this_to
);
3696 Fcompose_region_internal (from
, to
, gstr
, Qnil
);
3698 Fcompose_string_internal (string
, from
, to
, gstr
, Qnil
);
3707 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
3708 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
3709 OTF-SPEC specifies which featuress to apply in this format:
3710 (SCRIPT LANGSYS GSUB GPOS)
3712 SCRIPT is a symbol specifying a script tag of OpenType,
3713 LANGSYS is a symbol specifying a langsys tag of OpenType,
3714 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
3716 If LANGYS is nil, the default langsys is selected.
3718 The features are applied in the order appeared in the list. The
3719 symbol `*' means to apply all available features not appeared in this
3720 list, and the remaining features are ignored. For instance, (vatu
3721 pstf * haln) is to apply vatu and pstf in this order, then to apply
3722 all available features other than vatu, pstf, and haln.
3724 The features are applied to the glyphs in the range FROM and TO of
3725 the glyph-string GSTRING-IN.
3727 If some of a feature is actually applicable, the resulting glyphs are
3728 produced in the glyph-string GSTRING-OUT from the index INDEX. In
3729 this case, the value is the number of produced glyphs.
3731 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
3734 If GSTRING-OUT is too short to hold produced glyphs, no glyphs is
3735 produced in GSTRING-OUT, and the value is nil.
3737 See the documentation of `font-make-gstring' for the format of
3739 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
3740 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
3742 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
3747 check_otf_features (otf_features
);
3748 CHECK_FONT_GET_OBJECT (font_object
, font
);
3749 if (! font
->driver
->otf_drive
)
3750 error ("Font backend %s can't drive OpenType GSUB table",
3751 SDATA (SYMBOL_NAME (font
->driver
->type
)));
3752 CHECK_CONS (otf_features
);
3753 CHECK_SYMBOL (XCAR (otf_features
));
3754 val
= XCDR (otf_features
);
3755 CHECK_SYMBOL (XCAR (val
));
3756 val
= XCDR (otf_features
);
3759 len
= check_gstring (gstring_in
);
3760 CHECK_VECTOR (gstring_out
);
3761 CHECK_NATNUM (from
);
3763 CHECK_NATNUM (index
);
3765 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
3766 args_out_of_range_3 (from
, to
, make_number (len
));
3767 if (XINT (index
) >= ASIZE (gstring_out
))
3768 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
3769 num
= font
->driver
->otf_drive (font
, otf_features
,
3770 gstring_in
, XINT (from
), XINT (to
),
3771 gstring_out
, XINT (index
), 0);
3774 return make_number (num
);
3777 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
3779 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
3780 FEATURE-SPEC specifies which features of the font FONT-OBJECT to apply
3782 (SCRIPT LANGSYS FEATURE ...)
3783 See the documentation of `font-otf-gsub' for more detail.
3785 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
3786 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
3787 character code corresponding to the glyph or nil if there's no
3788 corresponding character. */)
3789 (font_object
, character
, otf_features
)
3790 Lisp_Object font_object
, character
, otf_features
;
3793 Lisp_Object gstring_in
, gstring_out
, g
;
3794 Lisp_Object alternates
;
3797 CHECK_FONT_GET_OBJECT (font_object
, font
);
3798 if (! font
->driver
->otf_drive
)
3799 error ("Font backend %s can't drive OpenType GSUB table",
3800 SDATA (SYMBOL_NAME (font
->driver
->type
)));
3801 CHECK_CHARACTER (character
);
3802 CHECK_CONS (otf_features
);
3804 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
3805 g
= LGSTRING_GLYPH (gstring_in
, 0);
3806 LGLYPH_SET_CHAR (g
, character
);
3807 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
3808 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
3809 gstring_out
, 0, 1)) < 0)
3810 gstring_out
= Ffont_make_gstring (font_object
,
3811 make_number (ASIZE (gstring_out
) * 2));
3813 for (i
= 0; i
< num
; i
++)
3815 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
3816 int c
= XINT (LGLYPH_CHAR (g
));
3817 unsigned code
= XUINT (LGLYPH_CODE (g
));
3819 alternates
= Fcons (Fcons (make_number (code
),
3820 c
> 0 ? make_number (c
) : Qnil
),
3823 return Fnreverse (alternates
);
3829 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
3830 doc
: /* Open FONT-ENTITY. */)
3831 (font_entity
, size
, frame
)
3832 Lisp_Object font_entity
;
3838 CHECK_FONT_ENTITY (font_entity
);
3840 size
= AREF (font_entity
, FONT_SIZE_INDEX
);
3841 CHECK_NUMBER (size
);
3843 frame
= selected_frame
;
3844 CHECK_LIVE_FRAME (frame
);
3846 isize
= XINT (size
);
3850 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
3852 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
3855 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
3856 doc
: /* Close FONT-OBJECT. */)
3857 (font_object
, frame
)
3858 Lisp_Object font_object
, frame
;
3860 CHECK_FONT_OBJECT (font_object
);
3862 frame
= selected_frame
;
3863 CHECK_LIVE_FRAME (frame
);
3864 font_close_object (XFRAME (frame
), font_object
);
3868 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
3869 doc
: /* Return information about FONT-OBJECT.
3870 The value is a vector:
3871 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
3874 NAME is a string of the font name (or nil if the font backend doesn't
3877 FILENAME is a string of the font file (or nil if the font backend
3878 doesn't provide a file name).
3880 PIXEL-SIZE is a pixel size by which the font is opened.
3882 SIZE is a maximum advance width of the font in pixel.
3884 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
3887 CAPABILITY is a list whose first element is a symbol representing the
3888 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
3889 remaining elements describes a detail of the font capability.
3891 If the font is OpenType font, the form of the list is
3892 \(opentype GSUB GPOS)
3893 where GSUB shows which "GSUB" features the font supports, and GPOS
3894 shows which "GPOS" features the font supports. Both GSUB and GPOS are
3895 lists of the format:
3896 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3898 If the font is not OpenType font, currently the length of the form is
3901 SCRIPT is a symbol representing OpenType script tag.
3903 LANGSYS is a symbol representing OpenType langsys tag, or nil
3904 representing the default langsys.
3906 FEATURE is a symbol representing OpenType feature tag.
3908 If the font is not OpenType font, OTF-CAPABILITY is nil. */)
3910 Lisp_Object font_object
;
3915 CHECK_FONT_GET_OBJECT (font_object
, font
);
3917 val
= Fmake_vector (make_number (9), Qnil
);
3918 if (font
->font
.full_name
)
3919 ASET (val
, 0, make_unibyte_string (font
->font
.full_name
,
3920 strlen (font
->font
.full_name
)));
3921 if (font
->file_name
)
3922 ASET (val
, 1, make_unibyte_string (font
->file_name
,
3923 strlen (font
->file_name
)));
3924 ASET (val
, 2, make_number (font
->pixel_size
));
3925 ASET (val
, 3, make_number (font
->font
.size
));
3926 ASET (val
, 4, make_number (font
->ascent
));
3927 ASET (val
, 5, make_number (font
->descent
));
3928 ASET (val
, 6, make_number (font
->font
.space_width
));
3929 ASET (val
, 7, make_number (font
->font
.average_width
));
3930 if (font
->driver
->otf_capability
)
3931 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
3933 ASET (val
, 8, Fcons (font
->format
, Qnil
));
3937 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
3938 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
3939 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
3940 (font_object
, string
)
3941 Lisp_Object font_object
, string
;
3947 CHECK_FONT_GET_OBJECT (font_object
, font
);
3948 CHECK_STRING (string
);
3949 len
= SCHARS (string
);
3950 vec
= Fmake_vector (make_number (len
), Qnil
);
3951 for (i
= 0; i
< len
; i
++)
3953 Lisp_Object ch
= Faref (string
, make_number (i
));
3957 struct font_metrics metrics
;
3959 code
= font
->driver
->encode_char (font
, c
);
3960 if (code
== FONT_INVALID_CODE
)
3962 val
= Fmake_vector (make_number (6), Qnil
);
3963 if (code
<= MOST_POSITIVE_FIXNUM
)
3964 ASET (val
, 0, make_number (code
));
3966 ASET (val
, 0, Fcons (make_number (code
>> 16),
3967 make_number (code
& 0xFFFF)));
3968 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
3969 ASET (val
, 1, make_number (metrics
.lbearing
));
3970 ASET (val
, 2, make_number (metrics
.rbearing
));
3971 ASET (val
, 3, make_number (metrics
.width
));
3972 ASET (val
, 4, make_number (metrics
.ascent
));
3973 ASET (val
, 5, make_number (metrics
.descent
));
3979 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
3980 doc
: /* Return t iff font-spec SPEC matches with FONT.
3981 FONT is a font-spec, font-entity, or font-object. */)
3983 Lisp_Object spec
, font
;
3985 CHECK_FONT_SPEC (spec
);
3986 if (FONT_OBJECT_P (font
))
3987 font
= ((struct font
*) XSAVE_VALUE (font
)->pointer
)->entity
;
3988 else if (! FONT_ENTITY_P (font
))
3989 CHECK_FONT_SPEC (font
);
3991 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
3994 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
3995 doc
: /* Return a font-object for displaying a character at POSISTION.
3996 Optional second arg WINDOW, if non-nil, is a window displaying
3997 the current buffer. It defaults to the currently selected window. */)
3998 (position
, window
, string
)
3999 Lisp_Object position
, window
, string
;
4006 CHECK_NUMBER_COERCE_MARKER (position
);
4007 pos
= XINT (position
);
4008 if (pos
< BEGV
|| pos
>= ZV
)
4009 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4016 CHECK_NUMBER (position
);
4017 CHECK_STRING (string
);
4018 pos
= XINT (position
);
4019 if (pos
< 0 || pos
>= SCHARS (string
))
4020 args_out_of_range (string
, position
);
4023 window
= selected_window
;
4024 CHECK_LIVE_WINDOW (window
);
4025 w
= XWINDOW (window
);
4027 return font_at (-1, pos
, NULL
, w
, string
);
4031 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4032 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4033 The value is a number of glyphs drawn.
4034 Type C-l to recover what previously shown. */)
4035 (font_object
, string
)
4036 Lisp_Object font_object
, string
;
4038 Lisp_Object frame
= selected_frame
;
4039 FRAME_PTR f
= XFRAME (frame
);
4045 CHECK_FONT_GET_OBJECT (font_object
, font
);
4046 CHECK_STRING (string
);
4047 len
= SCHARS (string
);
4048 code
= alloca (sizeof (unsigned) * len
);
4049 for (i
= 0; i
< len
; i
++)
4051 Lisp_Object ch
= Faref (string
, make_number (i
));
4055 code
[i
] = font
->driver
->encode_char (font
, c
);
4056 if (code
[i
] == FONT_INVALID_CODE
)
4059 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4061 if (font
->driver
->prepare_face
)
4062 font
->driver
->prepare_face (f
, face
);
4063 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4064 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4065 if (font
->driver
->done_face
)
4066 font
->driver
->done_face (f
, face
);
4068 return make_number (len
);
4072 #endif /* FONT_DEBUG */
4075 extern void syms_of_ftfont
P_ (());
4076 extern void syms_of_xfont
P_ (());
4077 extern void syms_of_xftfont
P_ (());
4078 extern void syms_of_ftxfont
P_ (());
4079 extern void syms_of_bdffont
P_ (());
4080 extern void syms_of_w32font
P_ (());
4081 extern void syms_of_atmfont
P_ (());
4086 sort_shift_bits
[FONT_SLANT_INDEX
] = 0;
4087 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 7;
4088 sort_shift_bits
[FONT_SIZE_INDEX
] = 14;
4089 sort_shift_bits
[FONT_WIDTH_INDEX
] = 21;
4090 sort_shift_bits
[FONT_ADSTYLE_INDEX
] = 28;
4091 sort_shift_bits
[FONT_FOUNDRY_INDEX
] = 29;
4092 sort_shift_bits
[FONT_FAMILY_INDEX
] = 30;
4093 sort_shift_bits
[FONT_REGISTRY_INDEX
] = 31;
4094 /* Note that sort_shift_bits[FONT_TYPE_INDEX] is never used. */
4096 staticpro (&font_style_table
);
4097 font_style_table
= Fmake_vector (make_number (3), Qnil
);
4099 staticpro (&font_family_alist
);
4100 font_family_alist
= Qnil
;
4102 staticpro (&font_charset_alist
);
4103 font_charset_alist
= Qnil
;
4105 DEFSYM (Qopentype
, "opentype");
4107 DEFSYM (Qiso8859_1
, "iso8859-1");
4108 DEFSYM (Qiso10646_1
, "iso10646-1");
4109 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4110 DEFSYM (Qunicode_sip
, "unicode-sip");
4112 DEFSYM (QCotf
, ":otf");
4113 DEFSYM (QClanguage
, ":language");
4114 DEFSYM (QCscript
, ":script");
4115 DEFSYM (QCantialias
, ":antialias");
4117 DEFSYM (QCfoundry
, ":foundry");
4118 DEFSYM (QCadstyle
, ":adstyle");
4119 DEFSYM (QCregistry
, ":registry");
4120 DEFSYM (QCspacing
, ":spacing");
4121 DEFSYM (QCdpi
, ":dpi");
4122 DEFSYM (QCscalable
, ":scalable");
4123 DEFSYM (QCextra
, ":extra");
4130 staticpro (&null_string
);
4131 null_string
= build_string ("");
4132 staticpro (&null_vector
);
4133 null_vector
= Fmake_vector (make_number (0), Qnil
);
4135 staticpro (&scratch_font_spec
);
4136 scratch_font_spec
= Ffont_spec (0, NULL
);
4137 staticpro (&scratch_font_prefer
);
4138 scratch_font_prefer
= Ffont_spec (0, NULL
);
4141 staticpro (&otf_list
);
4146 defsubr (&Sfont_spec
);
4147 defsubr (&Sfont_get
);
4148 defsubr (&Sfont_put
);
4149 defsubr (&Slist_fonts
);
4150 defsubr (&Slist_families
);
4151 defsubr (&Sfind_font
);
4152 defsubr (&Sfont_xlfd_name
);
4153 defsubr (&Sclear_font_cache
);
4154 defsubr (&Sinternal_set_font_style_table
);
4155 defsubr (&Sfont_make_gstring
);
4156 defsubr (&Sfont_fill_gstring
);
4157 defsubr (&Sfont_shape_text
);
4158 defsubr (&Sfont_drive_otf
);
4159 defsubr (&Sfont_otf_alternates
);
4162 defsubr (&Sopen_font
);
4163 defsubr (&Sclose_font
);
4164 defsubr (&Squery_font
);
4165 defsubr (&Sget_font_glyphs
);
4166 defsubr (&Sfont_match_p
);
4167 defsubr (&Sfont_at
);
4169 defsubr (&Sdraw_string
);
4171 #endif /* FONT_DEBUG */
4173 #ifdef USE_FONT_BACKEND
4174 if (enable_font_backend
)
4176 #ifdef HAVE_FREETYPE
4178 #ifdef HAVE_X_WINDOWS
4183 #endif /* HAVE_XFT */
4184 #endif /* HAVE_X_WINDOWS */
4185 #else /* not HAVE_FREETYPE */
4186 #ifdef HAVE_X_WINDOWS
4188 #endif /* HAVE_X_WINDOWS */
4189 #endif /* not HAVE_FREETYPE */
4192 #endif /* HAVE_BDFFONT */
4195 #endif /* WINDOWSNT */
4200 #endif /* USE_FONT_BACKEND */
4203 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
4204 (do not change this comment) */