1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006 Free Software Foundation, Inc.
4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H13PRO009
7 This file is part of GNU Emacs.
9 GNU Emacs is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 2, or (at your option)
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs; see the file COPYING. If not, write to
21 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22 Boston, MA 02110-1301, USA. */
36 #include "dispextern.h"
38 #include "character.h"
39 #include "composite.h"
49 #define xassert(X) do {if (!(X)) abort ();} while (0)
51 #define xassert(X) (void) 0
54 int enable_font_backend
;
56 Lisp_Object Qopentype
;
58 /* Important character set symbols. */
59 Lisp_Object Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
61 /* Like CHECK_FONT_SPEC but also validate properties of the font-spec,
62 and set X to the validated result. */
64 #define CHECK_VALIDATE_FONT_SPEC(x) \
66 if (! FONT_SPEC_P (x)) x = wrong_type_argument (Qfont, x); \
67 x = font_prop_validate (x); \
70 /* Number of pt per inch (from the TeXbook). */
71 #define PT_PER_INCH 72.27
73 /* Return a pixel size (integer) corresponding to POINT size (double)
75 #define POINT_TO_PIXEL(POINT, DPI) ((POINT) * (DPI) / PT_PER_INCH + 0.5)
77 /* Return a point size (double) corresponding to POINT size (integer)
79 #define PIXEL_TO_POINT(PIXEL, DPI) ((PIXEL) * PT_PER_INCH * 10 / (DPI) + 0.5)
81 /* Special string of zero length. It is used to specify a NULL name
82 in a font properties (e.g. adstyle). We don't use the symbol of
83 NULL name because it's confusing (Lisp printer prints nothing for
85 Lisp_Object null_string
;
87 /* Special vector of zero length. This is repeatedly used by (struct
88 font_driver *)->list when a specified font is not found. */
89 Lisp_Object null_vector
;
91 /* Vector of 3 elements. Each element is an alist for one of font
92 style properties (weight, slant, width). Each alist contains a
93 mapping between symbolic property values (e.g. `medium' for weight)
94 and numeric property values (e.g. 100). So, it looks like this:
95 [((thin . 0) ... (heavy . 210))
96 ((ro . 0) ... (ot . 210))
97 ((ultracondensed . 50) ... (wide . 200))] */
98 static Lisp_Object font_style_table
;
100 /* Alist of font family vs the corresponding aliases.
101 Each element has this form:
102 (FAMILY ALIAS1 ALIAS2 ...) */
104 static Lisp_Object font_family_alist
;
106 /* Symbols representing keys of normal font properties. */
107 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
, QCsize
, QCname
;
108 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
, QCextra
;
109 /* Symbols representing keys of font extra info. */
110 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClanguage
, QCscript
;
111 Lisp_Object QCantialias
;
112 /* Symbols representing values of font spacing property. */
113 Lisp_Object Qc
, Qm
, Qp
, Qd
;
115 /* Alist of font registry symbol and the corresponding charsets
116 information. The information is retrieved from
117 Vfont_encoding_alist on demand.
119 Eash element has the form:
120 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
124 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
125 encodes a character code to a glyph code of a font, and
126 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
127 character is supported by a font.
129 The latter form means that the information for REGISTRY couldn't be
131 static Lisp_Object font_charset_alist
;
133 /* List of all font drivers. Each font-backend (XXXfont.c) calls
134 register_font_driver in syms_of_XXXfont to register its font-driver
136 static struct font_driver_list
*font_driver_list
;
138 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
139 static Lisp_Object prop_name_to_numeric
P_ ((enum font_property_index
,
141 static Lisp_Object prop_numeric_to_name
P_ ((enum font_property_index
, int));
142 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
143 static void build_font_family_alist
P_ ((void));
145 /* Number of registered font drivers. */
146 static int num_font_drivers
;
148 /* Return a pixel size of font-spec SPEC on frame F. */
151 font_pixel_size (f
, spec
)
155 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
158 Lisp_Object extra
, val
;
164 point_size
= XFLOAT_DATA (size
);
165 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
166 val
= assq_no_quit (QCdpi
, extra
);
169 if (INTEGERP (XCDR (val
)))
170 dpi
= XINT (XCDR (val
));
172 dpi
= XFLOAT_DATA (XCDR (val
)) + 0.5;
176 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
180 /* Return a numeric value corresponding to PROP's NAME (symbol). If
181 NAME is not registered in font_style_table, return Qnil. PROP must
182 be one of FONT_{WEIGHT|SLANT|SWIDTH}_INDEX. */
185 prop_name_to_numeric (prop
, name
)
186 enum font_property_index prop
;
189 int table_index
= prop
- FONT_WEIGHT_INDEX
;
192 val
= assq_no_quit (name
, AREF (font_style_table
, table_index
));
193 return (NILP (val
) ? Qnil
: XCDR (val
));
197 /* Return a name (symbol) corresponding to PROP's NUMERIC value. If
198 no name is registered for NUMERIC in font_style_table, return a
199 symbol of integer name (e.g. `123'). PROP must be one of
200 FONT_{WEIGHT|SLANT|SWIDTH}_INDEX. */
203 prop_numeric_to_name (prop
, numeric
)
204 enum font_property_index prop
;
207 int table_index
= prop
- FONT_WEIGHT_INDEX
;
208 Lisp_Object table
= AREF (font_style_table
, table_index
);
211 while (! NILP (table
))
213 if (XINT (XCDR (XCAR (table
))) >= numeric
)
215 if (XINT (XCDR (XCAR (table
))) == numeric
)
216 return XCAR (XCAR (table
));
220 table
= XCDR (table
);
222 sprintf (buf
, "%d", numeric
);
227 /* Return a symbol whose name is STR (length LEN). If STR contains
228 uppercase letters, downcase them in advance. */
231 intern_downcase (str
, len
)
238 for (i
= 0; i
< len
; i
++)
239 if (isupper (str
[i
]))
242 return Fintern (make_unibyte_string (str
, len
), Qnil
);
245 return Fintern (null_string
, Qnil
);
246 bcopy (str
, buf
, len
);
248 if (isascii (buf
[i
]))
249 buf
[i
] = tolower (buf
[i
]);
250 return Fintern (make_unibyte_string (buf
, len
), Qnil
);
253 extern Lisp_Object Vface_alternative_font_family_alist
;
255 /* Setup font_family_alist of the form:
256 ((FAMILY-SYMBOL ALIAS-SYMBOL ...) ...)
257 from Vface_alternative_font_family_alist of the form:
258 ((FAMILY-STRING ALIAS-STRING ...) ...) */
261 build_font_family_alist ()
263 Lisp_Object alist
= Vface_alternative_font_family_alist
;
265 for (; CONSP (alist
); alist
= XCDR (alist
))
267 Lisp_Object tail
, elt
;
269 for (tail
= XCAR (alist
), elt
= Qnil
; CONSP (tail
); tail
= XCDR (tail
))
270 elt
= nconc2 (elt
, Fcons (Fintern (XCAR (tail
), Qnil
), Qnil
));
271 font_family_alist
= Fcons (elt
, font_family_alist
);
275 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
277 /* Return encoding charset and repertory charset for REGISTRY in
278 ENCODING and REPERTORY correspondingly. If correct information for
279 REGISTRY is available, return 0. Otherwise return -1. */
282 font_registry_charsets (registry
, encoding
, repertory
)
283 Lisp_Object registry
;
284 struct charset
**encoding
, **repertory
;
287 int encoding_id
, repertory_id
;
289 val
= assq_no_quit (registry
, font_charset_alist
);
295 encoding_id
= XINT (XCAR (val
));
296 repertory_id
= XINT (XCDR (val
));
300 val
= find_font_encoding (SYMBOL_NAME (registry
));
301 if (SYMBOLP (val
) && CHARSETP (val
))
303 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
305 else if (CONSP (val
))
307 if (! CHARSETP (XCAR (val
)))
309 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
310 if (NILP (XCDR (val
)))
314 if (! CHARSETP (XCDR (val
)))
316 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
321 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
323 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
327 *encoding
= CHARSET_FROM_ID (encoding_id
);
329 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
334 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
339 /* Font property value validaters. See the comment of
340 font_property_table for the meaning of the arguments. */
342 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
343 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
344 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
345 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
346 static int get_font_prop_index
P_ ((Lisp_Object
, int));
347 static Lisp_Object font_prop_validate
P_ ((Lisp_Object
));
350 font_prop_validate_symbol (prop
, val
)
351 Lisp_Object prop
, val
;
353 if (EQ (prop
, QCotf
))
354 return (SYMBOLP (val
) ? val
: Qerror
);
356 val
= (SCHARS (val
) == 0 ? null_string
357 : intern_downcase ((char *) SDATA (val
), SBYTES (val
)));
358 else if (SYMBOLP (val
))
360 if (SCHARS (SYMBOL_NAME (val
)) == 0)
369 font_prop_validate_style (prop
, val
)
370 Lisp_Object prop
, val
;
372 if (! INTEGERP (val
))
375 val
= intern_downcase ((char *) SDATA (val
), SBYTES (val
));
380 enum font_property_index prop_index
381 = (EQ (prop
, QCweight
) ? FONT_WEIGHT_INDEX
382 : EQ (prop
, QCslant
) ? FONT_SLANT_INDEX
385 val
= prop_name_to_numeric (prop_index
, val
);
394 font_prop_validate_non_neg (prop
, val
)
395 Lisp_Object prop
, val
;
397 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
402 font_prop_validate_spacing (prop
, val
)
403 Lisp_Object prop
, val
;
405 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
408 return make_number (FONT_SPACING_CHARCELL
);
410 return make_number (FONT_SPACING_MONO
);
412 return make_number (FONT_SPACING_PROPORTIONAL
);
417 font_prop_validate_otf (prop
, val
)
418 Lisp_Object prop
, val
;
420 Lisp_Object tail
, tmp
;
423 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
424 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
425 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
428 if (! SYMBOLP (XCAR (val
)))
433 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
435 for (i
= 0; i
< 2; i
++)
442 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
443 if (! SYMBOLP (XCAR (tmp
)))
451 /* Structure of known font property keys and validater of the
455 /* Pointer to the key symbol. */
457 /* Function to validate PROP's value VAL, or NULL if any value is
458 ok. The value is VAL or its regularized value if VAL is valid,
459 and Qerror if not. */
460 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
461 } font_property_table
[] =
462 { { &QCtype
, font_prop_validate_symbol
},
463 { &QCfoundry
, font_prop_validate_symbol
},
464 { &QCfamily
, font_prop_validate_symbol
},
465 { &QCadstyle
, font_prop_validate_symbol
},
466 { &QCregistry
, font_prop_validate_symbol
},
467 { &QCweight
, font_prop_validate_style
},
468 { &QCslant
, font_prop_validate_style
},
469 { &QCwidth
, font_prop_validate_style
},
470 { &QCsize
, font_prop_validate_non_neg
},
471 { &QClanguage
, font_prop_validate_symbol
},
472 { &QCscript
, font_prop_validate_symbol
},
473 { &QCdpi
, font_prop_validate_non_neg
},
474 { &QCspacing
, font_prop_validate_spacing
},
475 { &QCscalable
, NULL
},
476 { &QCotf
, font_prop_validate_otf
},
477 { &QCantialias
, font_prop_validate_symbol
}
480 /* Size (number of elements) of the above table. */
481 #define FONT_PROPERTY_TABLE_SIZE \
482 ((sizeof font_property_table) / (sizeof *font_property_table))
484 /* Return an index number of font property KEY or -1 if KEY is not an
485 already known property. Start searching font_property_table from
486 index FROM (which is 0 or FONT_EXTRA_INDEX). */
489 get_font_prop_index (key
, from
)
493 for (; from
< FONT_PROPERTY_TABLE_SIZE
; from
++)
494 if (EQ (key
, *font_property_table
[from
].key
))
499 /* Validate font properties in SPEC (vector) while updating elements
500 to regularized values. Signal an error if an invalid property is
504 font_prop_validate (spec
)
508 Lisp_Object prop
, val
, extra
;
510 for (i
= FONT_TYPE_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
512 if (! NILP (AREF (spec
, i
)))
514 prop
= *font_property_table
[i
].key
;
515 val
= (font_property_table
[i
].validater
) (prop
, AREF (spec
, i
));
516 if (EQ (val
, Qerror
))
517 Fsignal (Qfont
, list2 (build_string ("invalid font property"),
518 Fcons (prop
, AREF (spec
, i
))));
522 for (extra
= AREF (spec
, FONT_EXTRA_INDEX
);
523 CONSP (extra
); extra
= XCDR (extra
))
525 Lisp_Object elt
= XCAR (extra
);
528 i
= get_font_prop_index (prop
, FONT_EXTRA_INDEX
);
530 && font_property_table
[i
].validater
)
532 val
= (font_property_table
[i
].validater
) (prop
, XCDR (elt
));
533 if (EQ (val
, Qerror
))
534 Fsignal (Qfont
, list2 (build_string ("invalid font property"),
542 /* Store VAL as a value of extra font property PROP in FONT. */
545 font_put_extra (font
, prop
, val
)
546 Lisp_Object font
, prop
, val
;
548 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
549 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
553 extra
= Fcons (Fcons (prop
, val
), extra
);
554 ASET (font
, FONT_EXTRA_INDEX
, extra
);
562 /* Font name parser and unparser */
564 static Lisp_Object intern_font_field
P_ ((char *, int));
565 static int parse_matrix
P_ ((char *));
566 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
567 static int font_parse_name
P_ ((char *, Lisp_Object
));
569 /* An enumerator for each field of an XLFD font name. */
570 enum xlfd_field_index
589 /* An enumerator for mask bit corresponding to each XLFD field. */
592 XLFD_FOUNDRY_MASK
= 0x0001,
593 XLFD_FAMILY_MASK
= 0x0002,
594 XLFD_WEIGHT_MASK
= 0x0004,
595 XLFD_SLANT_MASK
= 0x0008,
596 XLFD_SWIDTH_MASK
= 0x0010,
597 XLFD_ADSTYLE_MASK
= 0x0020,
598 XLFD_PIXEL_MASK
= 0x0040,
599 XLFD_POINT_MASK
= 0x0080,
600 XLFD_RESX_MASK
= 0x0100,
601 XLFD_RESY_MASK
= 0x0200,
602 XLFD_SPACING_MASK
= 0x0400,
603 XLFD_AVGWIDTH_MASK
= 0x0800,
604 XLFD_REGISTRY_MASK
= 0x1000,
605 XLFD_ENCODING_MASK
= 0x2000
609 /* Return a Lispy value of a XLFD font field at STR and LEN bytes.
610 If LEN is zero, it returns `null_string'.
611 If STR is "*", it returns nil.
612 If all characters in STR are digits, it returns an integer.
613 Otherwise, it returns a symbol interned from downcased STR. */
616 intern_font_field (str
, len
)
624 if (*str
== '*' && len
== 1)
628 for (i
= 1; i
< len
; i
++)
629 if (! isdigit (str
[i
]))
632 return make_number (atoi (str
));
634 return intern_downcase (str
, len
);
637 /* Parse P pointing the pixel/point size field of the form
638 `[A B C D]' which specifies a transformation matrix:
644 by which all glyphs of the font are transformed. The spec says
645 that scalar value N for the pixel/point size is equivalent to:
646 A = N * resx/resy, B = C = 0, D = N.
648 Return the scalar value N if the form is valid. Otherwise return
659 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
662 matrix
[i
] = - strtod (p
+ 1, &end
);
664 matrix
[i
] = strtod (p
, &end
);
667 return (i
== 4 ? (int) matrix
[3] : -1);
670 /* Expand a wildcard field in FIELD (the first N fields are filled) to
671 multiple fields to fill in all 14 XLFD fields while restring a
672 field position by its contents. */
675 font_expand_wildcards (field
, n
)
676 Lisp_Object field
[XLFD_LAST_INDEX
];
680 Lisp_Object tmp
[XLFD_LAST_INDEX
];
681 /* Array of information about where this element can go. Nth
682 element is for Nth element of FIELD. */
684 /* Minimum possible field. */
686 /* Maxinum possible field. */
688 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
690 } range
[XLFD_LAST_INDEX
];
692 int range_from
, range_to
;
695 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
696 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
697 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
698 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
699 | XLFD_AVGWIDTH_MASK)
700 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
702 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
703 field. The value is shifted to left one bit by one in the
705 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
706 range_mask
= (range_mask
<< 1) | 1;
708 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
709 position-based retriction for FIELD[I]. */
710 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
711 i
++, range_from
++, range_to
++, range_mask
<<= 1)
713 Lisp_Object val
= field
[i
];
719 range
[i
].from
= range_from
;
720 range
[i
].to
= range_to
;
721 range
[i
].mask
= range_mask
;
725 /* The triplet FROM, TO, and MASK is a value-based
726 retriction for FIELD[I]. */
732 int numeric
= XINT (val
);
735 from
= to
= XLFD_ENCODING_INDEX
,
736 mask
= XLFD_ENCODING_MASK
;
737 else if (numeric
== 0)
738 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
739 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
740 else if (numeric
<= 48)
741 from
= to
= XLFD_PIXEL_INDEX
,
742 mask
= XLFD_PIXEL_MASK
;
744 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
745 mask
= XLFD_LARGENUM_MASK
;
747 else if (EQ (val
, null_string
))
748 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
749 mask
= XLFD_NULL_MASK
;
751 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
754 Lisp_Object name
= SYMBOL_NAME (val
);
756 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
757 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
758 mask
= XLFD_REGENC_MASK
;
760 from
= to
= XLFD_ENCODING_INDEX
,
761 mask
= XLFD_ENCODING_MASK
;
763 else if (range_from
<= XLFD_WEIGHT_INDEX
764 && range_to
>= XLFD_WEIGHT_INDEX
765 && !NILP (prop_name_to_numeric (FONT_WEIGHT_INDEX
, val
)))
766 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
767 else if (range_from
<= XLFD_SLANT_INDEX
768 && range_to
>= XLFD_SLANT_INDEX
769 && !NILP (prop_name_to_numeric (FONT_SLANT_INDEX
, val
)))
770 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
771 else if (range_from
<= XLFD_SWIDTH_INDEX
772 && range_to
>= XLFD_SWIDTH_INDEX
773 && !NILP (prop_name_to_numeric (FONT_WIDTH_INDEX
, val
)))
774 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
777 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
778 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
780 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
781 mask
= XLFD_SYMBOL_MASK
;
784 /* Merge position-based and value-based restrictions. */
786 while (from
< range_from
)
787 mask
&= ~(1 << from
++);
788 while (from
< 14 && ! (mask
& (1 << from
)))
790 while (to
> range_to
)
791 mask
&= ~(1 << to
--);
792 while (to
>= 0 && ! (mask
& (1 << to
)))
796 range
[i
].from
= from
;
798 range
[i
].mask
= mask
;
800 if (from
> range_from
|| to
< range_to
)
802 /* The range is narrowed by value-based restrictions.
803 Reflect it to the other fields. */
805 /* Following fields should be after FROM. */
807 /* Preceding fields should be before TO. */
808 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
810 /* Check FROM for non-wildcard field. */
811 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
813 while (range
[j
].from
< from
)
814 range
[j
].mask
&= ~(1 << range
[j
].from
++);
815 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
817 range
[j
].from
= from
;
820 from
= range
[j
].from
;
821 if (range
[j
].to
> to
)
823 while (range
[j
].to
> to
)
824 range
[j
].mask
&= ~(1 << range
[j
].to
--);
825 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
838 /* Decide all fileds from restrictions in RANGE. */
839 for (i
= j
= 0; i
< n
; i
++)
841 if (j
< range
[i
].from
)
843 if (i
== 0 || ! NILP (tmp
[i
- 1]))
844 /* None of TMP[X] corresponds to Jth field. */
846 for (; j
< range
[i
].from
; j
++)
851 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
853 for (; j
< XLFD_LAST_INDEX
; j
++)
855 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
856 field
[XLFD_ENCODING_INDEX
]
857 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
861 /* Parse NAME (null terminated) as XLFD and store information in FONT
862 (font-spec or font-entity). Size property of FONT is set as
864 specified XLFD fields FONT property
865 --------------------- -------------
866 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
867 POINT_SIZE and RESY calculated pixel size (Lisp integer)
868 POINT_SIZE POINT_SIZE/10 (Lisp float)
870 If NAME is successfully parsed, return 0. Otherwise return -1.
872 FONT is usually a font-spec, but when this function is called from
873 X font backend driver, it is a font-entity. In that case, NAME is
874 a fully specified XLFD, and we set FONT_EXTRA_INDEX of FONT to a
875 symbol RESX-RESY-SPACING-AVGWIDTH.
879 font_parse_xlfd (name
, font
)
883 int len
= strlen (name
);
885 Lisp_Object dpi
, spacing
;
887 char *f
[XLFD_LAST_INDEX
+ 1];
892 /* Maximum XLFD name length is 255. */
894 /* Accept "*-.." as a fully specified XLFD. */
895 if (name
[0] == '*' && name
[1] == '-')
896 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
899 for (p
= name
+ i
; *p
; p
++)
900 if (*p
== '-' && i
< XLFD_LAST_INDEX
)
904 dpi
= spacing
= Qnil
;
907 if (i
== XLFD_LAST_INDEX
)
911 /* Fully specified XLFD. */
912 for (i
= 0, j
= FONT_FOUNDRY_INDEX
; i
< XLFD_WEIGHT_INDEX
; i
++, j
++)
914 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
918 for (j
= FONT_WEIGHT_INDEX
; i
< XLFD_ADSTYLE_INDEX
; i
++, j
++)
920 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
923 Lisp_Object numeric
= prop_name_to_numeric (j
, val
);
925 if (INTEGERP (numeric
))
930 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
932 ASET (font
, FONT_ADSTYLE_INDEX
, val
);
933 i
= XLFD_REGISTRY_INDEX
;
934 val
= intern_font_field (f
[i
], f
[i
+ 2] - f
[i
]);
936 ASET (font
, FONT_REGISTRY_INDEX
, val
);
938 p
= f
[XLFD_PIXEL_INDEX
];
939 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
940 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
943 i
= XLFD_PIXEL_INDEX
;
944 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
946 ASET (font
, FONT_SIZE_INDEX
, val
);
949 double point_size
= -1;
951 xassert (FONT_SPEC_P (font
));
952 p
= f
[XLFD_POINT_INDEX
];
954 point_size
= parse_matrix (p
);
955 else if (isdigit (*p
))
956 point_size
= atoi (p
), point_size
/= 10;
958 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
961 i
= XLFD_PIXEL_INDEX
;
962 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
964 ASET (font
, FONT_SIZE_INDEX
, val
);
969 /* Parse RESX, RESY, SPACING, and AVGWIDTH. */
970 if (FONT_ENTITY_P (font
))
973 ASET (font
, FONT_EXTRA_INDEX
,
974 intern_font_field (f
[i
], f
[XLFD_REGISTRY_INDEX
] - 1 - f
[i
]));
978 /* Here we just setup DPI, SPACING, and AVGWIDTH. They are set
979 in FONT_EXTRA_INDEX later. */
981 dpi
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
982 i
= XLFD_SPACING_INDEX
;
983 spacing
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
984 p
= f
[XLFD_AVGWIDTH_INDEX
];
992 int wild_card_found
= 0;
993 Lisp_Object prop
[XLFD_LAST_INDEX
];
995 for (j
= 0; j
< i
; j
++)
999 if (f
[j
][1] && f
[j
][1] != '-')
1002 wild_card_found
= 1;
1004 else if (isdigit (*f
[j
]))
1006 for (p
= f
[j
] + 1; isdigit (*p
); p
++);
1007 if (*p
&& *p
!= '-')
1008 prop
[j
] = intern_downcase (f
[j
], p
- f
[j
]);
1010 prop
[j
] = make_number (atoi (f
[j
]));
1013 prop
[j
] = intern_font_field (f
[j
], f
[j
+ 1] - 1 - f
[j
]);
1015 prop
[j
] = intern_font_field (f
[j
], f
[i
] - f
[j
]);
1017 if (! wild_card_found
)
1019 if (font_expand_wildcards (prop
, i
) < 0)
1022 for (i
= 0, j
= FONT_FOUNDRY_INDEX
; i
< XLFD_WEIGHT_INDEX
; i
++, j
++)
1023 if (! NILP (prop
[i
]))
1024 ASET (font
, j
, prop
[i
]);
1025 for (j
= FONT_WEIGHT_INDEX
; i
< XLFD_ADSTYLE_INDEX
; i
++, j
++)
1026 if (! NILP (prop
[i
]))
1027 ASET (font
, j
, prop
[i
]);
1028 if (! NILP (prop
[XLFD_ADSTYLE_INDEX
]))
1029 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1030 val
= prop
[XLFD_REGISTRY_INDEX
];
1033 val
= prop
[XLFD_ENCODING_INDEX
];
1035 val
= Fintern (concat2 (build_string ("*-"), SYMBOL_NAME (val
)),
1038 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1039 val
= Fintern (concat2 (SYMBOL_NAME (val
), build_string ("-*")),
1042 val
= Fintern (concat3 (SYMBOL_NAME (val
), build_string ("-"),
1043 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
])),
1046 ASET (font
, FONT_REGISTRY_INDEX
, val
);
1048 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1049 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1050 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1052 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1054 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1057 dpi
= prop
[XLFD_RESX_INDEX
];
1058 spacing
= prop
[XLFD_SPACING_INDEX
];
1059 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1060 avgwidth
= XINT (prop
[XLFD_AVGWIDTH_INDEX
]);
1064 font_put_extra (font
, QCdpi
, dpi
);
1065 if (! NILP (spacing
))
1066 font_put_extra (font
, QCspacing
, spacing
);
1068 font_put_extra (font
, QCscalable
, avgwidth
== 0 ? Qt
: Qnil
);
1073 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1074 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1075 0, use PIXEL_SIZE instead. */
1078 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1084 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1088 xassert (FONTP (font
));
1090 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1093 if (i
== FONT_ADSTYLE_INDEX
)
1094 j
= XLFD_ADSTYLE_INDEX
;
1095 else if (i
== FONT_REGISTRY_INDEX
)
1096 j
= XLFD_REGISTRY_INDEX
;
1097 val
= AREF (font
, i
);
1100 if (j
== XLFD_REGISTRY_INDEX
)
1101 f
[j
] = "*-*", len
+= 4;
1103 f
[j
] = "*", len
+= 2;
1108 val
= SYMBOL_NAME (val
);
1109 if (j
== XLFD_REGISTRY_INDEX
1110 && ! strchr ((char *) SDATA (val
), '-'))
1112 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1113 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1115 f
[j
] = alloca (SBYTES (val
) + 3);
1116 sprintf (f
[j
], "%s-*", SDATA (val
));
1117 len
+= SBYTES (val
) + 3;
1121 f
[j
] = alloca (SBYTES (val
) + 4);
1122 sprintf (f
[j
], "%s*-*", SDATA (val
));
1123 len
+= SBYTES (val
) + 4;
1127 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1131 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1134 val
= AREF (font
, i
);
1136 f
[j
] = "*", len
+= 2;
1140 val
= prop_numeric_to_name (i
, XINT (val
));
1142 val
= SYMBOL_NAME (val
);
1143 xassert (STRINGP (val
));
1144 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1148 val
= AREF (font
, FONT_SIZE_INDEX
);
1149 xassert (NUMBERP (val
) || NILP (val
));
1152 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1155 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1156 else if (pixel_size
> 0)
1157 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", pixel_size
) + 1;
1158 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1160 else if (FLOATP (val
))
1162 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1163 i
= XFLOAT_DATA (val
) * 10;
1164 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1167 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1169 val
= AREF (font
, FONT_EXTRA_INDEX
);
1171 if (FONT_ENTITY_P (font
)
1172 && EQ (AREF (font
, FONT_TYPE_INDEX
), Qx
))
1174 /* Setup names for RESX-RESY-SPACING-AVWIDTH. */
1175 if (SYMBOLP (val
) && ! NILP (val
))
1177 val
= SYMBOL_NAME (val
);
1178 f
[XLFD_RESX_INDEX
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1181 f
[XLFD_RESX_INDEX
] = "*-*-*-*", len
+= 6;
1185 Lisp_Object dpi
= assq_no_quit (QCdpi
, val
);
1186 Lisp_Object spacing
= assq_no_quit (QCspacing
, val
);
1187 Lisp_Object scalable
= assq_no_quit (QCscalable
, val
);
1189 if (CONSP (dpi
) || CONSP (spacing
) || CONSP (scalable
))
1191 char *str
= alloca (24);
1194 if (CONSP (dpi
) && INTEGERP (XCDR (dpi
)))
1195 this_len
= sprintf (str
, "%d-%d",
1196 XINT (XCDR (dpi
)), XINT (XCDR (dpi
)));
1198 this_len
= sprintf (str
, "*-*");
1199 if (CONSP (spacing
) && ! NILP (XCDR (spacing
)))
1201 val
= XCDR (spacing
);
1204 if (XINT (val
) < FONT_SPACING_MONO
)
1206 else if (XINT (val
) < FONT_SPACING_CHARCELL
)
1211 xassert (SYMBOLP (val
));
1212 this_len
+= sprintf (str
+ this_len
, "-%c",
1213 SDATA (SYMBOL_NAME (val
))[0]);
1216 this_len
+= sprintf (str
+ this_len
, "-*");
1217 if (CONSP (scalable
) && ! NILP (XCDR (spacing
)))
1218 this_len
+= sprintf (str
+ this_len
, "-0");
1220 this_len
+= sprintf (str
+ this_len
, "-*");
1221 f
[XLFD_RESX_INDEX
] = str
;
1225 f
[XLFD_RESX_INDEX
] = "*-*-*-*", len
+= 8;
1228 len
++; /* for terminating '\0'. */
1231 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1232 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1233 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1234 f
[XLFD_SWIDTH_INDEX
],
1235 f
[XLFD_ADSTYLE_INDEX
], f
[XLFD_PIXEL_INDEX
],
1236 f
[XLFD_RESX_INDEX
], f
[XLFD_REGISTRY_INDEX
]);
1239 /* Parse NAME (null terminated) as Fonconfig's name format and store
1240 information in FONT (font-spec or font-entity). If NAME is
1241 successfully parsed, return 0. Otherwise return -1. */
1244 font_parse_fcname (name
, font
)
1249 int len
= strlen (name
);
1254 /* It is assured that (name[0] && name[0] != '-'). */
1262 for (p0
= name
+ 1; *p0
&& (*p0
!= '-' && *p0
!= ':'); p0
++)
1263 if (*p0
== '\\' && p0
[1])
1265 family
= intern_font_field (name
, p0
- name
);
1268 if (! isdigit (p0
[1]))
1270 point_size
= strtod (p0
+ 1, &p1
);
1271 if (*p1
&& *p1
!= ':')
1273 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1276 ASET (font
, FONT_FAMILY_INDEX
, family
);
1280 copy
= alloca (len
+ 1);
1285 /* Now parse ":KEY=VAL" patterns. Store known keys and values in
1286 extra, copy unknown ones to COPY. */
1289 Lisp_Object key
, val
;
1292 for (p1
= p0
+ 1; *p1
&& *p1
!= '=' && *p1
!= ':'; p1
++);
1295 /* Must be an enumerated value. */
1296 val
= intern_font_field (p0
+ 1, p1
- p0
- 1);
1297 if (memcmp (p0
+ 1, "light", 5) == 0
1298 || memcmp (p0
+ 1, "medium", 6) == 0
1299 || memcmp (p0
+ 1, "demibold", 8) == 0
1300 || memcmp (p0
+ 1, "bold", 4) == 0
1301 || memcmp (p0
+ 1, "black", 5) == 0)
1303 ASET (font
, FONT_WEIGHT_INDEX
, val
);
1305 else if (memcmp (p0
+ 1, "roman", 5) == 0
1306 || memcmp (p0
+ 1, "italic", 6) == 0
1307 || memcmp (p0
+ 1, "oblique", 7) == 0)
1309 ASET (font
, FONT_SLANT_INDEX
, val
);
1311 else if (memcmp (p0
+ 1, "charcell", 8) == 0
1312 || memcmp (p0
+ 1, "mono", 4) == 0
1313 || memcmp (p0
+ 1, "proportional", 12) == 0)
1315 font_put_extra (font
, QCspacing
,
1316 (p0
[1] == 'c' ? Qc
: p0
[1] == 'm' ? Qm
: Qp
));
1321 bcopy (p0
, copy
, p1
- p0
);
1327 if (memcmp (p0
+ 1, "pixelsize=", 10) == 0)
1328 prop
= FONT_SIZE_INDEX
;
1331 key
= intern_font_field (p0
, p1
- p0
);
1332 prop
= get_font_prop_index (key
, 0);
1335 for (p1
= p0
; *p1
&& *p1
!= ':'; p1
++);
1336 val
= intern_font_field (p0
, p1
- p0
);
1339 if (prop
>= 0 && prop
< FONT_EXTRA_INDEX
)
1341 ASET (font
, prop
, val
);
1344 font_put_extra (font
, key
, val
);
1353 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1354 NAME (NBYTES length), and return the name length. If
1355 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1358 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1366 int dpi
, spacing
, scalable
;
1369 Lisp_Object styles
[3];
1370 char *style_names
[3] = { "weight", "slant", "width" };
1372 val
= AREF (font
, FONT_FAMILY_INDEX
);
1373 if (SYMBOLP (val
) && ! NILP (val
))
1374 len
+= SBYTES (SYMBOL_NAME (val
));
1376 val
= AREF (font
, FONT_SIZE_INDEX
);
1379 if (XINT (val
) != 0)
1380 pixel_size
= XINT (val
);
1382 len
+= 21; /* for ":pixelsize=NUM" */
1384 else if (FLOATP (val
))
1387 point_size
= (int) XFLOAT_DATA (val
);
1388 len
+= 11; /* for "-NUM" */
1391 val
= AREF (font
, FONT_FOUNDRY_INDEX
);
1392 if (SYMBOLP (val
) && ! NILP (val
))
1393 /* ":foundry=NAME" */
1394 len
+= 9 + SBYTES (SYMBOL_NAME (val
));
1396 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
1398 val
= AREF (font
, i
);
1401 val
= prop_numeric_to_name (i
, XINT (val
));
1402 len
+= (strlen (style_names
[i
- FONT_WEIGHT_INDEX
])
1403 + 2 + SBYTES (SYMBOL_NAME (val
))); /* :xxx=NAME */
1405 styles
[i
- FONT_WEIGHT_INDEX
] = val
;
1408 val
= AREF (font
, FONT_EXTRA_INDEX
);
1409 if (FONT_ENTITY_P (font
)
1410 && EQ (AREF (font
, FONT_TYPE_INDEX
), Qx
))
1414 /* VAL is a symbol of name `RESX-RESY-SPACING-AVWIDTH'. */
1415 p
= (char *) SDATA (SYMBOL_NAME (val
));
1417 for (p
++; *p
!= '-'; p
++); /* skip RESX */
1418 for (p
++; *p
!= '-'; p
++); /* skip RESY */
1419 spacing
= (*p
== 'c' ? FONT_SPACING_CHARCELL
1420 : *p
== 'm' ? FONT_SPACING_MONO
1421 : FONT_SPACING_PROPORTIONAL
);
1422 for (p
++; *p
!= '-'; p
++); /* skip SPACING */
1423 scalable
= (atoi (p
) == 0);
1424 /* The longest pattern is ":dpi=NUM:scalable=False:spacing=100" */
1431 dpi
= spacing
= scalable
= -1;
1432 elt
= assq_no_quit (QCdpi
, val
);
1434 dpi
= XINT (XCDR (elt
)), len
+= 15; /* for ":dpi=NUM" */
1435 elt
= assq_no_quit (QCspacing
, val
);
1437 spacing
= XINT (XCDR (elt
)), len
+= 12; /* for ":spacing=100" */
1438 elt
= assq_no_quit (QCscalable
, val
);
1440 scalable
= ! NILP (XCDR (elt
)), len
+= 15; /* for ":scalable=False" */
1446 if (! NILP (AREF (font
, FONT_FAMILY_INDEX
)))
1447 p
+= sprintf(p
, "%s",
1448 SDATA (SYMBOL_NAME (AREF (font
, FONT_FAMILY_INDEX
))));
1452 p
+= sprintf (p
, "%d", point_size
);
1454 p
+= sprintf (p
, "-%d", point_size
);
1456 else if (pixel_size
> 0)
1457 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1458 if (SYMBOLP (AREF (font
, FONT_FOUNDRY_INDEX
))
1459 && ! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1460 p
+= sprintf (p
, ":foundry=%s",
1461 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1462 for (i
= 0; i
< 3; i
++)
1463 if (SYMBOLP (styles
[i
]) && ! NILP (styles
[i
]))
1464 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1465 SDATA (SYMBOL_NAME (styles
[i
])));
1467 p
+= sprintf (p
, ":dpi=%d", dpi
);
1469 p
+= sprintf (p
, ":spacing=%d", spacing
);
1471 p
+= sprintf (p
, ":scalable=True");
1472 else if (scalable
== 0)
1473 p
+= sprintf (p
, ":scalable=False");
1477 /* Parse NAME (null terminated) and store information in FONT
1478 (font-spec or font-entity). If NAME is successfully parsed, return
1479 0. Otherwise return -1.
1481 If NAME is XLFD and FONT is a font-entity, store
1482 RESX-RESY-SPACING-AVWIDTH information as a symbol in
1483 FONT_EXTRA_INDEX. */
1486 font_parse_name (name
, font
)
1490 if (name
[0] == '-' || index (name
, '*'))
1491 return font_parse_xlfd (name
, font
);
1492 return font_parse_fcname (name
, font
);
1495 /* Merge old style font specification (either a font name NAME or a
1496 combination of a family name FAMILY and a registry name REGISTRY
1497 into the font specification SPEC. */
1500 font_merge_old_spec (name
, family
, registry
, spec
)
1501 Lisp_Object name
, family
, registry
, spec
;
1505 if (font_parse_xlfd ((char *) SDATA (name
), spec
) < 0)
1507 Lisp_Object extra
= Fcons (Fcons (QCname
, name
), Qnil
);
1509 ASET (spec
, FONT_EXTRA_INDEX
, extra
);
1514 if (! NILP (family
))
1519 xassert (STRINGP (family
));
1520 len
= SBYTES (family
);
1521 p0
= (char *) SDATA (family
);
1522 p1
= index (p0
, '-');
1525 if ((*p0
!= '*' || p1
- p0
> 1)
1526 && NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
1527 ASET (spec
, FONT_FOUNDRY_INDEX
,
1528 intern_downcase (p0
, p1
- p0
));
1529 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
1530 ASET (spec
, FONT_FAMILY_INDEX
,
1531 intern_downcase (p1
+ 1, len
- (p1
+ 1 - p0
)));
1533 else if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
1534 ASET (spec
, FONT_FAMILY_INDEX
, intern_downcase (p0
, len
));
1536 if (! NILP (registry
)
1537 && NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
1538 ASET (spec
, FONT_REGISTRY_INDEX
,
1539 intern_downcase ((char *) SDATA (registry
), SBYTES (registry
)));
1544 /* This part (through the next ^L) is still experimental and never
1545 tested. We may drastically change codes. */
1549 #define LGSTRING_HEADER_SIZE 6
1550 #define LGSTRING_GLYPH_SIZE 8
1553 check_gstring (gstring
)
1554 Lisp_Object gstring
;
1559 CHECK_VECTOR (gstring
);
1560 val
= AREF (gstring
, 0);
1562 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1564 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1565 if (! NILP (LGSTRING_LBEARING (gstring
)))
1566 CHECK_NUMBER (LGSTRING_LBEARING (gstring
));
1567 if (! NILP (LGSTRING_RBEARING (gstring
)))
1568 CHECK_NUMBER (LGSTRING_RBEARING (gstring
));
1569 if (! NILP (LGSTRING_WIDTH (gstring
)))
1570 CHECK_NATNUM (LGSTRING_WIDTH (gstring
));
1571 if (! NILP (LGSTRING_ASCENT (gstring
)))
1572 CHECK_NUMBER (LGSTRING_ASCENT (gstring
));
1573 if (! NILP (LGSTRING_DESCENT (gstring
)))
1574 CHECK_NUMBER (LGSTRING_DESCENT(gstring
));
1576 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1578 val
= LGSTRING_GLYPH (gstring
, i
);
1580 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1582 if (NILP (LGLYPH_CHAR (val
)))
1584 CHECK_NATNUM (LGLYPH_FROM (val
));
1585 CHECK_NATNUM (LGLYPH_TO (val
));
1586 CHECK_CHARACTER (LGLYPH_CHAR (val
));
1587 if (! NILP (LGLYPH_CODE (val
)))
1588 CHECK_NATNUM (LGLYPH_CODE (val
));
1589 if (! NILP (LGLYPH_WIDTH (val
)))
1590 CHECK_NATNUM (LGLYPH_WIDTH (val
));
1591 if (! NILP (LGLYPH_ADJUSTMENT (val
)))
1593 val
= LGLYPH_ADJUSTMENT (val
);
1595 if (ASIZE (val
) < 3)
1597 for (j
= 0; j
< 3; j
++)
1598 CHECK_NUMBER (AREF (val
, j
));
1603 error ("Invalid glyph-string format");
1608 check_otf_features (otf_features
)
1609 Lisp_Object otf_features
;
1611 Lisp_Object val
, elt
;
1613 CHECK_CONS (otf_features
);
1614 CHECK_SYMBOL (XCAR (otf_features
));
1615 otf_features
= XCDR (otf_features
);
1616 CHECK_CONS (otf_features
);
1617 CHECK_SYMBOL (XCAR (otf_features
));
1618 otf_features
= XCDR (otf_features
);
1619 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1621 CHECK_SYMBOL (Fcar (val
));
1622 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1623 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1625 otf_features
= XCDR (otf_features
);
1626 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1628 CHECK_SYMBOL (Fcar (val
));
1629 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1630 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1637 Lisp_Object otf_list
;
1640 otf_tag_symbol (tag
)
1645 OTF_tag_name (tag
, name
);
1646 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1650 otf_open (entity
, file
)
1654 Lisp_Object val
= Fassoc (entity
, otf_list
);
1658 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1661 otf
= file
? OTF_open (file
) : NULL
;
1662 val
= make_save_value (otf
, 0);
1663 otf_list
= Fcons (Fcons (entity
, val
), otf_list
);
1669 /* Return a list describing which scripts/languages FONT supports by
1670 which GSUB/GPOS features of OpenType tables. See the comment of
1671 (sturct font_driver).otf_capability. */
1674 font_otf_capability (font
)
1678 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1681 otf
= otf_open (font
->entity
, font
->file_name
);
1684 for (i
= 0; i
< 2; i
++)
1686 OTF_GSUB_GPOS
*gsub_gpos
;
1687 Lisp_Object script_list
= Qnil
;
1690 if (OTF_get_features (otf
, i
== 0) < 0)
1692 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1693 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1695 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1696 Lisp_Object langsys_list
= Qnil
;
1697 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1700 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1702 OTF_LangSys
*langsys
;
1703 Lisp_Object feature_list
= Qnil
;
1704 Lisp_Object langsys_tag
;
1707 if (k
== script
->LangSysCount
)
1709 langsys
= &script
->DefaultLangSys
;
1714 langsys
= script
->LangSys
+ k
;
1716 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1718 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1720 OTF_Feature
*feature
1721 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1722 Lisp_Object feature_tag
1723 = otf_tag_symbol (feature
->FeatureTag
);
1725 feature_list
= Fcons (feature_tag
, feature_list
);
1727 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1730 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1735 XSETCAR (capability
, script_list
);
1737 XSETCDR (capability
, script_list
);
1743 /* Parse OTF features in SPEC and write a proper features spec string
1744 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1745 assured that the sufficient memory has already allocated for
1749 generate_otf_features (spec
, features
)
1759 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1765 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1770 else if (! asterisk
)
1772 val
= SYMBOL_NAME (val
);
1773 p
+= sprintf (p
, "%s", SDATA (val
));
1777 val
= SYMBOL_NAME (val
);
1778 p
+= sprintf (p
, "~%s", SDATA (val
));
1782 error ("OTF spec too long");
1787 font_otf_DeviceTable (device_table
)
1788 OTF_DeviceTable
*device_table
;
1790 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1792 return Fcons (make_number (len
),
1793 make_unibyte_string (device_table
->DeltaValue
, len
));
1797 font_otf_ValueRecord (value_format
, value_record
)
1799 OTF_ValueRecord
*value_record
;
1801 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1803 if (value_format
& OTF_XPlacement
)
1804 ASET (val
, 0, value_record
->XPlacement
);
1805 if (value_format
& OTF_YPlacement
)
1806 ASET (val
, 1, value_record
->YPlacement
);
1807 if (value_format
& OTF_XAdvance
)
1808 ASET (val
, 2, value_record
->XAdvance
);
1809 if (value_format
& OTF_YAdvance
)
1810 ASET (val
, 3, value_record
->YAdvance
);
1811 if (value_format
& OTF_XPlaDevice
)
1812 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1813 if (value_format
& OTF_YPlaDevice
)
1814 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1815 if (value_format
& OTF_XAdvDevice
)
1816 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
1817 if (value_format
& OTF_YAdvDevice
)
1818 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
1823 font_otf_Anchor (anchor
)
1828 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
1829 ASET (val
, 0, make_number (anchor
->XCoordinate
));
1830 ASET (val
, 1, make_number (anchor
->YCoordinate
));
1831 if (anchor
->AnchorFormat
== 2)
1832 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
1835 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
1836 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
1841 #endif /* HAVE_LIBOTF */
1843 /* G-string (glyph string) handler */
1845 /* G-string is a vector of the form [HEADER GLYPH ...].
1846 See the docstring of `font-make-gstring' for more detail. */
1849 font_prepare_composition (cmp
, f
)
1850 struct composition
*cmp
;
1854 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
1855 cmp
->hash_index
* 2);
1857 cmp
->font
= XSAVE_VALUE (LGSTRING_FONT (gstring
))->pointer
;
1858 cmp
->glyph_len
= LGSTRING_LENGTH (gstring
);
1859 cmp
->pixel_width
= LGSTRING_WIDTH (gstring
);
1860 cmp
->lbearing
= LGSTRING_LBEARING (gstring
);
1861 cmp
->rbearing
= LGSTRING_RBEARING (gstring
);
1862 cmp
->ascent
= LGSTRING_ASCENT (gstring
);
1863 cmp
->descent
= LGSTRING_DESCENT (gstring
);
1864 cmp
->width
= cmp
->pixel_width
/ FRAME_COLUMN_WIDTH (f
);
1865 if (cmp
->width
== 0)
1874 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
1875 static int font_compare
P_ ((const void *, const void *));
1876 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
1877 Lisp_Object
, Lisp_Object
));
1879 /* We sort fonts by scoring each of them against a specified
1880 font-spec. The score value is 32 bit (`unsigned'), and the smaller
1881 the value is, the closer the font is to the font-spec.
1883 Each 1-bit of the highest 4 bits of the score is used for atomic
1884 properties FOUNDRY, FAMILY, ADSTYLE, and REGISTRY.
1886 Each 7-bit in the lowest 28 bits are used for numeric properties
1887 WEIGHT, SLANT, WIDTH, and SIZE. */
1889 /* How many bits to shift to store the difference value of each font
1890 property in a score. */
1891 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
1893 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
1894 The return value indicates how different ENTITY is compared with
1898 font_score (entity
, spec_prop
)
1899 Lisp_Object entity
, *spec_prop
;
1903 /* Score four atomic fields. Maximum difference is 1. */
1904 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
1905 if (! NILP (spec_prop
[i
])
1906 && ! EQ (spec_prop
[i
], AREF (entity
, i
)))
1907 score
|= 1 << sort_shift_bits
[i
];
1909 /* Score four numeric fields. Maximum difference is 127. */
1910 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
1912 Lisp_Object entity_val
= AREF (entity
, i
);
1914 if (! NILP (spec_prop
[i
]) && ! EQ (spec_prop
[i
], entity_val
))
1916 if (! INTEGERP (entity_val
))
1917 score
|= 127 << sort_shift_bits
[i
];
1920 int diff
= XINT (entity_val
) - XINT (spec_prop
[i
]);
1924 if (i
== FONT_SIZE_INDEX
)
1926 if (XINT (entity_val
) > 0
1927 && diff
> FONT_PIXEL_SIZE_QUANTUM
)
1928 score
|= min (diff
, 127) << sort_shift_bits
[i
];
1931 score
|= min (diff
, 127) << sort_shift_bits
[i
];
1940 /* The comparison function for qsort. */
1943 font_compare (d1
, d2
)
1944 const void *d1
, *d2
;
1946 return (*(unsigned *) d1
< *(unsigned *) d2
1947 ? -1 : *(unsigned *) d1
> *(unsigned *) d2
);
1951 /* The structure for elements being sorted by qsort. */
1952 struct font_sort_data
1959 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
1960 If PREFER specifies a point-size, calculate the corresponding
1961 pixel-size from QCdpi property of PREFER or from the Y-resolution
1962 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
1963 get the font-entities in VEC. */
1966 font_sort_entites (vec
, prefer
, frame
, spec
)
1967 Lisp_Object vec
, prefer
, frame
, spec
;
1969 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
1971 struct font_sort_data
*data
;
1978 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
1979 prefer_prop
[i
] = AREF (prefer
, i
);
1983 /* As it is assured that all fonts in VEC match with SPEC, we
1984 should ignore properties specified in SPEC. So, set the
1985 corresponding properties in PREFER_PROP to nil. */
1986 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
1987 if (! NILP (AREF (spec
, i
)))
1988 prefer_prop
[i
++] = Qnil
;
1991 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
1992 prefer_prop
[FONT_SIZE_INDEX
]
1993 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
1995 /* Scoring and sorting. */
1996 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
1997 for (i
= 0; i
< len
; i
++)
1999 data
[i
].entity
= AREF (vec
, i
);
2000 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
);
2002 qsort (data
, len
, sizeof *data
, font_compare
);
2003 for (i
= 0; i
< len
; i
++)
2004 ASET (vec
, i
, data
[i
].entity
);
2011 /* API of Font Service Layer. */
2013 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2014 sort_shift_bits. Finternal_set_font_selection_order calls this
2015 function with font_sort_order after setting up it. */
2018 font_update_sort_order (order
)
2021 int i
, shift_bits
= 21;
2023 for (i
= 0; i
< 4; i
++, shift_bits
-= 7)
2025 int xlfd_idx
= order
[i
];
2027 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2028 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2029 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2030 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2031 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2032 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2034 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2039 /* Return weight property of FONT as symbol. */
2042 font_symbolic_weight (font
)
2045 Lisp_Object weight
= AREF (font
, FONT_WEIGHT_INDEX
);
2047 if (INTEGERP (weight
))
2048 weight
= prop_numeric_to_name (FONT_WEIGHT_INDEX
, XINT (weight
));
2053 /* Return slant property of FONT as symbol. */
2056 font_symbolic_slant (font
)
2059 Lisp_Object slant
= AREF (font
, FONT_SLANT_INDEX
);
2061 if (INTEGERP (slant
))
2062 slant
= prop_numeric_to_name (FONT_SLANT_INDEX
, XINT (slant
));
2067 /* Return width property of FONT as symbol. */
2070 font_symbolic_width (font
)
2073 Lisp_Object width
= AREF (font
, FONT_WIDTH_INDEX
);
2075 if (INTEGERP (width
))
2076 width
= prop_numeric_to_name (FONT_WIDTH_INDEX
, XINT (width
));
2081 /* Check if ENTITY matches with the font specification SPEC. */
2084 font_match_p (spec
, entity
)
2085 Lisp_Object spec
, entity
;
2089 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2090 if (! NILP (AREF (spec
, i
))
2091 && ! EQ (AREF (spec
, i
), AREF (entity
, i
)))
2093 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
))
2094 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0
2095 && (XINT (AREF (spec
, FONT_SIZE_INDEX
))
2096 != XINT (AREF (entity
, FONT_SIZE_INDEX
))))
2102 /* Return a lispy font object corresponding to FONT. */
2105 font_find_object (font
)
2108 Lisp_Object tail
, elt
;
2110 for (tail
= AREF (font
->entity
, FONT_OBJLIST_INDEX
); CONSP (tail
);
2114 if (font
== XSAVE_VALUE (elt
)->pointer
2115 && XSAVE_VALUE (elt
)->integer
> 0)
2122 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2125 /* Return a vector of font-entities matching with SPEC on frame F. */
2128 font_list_entities (frame
, spec
)
2129 Lisp_Object frame
, spec
;
2131 FRAME_PTR f
= XFRAME (frame
);
2132 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2133 Lisp_Object ftype
, family
, size
, alternate_familes
;
2134 Lisp_Object
*vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2140 family
= AREF (spec
, FONT_FAMILY_INDEX
);
2142 alternate_familes
= Qnil
;
2145 if (NILP (font_family_alist
)
2146 && !NILP (Vface_alternative_font_family_alist
))
2147 build_font_family_alist ();
2148 alternate_familes
= assq_no_quit (family
, font_family_alist
);
2149 if (! NILP (alternate_familes
))
2150 alternate_familes
= XCDR (alternate_familes
);
2152 size
= AREF (spec
, FONT_SIZE_INDEX
);
2154 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2156 xassert (ASIZE (spec
) == FONT_SPEC_MAX
);
2157 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2159 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2161 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2163 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
2164 Lisp_Object tail
= alternate_familes
;
2167 xassert (CONSP (cache
));
2168 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2169 ASET (spec
, FONT_FAMILY_INDEX
, family
);
2173 val
= assoc_no_quit (spec
, XCDR (cache
));
2178 val
= driver_list
->driver
->list (frame
, spec
);
2180 XSETCDR (cache
, Fcons (Fcons (Fcopy_sequence (spec
), val
),
2183 if (VECTORP (val
) && ASIZE (val
) > 0)
2190 ASET (spec
, FONT_FAMILY_INDEX
, XCAR (tail
));
2194 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2195 ASET (spec
, FONT_FAMILY_INDEX
, family
);
2196 ASET (spec
, FONT_SIZE_INDEX
, size
);
2197 return (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2201 /* Return a font entity matching with SPEC on FRAME. */
2204 font_matching_entity (frame
, spec
)
2205 Lisp_Object frame
, spec
;
2207 FRAME_PTR f
= XFRAME (frame
);
2208 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2209 Lisp_Object ftype
, size
, entity
;
2211 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2212 size
= AREF (spec
, FONT_SIZE_INDEX
);
2214 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2216 for (; driver_list
; driver_list
= driver_list
->next
)
2218 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2220 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
2223 xassert (CONSP (cache
));
2224 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2225 key
= Fcons (spec
, Qnil
);
2226 entity
= assoc_no_quit (key
, XCDR (cache
));
2228 entity
= XCDR (entity
);
2231 entity
= driver_list
->driver
->match (frame
, spec
);
2232 if (! NILP (entity
))
2234 XSETCAR (key
, Fcopy_sequence (spec
));
2235 XSETCDR (cache
, Fcons (Fcons (key
, entity
), XCDR (cache
)));
2238 if (! NILP (entity
))
2241 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2242 ASET (spec
, FONT_SIZE_INDEX
, size
);
2246 static int num_fonts
;
2249 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2250 opened font object. */
2253 font_open_entity (f
, entity
, pixel_size
)
2258 struct font_driver_list
*driver_list
;
2259 Lisp_Object objlist
, size
, val
;
2262 size
= AREF (entity
, FONT_SIZE_INDEX
);
2263 xassert (NATNUMP (size
));
2264 if (XINT (size
) != 0)
2265 pixel_size
= XINT (size
);
2267 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2268 objlist
= XCDR (objlist
))
2270 font
= XSAVE_VALUE (XCAR (objlist
))->pointer
;
2271 if (font
->pixel_size
== pixel_size
)
2273 XSAVE_VALUE (XCAR (objlist
))->integer
++;
2274 return XCAR (objlist
);
2278 xassert (FONT_ENTITY_P (entity
));
2279 val
= AREF (entity
, FONT_TYPE_INDEX
);
2280 for (driver_list
= f
->font_driver_list
;
2281 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2282 driver_list
= driver_list
->next
);
2286 font
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2289 font
->scalable
= XINT (size
) == 0;
2291 val
= make_save_value (font
, 1);
2292 ASET (entity
, FONT_OBJLIST_INDEX
,
2293 Fcons (val
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2299 /* Close FONT_OBJECT that is opened on frame F. */
2302 font_close_object (f
, font_object
)
2304 Lisp_Object font_object
;
2306 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2307 Lisp_Object objlist
;
2308 Lisp_Object tail
, prev
= Qnil
;
2310 XSAVE_VALUE (font_object
)->integer
--;
2311 xassert (XSAVE_VALUE (font_object
)->integer
>= 0);
2312 if (XSAVE_VALUE (font_object
)->integer
> 0)
2315 objlist
= AREF (font
->entity
, FONT_OBJLIST_INDEX
);
2316 for (prev
= Qnil
, tail
= objlist
; CONSP (tail
);
2317 prev
= tail
, tail
= XCDR (tail
))
2318 if (EQ (font_object
, XCAR (tail
)))
2320 if (font
->driver
->close
)
2321 font
->driver
->close (f
, font
);
2322 XSAVE_VALUE (font_object
)->pointer
= NULL
;
2324 ASET (font
->entity
, FONT_OBJLIST_INDEX
, XCDR (objlist
));
2326 XSETCDR (prev
, XCDR (objlist
));
2333 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2334 FONT is a font-entity and it must be opened to check. */
2337 font_has_char (f
, font
, c
)
2344 if (FONT_ENTITY_P (font
))
2346 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2347 struct font_driver_list
*driver_list
;
2349 for (driver_list
= f
->font_driver_list
;
2350 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2351 driver_list
= driver_list
->next
);
2354 if (! driver_list
->driver
->has_char
)
2356 return driver_list
->driver
->has_char (font
, c
);
2359 xassert (FONT_OBJECT_P (font
));
2360 fontp
= XSAVE_VALUE (font
)->pointer
;
2362 if (fontp
->driver
->has_char
)
2364 int result
= fontp
->driver
->has_char (fontp
->entity
, c
);
2369 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2373 /* Return the glyph ID of FONT_OBJECT for character C. */
2376 font_encode_char (font_object
, c
)
2377 Lisp_Object font_object
;
2380 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2382 return font
->driver
->encode_char (font
, c
);
2386 /* Return the name of FONT_OBJECT. */
2389 font_get_name (font_object
)
2390 Lisp_Object font_object
;
2392 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2393 char *name
= (font
->font
.full_name
? font
->font
.full_name
2394 : font
->font
.name
? font
->font
.name
2397 return (name
? make_unibyte_string (name
, strlen (name
)) : null_string
);
2401 /* Return the specification of FONT_OBJECT. */
2404 font_get_spec (font_object
)
2405 Lisp_Object font_object
;
2407 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2408 Lisp_Object spec
= Ffont_spec (0, NULL
);
2411 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2412 ASET (spec
, i
, AREF (font
->entity
, i
));
2413 ASET (spec
, FONT_SIZE_INDEX
, make_number (font
->pixel_size
));
2418 /* Return the frame on which FONT exists. FONT is a font object or a
2422 font_get_frame (font
)
2425 if (FONT_OBJECT_P (font
))
2426 font
= ((struct font
*) XSAVE_VALUE (font
)->pointer
)->entity
;
2427 xassert (FONT_ENTITY_P (font
));
2428 return AREF (font
, FONT_FRAME_INDEX
);
2432 /* Find a font entity best matching with LFACE. If SPEC is non-nil,
2433 the font must exactly match with it. C, if not negative, is a
2434 character that the entity must support. */
2437 font_find_for_lface (f
, lface
, spec
, c
)
2443 Lisp_Object frame
, entities
;
2446 XSETFRAME (frame
, f
);
2452 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2453 ASET (scratch_font_spec
, i
, Qnil
);
2454 ASET (scratch_font_spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2456 if (! NILP (lface
[LFACE_FAMILY_INDEX
]))
2457 font_merge_old_spec (Qnil
, lface
[LFACE_FAMILY_INDEX
], Qnil
,
2459 entities
= font_list_entities (frame
, scratch_font_spec
);
2460 while (ASIZE (entities
) == 0)
2462 /* Try without FOUNDRY or FAMILY. */
2463 if (! NILP (AREF (scratch_font_spec
, FONT_FOUNDRY_INDEX
)))
2465 ASET (scratch_font_spec
, FONT_FOUNDRY_INDEX
, Qnil
);
2466 entities
= font_list_entities (frame
, scratch_font_spec
);
2468 else if (! NILP (AREF (scratch_font_spec
, FONT_FAMILY_INDEX
)))
2470 ASET (scratch_font_spec
, FONT_FAMILY_INDEX
, Qnil
);
2471 entities
= font_list_entities (frame
, scratch_font_spec
);
2479 Lisp_Object registry
= AREF (spec
, FONT_REGISTRY_INDEX
);
2481 if (NILP (registry
))
2482 registry
= Qiso8859_1
;
2486 struct charset
*repertory
;
2488 if (font_registry_charsets (registry
, NULL
, &repertory
) < 0)
2492 if (ENCODE_CHAR (repertory
, c
)
2493 == CHARSET_INVALID_CODE (repertory
))
2495 /* Any font of this registry support C. So, let's
2496 suppress the further checking. */
2499 else if (c
> MAX_UNICODE_CHAR
)
2502 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2503 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2504 ASET (scratch_font_spec
, FONT_REGISTRY_INDEX
, registry
);
2505 entities
= font_list_entities (frame
, scratch_font_spec
);
2508 if (ASIZE (entities
) == 0)
2510 if (ASIZE (entities
) > 1)
2512 /* Sort fonts by properties specified in LFACE. */
2513 Lisp_Object prefer
= scratch_font_prefer
;
2516 if (! NILP (lface
[LFACE_FAMILY_INDEX
]))
2517 font_merge_old_spec (Qnil
, lface
[LFACE_FAMILY_INDEX
], Qnil
, prefer
);
2518 ASET (prefer
, FONT_WEIGHT_INDEX
,
2519 font_prop_validate_style (QCweight
, lface
[LFACE_WEIGHT_INDEX
]));
2520 ASET (prefer
, FONT_SLANT_INDEX
,
2521 font_prop_validate_style (QCslant
, lface
[LFACE_SLANT_INDEX
]));
2522 ASET (prefer
, FONT_WIDTH_INDEX
,
2523 font_prop_validate_style (QCwidth
, lface
[LFACE_SWIDTH_INDEX
]));
2524 pt
= XINT (lface
[LFACE_HEIGHT_INDEX
]);
2525 ASET (prefer
, FONT_SIZE_INDEX
, make_float (pt
/ 10));
2527 font_sort_entites (entities
, prefer
, frame
, spec
);
2531 return AREF (entities
, 0);
2532 for (i
= 0; i
< ASIZE (entities
); i
++)
2534 int result
= font_has_char (f
, AREF (entities
, i
), c
);
2535 Lisp_Object font_object
;
2538 return AREF (entities
, i
);
2541 font_object
= font_open_for_lface (f
, AREF (entities
, i
), lface
, spec
);
2542 if (NILP (font_object
))
2544 result
= font_has_char (f
, font_object
, c
);
2545 font_close_object (f
, font_object
);
2547 return AREF (entities
, i
);
2554 font_open_for_lface (f
, entity
, lface
, spec
)
2562 if (FONT_SPEC_P (spec
) && INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2563 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2566 double pt
= XINT (lface
[LFACE_HEIGHT_INDEX
]);
2569 size
= POINT_TO_PIXEL (pt
, f
->resy
);
2571 return font_open_entity (f
, entity
, size
);
2575 /* Load a font best matching with FACE's font-related properties into
2576 FACE on frame F. If no proper font is found, record that FACE has
2580 font_load_for_face (f
, face
)
2584 Lisp_Object font_object
= face
->lface
[LFACE_FONT_INDEX
];
2586 if (NILP (font_object
))
2588 Lisp_Object entity
= font_find_for_lface (f
, face
->lface
, Qnil
, -1);
2590 if (! NILP (entity
))
2591 font_object
= font_open_for_lface (f
, entity
, face
->lface
, Qnil
);
2594 if (! NILP (font_object
))
2596 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2598 face
->font
= font
->font
.font
;
2599 face
->font_info
= (struct font_info
*) font
;
2600 face
->font_info_id
= 0;
2601 face
->font_name
= font
->font
.full_name
;
2606 face
->font_info
= NULL
;
2607 face
->font_info_id
= -1;
2608 face
->font_name
= NULL
;
2609 add_to_log ("Unable to load font for a face%s", null_string
, Qnil
);
2614 /* Make FACE on frame F ready to use the font opened for FACE. */
2617 font_prepare_for_face (f
, face
)
2621 struct font
*font
= (struct font
*) face
->font_info
;
2623 if (font
->driver
->prepare_face
)
2624 font
->driver
->prepare_face (f
, face
);
2628 /* Make FACE on frame F stop using the font opened for FACE. */
2631 font_done_for_face (f
, face
)
2635 struct font
*font
= (struct font
*) face
->font_info
;
2637 if (font
->driver
->done_face
)
2638 font
->driver
->done_face (f
, face
);
2643 /* Open a font best matching with NAME on frame F. If no proper font
2644 is found, return Qnil. */
2647 font_open_by_name (f
, name
)
2651 Lisp_Object args
[2];
2652 Lisp_Object spec
, prefer
, size
, entity
, entity_list
;
2657 XSETFRAME (frame
, f
);
2660 args
[1] = make_unibyte_string (name
, strlen (name
));
2661 spec
= Ffont_spec (2, args
);
2662 prefer
= scratch_font_prefer
;
2663 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2664 if (NILP (AREF (spec
, i
)))
2665 ASET (prefer
, i
, make_number (100));
2666 size
= AREF (spec
, FONT_SIZE_INDEX
);
2669 else if (INTEGERP (size
))
2670 pixel_size
= XINT (size
);
2671 else /* FLOATP (size) */
2673 double pt
= XFLOAT_DATA (size
);
2675 pixel_size
= POINT_TO_PIXEL (pt
, f
->resy
);
2676 size
= make_number (pixel_size
);
2677 ASET (spec
, FONT_SIZE_INDEX
, size
);
2679 if (pixel_size
== 0)
2681 pixel_size
= POINT_TO_PIXEL (12.0, f
->resy
);
2682 size
= make_number (pixel_size
);
2684 ASET (prefer
, FONT_SIZE_INDEX
, size
);
2685 if (NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
2686 ASET (spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2688 entity_list
= Flist_fonts (spec
, frame
, make_number (1), prefer
);
2689 if (NILP (entity_list
))
2690 entity
= font_matching_entity (frame
, spec
);
2692 entity
= XCAR (entity_list
);
2693 return (NILP (entity
)
2695 : font_open_entity (f
, entity
, pixel_size
));
2699 /* Register font-driver DRIVER. This function is used in two ways.
2701 The first is with frame F non-NULL. In this case, make DRIVER
2702 available (but not yet activated) on F. All frame creaters
2703 (e.g. Fx_create_frame) must call this function at least once with
2704 an available font-driver.
2706 The second is with frame F NULL. In this case, DRIVER is globally
2707 registered in the variable `font_driver_list'. All font-driver
2708 implementations must call this function in its syms_of_XXXX
2709 (e.g. syms_of_xfont). */
2712 register_font_driver (driver
, f
)
2713 struct font_driver
*driver
;
2716 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
2717 struct font_driver_list
*prev
, *list
;
2719 if (f
&& ! driver
->draw
)
2720 error ("Unsable font driver for a frame: %s",
2721 SDATA (SYMBOL_NAME (driver
->type
)));
2723 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
2724 if (EQ (list
->driver
->type
, driver
->type
))
2725 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
2727 list
= malloc (sizeof (struct font_driver_list
));
2729 list
->driver
= driver
;
2734 f
->font_driver_list
= list
;
2736 font_driver_list
= list
;
2741 /* Free font-driver list on frame F. It doesn't free font-drivers
2745 free_font_driver_list (f
)
2748 while (f
->font_driver_list
)
2750 struct font_driver_list
*next
= f
->font_driver_list
->next
;
2752 free (f
->font_driver_list
);
2753 f
->font_driver_list
= next
;
2758 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
2759 symbols, e.g. xft, x). If NEW_DRIVERS is nil, make F use all
2760 available font drivers. If no backend is available, dont't alter
2761 F->font_driver_list.
2763 A caller must free all realized faces and clear all font caches if
2764 any in advance. The return value is a list of font backends
2765 actually made used on F. */
2768 font_update_drivers (f
, new_drivers
)
2770 Lisp_Object new_drivers
;
2772 Lisp_Object active_drivers
= Qnil
;
2773 struct font_driver_list
*list
;
2775 /* At first, finialize all font drivers for F. */
2776 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
2779 if (list
->driver
->end_for_frame
)
2780 list
->driver
->end_for_frame (f
);
2784 /* Then start the requested drivers. */
2785 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
2786 if (NILP (new_drivers
)
2787 || ! NILP (Fmemq (list
->driver
->type
, new_drivers
)))
2789 if (! list
->driver
->start_for_frame
2790 || list
->driver
->start_for_frame (f
) == 0);
2793 active_drivers
= nconc2 (active_drivers
,
2794 Fcons (list
->driver
->type
, Qnil
));
2798 return active_drivers
;
2802 font_put_frame_data (f
, driver
, data
)
2804 struct font_driver
*driver
;
2807 struct font_data_list
*list
, *prev
;
2809 for (prev
= NULL
, list
= f
->font_data_list
; list
;
2810 prev
= list
, list
= list
->next
)
2811 if (list
->driver
== driver
)
2818 prev
->next
= list
->next
;
2820 f
->font_data_list
= list
->next
;
2828 list
= malloc (sizeof (struct font_data_list
));
2831 list
->driver
= driver
;
2832 list
->next
= f
->font_data_list
;
2833 f
->font_data_list
= list
;
2841 font_get_frame_data (f
, driver
)
2843 struct font_driver
*driver
;
2845 struct font_data_list
*list
;
2847 for (list
= f
->font_data_list
; list
; list
= list
->next
)
2848 if (list
->driver
== driver
)
2856 /* Return the font used to draw character C by FACE at buffer position
2857 POS in window W. If OBJECT is non-nil, it is a string containing C
2861 font_at (c
, pos
, face
, w
, object
)
2872 f
= XFRAME (w
->frame
);
2873 if (! FRAME_WINDOW_P (f
))
2877 if (STRINGP (object
))
2878 face_id
= face_at_string_position (w
, object
, pos
, 0, -1, -1, &dummy
,
2879 DEFAULT_FACE_ID
, 0);
2881 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
,
2883 face
= FACE_FROM_ID (f
, face_id
);
2885 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, object
);
2886 face
= FACE_FROM_ID (f
, face_id
);
2887 if (! face
->font_info
)
2889 return font_find_object ((struct font
*) face
->font_info
);
2895 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 1, 0,
2896 doc
: /* Return t if OBJECT is a font-spec or font-entity.
2897 Return nil otherwise. */)
2901 return (FONTP (object
) ? Qt
: Qnil
);
2904 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
2905 doc
: /* Return a newly created font-spec with arguments as properties.
2907 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
2908 valid font property name listed below:
2910 `:family', `:weight', `:slant', `:width'
2912 They are the same as face attributes of the same name. See
2913 `set-face-attribute.
2917 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
2921 VALUE must be a string or a symbol specifying the additional
2922 typographic style information of a font, e.g. ``sans''. Usually null.
2926 VALUE must be a string or a symbol specifying the charset registry and
2927 encoding of a font, e.g. ``iso8859-1''.
2931 VALUE must be a non-negative integer or a floating point number
2932 specifying the font size. It specifies the font size in 1/10 pixels
2933 (if VALUE is an integer), or in points (if VALUE is a float).
2934 usage: (font-spec ARGS ...) */)
2939 Lisp_Object spec
= Fmake_vector (make_number (FONT_SPEC_MAX
), Qnil
);
2942 for (i
= 0; i
< nargs
; i
+= 2)
2944 enum font_property_index prop
;
2945 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
2947 prop
= get_font_prop_index (key
, 0);
2948 if (prop
< FONT_EXTRA_INDEX
)
2949 ASET (spec
, prop
, val
);
2952 if (EQ (key
, QCname
))
2955 font_parse_name ((char *) SDATA (val
), spec
);
2957 font_put_extra (spec
, key
, val
);
2960 CHECK_VALIDATE_FONT_SPEC (spec
);
2965 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
2966 doc
: /* Return the value of FONT's property KEY.
2967 FONT is a font-spec, a font-entity, or a font-object. */)
2969 Lisp_Object font
, key
;
2971 enum font_property_index idx
;
2973 if (FONT_OBJECT_P (font
))
2975 struct font
*fontp
= XSAVE_VALUE (font
)->pointer
;
2977 if (EQ (key
, QCotf
))
2979 if (fontp
->driver
->otf_capability
)
2980 return fontp
->driver
->otf_capability (fontp
);
2984 font
= fontp
->entity
;
2988 idx
= get_font_prop_index (key
, 0);
2989 if (idx
< FONT_EXTRA_INDEX
)
2990 return AREF (font
, idx
);
2991 if (FONT_ENTITY_P (font
))
2993 return Fcdr (Fassoc (AREF (font
, FONT_EXTRA_INDEX
), key
));
2997 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
2998 doc
: /* Set one property of FONT-SPEC: give property KEY value VALUE. */)
2999 (font_spec
, prop
, val
)
3000 Lisp_Object font_spec
, prop
, val
;
3002 enum font_property_index idx
;
3003 Lisp_Object extra
, slot
;
3005 CHECK_FONT_SPEC (font_spec
);
3006 idx
= get_font_prop_index (prop
, 0);
3007 if (idx
< FONT_EXTRA_INDEX
)
3008 return ASET (font_spec
, idx
, val
);
3009 extra
= AREF (font_spec
, FONT_EXTRA_INDEX
);
3010 slot
= Fassoc (extra
, prop
);
3012 extra
= Fcons (Fcons (prop
, val
), extra
);
3014 Fsetcdr (slot
, val
);
3018 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3019 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3020 Optional 2nd argument FRAME specifies the target frame.
3021 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3022 Optional 4th argument PREFER, if non-nil, is a font-spec to
3023 control the order of the returned list. Fonts are sorted by
3024 how they are close to PREFER. */)
3025 (font_spec
, frame
, num
, prefer
)
3026 Lisp_Object font_spec
, frame
, num
, prefer
;
3028 Lisp_Object vec
, list
, tail
;
3032 frame
= selected_frame
;
3033 CHECK_LIVE_FRAME (frame
);
3034 CHECK_VALIDATE_FONT_SPEC (font_spec
);
3042 if (! NILP (prefer
))
3043 CHECK_FONT (prefer
);
3045 vec
= font_list_entities (frame
, font_spec
);
3050 return Fcons (AREF (vec
, 0), Qnil
);
3052 if (! NILP (prefer
))
3053 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
);
3055 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3056 if (n
== 0 || n
> len
)
3058 for (i
= 1; i
< n
; i
++)
3060 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3062 XSETCDR (tail
, val
);
3068 DEFUN ("list-families", Flist_families
, Slist_families
, 0, 1, 0,
3069 doc
: /* List available font families on the current frame.
3070 Optional 2nd argument FRAME specifies the target frame. */)
3075 struct font_driver_list
*driver_list
;
3079 frame
= selected_frame
;
3080 CHECK_LIVE_FRAME (frame
);
3083 for (driver_list
= f
->font_driver_list
; driver_list
;
3084 driver_list
= driver_list
->next
)
3085 if (driver_list
->driver
->list_family
)
3087 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3093 Lisp_Object tail
= list
;
3095 for (; CONSP (val
); val
= XCDR (val
))
3096 if (NILP (Fmemq (XCAR (val
), tail
)))
3097 list
= Fcons (XCAR (val
), list
);
3103 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3104 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3105 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3107 Lisp_Object font_spec
, frame
;
3109 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3116 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 1, 0,
3117 doc
: /* Return XLFD name of FONT.
3118 FONT is a font-spec, font-entity, or font-object.
3119 If the name is too long for XLFD (maximum 255 chars), return nil. */)
3126 if (FONT_SPEC_P (font
))
3127 CHECK_VALIDATE_FONT_SPEC (font
);
3128 else if (FONT_ENTITY_P (font
))
3134 CHECK_FONT_GET_OBJECT (font
, fontp
);
3135 font
= fontp
->entity
;
3136 pixel_size
= fontp
->pixel_size
;
3139 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3141 return build_string (name
);
3144 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3145 doc
: /* Clear font cache. */)
3148 Lisp_Object list
, frame
;
3150 FOR_EACH_FRAME (list
, frame
)
3152 FRAME_PTR f
= XFRAME (frame
);
3153 struct font_driver_list
*driver_list
= f
->font_driver_list
;
3155 for (; driver_list
; driver_list
= driver_list
->next
)
3156 if (driver_list
->on
)
3158 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
3159 Lisp_Object tail
, elt
;
3161 for (tail
= XCDR (cache
); CONSP (tail
); tail
= XCDR (tail
))
3164 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
3166 Lisp_Object vec
= XCDR (elt
);
3169 for (i
= 0; i
< ASIZE (vec
); i
++)
3171 Lisp_Object entity
= AREF (vec
, i
);
3173 if (EQ (driver_list
->driver
->type
,
3174 AREF (entity
, FONT_TYPE_INDEX
)))
3177 = AREF (entity
, FONT_OBJLIST_INDEX
);
3179 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
3181 Lisp_Object val
= XCAR (objlist
);
3182 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
3183 struct font
*font
= p
->pointer
;
3185 xassert (font
&& (driver_list
->driver
3187 driver_list
->driver
->close (f
, font
);
3191 if (driver_list
->driver
->free_entity
)
3192 driver_list
->driver
->free_entity (entity
);
3197 XSETCDR (cache
, Qnil
);
3204 DEFUN ("internal-set-font-style-table", Finternal_set_font_style_table
,
3205 Sinternal_set_font_style_table
, 2, 2, 0,
3206 doc
: /* Set font style table for PROP to TABLE.
3207 PROP must be `:weight', `:slant', or `:width'.
3208 TABLE must be an alist of symbols vs the corresponding numeric values
3209 sorted by numeric values. */)
3211 Lisp_Object prop
, table
;
3215 Lisp_Object tail
, val
;
3217 CHECK_SYMBOL (prop
);
3218 table_index
= (EQ (prop
, QCweight
) ? 0
3219 : EQ (prop
, QCslant
) ? 1
3220 : EQ (prop
, QCwidth
) ? 2
3222 if (table_index
>= ASIZE (font_style_table
))
3223 error ("Invalid font style property: %s", SDATA (SYMBOL_NAME (prop
)));
3224 table
= Fcopy_sequence (table
);
3226 for (tail
= table
; ! NILP (tail
); tail
= Fcdr (tail
))
3228 prop
= Fcar (Fcar (tail
));
3229 val
= Fcdr (Fcar (tail
));
3230 CHECK_SYMBOL (prop
);
3232 if (numeric
> XINT (val
))
3233 error ("Numeric values not sorted for %s", SDATA (SYMBOL_NAME (prop
)));
3234 numeric
= XINT (val
);
3235 XSETCAR (tail
, Fcons (prop
, val
));
3237 ASET (font_style_table
, table_index
, table
);
3241 /* The following three functions are still expremental. */
3243 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
3244 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
3245 FONT-OBJECT may be nil if it is not yet known.
3247 G-string is sequence of glyphs of a specific font,
3248 and is a vector of this form:
3249 [ HEADER GLYPH ... ]
3250 HEADER is a vector of this form:
3251 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
3253 FONT-OBJECT is a font-object for all glyphs in the g-string,
3254 WIDTH thry DESCENT are the metrics (in pixels) of the whole G-string.
3255 GLYPH is a vector of this form:
3256 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
3257 [ [X-OFF Y-OFF WADJUST] | nil] ]
3259 FROM-IDX and TO-IDX are used internally and should not be touched.
3260 C is the character of the glyph.
3261 CODE is the glyph-code of C in FONT-OBJECT.
3262 WIDTH thry DESCENT are the metrics (in pixels) of the glyph.
3263 X-OFF and Y-OFF are offests to the base position for the glyph.
3264 WADJUST is the adjustment to the normal width of the glyph. */)
3266 Lisp_Object font_object
, num
;
3268 Lisp_Object gstring
, g
;
3272 if (! NILP (font_object
))
3273 CHECK_FONT_OBJECT (font_object
);
3276 len
= XINT (num
) + 1;
3277 gstring
= Fmake_vector (make_number (len
), Qnil
);
3278 g
= Fmake_vector (make_number (6), Qnil
);
3279 ASET (g
, 0, font_object
);
3280 ASET (gstring
, 0, g
);
3281 for (i
= 1; i
< len
; i
++)
3282 ASET (gstring
, i
, Fmake_vector (make_number (10), Qnil
));
3286 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
3287 doc
: /* Fillin glyph-string GSTRING by characters for FONT-OBJECT.
3288 START and END specifies the region to extract characters.
3289 If optional 3rd argument OBJECT is non-nil, it is a buffer or a string from
3290 where to extract characters.
3291 FONT-OBJECT may be nil if GSTRING already already contains one. */)
3292 (gstring
, font_object
, start
, end
, object
)
3293 Lisp_Object gstring
, font_object
, start
, end
, object
;
3299 CHECK_VECTOR (gstring
);
3300 if (NILP (font_object
))
3301 font_object
= LGSTRING_FONT (gstring
);
3302 CHECK_FONT_GET_OBJECT (font_object
, font
);
3304 if (STRINGP (object
))
3306 const unsigned char *p
;
3308 CHECK_NATNUM (start
);
3310 if (XINT (start
) > XINT (end
)
3311 || XINT (end
) > ASIZE (object
)
3312 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3313 args_out_of_range_3 (object
, start
, end
);
3315 len
= XINT (end
) - XINT (start
);
3316 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
3317 for (i
= 0; i
< len
; i
++)
3319 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3321 c
= STRING_CHAR_ADVANCE (p
);
3322 code
= font
->driver
->encode_char (font
, c
);
3323 if (code
> MOST_POSITIVE_FIXNUM
)
3324 error ("Glyph code 0x%X is too large", code
);
3325 LGLYPH_SET_FROM (g
, i
);
3326 LGLYPH_SET_TO (g
, i
);
3327 LGLYPH_SET_CHAR (g
, c
);
3328 LGLYPH_SET_CODE (g
, code
);
3335 if (! NILP (object
))
3336 Fset_buffer (object
);
3337 validate_region (&start
, &end
);
3338 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3339 args_out_of_range (start
, end
);
3340 len
= XINT (end
) - XINT (start
);
3342 pos_byte
= CHAR_TO_BYTE (pos
);
3343 for (i
= 0; i
< len
; i
++)
3345 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3347 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
3348 code
= font
->driver
->encode_char (font
, c
);
3349 if (code
> MOST_POSITIVE_FIXNUM
)
3350 error ("Glyph code 0x%X is too large", code
);
3351 LGLYPH_SET_FROM (g
, i
);
3352 LGLYPH_SET_TO (g
, i
);
3353 LGLYPH_SET_CHAR (g
, c
);
3354 LGLYPH_SET_CODE (g
, code
);
3357 for (i
= LGSTRING_LENGTH (gstring
) - 1; i
>= len
; i
--)
3358 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
3362 DEFUN ("font-shape-text", Ffont_shape_text
, Sfont_shape_text
, 3, 4, 0,
3363 doc
: /* Shape text between FROM and TO by FONT-OBJECT.
3364 If optional 4th argument STRING is non-nil, it is a string to shape,
3365 and FROM and TO are indices to the string.
3366 The value is the end position of the shaped text. */)
3367 (from
, to
, font_object
, string
)
3368 Lisp_Object from
, to
, font_object
, string
;
3371 struct font_metrics metrics
;
3372 EMACS_INT start
, end
;
3373 Lisp_Object gstring
, n
;
3378 validate_region (&from
, &to
);
3379 start
= XFASTINT (from
);
3380 end
= XFASTINT (to
);
3381 modify_region (current_buffer
, start
, end
, 0);
3385 CHECK_STRING (string
);
3386 start
= XINT (from
);
3388 if (start
< 0 || start
> end
|| end
> SCHARS (string
))
3389 args_out_of_range_3 (string
, from
, to
);
3392 CHECK_FONT_GET_OBJECT (font_object
, font
);
3393 if (! font
->driver
->shape
)
3396 gstring
= Ffont_make_gstring (font_object
, make_number (end
- start
));
3397 Ffont_fill_gstring (gstring
, font_object
, from
, to
, string
);
3398 n
= font
->driver
->shape (gstring
);
3401 for (i
= 0; i
< XINT (n
);)
3404 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3405 EMACS_INT this_from
= LGLYPH_FROM (g
);
3406 EMACS_INT this_to
= LGLYPH_TO (g
) + 1;
3409 metrics
.lbearing
= LGLYPH_LBEARING (g
);
3410 metrics
.rbearing
= LGLYPH_RBEARING (g
);
3411 metrics
.ascent
= LGLYPH_ASCENT (g
);
3412 metrics
.descent
= LGLYPH_DESCENT (g
);
3413 if (NILP (LGLYPH_ADJUSTMENT (g
)))
3414 metrics
.width
= LGLYPH_WIDTH (g
);
3417 metrics
.width
= LGLYPH_WADJUST (g
);
3418 metrics
.lbearing
+= LGLYPH_XOFF (g
);
3419 metrics
.rbearing
+= LGLYPH_XOFF (g
);
3420 metrics
.ascent
-= LGLYPH_YOFF (g
);
3421 metrics
.descent
+= LGLYPH_YOFF (g
);
3423 for (j
= i
+ 1; j
< XINT (n
); j
++)
3427 g
= LGSTRING_GLYPH (gstring
, j
);
3428 if (this_from
!= LGLYPH_FROM (g
))
3430 x
= metrics
.width
+ LGLYPH_LBEARING (g
) + LGLYPH_XOFF (g
);
3431 if (metrics
.lbearing
> x
)
3432 metrics
.lbearing
= x
;
3433 x
= metrics
.width
+ LGLYPH_RBEARING (g
) + LGLYPH_XOFF (g
);
3434 if (metrics
.rbearing
< x
)
3435 metrics
.rbearing
= x
;
3436 x
= LGLYPH_ASCENT (g
) - LGLYPH_YOFF (g
);
3437 if (metrics
.ascent
< x
)
3439 x
= LGLYPH_DESCENT (g
) - LGLYPH_YOFF (g
);
3440 if (metrics
.descent
< x
)
3441 metrics
.descent
= x
;
3442 if (NILP (LGLYPH_ADJUSTMENT (g
)))
3443 metrics
.width
+= LGLYPH_WIDTH (g
);
3445 metrics
.width
+= LGLYPH_WADJUST (g
);
3448 gstr
= Ffont_make_gstring (font_object
, make_number (j
- i
));
3449 LGSTRING_SET_WIDTH (gstr
, metrics
.width
);
3450 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
3451 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
);
3452 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
3453 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
3454 for (k
= i
; i
< j
; i
++)
3455 LGSTRING_SET_GLYPH (gstr
, i
- k
, LGSTRING_GLYPH (gstring
, i
));
3457 Fcompose_region_internal (make_number (start
+ this_from
),
3458 make_number (start
+ this_to
),
3461 Fcompose_string_internal (string
,
3462 make_number (start
+ this_from
),
3463 make_number (start
+ this_to
),
3467 return make_number (start
+ XINT (n
));
3470 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
3471 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
3472 OTF-SPEC specifies which featuress to apply in this format:
3473 (SCRIPT LANGSYS GSUB GPOS)
3475 SCRIPT is a symbol specifying a script tag of OpenType,
3476 LANGSYS is a symbol specifying a langsys tag of OpenType,
3477 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
3479 If LANGYS is nil, the default langsys is selected.
3481 The features are applied in the order appeared in the list. The
3482 symbol `*' means to apply all available features not appeared in this
3483 list, and the remaining features are ignored. For instance, (vatu
3484 pstf * haln) is to apply vatu and pstf in this order, then to apply
3485 all available features other than vatu, pstf, and haln.
3487 The features are applied to the glyphs in the range FROM and TO of
3488 the glyph-string GSTRING-IN.
3490 If some of a feature is actually applicable, the resulting glyphs are
3491 produced in the glyph-string GSTRING-OUT from the index INDEX. In
3492 this case, the value is the number of produced glyphs.
3494 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
3497 If GSTRING-OUT is too short to hold produced glyphs, no glyphs is
3498 produced in GSTRING-OUT, and the value is nil.
3500 See the documentation of `font-make-gstring' for the format of
3502 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
3503 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
3505 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
3510 check_otf_features (otf_features
);
3511 CHECK_FONT_GET_OBJECT (font_object
, font
);
3512 if (! font
->driver
->otf_drive
)
3513 error ("Font backend %s can't drive OpenType GSUB table",
3514 SDATA (SYMBOL_NAME (font
->driver
->type
)));
3515 CHECK_CONS (otf_features
);
3516 CHECK_SYMBOL (XCAR (otf_features
));
3517 val
= XCDR (otf_features
);
3518 CHECK_SYMBOL (XCAR (val
));
3519 val
= XCDR (otf_features
);
3522 len
= check_gstring (gstring_in
);
3523 CHECK_VECTOR (gstring_out
);
3524 CHECK_NATNUM (from
);
3526 CHECK_NATNUM (index
);
3528 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
3529 args_out_of_range_3 (from
, to
, make_number (len
));
3530 if (XINT (index
) >= ASIZE (gstring_out
))
3531 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
3532 num
= font
->driver
->otf_drive (font
, otf_features
,
3533 gstring_in
, XINT (from
), XINT (to
),
3534 gstring_out
, XINT (index
), 0);
3537 return make_number (num
);
3540 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
3542 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
3543 FEATURE-SPEC specifies which features of the font FONT-OBJECT to apply
3545 (SCRIPT LANGSYS FEATURE ...)
3546 See the documentation of `font-otf-gsub' for more detail.
3548 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
3549 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
3550 character code corresponding to the glyph or nil if there's no
3551 corresponding character. */)
3552 (font_object
, character
, otf_features
)
3553 Lisp_Object font_object
, character
, otf_features
;
3556 Lisp_Object gstring_in
, gstring_out
, g
;
3557 Lisp_Object alternates
;
3560 CHECK_FONT_GET_OBJECT (font_object
, font
);
3561 if (! font
->driver
->otf_drive
)
3562 error ("Font backend %s can't drive OpenType GSUB table",
3563 SDATA (SYMBOL_NAME (font
->driver
->type
)));
3564 CHECK_CHARACTER (character
);
3565 CHECK_CONS (otf_features
);
3567 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
3568 g
= LGSTRING_GLYPH (gstring_in
, 0);
3569 LGLYPH_SET_CHAR (g
, character
);
3570 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
3571 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
3572 gstring_out
, 0, 1)) < 0)
3573 gstring_out
= Ffont_make_gstring (font_object
,
3574 make_number (ASIZE (gstring_out
) * 2));
3576 for (i
= 0; i
< num
; i
++)
3578 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
3579 int c
= XINT (LGLYPH_CHAR (g
));
3580 unsigned code
= XUINT (LGLYPH_CODE (g
));
3582 alternates
= Fcons (Fcons (make_number (code
),
3583 c
> 0 ? make_number (c
) : Qnil
),
3586 return Fnreverse (alternates
);
3592 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
3593 doc
: /* Open FONT-ENTITY. */)
3594 (font_entity
, size
, frame
)
3595 Lisp_Object font_entity
;
3601 CHECK_FONT_ENTITY (font_entity
);
3603 size
= AREF (font_entity
, FONT_SIZE_INDEX
);
3604 CHECK_NUMBER (size
);
3606 frame
= selected_frame
;
3607 CHECK_LIVE_FRAME (frame
);
3609 isize
= XINT (size
);
3613 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
3615 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
3618 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
3619 doc
: /* Close FONT-OBJECT. */)
3620 (font_object
, frame
)
3621 Lisp_Object font_object
, frame
;
3623 CHECK_FONT_OBJECT (font_object
);
3625 frame
= selected_frame
;
3626 CHECK_LIVE_FRAME (frame
);
3627 font_close_object (XFRAME (frame
), font_object
);
3631 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
3632 doc
: /* Return information about FONT-OBJECT.
3633 The value is a vector:
3634 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
3637 NAME is a string of the font name (or nil if the font backend doesn't
3640 FILENAME is a string of the font file (or nil if the font backend
3641 doesn't provide a file name).
3643 PIXEL-SIZE is a pixel size by which the font is opened.
3645 SIZE is a maximum advance width of the font in pixel.
3647 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
3650 CAPABILITY is a list whose first element is a symbol representing the
3651 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
3652 remaining elements describes a detail of the font capability.
3654 If the font is OpenType font, the form of the list is
3655 \(opentype GSUB GPOS)
3656 where GSUB shows which "GSUB" features the font supports, and GPOS
3657 shows which "GPOS" features the font supports. Both GSUB and GPOS are
3658 lists of the format:
3659 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3661 If the font is not OpenType font, currently the length of the form is
3664 SCRIPT is a symbol representing OpenType script tag.
3666 LANGSYS is a symbol representing OpenType langsys tag, or nil
3667 representing the default langsys.
3669 FEATURE is a symbol representing OpenType feature tag.
3671 If the font is not OpenType font, OTF-CAPABILITY is nil. */)
3673 Lisp_Object font_object
;
3678 CHECK_FONT_GET_OBJECT (font_object
, font
);
3680 val
= Fmake_vector (make_number (9), Qnil
);
3681 if (font
->font
.full_name
)
3682 ASET (val
, 0, make_unibyte_string (font
->font
.full_name
,
3683 strlen (font
->font
.full_name
)));
3684 if (font
->file_name
)
3685 ASET (val
, 1, make_unibyte_string (font
->file_name
,
3686 strlen (font
->file_name
)));
3687 ASET (val
, 2, make_number (font
->pixel_size
));
3688 ASET (val
, 3, make_number (font
->font
.size
));
3689 ASET (val
, 4, make_number (font
->ascent
));
3690 ASET (val
, 5, make_number (font
->descent
));
3691 ASET (val
, 6, make_number (font
->font
.space_width
));
3692 ASET (val
, 7, make_number (font
->font
.average_width
));
3693 if (font
->driver
->otf_capability
)
3694 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
3696 ASET (val
, 8, Fcons (font
->format
, Qnil
));
3700 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
3701 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
3702 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
3703 (font_object
, string
)
3704 Lisp_Object font_object
, string
;
3710 CHECK_FONT_GET_OBJECT (font_object
, font
);
3711 CHECK_STRING (string
);
3712 len
= SCHARS (string
);
3713 vec
= Fmake_vector (make_number (len
), Qnil
);
3714 for (i
= 0; i
< len
; i
++)
3716 Lisp_Object ch
= Faref (string
, make_number (i
));
3720 struct font_metrics metrics
;
3722 code
= font
->driver
->encode_char (font
, c
);
3723 if (code
== FONT_INVALID_CODE
)
3725 val
= Fmake_vector (make_number (6), Qnil
);
3726 if (code
<= MOST_POSITIVE_FIXNUM
)
3727 ASET (val
, 0, make_number (code
));
3729 ASET (val
, 0, Fcons (make_number (code
>> 16),
3730 make_number (code
& 0xFFFF)));
3731 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
3732 ASET (val
, 1, make_number (metrics
.lbearing
));
3733 ASET (val
, 2, make_number (metrics
.rbearing
));
3734 ASET (val
, 3, make_number (metrics
.width
));
3735 ASET (val
, 4, make_number (metrics
.ascent
));
3736 ASET (val
, 5, make_number (metrics
.descent
));
3742 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
3743 doc
: /* Return t iff font-spec SPEC matches with FONT.
3744 FONT is a font-spec, font-entity, or font-object. */)
3746 Lisp_Object spec
, font
;
3748 CHECK_FONT_SPEC (spec
);
3749 if (FONT_OBJECT_P (font
))
3750 font
= ((struct font
*) XSAVE_VALUE (font
)->pointer
)->entity
;
3751 else if (! FONT_ENTITY_P (font
))
3752 CHECK_FONT_SPEC (font
);
3754 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
3757 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
3758 doc
: /* Return a font-object for displaying a character at POSISTION.
3759 Optional second arg WINDOW, if non-nil, is a window displaying
3760 the current buffer. It defaults to the currently selected window. */)
3761 (position
, window
, string
)
3762 Lisp_Object position
, window
, string
;
3765 EMACS_INT pos
, pos_byte
;
3770 CHECK_NUMBER_COERCE_MARKER (position
);
3771 pos
= XINT (position
);
3772 if (pos
< BEGV
|| pos
>= ZV
)
3773 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
3774 pos_byte
= CHAR_TO_BYTE (pos
);
3775 c
= FETCH_CHAR (pos_byte
);
3782 CHECK_NUMBER (position
);
3783 CHECK_STRING (string
);
3784 pos
= XINT (position
);
3785 if (pos
< 0 || pos
>= SCHARS (string
))
3786 args_out_of_range (string
, position
);
3787 pos_byte
= string_char_to_byte (string
, pos
);
3788 str
= SDATA (string
) + pos_byte
;
3789 len
= SBYTES (string
) - pos_byte
;
3790 c
= STRING_CHAR (str
, eln
);
3793 window
= selected_window
;
3794 CHECK_LIVE_WINDOW (window
);
3795 w
= XWINDOW (selected_window
);
3797 return font_at (c
, pos
, NULL
, w
, Qnil
);
3801 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
3802 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
3803 The value is a number of glyphs drawn.
3804 Type C-l to recover what previously shown. */)
3805 (font_object
, string
)
3806 Lisp_Object font_object
, string
;
3808 Lisp_Object frame
= selected_frame
;
3809 FRAME_PTR f
= XFRAME (frame
);
3815 CHECK_FONT_GET_OBJECT (font_object
, font
);
3816 CHECK_STRING (string
);
3817 len
= SCHARS (string
);
3818 code
= alloca (sizeof (unsigned) * len
);
3819 for (i
= 0; i
< len
; i
++)
3821 Lisp_Object ch
= Faref (string
, make_number (i
));
3825 code
[i
] = font
->driver
->encode_char (font
, c
);
3826 if (code
[i
] == FONT_INVALID_CODE
)
3829 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3831 if (font
->driver
->prepare_face
)
3832 font
->driver
->prepare_face (f
, face
);
3833 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
3834 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
3835 if (font
->driver
->done_face
)
3836 font
->driver
->done_face (f
, face
);
3838 return make_number (len
);
3842 #endif /* FONT_DEBUG */
3845 extern void syms_of_ftfont
P_ (());
3846 extern void syms_of_xfont
P_ (());
3847 extern void syms_of_xftfont
P_ (());
3848 extern void syms_of_ftxfont
P_ (());
3849 extern void syms_of_bdffont
P_ (());
3850 extern void syms_of_w32font
P_ (());
3851 extern void syms_of_atmfont
P_ (());
3856 sort_shift_bits
[FONT_SLANT_INDEX
] = 0;
3857 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 7;
3858 sort_shift_bits
[FONT_SIZE_INDEX
] = 14;
3859 sort_shift_bits
[FONT_WIDTH_INDEX
] = 21;
3860 sort_shift_bits
[FONT_ADSTYLE_INDEX
] = 28;
3861 sort_shift_bits
[FONT_FOUNDRY_INDEX
] = 29;
3862 sort_shift_bits
[FONT_FAMILY_INDEX
] = 30;
3863 sort_shift_bits
[FONT_REGISTRY_INDEX
] = 31;
3864 /* Note that sort_shift_bits[FONT_TYPE_INDEX] is never used. */
3866 staticpro (&font_style_table
);
3867 font_style_table
= Fmake_vector (make_number (3), Qnil
);
3869 staticpro (&font_family_alist
);
3870 font_family_alist
= Qnil
;
3872 staticpro (&font_charset_alist
);
3873 font_charset_alist
= Qnil
;
3875 DEFSYM (Qopentype
, "opentype");
3877 DEFSYM (Qiso8859_1
, "iso8859-1");
3878 DEFSYM (Qiso10646_1
, "iso10646-1");
3879 DEFSYM (Qunicode_bmp
, "unicode-bmp");
3880 DEFSYM (Qunicode_sip
, "unicode-sip");
3882 DEFSYM (QCotf
, ":otf");
3883 DEFSYM (QClanguage
, ":language");
3884 DEFSYM (QCscript
, ":script");
3885 DEFSYM (QCantialias
, ":antialias");
3887 DEFSYM (QCfoundry
, ":foundry");
3888 DEFSYM (QCadstyle
, ":adstyle");
3889 DEFSYM (QCregistry
, ":registry");
3890 DEFSYM (QCspacing
, ":spacing");
3891 DEFSYM (QCdpi
, ":dpi");
3892 DEFSYM (QCscalable
, ":scalable");
3893 DEFSYM (QCextra
, ":extra");
3900 staticpro (&null_string
);
3901 null_string
= build_string ("");
3902 staticpro (&null_vector
);
3903 null_vector
= Fmake_vector (make_number (0), Qnil
);
3905 staticpro (&scratch_font_spec
);
3906 scratch_font_spec
= Ffont_spec (0, NULL
);
3907 staticpro (&scratch_font_prefer
);
3908 scratch_font_prefer
= Ffont_spec (0, NULL
);
3911 staticpro (&otf_list
);
3916 defsubr (&Sfont_spec
);
3917 defsubr (&Sfont_get
);
3918 defsubr (&Sfont_put
);
3919 defsubr (&Slist_fonts
);
3920 defsubr (&Slist_families
);
3921 defsubr (&Sfind_font
);
3922 defsubr (&Sfont_xlfd_name
);
3923 defsubr (&Sclear_font_cache
);
3924 defsubr (&Sinternal_set_font_style_table
);
3925 defsubr (&Sfont_make_gstring
);
3926 defsubr (&Sfont_fill_gstring
);
3927 defsubr (&Sfont_shape_text
);
3928 defsubr (&Sfont_drive_otf
);
3929 defsubr (&Sfont_otf_alternates
);
3932 defsubr (&Sopen_font
);
3933 defsubr (&Sclose_font
);
3934 defsubr (&Squery_font
);
3935 defsubr (&Sget_font_glyphs
);
3936 defsubr (&Sfont_match_p
);
3937 defsubr (&Sfont_at
);
3939 defsubr (&Sdraw_string
);
3941 #endif /* FONT_DEBUG */
3943 #ifdef USE_FONT_BACKEND
3944 if (enable_font_backend
)
3946 #ifdef HAVE_FREETYPE
3948 #ifdef HAVE_X_WINDOWS
3953 #endif /* HAVE_XFT */
3954 #endif /* HAVE_X_WINDOWS */
3955 #else /* not HAVE_FREETYPE */
3956 #ifdef HAVE_X_WINDOWS
3958 #endif /* HAVE_X_WINDOWS */
3959 #endif /* not HAVE_FREETYPE */
3962 #endif /* HAVE_BDFFONT */
3965 #endif /* WINDOWSNT */
3970 #endif /* USE_FONT_BACKEND */
3973 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
3974 (do not change this comment) */