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;
1157 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", pixel_size
) + 1;
1159 else if (FLOATP (val
))
1161 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1162 i
= XFLOAT_DATA (val
) * 10;
1163 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1166 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1168 val
= AREF (font
, FONT_EXTRA_INDEX
);
1170 if (FONT_ENTITY_P (font
)
1171 && EQ (AREF (font
, FONT_TYPE_INDEX
), Qx
))
1173 /* Setup names for RESX-RESY-SPACING-AVWIDTH. */
1174 if (SYMBOLP (val
) && ! NILP (val
))
1176 val
= SYMBOL_NAME (val
);
1177 f
[XLFD_RESX_INDEX
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1180 f
[XLFD_RESX_INDEX
] = "*-*-*-*", len
+= 6;
1184 Lisp_Object dpi
= assq_no_quit (QCdpi
, val
);
1185 Lisp_Object spacing
= assq_no_quit (QCspacing
, val
);
1186 Lisp_Object scalable
= assq_no_quit (QCscalable
, val
);
1188 if (CONSP (dpi
) || CONSP (spacing
) || CONSP (scalable
))
1190 char *str
= alloca (24);
1193 if (CONSP (dpi
) && INTEGERP (XCDR (dpi
)))
1194 this_len
= sprintf (str
, "%d-%d",
1195 XINT (XCDR (dpi
)), XINT (XCDR (dpi
)));
1197 this_len
= sprintf (str
, "*-*");
1198 if (CONSP (spacing
) && ! NILP (XCDR (spacing
)))
1200 val
= XCDR (spacing
);
1203 if (XINT (val
) < FONT_SPACING_MONO
)
1205 else if (XINT (val
) < FONT_SPACING_CHARCELL
)
1210 xassert (SYMBOLP (val
));
1211 this_len
+= sprintf (str
+ this_len
, "-%c",
1212 SDATA (SYMBOL_NAME (val
))[0]);
1215 this_len
+= sprintf (str
+ this_len
, "-*");
1216 if (CONSP (scalable
) && ! NILP (XCDR (spacing
)))
1217 this_len
+= sprintf (str
+ this_len
, "-0");
1219 this_len
+= sprintf (str
+ this_len
, "-*");
1220 f
[XLFD_RESX_INDEX
] = str
;
1224 f
[XLFD_RESX_INDEX
] = "*-*-*-*", len
+= 8;
1227 len
++; /* for terminating '\0'. */
1230 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1231 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1232 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1233 f
[XLFD_SWIDTH_INDEX
],
1234 f
[XLFD_ADSTYLE_INDEX
], f
[XLFD_PIXEL_INDEX
],
1235 f
[XLFD_RESX_INDEX
], f
[XLFD_REGISTRY_INDEX
]);
1238 /* Parse NAME (null terminated) as Fonconfig's name format and store
1239 information in FONT (font-spec or font-entity). If NAME is
1240 successfully parsed, return 0. Otherwise return -1. */
1243 font_parse_fcname (name
, font
)
1248 int len
= strlen (name
);
1253 /* It is assured that (name[0] && name[0] != '-'). */
1261 for (p0
= name
+ 1; *p0
&& (*p0
!= '-' && *p0
!= ':'); p0
++)
1262 if (*p0
== '\\' && p0
[1])
1264 family
= intern_font_field (name
, p0
- name
);
1267 if (! isdigit (p0
[1]))
1269 point_size
= strtod (p0
+ 1, &p1
);
1270 if (*p1
&& *p1
!= ':')
1272 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1275 ASET (font
, FONT_FAMILY_INDEX
, family
);
1279 copy
= alloca (len
+ 1);
1284 /* Now parse ":KEY=VAL" patterns. Store known keys and values in
1285 extra, copy unknown ones to COPY. */
1288 Lisp_Object key
, val
;
1291 for (p1
= p0
+ 1; *p1
&& *p1
!= '=' && *p1
!= ':'; p1
++);
1294 /* Must be an enumerated value. */
1295 val
= intern_font_field (p0
+ 1, p1
- p0
- 1);
1296 if (memcmp (p0
+ 1, "light", 5) == 0
1297 || memcmp (p0
+ 1, "medium", 6) == 0
1298 || memcmp (p0
+ 1, "demibold", 8) == 0
1299 || memcmp (p0
+ 1, "bold", 4) == 0
1300 || memcmp (p0
+ 1, "black", 5) == 0)
1302 ASET (font
, FONT_WEIGHT_INDEX
, val
);
1304 else if (memcmp (p0
+ 1, "roman", 5) == 0
1305 || memcmp (p0
+ 1, "italic", 6) == 0
1306 || memcmp (p0
+ 1, "oblique", 7) == 0)
1308 ASET (font
, FONT_SLANT_INDEX
, val
);
1310 else if (memcmp (p0
+ 1, "charcell", 8) == 0
1311 || memcmp (p0
+ 1, "mono", 4) == 0
1312 || memcmp (p0
+ 1, "proportional", 12) == 0)
1314 font_put_extra (font
, QCspacing
,
1315 (p0
[1] == 'c' ? Qc
: p0
[1] == 'm' ? Qm
: Qp
));
1320 bcopy (p0
, copy
, p1
- p0
);
1326 if (memcmp (p0
+ 1, "pixelsize=", 10) == 0)
1327 prop
= FONT_SIZE_INDEX
;
1330 key
= intern_font_field (p0
, p1
- p0
);
1331 prop
= get_font_prop_index (key
, 0);
1334 for (p1
= p0
; *p1
&& *p1
!= ':'; p1
++);
1335 val
= intern_font_field (p0
, p1
- p0
);
1338 if (prop
>= 0 && prop
< FONT_EXTRA_INDEX
)
1340 ASET (font
, prop
, val
);
1343 font_put_extra (font
, key
, val
);
1352 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1353 NAME (NBYTES length), and return the name length. If
1354 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1357 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1365 int dpi
, spacing
, scalable
;
1368 Lisp_Object styles
[3];
1369 char *style_names
[3] = { "weight", "slant", "width" };
1371 val
= AREF (font
, FONT_FAMILY_INDEX
);
1372 if (SYMBOLP (val
) && ! NILP (val
))
1373 len
+= SBYTES (SYMBOL_NAME (val
));
1375 val
= AREF (font
, FONT_SIZE_INDEX
);
1378 if (XINT (val
) != 0)
1379 pixel_size
= XINT (val
);
1381 len
+= 21; /* for ":pixelsize=NUM" */
1383 else if (FLOATP (val
))
1386 point_size
= (int) XFLOAT_DATA (val
);
1387 len
+= 11; /* for "-NUM" */
1390 val
= AREF (font
, FONT_FOUNDRY_INDEX
);
1391 if (SYMBOLP (val
) && ! NILP (val
))
1392 /* ":foundry=NAME" */
1393 len
+= 9 + SBYTES (SYMBOL_NAME (val
));
1395 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
1397 val
= AREF (font
, i
);
1400 val
= prop_numeric_to_name (i
, XINT (val
));
1401 len
+= (strlen (style_names
[i
- FONT_WEIGHT_INDEX
])
1402 + 2 + SBYTES (SYMBOL_NAME (val
))); /* :xxx=NAME */
1404 styles
[i
- FONT_WEIGHT_INDEX
] = val
;
1407 val
= AREF (font
, FONT_EXTRA_INDEX
);
1408 if (FONT_ENTITY_P (font
)
1409 && EQ (AREF (font
, FONT_TYPE_INDEX
), Qx
))
1413 /* VAL is a symbol of name `RESX-RESY-SPACING-AVWIDTH'. */
1414 p
= (char *) SDATA (SYMBOL_NAME (val
));
1416 for (p
++; *p
!= '-'; p
++); /* skip RESX */
1417 for (p
++; *p
!= '-'; p
++); /* skip RESY */
1418 spacing
= (*p
== 'c' ? FONT_SPACING_CHARCELL
1419 : *p
== 'm' ? FONT_SPACING_MONO
1420 : FONT_SPACING_PROPORTIONAL
);
1421 for (p
++; *p
!= '-'; p
++); /* skip SPACING */
1422 scalable
= (atoi (p
) == 0);
1423 /* The longest pattern is ":dpi=NUM:scalable=False:spacing=100" */
1430 dpi
= spacing
= scalable
= -1;
1431 elt
= assq_no_quit (QCdpi
, val
);
1433 dpi
= XINT (XCDR (elt
)), len
+= 15; /* for ":dpi=NUM" */
1434 elt
= assq_no_quit (QCspacing
, val
);
1436 spacing
= XINT (XCDR (elt
)), len
+= 12; /* for ":spacing=100" */
1437 elt
= assq_no_quit (QCscalable
, val
);
1439 scalable
= ! NILP (XCDR (elt
)), len
+= 15; /* for ":scalable=False" */
1445 if (! NILP (AREF (font
, FONT_FAMILY_INDEX
)))
1446 p
+= sprintf(p
, "%s",
1447 SDATA (SYMBOL_NAME (AREF (font
, FONT_FAMILY_INDEX
))));
1451 p
+= sprintf (p
, "%d", point_size
);
1453 p
+= sprintf (p
, "-%d", point_size
);
1455 else if (pixel_size
> 0)
1456 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1457 if (SYMBOLP (AREF (font
, FONT_FOUNDRY_INDEX
))
1458 && ! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1459 p
+= sprintf (p
, ":foundry=%s",
1460 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1461 for (i
= 0; i
< 3; i
++)
1462 if (SYMBOLP (styles
[i
]) && ! NILP (styles
[i
]))
1463 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1464 SDATA (SYMBOL_NAME (styles
[i
])));
1466 p
+= sprintf (p
, ":dpi=%d", dpi
);
1468 p
+= sprintf (p
, ":spacing=%d", spacing
);
1470 p
+= sprintf (p
, ":scalable=True");
1471 else if (scalable
== 0)
1472 p
+= sprintf (p
, ":scalable=False");
1476 /* Parse NAME (null terminated) and store information in FONT
1477 (font-spec or font-entity). If NAME is successfully parsed, return
1478 0. Otherwise return -1.
1480 If NAME is XLFD and FONT is a font-entity, store
1481 RESX-RESY-SPACING-AVWIDTH information as a symbol in
1482 FONT_EXTRA_INDEX. */
1485 font_parse_name (name
, font
)
1489 if (name
[0] == '-' || index (name
, '*'))
1490 return font_parse_xlfd (name
, font
);
1491 return font_parse_fcname (name
, font
);
1494 /* Merge old style font specification (either a font name NAME or a
1495 combination of a family name FAMILY and a registry name REGISTRY
1496 into the font specification SPEC. */
1499 font_merge_old_spec (name
, family
, registry
, spec
)
1500 Lisp_Object name
, family
, registry
, spec
;
1504 if (font_parse_xlfd ((char *) SDATA (name
), spec
) < 0)
1506 Lisp_Object extra
= Fcons (Fcons (QCname
, name
), Qnil
);
1508 ASET (spec
, FONT_EXTRA_INDEX
, extra
);
1513 if (! NILP (family
))
1518 xassert (STRINGP (family
));
1519 len
= SBYTES (family
);
1520 p0
= (char *) SDATA (family
);
1521 p1
= index (p0
, '-');
1524 if ((*p0
!= '*' || p1
- p0
> 1)
1525 && NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
1526 ASET (spec
, FONT_FOUNDRY_INDEX
,
1527 intern_downcase (p0
, p1
- p0
));
1528 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
1529 ASET (spec
, FONT_FAMILY_INDEX
,
1530 intern_downcase (p1
+ 1, len
- (p1
+ 1 - p0
)));
1532 else if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
1533 ASET (spec
, FONT_FAMILY_INDEX
, intern_downcase (p0
, len
));
1535 if (! NILP (registry
)
1536 && NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
1537 ASET (spec
, FONT_REGISTRY_INDEX
,
1538 intern_downcase ((char *) SDATA (registry
), SBYTES (registry
)));
1543 /* This part (through the next ^L) is still experimental and never
1544 tested. We may drastically change codes. */
1548 #define LGSTRING_HEADER_SIZE 6
1549 #define LGSTRING_GLYPH_SIZE 8
1552 check_gstring (gstring
)
1553 Lisp_Object gstring
;
1558 CHECK_VECTOR (gstring
);
1559 val
= AREF (gstring
, 0);
1561 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1563 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1564 if (! NILP (LGSTRING_LBEARING (gstring
)))
1565 CHECK_NUMBER (LGSTRING_LBEARING (gstring
));
1566 if (! NILP (LGSTRING_RBEARING (gstring
)))
1567 CHECK_NUMBER (LGSTRING_RBEARING (gstring
));
1568 if (! NILP (LGSTRING_WIDTH (gstring
)))
1569 CHECK_NATNUM (LGSTRING_WIDTH (gstring
));
1570 if (! NILP (LGSTRING_ASCENT (gstring
)))
1571 CHECK_NUMBER (LGSTRING_ASCENT (gstring
));
1572 if (! NILP (LGSTRING_DESCENT (gstring
)))
1573 CHECK_NUMBER (LGSTRING_DESCENT(gstring
));
1575 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1577 val
= LGSTRING_GLYPH (gstring
, i
);
1579 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1581 if (NILP (LGLYPH_CHAR (val
)))
1583 CHECK_NATNUM (LGLYPH_FROM (val
));
1584 CHECK_NATNUM (LGLYPH_TO (val
));
1585 CHECK_CHARACTER (LGLYPH_CHAR (val
));
1586 if (! NILP (LGLYPH_CODE (val
)))
1587 CHECK_NATNUM (LGLYPH_CODE (val
));
1588 if (! NILP (LGLYPH_WIDTH (val
)))
1589 CHECK_NATNUM (LGLYPH_WIDTH (val
));
1590 if (! NILP (LGLYPH_ADJUSTMENT (val
)))
1592 val
= LGLYPH_ADJUSTMENT (val
);
1594 if (ASIZE (val
) < 3)
1596 for (j
= 0; j
< 3; j
++)
1597 CHECK_NUMBER (AREF (val
, j
));
1602 error ("Invalid glyph-string format");
1607 check_otf_features (otf_features
)
1608 Lisp_Object otf_features
;
1610 Lisp_Object val
, elt
;
1612 CHECK_CONS (otf_features
);
1613 CHECK_SYMBOL (XCAR (otf_features
));
1614 otf_features
= XCDR (otf_features
);
1615 CHECK_CONS (otf_features
);
1616 CHECK_SYMBOL (XCAR (otf_features
));
1617 otf_features
= XCDR (otf_features
);
1618 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1620 CHECK_SYMBOL (Fcar (val
));
1621 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1622 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1624 otf_features
= XCDR (otf_features
);
1625 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1627 CHECK_SYMBOL (Fcar (val
));
1628 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1629 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1636 Lisp_Object otf_list
;
1639 otf_tag_symbol (tag
)
1644 OTF_tag_name (tag
, name
);
1645 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1649 otf_open (entity
, file
)
1653 Lisp_Object val
= Fassoc (entity
, otf_list
);
1657 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1660 otf
= file
? OTF_open (file
) : NULL
;
1661 val
= make_save_value (otf
, 0);
1662 otf_list
= Fcons (Fcons (entity
, val
), otf_list
);
1668 /* Return a list describing which scripts/languages FONT supports by
1669 which GSUB/GPOS features of OpenType tables. See the comment of
1670 (sturct font_driver).otf_capability. */
1673 font_otf_capability (font
)
1677 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1680 otf
= otf_open (font
->entity
, font
->file_name
);
1683 for (i
= 0; i
< 2; i
++)
1685 OTF_GSUB_GPOS
*gsub_gpos
;
1686 Lisp_Object script_list
= Qnil
;
1689 if (OTF_get_features (otf
, i
== 0) < 0)
1691 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1692 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1694 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1695 Lisp_Object langsys_list
= Qnil
;
1696 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1699 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1701 OTF_LangSys
*langsys
;
1702 Lisp_Object feature_list
= Qnil
;
1703 Lisp_Object langsys_tag
;
1706 if (k
== script
->LangSysCount
)
1708 langsys
= &script
->DefaultLangSys
;
1713 langsys
= script
->LangSys
+ k
;
1715 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1717 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1719 OTF_Feature
*feature
1720 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1721 Lisp_Object feature_tag
1722 = otf_tag_symbol (feature
->FeatureTag
);
1724 feature_list
= Fcons (feature_tag
, feature_list
);
1726 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1729 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1734 XSETCAR (capability
, script_list
);
1736 XSETCDR (capability
, script_list
);
1742 /* Parse OTF features in SPEC and write a proper features spec string
1743 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1744 assured that the sufficient memory has already allocated for
1748 generate_otf_features (spec
, features
)
1758 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1764 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1769 else if (! asterisk
)
1771 val
= SYMBOL_NAME (val
);
1772 p
+= sprintf (p
, "%s", SDATA (val
));
1776 val
= SYMBOL_NAME (val
);
1777 p
+= sprintf (p
, "~%s", SDATA (val
));
1781 error ("OTF spec too long");
1786 font_otf_DeviceTable (device_table
)
1787 OTF_DeviceTable
*device_table
;
1789 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1791 return Fcons (make_number (len
),
1792 make_unibyte_string (device_table
->DeltaValue
, len
));
1796 font_otf_ValueRecord (value_format
, value_record
)
1798 OTF_ValueRecord
*value_record
;
1800 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1802 if (value_format
& OTF_XPlacement
)
1803 ASET (val
, 0, value_record
->XPlacement
);
1804 if (value_format
& OTF_YPlacement
)
1805 ASET (val
, 1, value_record
->YPlacement
);
1806 if (value_format
& OTF_XAdvance
)
1807 ASET (val
, 2, value_record
->XAdvance
);
1808 if (value_format
& OTF_YAdvance
)
1809 ASET (val
, 3, value_record
->YAdvance
);
1810 if (value_format
& OTF_XPlaDevice
)
1811 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1812 if (value_format
& OTF_YPlaDevice
)
1813 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1814 if (value_format
& OTF_XAdvDevice
)
1815 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
1816 if (value_format
& OTF_YAdvDevice
)
1817 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
1822 font_otf_Anchor (anchor
)
1827 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
1828 ASET (val
, 0, make_number (anchor
->XCoordinate
));
1829 ASET (val
, 1, make_number (anchor
->YCoordinate
));
1830 if (anchor
->AnchorFormat
== 2)
1831 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
1834 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
1835 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
1840 #endif /* HAVE_LIBOTF */
1842 /* G-string (glyph string) handler */
1844 /* G-string is a vector of the form [HEADER GLYPH ...].
1845 See the docstring of `font-make-gstring' for more detail. */
1848 font_prepare_composition (cmp
, f
)
1849 struct composition
*cmp
;
1853 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
1854 cmp
->hash_index
* 2);
1856 cmp
->font
= XSAVE_VALUE (LGSTRING_FONT (gstring
))->pointer
;
1857 cmp
->glyph_len
= LGSTRING_LENGTH (gstring
);
1858 cmp
->pixel_width
= LGSTRING_WIDTH (gstring
);
1859 cmp
->lbearing
= LGSTRING_LBEARING (gstring
);
1860 cmp
->rbearing
= LGSTRING_RBEARING (gstring
);
1861 cmp
->ascent
= LGSTRING_ASCENT (gstring
);
1862 cmp
->descent
= LGSTRING_DESCENT (gstring
);
1863 cmp
->width
= cmp
->pixel_width
/ FRAME_COLUMN_WIDTH (f
);
1864 if (cmp
->width
== 0)
1871 font_gstring_produce (old
, from
, to
, new, idx
, code
, n
)
1879 Lisp_Object min_idx
, max_idx
;
1882 if (idx
+ n
> ASIZE (new))
1888 min_idx
= make_number (0);
1889 max_idx
= make_number (1);
1893 min_idx
= AREF (AREF (old
, from
- 1), 0);
1894 max_idx
= AREF (AREF (old
, from
- 1), 1);
1897 else if (from
+ 1 == to
)
1899 min_idx
= AREF (AREF (old
, from
), 0);
1900 max_idx
= AREF (AREF (old
, from
), 1);
1904 int min_idx_i
= XINT (AREF (AREF (old
, from
), 0));
1905 int max_idx_i
= XINT (AREF (AREF (old
, from
), 1));
1907 for (i
= from
+ 1; i
< to
; i
++)
1909 if (min_idx_i
> XINT (AREF (AREF (old
, i
), 0)))
1910 min_idx_i
= XINT (AREF (AREF (old
, i
), 0));
1911 if (max_idx_i
< XINT (AREF (AREF (old
, i
), 1)))
1912 max_idx_i
= XINT (AREF (AREF (old
, i
), 1));
1914 min_idx
= make_number (min_idx_i
);
1915 max_idx
= make_number (max_idx_i
);
1918 for (i
= 0; i
< n
; i
++)
1920 ASET (AREF (new, idx
+ i
), 0, min_idx
);
1921 ASET (AREF (new, idx
+ i
), 1, max_idx
);
1922 ASET (AREF (new, idx
+ i
), 2, make_number (code
[i
]));
1930 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
1931 static int font_compare
P_ ((const void *, const void *));
1932 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
1933 Lisp_Object
, Lisp_Object
));
1935 /* We sort fonts by scoring each of them against a specified
1936 font-spec. The score value is 32 bit (`unsigned'), and the smaller
1937 the value is, the closer the font is to the font-spec.
1939 Each 1-bit of the highest 4 bits of the score is used for atomic
1940 properties FOUNDRY, FAMILY, ADSTYLE, and REGISTRY.
1942 Each 7-bit in the lowest 28 bits are used for numeric properties
1943 WEIGHT, SLANT, WIDTH, and SIZE. */
1945 /* How many bits to shift to store the difference value of each font
1946 property in a score. */
1947 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
1949 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
1950 The return value indicates how different ENTITY is compared with
1954 font_score (entity
, spec_prop
)
1955 Lisp_Object entity
, *spec_prop
;
1959 /* Score four atomic fields. Maximum difference is 1. */
1960 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
1961 if (! NILP (spec_prop
[i
])
1962 && ! EQ (spec_prop
[i
], AREF (entity
, i
)))
1963 score
|= 1 << sort_shift_bits
[i
];
1965 /* Score four numeric fields. Maximum difference is 127. */
1966 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
1968 Lisp_Object entity_val
= AREF (entity
, i
);
1970 if (! NILP (spec_prop
[i
]) && ! EQ (spec_prop
[i
], entity_val
))
1972 if (! INTEGERP (entity_val
))
1973 score
|= 127 << sort_shift_bits
[i
];
1976 int diff
= XINT (entity_val
) - XINT (spec_prop
[i
]);
1980 if (i
== FONT_SIZE_INDEX
)
1982 if (XINT (entity_val
) > 0
1983 && diff
> FONT_PIXEL_SIZE_QUANTUM
)
1984 score
|= min (diff
, 127) << sort_shift_bits
[i
];
1987 score
|= min (diff
, 127) << sort_shift_bits
[i
];
1996 /* The comparison function for qsort. */
1999 font_compare (d1
, d2
)
2000 const void *d1
, *d2
;
2002 return (*(unsigned *) d1
< *(unsigned *) d2
2003 ? -1 : *(unsigned *) d1
> *(unsigned *) d2
);
2007 /* The structure for elements being sorted by qsort. */
2008 struct font_sort_data
2015 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2016 If PREFER specifies a point-size, calculate the corresponding
2017 pixel-size from QCdpi property of PREFER or from the Y-resolution
2018 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
2019 get the font-entities in VEC. */
2022 font_sort_entites (vec
, prefer
, frame
, spec
)
2023 Lisp_Object vec
, prefer
, frame
, spec
;
2025 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2027 struct font_sort_data
*data
;
2034 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2035 prefer_prop
[i
] = AREF (prefer
, i
);
2039 /* As it is assured that all fonts in VEC match with SPEC, we
2040 should ignore properties specified in SPEC. So, set the
2041 corresponding properties in PREFER_PROP to nil. */
2042 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2043 if (! NILP (AREF (spec
, i
)))
2044 prefer_prop
[i
++] = Qnil
;
2047 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2048 prefer_prop
[FONT_SIZE_INDEX
]
2049 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2051 /* Scoring and sorting. */
2052 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2053 for (i
= 0; i
< len
; i
++)
2055 data
[i
].entity
= AREF (vec
, i
);
2056 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
);
2058 qsort (data
, len
, sizeof *data
, font_compare
);
2059 for (i
= 0; i
< len
; i
++)
2060 ASET (vec
, i
, data
[i
].entity
);
2067 /* API of Font Service Layer. */
2069 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2070 sort_shift_bits. Finternal_set_font_selection_order calls this
2071 function with font_sort_order after setting up it. */
2074 font_update_sort_order (order
)
2077 int i
, shift_bits
= 21;
2079 for (i
= 0; i
< 4; i
++, shift_bits
-= 7)
2081 int xlfd_idx
= order
[i
];
2083 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2084 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2085 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2086 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2087 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2088 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2090 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2095 /* Return weight property of FONT as symbol. */
2098 font_symbolic_weight (font
)
2101 Lisp_Object weight
= AREF (font
, FONT_WEIGHT_INDEX
);
2103 if (INTEGERP (weight
))
2104 weight
= prop_numeric_to_name (FONT_WEIGHT_INDEX
, XINT (weight
));
2109 /* Return slant property of FONT as symbol. */
2112 font_symbolic_slant (font
)
2115 Lisp_Object slant
= AREF (font
, FONT_SLANT_INDEX
);
2117 if (INTEGERP (slant
))
2118 slant
= prop_numeric_to_name (FONT_SLANT_INDEX
, XINT (slant
));
2123 /* Return width property of FONT as symbol. */
2126 font_symbolic_width (font
)
2129 Lisp_Object width
= AREF (font
, FONT_WIDTH_INDEX
);
2131 if (INTEGERP (width
))
2132 width
= prop_numeric_to_name (FONT_WIDTH_INDEX
, XINT (width
));
2137 /* Check if ENTITY matches with the font specification SPEC. */
2140 font_match_p (spec
, entity
)
2141 Lisp_Object spec
, entity
;
2145 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2146 if (! NILP (AREF (spec
, i
))
2147 && ! EQ (AREF (spec
, i
), AREF (entity
, i
)))
2149 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
))
2150 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0
2151 && (XINT (AREF (spec
, FONT_SIZE_INDEX
))
2152 != XINT (AREF (entity
, FONT_SIZE_INDEX
))))
2158 /* Return a lispy font object corresponding to FONT. */
2161 font_find_object (font
)
2164 Lisp_Object tail
, elt
;
2166 for (tail
= AREF (font
->entity
, FONT_OBJLIST_INDEX
); CONSP (tail
);
2170 if (font
== XSAVE_VALUE (elt
)->pointer
2171 && XSAVE_VALUE (elt
)->integer
> 0)
2178 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2181 /* Return a vector of font-entities matching with SPEC on frame F. */
2184 font_list_entities (frame
, spec
)
2185 Lisp_Object frame
, spec
;
2187 FRAME_PTR f
= XFRAME (frame
);
2188 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2189 Lisp_Object ftype
, family
, size
, alternate_familes
;
2190 Lisp_Object
*vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2196 family
= AREF (spec
, FONT_FAMILY_INDEX
);
2198 alternate_familes
= Qnil
;
2201 if (NILP (font_family_alist
)
2202 && !NILP (Vface_alternative_font_family_alist
))
2203 build_font_family_alist ();
2204 alternate_familes
= assq_no_quit (family
, font_family_alist
);
2205 if (! NILP (alternate_familes
))
2206 alternate_familes
= XCDR (alternate_familes
);
2208 size
= AREF (spec
, FONT_SIZE_INDEX
);
2210 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2212 xassert (ASIZE (spec
) == FONT_SPEC_MAX
);
2213 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2215 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2217 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2219 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
2220 Lisp_Object tail
= alternate_familes
;
2223 xassert (CONSP (cache
));
2224 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2225 ASET (spec
, FONT_FAMILY_INDEX
, family
);
2229 val
= assoc_no_quit (spec
, XCDR (cache
));
2234 val
= driver_list
->driver
->list (frame
, spec
);
2236 XSETCDR (cache
, Fcons (Fcons (Fcopy_sequence (spec
), val
),
2239 if (VECTORP (val
) && ASIZE (val
) > 0)
2246 ASET (spec
, FONT_FAMILY_INDEX
, XCAR (tail
));
2250 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2251 ASET (spec
, FONT_FAMILY_INDEX
, family
);
2252 ASET (spec
, FONT_SIZE_INDEX
, size
);
2253 return (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2257 /* Return a font entity matching with SPEC on FRAME. */
2260 font_matching_entity (frame
, spec
)
2261 Lisp_Object frame
, spec
;
2263 FRAME_PTR f
= XFRAME (frame
);
2264 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2265 Lisp_Object ftype
, size
, entity
;
2267 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2268 size
= AREF (spec
, FONT_SIZE_INDEX
);
2270 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2272 for (; driver_list
; driver_list
= driver_list
->next
)
2274 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2276 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
2279 xassert (CONSP (cache
));
2280 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2281 key
= Fcons (spec
, Qnil
);
2282 entity
= assoc_no_quit (key
, XCDR (cache
));
2284 entity
= XCDR (entity
);
2287 entity
= driver_list
->driver
->match (frame
, spec
);
2288 if (! NILP (entity
))
2290 XSETCAR (key
, Fcopy_sequence (spec
));
2291 XSETCDR (cache
, Fcons (Fcons (key
, entity
), XCDR (cache
)));
2294 if (! NILP (entity
))
2297 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2298 ASET (spec
, FONT_SIZE_INDEX
, size
);
2302 static int num_fonts
;
2305 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2306 opened font object. */
2309 font_open_entity (f
, entity
, pixel_size
)
2314 struct font_driver_list
*driver_list
;
2315 Lisp_Object objlist
, size
, val
;
2318 size
= AREF (entity
, FONT_SIZE_INDEX
);
2319 xassert (NATNUMP (size
));
2320 if (XINT (size
) != 0)
2321 pixel_size
= XINT (size
);
2323 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2324 objlist
= XCDR (objlist
))
2326 font
= XSAVE_VALUE (XCAR (objlist
))->pointer
;
2327 if (font
->pixel_size
== pixel_size
)
2329 XSAVE_VALUE (XCAR (objlist
))->integer
++;
2330 return XCAR (objlist
);
2334 xassert (FONT_ENTITY_P (entity
));
2335 val
= AREF (entity
, FONT_TYPE_INDEX
);
2336 for (driver_list
= f
->font_driver_list
;
2337 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2338 driver_list
= driver_list
->next
);
2342 font
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2345 font
->scalable
= XINT (size
) == 0;
2347 val
= make_save_value (font
, 1);
2348 ASET (entity
, FONT_OBJLIST_INDEX
,
2349 Fcons (val
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2355 /* Close FONT_OBJECT that is opened on frame F. */
2358 font_close_object (f
, font_object
)
2360 Lisp_Object font_object
;
2362 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2363 Lisp_Object objlist
;
2364 Lisp_Object tail
, prev
= Qnil
;
2366 XSAVE_VALUE (font_object
)->integer
--;
2367 xassert (XSAVE_VALUE (font_object
)->integer
>= 0);
2368 if (XSAVE_VALUE (font_object
)->integer
> 0)
2371 objlist
= AREF (font
->entity
, FONT_OBJLIST_INDEX
);
2372 for (prev
= Qnil
, tail
= objlist
; CONSP (tail
);
2373 prev
= tail
, tail
= XCDR (tail
))
2374 if (EQ (font_object
, XCAR (tail
)))
2376 if (font
->driver
->close
)
2377 font
->driver
->close (f
, font
);
2378 XSAVE_VALUE (font_object
)->pointer
= NULL
;
2380 ASET (font
->entity
, FONT_OBJLIST_INDEX
, XCDR (objlist
));
2382 XSETCDR (prev
, XCDR (objlist
));
2389 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2390 FONT is a font-entity and it must be opened to check. */
2393 font_has_char (f
, font
, c
)
2400 if (FONT_ENTITY_P (font
))
2402 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2403 struct font_driver_list
*driver_list
;
2405 for (driver_list
= f
->font_driver_list
;
2406 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2407 driver_list
= driver_list
->next
);
2410 if (! driver_list
->driver
->has_char
)
2412 return driver_list
->driver
->has_char (font
, c
);
2415 xassert (FONT_OBJECT_P (font
));
2416 fontp
= XSAVE_VALUE (font
)->pointer
;
2418 if (fontp
->driver
->has_char
)
2420 int result
= fontp
->driver
->has_char (fontp
->entity
, c
);
2425 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2429 /* Return the glyph ID of FONT_OBJECT for character C. */
2432 font_encode_char (font_object
, c
)
2433 Lisp_Object font_object
;
2436 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2438 return font
->driver
->encode_char (font
, c
);
2442 /* Return the name of FONT_OBJECT. */
2445 font_get_name (font_object
)
2446 Lisp_Object font_object
;
2448 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2449 char *name
= (font
->font
.full_name
? font
->font
.full_name
2450 : font
->font
.name
? font
->font
.name
2453 return (name
? make_unibyte_string (name
, strlen (name
)) : null_string
);
2457 /* Return the specification of FONT_OBJECT. */
2460 font_get_spec (font_object
)
2461 Lisp_Object font_object
;
2463 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2464 Lisp_Object spec
= Ffont_spec (0, NULL
);
2467 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2468 ASET (spec
, i
, AREF (font
->entity
, i
));
2469 ASET (spec
, FONT_SIZE_INDEX
, make_number (font
->pixel_size
));
2474 /* Return the frame on which FONT exists. FONT is a font object or a
2478 font_get_frame (font
)
2481 if (FONT_OBJECT_P (font
))
2482 font
= ((struct font
*) XSAVE_VALUE (font
)->pointer
)->entity
;
2483 xassert (FONT_ENTITY_P (font
));
2484 return AREF (font
, FONT_FRAME_INDEX
);
2488 /* Find a font entity best matching with LFACE. If SPEC is non-nil,
2489 the font must exactly match with it. C, if not negative, is a
2490 character that the entity must support. */
2493 font_find_for_lface (f
, lface
, spec
, c
)
2499 Lisp_Object frame
, entities
;
2502 XSETFRAME (frame
, f
);
2508 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2509 ASET (scratch_font_spec
, i
, Qnil
);
2510 ASET (scratch_font_spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2512 if (! NILP (lface
[LFACE_FAMILY_INDEX
]))
2513 font_merge_old_spec (Qnil
, lface
[LFACE_FAMILY_INDEX
], Qnil
,
2515 entities
= font_list_entities (frame
, scratch_font_spec
);
2516 while (ASIZE (entities
) == 0)
2518 /* Try without FOUNDRY or FAMILY. */
2519 if (! NILP (AREF (scratch_font_spec
, FONT_FOUNDRY_INDEX
)))
2521 ASET (scratch_font_spec
, FONT_FOUNDRY_INDEX
, Qnil
);
2522 entities
= font_list_entities (frame
, scratch_font_spec
);
2524 else if (! NILP (AREF (scratch_font_spec
, FONT_FAMILY_INDEX
)))
2526 ASET (scratch_font_spec
, FONT_FAMILY_INDEX
, Qnil
);
2527 entities
= font_list_entities (frame
, scratch_font_spec
);
2535 Lisp_Object registry
= AREF (spec
, FONT_REGISTRY_INDEX
);
2537 if (NILP (registry
))
2538 registry
= Qiso8859_1
;
2542 struct charset
*repertory
;
2544 if (font_registry_charsets (registry
, NULL
, &repertory
) < 0)
2548 if (ENCODE_CHAR (repertory
, c
)
2549 == CHARSET_INVALID_CODE (repertory
))
2551 /* Any font of this registry support C. So, let's
2552 suppress the further checking. */
2555 else if (c
> MAX_UNICODE_CHAR
)
2558 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2559 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2560 ASET (scratch_font_spec
, FONT_REGISTRY_INDEX
, registry
);
2561 entities
= font_list_entities (frame
, scratch_font_spec
);
2564 if (ASIZE (entities
) == 0)
2566 if (ASIZE (entities
) > 1)
2568 /* Sort fonts by properties specified in LFACE. */
2569 Lisp_Object prefer
= scratch_font_prefer
;
2572 if (! NILP (lface
[LFACE_FAMILY_INDEX
]))
2573 font_merge_old_spec (Qnil
, lface
[LFACE_FAMILY_INDEX
], Qnil
, prefer
);
2574 ASET (prefer
, FONT_WEIGHT_INDEX
,
2575 font_prop_validate_style (QCweight
, lface
[LFACE_WEIGHT_INDEX
]));
2576 ASET (prefer
, FONT_SLANT_INDEX
,
2577 font_prop_validate_style (QCslant
, lface
[LFACE_SLANT_INDEX
]));
2578 ASET (prefer
, FONT_WIDTH_INDEX
,
2579 font_prop_validate_style (QCwidth
, lface
[LFACE_SWIDTH_INDEX
]));
2580 pt
= XINT (lface
[LFACE_HEIGHT_INDEX
]);
2581 ASET (prefer
, FONT_SIZE_INDEX
, make_float (pt
/ 10));
2583 font_sort_entites (entities
, prefer
, frame
, spec
);
2587 return AREF (entities
, 0);
2588 for (i
= 0; i
< ASIZE (entities
); i
++)
2590 int result
= font_has_char (f
, AREF (entities
, i
), c
);
2591 Lisp_Object font_object
;
2594 return AREF (entities
, i
);
2597 font_object
= font_open_for_lface (f
, AREF (entities
, i
), lface
, spec
);
2598 if (NILP (font_object
))
2600 result
= font_has_char (f
, font_object
, c
);
2601 font_close_object (f
, font_object
);
2603 return AREF (entities
, i
);
2610 font_open_for_lface (f
, entity
, lface
, spec
)
2618 if (FONT_SPEC_P (spec
) && INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2619 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2622 double pt
= XINT (lface
[LFACE_HEIGHT_INDEX
]);
2625 size
= POINT_TO_PIXEL (pt
, f
->resy
);
2627 return font_open_entity (f
, entity
, size
);
2631 /* Load a font best matching with FACE's font-related properties into
2632 FACE on frame F. If no proper font is found, record that FACE has
2636 font_load_for_face (f
, face
)
2640 Lisp_Object font_object
= face
->lface
[LFACE_FONT_INDEX
];
2642 if (NILP (font_object
))
2644 Lisp_Object entity
= font_find_for_lface (f
, face
->lface
, Qnil
, -1);
2646 if (! NILP (entity
))
2647 font_object
= font_open_for_lface (f
, entity
, face
->lface
, Qnil
);
2650 if (! NILP (font_object
))
2652 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2654 face
->font
= font
->font
.font
;
2655 face
->font_info
= (struct font_info
*) font
;
2656 face
->font_info_id
= 0;
2657 face
->font_name
= font
->font
.full_name
;
2662 face
->font_info
= NULL
;
2663 face
->font_info_id
= -1;
2664 face
->font_name
= NULL
;
2665 add_to_log ("Unable to load font for a face%s", null_string
, Qnil
);
2670 /* Make FACE on frame F ready to use the font opened for FACE. */
2673 font_prepare_for_face (f
, face
)
2677 struct font
*font
= (struct font
*) face
->font_info
;
2679 if (font
->driver
->prepare_face
)
2680 font
->driver
->prepare_face (f
, face
);
2684 /* Make FACE on frame F stop using the font opened for FACE. */
2687 font_done_for_face (f
, face
)
2691 struct font
*font
= (struct font
*) face
->font_info
;
2693 if (font
->driver
->done_face
)
2694 font
->driver
->done_face (f
, face
);
2699 /* Open a font best matching with NAME on frame F. If no proper font
2700 is found, return Qnil. */
2703 font_open_by_name (f
, name
)
2707 Lisp_Object args
[2];
2708 Lisp_Object spec
, prefer
, size
, entity
, entity_list
;
2713 XSETFRAME (frame
, f
);
2716 args
[1] = make_unibyte_string (name
, strlen (name
));
2717 spec
= Ffont_spec (2, args
);
2718 prefer
= scratch_font_prefer
;
2719 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2720 if (NILP (AREF (spec
, i
)))
2721 ASET (prefer
, i
, make_number (100));
2722 size
= AREF (spec
, FONT_SIZE_INDEX
);
2725 else if (INTEGERP (size
))
2726 pixel_size
= XINT (size
);
2727 else /* FLOATP (size) */
2729 double pt
= XFLOAT_DATA (size
);
2731 pixel_size
= POINT_TO_PIXEL (pt
, f
->resy
);
2732 size
= make_number (pixel_size
);
2733 ASET (spec
, FONT_SIZE_INDEX
, size
);
2735 if (pixel_size
== 0)
2737 pixel_size
= POINT_TO_PIXEL (12.0, f
->resy
);
2738 size
= make_number (pixel_size
);
2740 ASET (prefer
, FONT_SIZE_INDEX
, size
);
2741 if (NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
2742 ASET (spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2744 entity_list
= Flist_fonts (spec
, frame
, make_number (1), prefer
);
2745 if (NILP (entity_list
))
2746 entity
= font_matching_entity (frame
, spec
);
2748 entity
= XCAR (entity_list
);
2749 return (NILP (entity
)
2751 : font_open_entity (f
, entity
, pixel_size
));
2755 /* Register font-driver DRIVER. This function is used in two ways.
2757 The first is with frame F non-NULL. In this case, make DRIVER
2758 available (but not yet activated) on F. All frame creaters
2759 (e.g. Fx_create_frame) must call this function at least once with
2760 an available font-driver.
2762 The second is with frame F NULL. In this case, DRIVER is globally
2763 registered in the variable `font_driver_list'. All font-driver
2764 implementations must call this function in its syms_of_XXXX
2765 (e.g. syms_of_xfont). */
2768 register_font_driver (driver
, f
)
2769 struct font_driver
*driver
;
2772 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
2773 struct font_driver_list
*prev
, *list
;
2775 if (f
&& ! driver
->draw
)
2776 error ("Unsable font driver for a frame: %s",
2777 SDATA (SYMBOL_NAME (driver
->type
)));
2779 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
2780 if (EQ (list
->driver
->type
, driver
->type
))
2781 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
2783 list
= malloc (sizeof (struct font_driver_list
));
2785 list
->driver
= driver
;
2790 f
->font_driver_list
= list
;
2792 font_driver_list
= list
;
2797 /* Free font-driver list on frame F. It doesn't free font-drivers
2801 free_font_driver_list (f
)
2804 while (f
->font_driver_list
)
2806 struct font_driver_list
*next
= f
->font_driver_list
->next
;
2808 free (f
->font_driver_list
);
2809 f
->font_driver_list
= next
;
2814 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
2815 symbols, e.g. xft, x). If NEW_DRIVERS is nil, make F use all
2816 available font drivers. If no backend is available, dont't alter
2817 F->font_driver_list.
2819 A caller must free all realized faces and clear all font caches if
2820 any in advance. The return value is a list of font backends
2821 actually made used on F. */
2824 font_update_drivers (f
, new_drivers
)
2826 Lisp_Object new_drivers
;
2828 Lisp_Object active_drivers
= Qnil
;
2829 struct font_driver_list
*list
;
2831 /* At first, finialize all font drivers for F. */
2832 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
2835 if (list
->driver
->end_for_frame
)
2836 list
->driver
->end_for_frame (f
);
2840 /* Then start the requested drivers. */
2841 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
2842 if (NILP (new_drivers
)
2843 || ! NILP (Fmemq (list
->driver
->type
, new_drivers
)))
2845 if (! list
->driver
->start_for_frame
2846 || list
->driver
->start_for_frame (f
) == 0);
2849 active_drivers
= nconc2 (active_drivers
,
2850 Fcons (list
->driver
->type
, Qnil
));
2854 return active_drivers
;
2858 font_put_frame_data (f
, driver
, data
)
2860 struct font_driver
*driver
;
2863 struct font_data_list
*list
, *prev
;
2865 for (prev
= NULL
, list
= f
->font_data_list
; list
;
2866 prev
= list
, list
= list
->next
)
2867 if (list
->driver
== driver
)
2874 prev
->next
= list
->next
;
2876 f
->font_data_list
= list
->next
;
2884 list
= malloc (sizeof (struct font_data_list
));
2887 list
->driver
= driver
;
2888 list
->next
= f
->font_data_list
;
2889 f
->font_data_list
= list
;
2897 font_get_frame_data (f
, driver
)
2899 struct font_driver
*driver
;
2901 struct font_data_list
*list
;
2903 for (list
= f
->font_data_list
; list
; list
= list
->next
)
2904 if (list
->driver
== driver
)
2912 /* Return the font used to draw character C by FACE at buffer position
2913 POS in window W. If OBJECT is non-nil, it is a string containing C
2917 font_at (c
, pos
, face
, w
, object
)
2928 f
= XFRAME (w
->frame
);
2929 if (! FRAME_WINDOW_P (f
))
2933 if (STRINGP (object
))
2934 face_id
= face_at_string_position (w
, object
, pos
, 0, -1, -1, &dummy
,
2935 DEFAULT_FACE_ID
, 0);
2937 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
,
2939 face
= FACE_FROM_ID (f
, face_id
);
2941 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, object
);
2942 face
= FACE_FROM_ID (f
, face_id
);
2943 if (! face
->font_info
)
2945 return font_find_object ((struct font
*) face
->font_info
);
2951 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 1, 0,
2952 doc
: /* Return t if OBJECT is a font-spec or font-entity.
2953 Return nil otherwise. */)
2957 return (FONTP (object
) ? Qt
: Qnil
);
2960 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
2961 doc
: /* Return a newly created font-spec with arguments as properties.
2963 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
2964 valid font property name listed below:
2966 `:family', `:weight', `:slant', `:width'
2968 They are the same as face attributes of the same name. See
2969 `set-face-attribute.
2973 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
2977 VALUE must be a string or a symbol specifying the additional
2978 typographic style information of a font, e.g. ``sans''. Usually null.
2982 VALUE must be a string or a symbol specifying the charset registry and
2983 encoding of a font, e.g. ``iso8859-1''.
2987 VALUE must be a non-negative integer or a floating point number
2988 specifying the font size. It specifies the font size in 1/10 pixels
2989 (if VALUE is an integer), or in points (if VALUE is a float).
2990 usage: (font-spec ARGS ...) */)
2995 Lisp_Object spec
= Fmake_vector (make_number (FONT_SPEC_MAX
), Qnil
);
2998 for (i
= 0; i
< nargs
; i
+= 2)
3000 enum font_property_index prop
;
3001 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3003 prop
= get_font_prop_index (key
, 0);
3004 if (prop
< FONT_EXTRA_INDEX
)
3005 ASET (spec
, prop
, val
);
3008 if (EQ (key
, QCname
))
3011 font_parse_name ((char *) SDATA (val
), spec
);
3013 font_put_extra (spec
, key
, val
);
3016 CHECK_VALIDATE_FONT_SPEC (spec
);
3021 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3022 doc
: /* Return the value of FONT's property KEY.
3023 FONT is a font-spec, a font-entity, or a font-object. */)
3025 Lisp_Object font
, key
;
3027 enum font_property_index idx
;
3029 if (FONT_OBJECT_P (font
))
3031 struct font
*fontp
= XSAVE_VALUE (font
)->pointer
;
3033 if (EQ (key
, QCotf
))
3035 if (fontp
->driver
->otf_capability
)
3036 return fontp
->driver
->otf_capability (fontp
);
3040 font
= fontp
->entity
;
3044 idx
= get_font_prop_index (key
, 0);
3045 if (idx
< FONT_EXTRA_INDEX
)
3046 return AREF (font
, idx
);
3047 if (FONT_ENTITY_P (font
))
3049 return Fcdr (Fassoc (AREF (font
, FONT_EXTRA_INDEX
), key
));
3053 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3054 doc
: /* Set one property of FONT-SPEC: give property KEY value VALUE. */)
3055 (font_spec
, prop
, val
)
3056 Lisp_Object font_spec
, prop
, val
;
3058 enum font_property_index idx
;
3059 Lisp_Object extra
, slot
;
3061 CHECK_FONT_SPEC (font_spec
);
3062 idx
= get_font_prop_index (prop
, 0);
3063 if (idx
< FONT_EXTRA_INDEX
)
3064 return ASET (font_spec
, idx
, val
);
3065 extra
= AREF (font_spec
, FONT_EXTRA_INDEX
);
3066 slot
= Fassoc (extra
, prop
);
3068 extra
= Fcons (Fcons (prop
, val
), extra
);
3070 Fsetcdr (slot
, val
);
3074 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3075 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3076 Optional 2nd argument FRAME specifies the target frame.
3077 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3078 Optional 4th argument PREFER, if non-nil, is a font-spec to
3079 control the order of the returned list. Fonts are sorted by
3080 how they are close to PREFER. */)
3081 (font_spec
, frame
, num
, prefer
)
3082 Lisp_Object font_spec
, frame
, num
, prefer
;
3084 Lisp_Object vec
, list
, tail
;
3088 frame
= selected_frame
;
3089 CHECK_LIVE_FRAME (frame
);
3090 CHECK_VALIDATE_FONT_SPEC (font_spec
);
3098 if (! NILP (prefer
))
3099 CHECK_FONT (prefer
);
3101 vec
= font_list_entities (frame
, font_spec
);
3106 return Fcons (AREF (vec
, 0), Qnil
);
3108 if (! NILP (prefer
))
3109 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
);
3111 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3112 if (n
== 0 || n
> len
)
3114 for (i
= 1; i
< n
; i
++)
3116 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3118 XSETCDR (tail
, val
);
3124 DEFUN ("list-families", Flist_families
, Slist_families
, 0, 1, 0,
3125 doc
: /* List available font families on the current frame.
3126 Optional 2nd argument FRAME specifies the target frame. */)
3131 struct font_driver_list
*driver_list
;
3135 frame
= selected_frame
;
3136 CHECK_LIVE_FRAME (frame
);
3139 for (driver_list
= f
->font_driver_list
; driver_list
;
3140 driver_list
= driver_list
->next
)
3141 if (driver_list
->driver
->list_family
)
3143 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3149 Lisp_Object tail
= list
;
3151 for (; CONSP (val
); val
= XCDR (val
))
3152 if (NILP (Fmemq (XCAR (val
), tail
)))
3153 list
= Fcons (XCAR (val
), list
);
3159 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3160 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3161 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3163 Lisp_Object font_spec
, frame
;
3165 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3172 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 1, 0,
3173 doc
: /* Return XLFD name of FONT.
3174 FONT is a font-spec, font-entity, or font-object.
3175 If the name is too long for XLFD (maximum 255 chars), return nil. */)
3182 if (FONT_SPEC_P (font
))
3183 CHECK_VALIDATE_FONT_SPEC (font
);
3184 else if (FONT_ENTITY_P (font
))
3190 CHECK_FONT_GET_OBJECT (font
, fontp
);
3191 font
= fontp
->entity
;
3192 pixel_size
= fontp
->pixel_size
;
3195 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3197 return build_string (name
);
3200 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3201 doc
: /* Clear font cache. */)
3204 Lisp_Object list
, frame
;
3206 FOR_EACH_FRAME (list
, frame
)
3208 FRAME_PTR f
= XFRAME (frame
);
3209 struct font_driver_list
*driver_list
= f
->font_driver_list
;
3211 for (; driver_list
; driver_list
= driver_list
->next
)
3212 if (driver_list
->on
)
3214 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
3215 Lisp_Object tail
, elt
;
3217 for (tail
= XCDR (cache
); CONSP (tail
); tail
= XCDR (tail
))
3220 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
3222 Lisp_Object vec
= XCDR (elt
);
3225 for (i
= 0; i
< ASIZE (vec
); i
++)
3227 Lisp_Object entity
= AREF (vec
, i
);
3229 if (EQ (driver_list
->driver
->type
,
3230 AREF (entity
, FONT_TYPE_INDEX
)))
3233 = AREF (entity
, FONT_OBJLIST_INDEX
);
3235 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
3237 Lisp_Object val
= XCAR (objlist
);
3238 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
3239 struct font
*font
= p
->pointer
;
3241 xassert (font
&& (driver_list
->driver
3243 driver_list
->driver
->close (f
, font
);
3247 if (driver_list
->driver
->free_entity
)
3248 driver_list
->driver
->free_entity (entity
);
3253 XSETCDR (cache
, Qnil
);
3260 DEFUN ("internal-set-font-style-table", Finternal_set_font_style_table
,
3261 Sinternal_set_font_style_table
, 2, 2, 0,
3262 doc
: /* Set font style table for PROP to TABLE.
3263 PROP must be `:weight', `:slant', or `:width'.
3264 TABLE must be an alist of symbols vs the corresponding numeric values
3265 sorted by numeric values. */)
3267 Lisp_Object prop
, table
;
3271 Lisp_Object tail
, val
;
3273 CHECK_SYMBOL (prop
);
3274 table_index
= (EQ (prop
, QCweight
) ? 0
3275 : EQ (prop
, QCslant
) ? 1
3276 : EQ (prop
, QCwidth
) ? 2
3278 if (table_index
>= ASIZE (font_style_table
))
3279 error ("Invalid font style property: %s", SDATA (SYMBOL_NAME (prop
)));
3280 table
= Fcopy_sequence (table
);
3282 for (tail
= table
; ! NILP (tail
); tail
= Fcdr (tail
))
3284 prop
= Fcar (Fcar (tail
));
3285 val
= Fcdr (Fcar (tail
));
3286 CHECK_SYMBOL (prop
);
3288 if (numeric
> XINT (val
))
3289 error ("Numeric values not sorted for %s", SDATA (SYMBOL_NAME (prop
)));
3290 numeric
= XINT (val
);
3291 XSETCAR (tail
, Fcons (prop
, val
));
3293 ASET (font_style_table
, table_index
, table
);
3297 /* The following three functions are still expremental. */
3299 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
3300 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
3301 FONT-OBJECT may be nil if it is not yet known.
3303 G-string is sequence of glyphs of a specific font,
3304 and is a vector of this form:
3305 [ HEADER GLYPH ... ]
3306 HEADER is a vector of this form:
3307 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
3309 FONT-OBJECT is a font-object for all glyphs in the g-string,
3310 WIDTH thry DESCENT are the metrics (in pixels) of the whole G-string.
3311 GLYPH is a vector of this form:
3312 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
3313 [ [X-OFF Y-OFF WADJUST] | nil] ]
3315 FROM-IDX and TO-IDX are used internally and should not be touched.
3316 C is the character of the glyph.
3317 CODE is the glyph-code of C in FONT-OBJECT.
3318 WIDTH thry DESCENT are the metrics (in pixels) of the glyph.
3319 X-OFF and Y-OFF are offests to the base position for the glyph.
3320 WADJUST is the adjustment to the normal width of the glyph. */)
3322 Lisp_Object font_object
, num
;
3324 Lisp_Object gstring
, g
;
3328 if (! NILP (font_object
))
3329 CHECK_FONT_OBJECT (font_object
);
3332 len
= XINT (num
) + 1;
3333 gstring
= Fmake_vector (make_number (len
), Qnil
);
3334 g
= Fmake_vector (make_number (6), Qnil
);
3335 ASET (g
, 0, font_object
);
3336 ASET (gstring
, 0, g
);
3337 for (i
= 1; i
< len
; i
++)
3338 ASET (gstring
, i
, Fmake_vector (make_number (10), Qnil
));
3342 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
3343 doc
: /* Fillin glyph-string GSTRING by characters for FONT-OBJECT.
3344 START and END specifies the region to extract characters.
3345 If optional 3rd argument OBJECT is non-nil, it is a buffer or a string from
3346 where to extract characters.
3347 FONT-OBJECT may be nil if GSTRING already already contains one. */)
3348 (gstring
, font_object
, start
, end
, object
)
3349 Lisp_Object gstring
, font_object
, start
, end
, object
;
3355 CHECK_VECTOR (gstring
);
3356 if (NILP (font_object
))
3357 font_object
= LGSTRING_FONT (gstring
);
3358 CHECK_FONT_GET_OBJECT (font_object
, font
);
3360 if (STRINGP (object
))
3362 const unsigned char *p
;
3364 CHECK_NATNUM (start
);
3366 if (XINT (start
) > XINT (end
)
3367 || XINT (end
) > ASIZE (object
)
3368 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3369 args_out_of_range_3 (object
, start
, end
);
3371 len
= XINT (end
) - XINT (start
);
3372 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
3373 for (i
= 0; i
< len
; i
++)
3375 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3377 c
= STRING_CHAR_ADVANCE (p
);
3378 code
= font
->driver
->encode_char (font
, c
);
3379 if (code
> MOST_POSITIVE_FIXNUM
)
3380 error ("Glyph code 0x%X is too large", code
);
3381 LGLYPH_SET_FROM (g
, i
);
3382 LGLYPH_SET_TO (g
, i
);
3383 LGLYPH_SET_CHAR (g
, c
);
3384 LGLYPH_SET_CODE (g
, code
);
3391 if (! NILP (object
))
3392 Fset_buffer (object
);
3393 validate_region (&start
, &end
);
3394 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3395 args_out_of_range (start
, end
);
3396 len
= XINT (end
) - XINT (start
);
3398 pos_byte
= CHAR_TO_BYTE (pos
);
3399 for (i
= 0; i
< len
; i
++)
3401 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3403 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
3404 code
= font
->driver
->encode_char (font
, c
);
3405 if (code
> MOST_POSITIVE_FIXNUM
)
3406 error ("Glyph code 0x%X is too large", code
);
3407 LGLYPH_SET_FROM (g
, i
);
3408 LGLYPH_SET_TO (g
, i
);
3409 LGLYPH_SET_CHAR (g
, c
);
3410 LGLYPH_SET_CODE (g
, code
);
3413 for (i
= LGSTRING_LENGTH (gstring
) - 1; i
>= len
; i
--)
3414 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
3418 DEFUN ("font-shape-text", Ffont_shape_text
, Sfont_shape_text
, 3, 4, 0,
3419 doc
: /* Shape text between FROM and TO by FONT-OBJECT.
3420 If optional 4th argument STRING is non-nil, it is a string to shape,
3421 and FROM and TO are indices to the string.
3422 The value is the end position of the shaped text. */)
3423 (from
, to
, font_object
, string
)
3424 Lisp_Object from
, to
, font_object
, string
;
3427 struct font_metrics metrics
;
3428 EMACS_INT start
, end
;
3429 Lisp_Object gstring
, n
;
3434 validate_region (&from
, &to
);
3435 start
= XFASTINT (from
);
3436 end
= XFASTINT (to
);
3437 modify_region (current_buffer
, start
, end
, 0);
3441 CHECK_STRING (string
);
3442 start
= XINT (from
);
3444 if (start
< 0 || start
> end
|| end
> SCHARS (string
))
3445 args_out_of_range_3 (string
, from
, to
);
3448 CHECK_FONT_GET_OBJECT (font_object
, font
);
3449 if (! font
->driver
->shape
)
3452 gstring
= Ffont_make_gstring (font_object
, make_number (end
- start
));
3453 Ffont_fill_gstring (gstring
, font_object
, from
, to
, string
);
3454 n
= font
->driver
->shape (gstring
);
3457 for (i
= 0; i
< XINT (n
);)
3460 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3461 EMACS_INT this_from
= LGLYPH_FROM (g
);
3462 EMACS_INT this_to
= LGLYPH_TO (g
) + 1;
3465 metrics
.lbearing
= LGLYPH_LBEARING (g
);
3466 metrics
.rbearing
= LGLYPH_RBEARING (g
);
3467 metrics
.ascent
= LGLYPH_ASCENT (g
);
3468 metrics
.descent
= LGLYPH_DESCENT (g
);
3469 if (NILP (LGLYPH_ADJUSTMENT (g
)))
3470 metrics
.width
= LGLYPH_WIDTH (g
);
3473 metrics
.width
= LGLYPH_WADJUST (g
);
3474 metrics
.lbearing
+= LGLYPH_XOFF (g
);
3475 metrics
.rbearing
+= LGLYPH_XOFF (g
);
3476 metrics
.ascent
-= LGLYPH_YOFF (g
);
3477 metrics
.descent
+= LGLYPH_YOFF (g
);
3479 for (j
= i
+ 1; j
< XINT (n
); j
++)
3483 g
= LGSTRING_GLYPH (gstring
, j
);
3484 if (this_from
!= LGLYPH_FROM (g
))
3486 x
= metrics
.width
+ LGLYPH_LBEARING (g
) + LGLYPH_XOFF (g
);
3487 if (metrics
.lbearing
> x
)
3488 metrics
.lbearing
= x
;
3489 x
= metrics
.width
+ LGLYPH_RBEARING (g
) + LGLYPH_XOFF (g
);
3490 if (metrics
.rbearing
< x
)
3491 metrics
.rbearing
= x
;
3492 x
= LGLYPH_ASCENT (g
) - LGLYPH_YOFF (g
);
3493 if (metrics
.ascent
< x
)
3495 x
= LGLYPH_DESCENT (g
) - LGLYPH_YOFF (g
);
3496 if (metrics
.descent
< x
)
3497 metrics
.descent
= x
;
3498 if (NILP (LGLYPH_ADJUSTMENT (g
)))
3499 metrics
.width
+= LGLYPH_WIDTH (g
);
3501 metrics
.width
+= LGLYPH_WADJUST (g
);
3504 gstr
= Ffont_make_gstring (font_object
, make_number (j
- i
));
3505 LGSTRING_SET_WIDTH (gstr
, metrics
.width
);
3506 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
3507 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
);
3508 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
3509 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
3510 for (k
= i
; i
< j
; i
++)
3511 LGSTRING_SET_GLYPH (gstr
, i
- k
, LGSTRING_GLYPH (gstring
, i
));
3513 Fcompose_region_internal (make_number (start
+ this_from
),
3514 make_number (start
+ this_to
),
3517 Fcompose_string_internal (string
,
3518 make_number (start
+ this_from
),
3519 make_number (start
+ this_to
),
3523 return make_number (start
+ XINT (n
));
3526 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
3527 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
3528 OTF-SPEC specifies which featuress to apply in this format:
3529 (SCRIPT LANGSYS GSUB GPOS)
3531 SCRIPT is a symbol specifying a script tag of OpenType,
3532 LANGSYS is a symbol specifying a langsys tag of OpenType,
3533 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
3535 If LANGYS is nil, the default langsys is selected.
3537 The features are applied in the order appeared in the list. The
3538 symbol `*' means to apply all available features not appeared in this
3539 list, and the remaining features are ignored. For instance, (vatu
3540 pstf * haln) is to apply vatu and pstf in this order, then to apply
3541 all available features other than vatu, pstf, and haln.
3543 The features are applied to the glyphs in the range FROM and TO of
3544 the glyph-string GSTRING-IN.
3546 If some of a feature is actually applicable, the resulting glyphs are
3547 produced in the glyph-string GSTRING-OUT from the index INDEX. In
3548 this case, the value is the number of produced glyphs.
3550 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
3553 If GSTRING-OUT is too short to hold produced glyphs, no glyphs is
3554 produced in GSTRING-OUT, and the value is nil.
3556 See the documentation of `font-make-gstring' for the format of
3558 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
3559 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
3561 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
3566 check_otf_features (otf_features
);
3567 CHECK_FONT_GET_OBJECT (font_object
, font
);
3568 if (! font
->driver
->otf_drive
)
3569 error ("Font backend %s can't drive OpenType GSUB table",
3570 SDATA (SYMBOL_NAME (font
->driver
->type
)));
3571 CHECK_CONS (otf_features
);
3572 CHECK_SYMBOL (XCAR (otf_features
));
3573 val
= XCDR (otf_features
);
3574 CHECK_SYMBOL (XCAR (val
));
3575 val
= XCDR (otf_features
);
3578 len
= check_gstring (gstring_in
);
3579 CHECK_VECTOR (gstring_out
);
3580 CHECK_NATNUM (from
);
3582 CHECK_NATNUM (index
);
3584 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
3585 args_out_of_range_3 (from
, to
, make_number (len
));
3586 if (XINT (index
) >= ASIZE (gstring_out
))
3587 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
3588 num
= font
->driver
->otf_drive (font
, otf_features
,
3589 gstring_in
, XINT (from
), XINT (to
),
3590 gstring_out
, XINT (index
), 0);
3593 return make_number (num
);
3596 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
3598 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
3599 FEATURE-SPEC specifies which features of the font FONT-OBJECT to apply
3601 (SCRIPT LANGSYS FEATURE ...)
3602 See the documentation of `font-otf-gsub' for more detail.
3604 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
3605 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
3606 character code corresponding to the glyph or nil if there's no
3607 corresponding character. */)
3608 (font_object
, character
, otf_features
)
3609 Lisp_Object font_object
, character
, otf_features
;
3612 Lisp_Object gstring_in
, gstring_out
, g
;
3613 Lisp_Object alternates
;
3616 CHECK_FONT_GET_OBJECT (font_object
, font
);
3617 if (! font
->driver
->otf_drive
)
3618 error ("Font backend %s can't drive OpenType GSUB table",
3619 SDATA (SYMBOL_NAME (font
->driver
->type
)));
3620 CHECK_CHARACTER (character
);
3621 CHECK_CONS (otf_features
);
3623 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
3624 g
= LGSTRING_GLYPH (gstring_in
, 0);
3625 LGLYPH_SET_CHAR (g
, character
);
3626 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
3627 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
3628 gstring_out
, 0, 1)) < 0)
3629 gstring_out
= Ffont_make_gstring (font_object
,
3630 make_number (ASIZE (gstring_out
) * 2));
3632 for (i
= 0; i
< num
; i
++)
3634 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
3635 int c
= XINT (LGLYPH_CHAR (g
));
3636 unsigned code
= XUINT (LGLYPH_CODE (g
));
3638 alternates
= Fcons (Fcons (make_number (code
),
3639 c
> 0 ? make_number (c
) : Qnil
),
3642 return Fnreverse (alternates
);
3648 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
3649 doc
: /* Open FONT-ENTITY. */)
3650 (font_entity
, size
, frame
)
3651 Lisp_Object font_entity
;
3657 CHECK_FONT_ENTITY (font_entity
);
3659 size
= AREF (font_entity
, FONT_SIZE_INDEX
);
3660 CHECK_NUMBER (size
);
3662 frame
= selected_frame
;
3663 CHECK_LIVE_FRAME (frame
);
3665 isize
= XINT (size
);
3669 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
3671 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
3674 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
3675 doc
: /* Close FONT-OBJECT. */)
3676 (font_object
, frame
)
3677 Lisp_Object font_object
, frame
;
3679 CHECK_FONT_OBJECT (font_object
);
3681 frame
= selected_frame
;
3682 CHECK_LIVE_FRAME (frame
);
3683 font_close_object (XFRAME (frame
), font_object
);
3687 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
3688 doc
: /* Return information about FONT-OBJECT.
3689 The value is a vector:
3690 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
3693 NAME is a string of the font name (or nil if the font backend doesn't
3696 FILENAME is a string of the font file (or nil if the font backend
3697 doesn't provide a file name).
3699 PIXEL-SIZE is a pixel size by which the font is opened.
3701 SIZE is a maximum advance width of the font in pixel.
3703 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
3706 CAPABILITY is a list whose first element is a symbol representing the
3707 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
3708 remaining elements describes a detail of the font capability.
3710 If the font is OpenType font, the form of the list is
3711 \(opentype GSUB GPOS)
3712 where GSUB shows which "GSUB" features the font supports, and GPOS
3713 shows which "GPOS" features the font supports. Both GSUB and GPOS are
3714 lists of the format:
3715 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3717 If the font is not OpenType font, currently the length of the form is
3720 SCRIPT is a symbol representing OpenType script tag.
3722 LANGSYS is a symbol representing OpenType langsys tag, or nil
3723 representing the default langsys.
3725 FEATURE is a symbol representing OpenType feature tag.
3727 If the font is not OpenType font, OTF-CAPABILITY is nil. */)
3729 Lisp_Object font_object
;
3734 CHECK_FONT_GET_OBJECT (font_object
, font
);
3736 val
= Fmake_vector (make_number (9), Qnil
);
3737 if (font
->font
.full_name
)
3738 ASET (val
, 0, make_unibyte_string (font
->font
.full_name
,
3739 strlen (font
->font
.full_name
)));
3740 if (font
->file_name
)
3741 ASET (val
, 1, make_unibyte_string (font
->file_name
,
3742 strlen (font
->file_name
)));
3743 ASET (val
, 2, make_number (font
->pixel_size
));
3744 ASET (val
, 3, make_number (font
->font
.size
));
3745 ASET (val
, 4, make_number (font
->ascent
));
3746 ASET (val
, 5, make_number (font
->descent
));
3747 ASET (val
, 6, make_number (font
->font
.space_width
));
3748 ASET (val
, 7, make_number (font
->font
.average_width
));
3749 if (font
->driver
->otf_capability
)
3750 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
3752 ASET (val
, 8, Fcons (font
->format
, Qnil
));
3756 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
3757 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
3758 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
3759 (font_object
, string
)
3760 Lisp_Object font_object
, string
;
3766 CHECK_FONT_GET_OBJECT (font_object
, font
);
3767 CHECK_STRING (string
);
3768 len
= SCHARS (string
);
3769 vec
= Fmake_vector (make_number (len
), Qnil
);
3770 for (i
= 0; i
< len
; i
++)
3772 Lisp_Object ch
= Faref (string
, make_number (i
));
3776 struct font_metrics metrics
;
3778 code
= font
->driver
->encode_char (font
, c
);
3779 if (code
== FONT_INVALID_CODE
)
3781 val
= Fmake_vector (make_number (6), Qnil
);
3782 if (code
<= MOST_POSITIVE_FIXNUM
)
3783 ASET (val
, 0, make_number (code
));
3785 ASET (val
, 0, Fcons (make_number (code
>> 16),
3786 make_number (code
& 0xFFFF)));
3787 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
3788 ASET (val
, 1, make_number (metrics
.lbearing
));
3789 ASET (val
, 2, make_number (metrics
.rbearing
));
3790 ASET (val
, 3, make_number (metrics
.width
));
3791 ASET (val
, 4, make_number (metrics
.ascent
));
3792 ASET (val
, 5, make_number (metrics
.descent
));
3798 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
3799 doc
: /* Return t iff font-spec SPEC matches with FONT.
3800 FONT is a font-spec, font-entity, or font-object. */)
3802 Lisp_Object spec
, font
;
3804 CHECK_FONT_SPEC (spec
);
3805 if (FONT_OBJECT_P (font
))
3806 font
= ((struct font
*) XSAVE_VALUE (font
)->pointer
)->entity
;
3807 else if (! FONT_ENTITY_P (font
))
3808 CHECK_FONT_SPEC (font
);
3810 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
3813 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
3814 doc
: /* Return a font-object for displaying a character at POSISTION.
3815 Optional second arg WINDOW, if non-nil, is a window displaying
3816 the current buffer. It defaults to the currently selected window. */)
3817 (position
, window
, string
)
3818 Lisp_Object position
, window
, string
;
3821 EMACS_INT pos
, pos_byte
;
3826 CHECK_NUMBER_COERCE_MARKER (position
);
3827 pos
= XINT (position
);
3828 if (pos
< BEGV
|| pos
>= ZV
)
3829 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
3830 pos_byte
= CHAR_TO_BYTE (pos
);
3831 c
= FETCH_CHAR (pos_byte
);
3838 CHECK_NUMBER (position
);
3839 CHECK_STRING (string
);
3840 pos
= XINT (position
);
3841 if (pos
< 0 || pos
>= SCHARS (string
))
3842 args_out_of_range (string
, position
);
3843 pos_byte
= string_char_to_byte (string
, pos
);
3844 str
= SDATA (string
) + pos_byte
;
3845 len
= SBYTES (string
) - pos_byte
;
3846 c
= STRING_CHAR (str
, eln
);
3849 window
= selected_window
;
3850 CHECK_LIVE_WINDOW (window
);
3851 w
= XWINDOW (selected_window
);
3853 return font_at (c
, pos
, NULL
, w
, Qnil
);
3857 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
3858 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
3859 The value is a number of glyphs drawn.
3860 Type C-l to recover what previously shown. */)
3861 (font_object
, string
)
3862 Lisp_Object font_object
, string
;
3864 Lisp_Object frame
= selected_frame
;
3865 FRAME_PTR f
= XFRAME (frame
);
3871 CHECK_FONT_GET_OBJECT (font_object
, font
);
3872 CHECK_STRING (string
);
3873 len
= SCHARS (string
);
3874 code
= alloca (sizeof (unsigned) * len
);
3875 for (i
= 0; i
< len
; i
++)
3877 Lisp_Object ch
= Faref (string
, make_number (i
));
3881 code
[i
] = font
->driver
->encode_char (font
, c
);
3882 if (code
[i
] == FONT_INVALID_CODE
)
3885 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3887 if (font
->driver
->prepare_face
)
3888 font
->driver
->prepare_face (f
, face
);
3889 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
3890 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
3891 if (font
->driver
->done_face
)
3892 font
->driver
->done_face (f
, face
);
3894 return make_number (len
);
3898 #endif /* FONT_DEBUG */
3901 extern void syms_of_ftfont
P_ (());
3902 extern void syms_of_xfont
P_ (());
3903 extern void syms_of_xftfont
P_ (());
3904 extern void syms_of_ftxfont
P_ (());
3905 extern void syms_of_bdffont
P_ (());
3906 extern void syms_of_w32font
P_ (());
3907 extern void syms_of_atmfont
P_ (());
3912 sort_shift_bits
[FONT_SLANT_INDEX
] = 0;
3913 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 7;
3914 sort_shift_bits
[FONT_SIZE_INDEX
] = 14;
3915 sort_shift_bits
[FONT_WIDTH_INDEX
] = 21;
3916 sort_shift_bits
[FONT_ADSTYLE_INDEX
] = 28;
3917 sort_shift_bits
[FONT_FOUNDRY_INDEX
] = 29;
3918 sort_shift_bits
[FONT_FAMILY_INDEX
] = 30;
3919 sort_shift_bits
[FONT_REGISTRY_INDEX
] = 31;
3920 /* Note that sort_shift_bits[FONT_TYPE_INDEX] is never used. */
3922 staticpro (&font_style_table
);
3923 font_style_table
= Fmake_vector (make_number (3), Qnil
);
3925 staticpro (&font_family_alist
);
3926 font_family_alist
= Qnil
;
3928 staticpro (&font_charset_alist
);
3929 font_charset_alist
= Qnil
;
3931 DEFSYM (Qopentype
, "opentype");
3933 DEFSYM (Qiso8859_1
, "iso8859-1");
3934 DEFSYM (Qiso10646_1
, "iso10646-1");
3935 DEFSYM (Qunicode_bmp
, "unicode-bmp");
3936 DEFSYM (Qunicode_sip
, "unicode-sip");
3938 DEFSYM (QCotf
, ":otf");
3939 DEFSYM (QClanguage
, ":language");
3940 DEFSYM (QCscript
, ":script");
3941 DEFSYM (QCantialias
, ":antialias");
3943 DEFSYM (QCfoundry
, ":foundry");
3944 DEFSYM (QCadstyle
, ":adstyle");
3945 DEFSYM (QCregistry
, ":registry");
3946 DEFSYM (QCspacing
, ":spacing");
3947 DEFSYM (QCdpi
, ":dpi");
3948 DEFSYM (QCscalable
, ":scalable");
3949 DEFSYM (QCextra
, ":extra");
3956 staticpro (&null_string
);
3957 null_string
= build_string ("");
3958 staticpro (&null_vector
);
3959 null_vector
= Fmake_vector (make_number (0), Qnil
);
3961 staticpro (&scratch_font_spec
);
3962 scratch_font_spec
= Ffont_spec (0, NULL
);
3963 staticpro (&scratch_font_prefer
);
3964 scratch_font_prefer
= Ffont_spec (0, NULL
);
3967 staticpro (&otf_list
);
3972 defsubr (&Sfont_spec
);
3973 defsubr (&Sfont_get
);
3974 defsubr (&Sfont_put
);
3975 defsubr (&Slist_fonts
);
3976 defsubr (&Slist_families
);
3977 defsubr (&Sfind_font
);
3978 defsubr (&Sfont_xlfd_name
);
3979 defsubr (&Sclear_font_cache
);
3980 defsubr (&Sinternal_set_font_style_table
);
3981 defsubr (&Sfont_make_gstring
);
3982 defsubr (&Sfont_fill_gstring
);
3983 defsubr (&Sfont_shape_text
);
3984 defsubr (&Sfont_drive_otf
);
3985 defsubr (&Sfont_otf_alternates
);
3988 defsubr (&Sopen_font
);
3989 defsubr (&Sclose_font
);
3990 defsubr (&Squery_font
);
3991 defsubr (&Sget_font_glyphs
);
3992 defsubr (&Sfont_match_p
);
3993 defsubr (&Sfont_at
);
3995 defsubr (&Sdraw_string
);
3997 #endif /* FONT_DEBUG */
3999 #ifdef USE_FONT_BACKEND
4000 if (enable_font_backend
)
4002 #ifdef HAVE_FREETYPE
4004 #ifdef HAVE_X_WINDOWS
4009 #endif /* HAVE_XFT */
4010 #endif /* HAVE_X_WINDOWS */
4011 #else /* not HAVE_FREETYPE */
4012 #ifdef HAVE_X_WINDOWS
4014 #endif /* HAVE_X_WINDOWS */
4015 #endif /* not HAVE_FREETYPE */
4018 #endif /* HAVE_BDFFONT */
4021 #endif /* WINDOWSNT */
4026 #endif /* USE_FONT_BACKEND */
4029 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
4030 (do not change this comment) */