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. */
33 #include "dispextern.h"
35 #include "character.h"
36 #include "composite.h"
46 #define xassert(X) do {if (!(X)) abort ();} while (0)
48 #define xassert(X) (void) 0
51 int enable_font_backend
;
55 Lisp_Object Qopentype
;
57 /* Important character set symbols. */
58 Lisp_Object Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
60 /* Like CHECK_FONT_SPEC but also validate properties of the font-spec,
61 and set X to the validated result. */
63 #define CHECK_VALIDATE_FONT_SPEC(x) \
65 if (! FONT_SPEC_P (x)) x = wrong_type_argument (Qfont, x); \
66 x = font_prop_validate (x); \
69 /* Number of pt per inch (from the TeXbook). */
70 #define PT_PER_INCH 72.27
72 /* Return a pixel size (integer) corresponding to POINT size (double)
74 #define POINT_TO_PIXEL(POINT, DPI) ((POINT) * (DPI) / PT_PER_INCH + 0.5)
76 /* Return a point size (double) corresponding to POINT size (integer)
78 #define PIXEL_TO_POINT(PIXEL, DPI) ((PIXEL) * PT_PER_INCH * 10 / (DPI) + 0.5)
80 /* Special string of zero length. It is used to specify a NULL name
81 in a font properties (e.g. adstyle). We don't use the symbol of
82 NULL name because it's confusing (Lisp printer prints nothing for
84 Lisp_Object null_string
;
86 /* Special vector of zero length. This is repeatedly used by (struct
87 font_driver *)->list when a specified font is not found. */
88 Lisp_Object null_vector
;
90 /* Vector of 3 elements. Each element is an alist for one of font
91 style properties (weight, slant, width). The alist contains a
92 mapping between symbolic property values (e.g. `medium' for weight)
93 and numeric property values (e.g. 100). So, it looks like this:
94 [((thin . 0) ... (heavy . 210))
95 ((ro . 0) ... (ot . 210))
96 ((ultracondensed . 50) ... (wide . 200))] */
97 static Lisp_Object font_style_table
;
99 /* Alist of font family vs the corresponding aliases.
100 Each element has this form:
101 (FAMILY ALIAS1 ALIAS2 ...) */
103 static Lisp_Object font_family_alist
;
105 /* Symbols representing keys of normal font properties. */
106 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
, QCsize
, QCname
;
107 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
, QCextra
;
108 /* Symbols representing keys of font extra info. */
109 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClanguage
, QCscript
;
110 /* Symbols representing values of font spacing property. */
111 Lisp_Object Qc
, Qm
, Qp
, Qd
;
113 /* List of all font drivers. All font-backends (XXXfont.c) call
114 add_font_driver in syms_of_XXXfont to register the font-driver
116 static struct font_driver_list
*font_driver_list
;
118 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
119 static Lisp_Object prop_name_to_numeric
P_ ((enum font_property_index
,
121 static Lisp_Object prop_numeric_to_name
P_ ((enum font_property_index
, int));
122 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
123 static void build_font_family_alist
P_ ((void));
125 /* Number of registered font drivers. */
126 static int num_font_drivers
;
128 /* Return a pixel size of font-spec SPEC on frame F. */
131 font_pixel_size (f
, spec
)
135 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
138 Lisp_Object extra
, val
;
144 point_size
= XFLOAT_DATA (size
);
145 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
146 val
= assq_no_quit (QCdpi
, extra
);
149 if (INTEGERP (XCDR (val
)))
150 dpi
= XINT (XCDR (val
));
152 dpi
= XFLOAT_DATA (XCDR (val
)) + 0.5;
156 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
160 /* Return a numeric value corresponding to PROP's NAME (symbol). If
161 NAME is not registered in font_style_table, return Qnil. PROP must
162 be one of FONT_{WEIGHT|SLANT|SWIDTH}_INDEX. */
165 prop_name_to_numeric (prop
, name
)
166 enum font_property_index prop
;
169 int table_index
= prop
- FONT_WEIGHT_INDEX
;
172 val
= assq_no_quit (name
, AREF (font_style_table
, table_index
));
173 return (NILP (val
) ? Qnil
: XCDR (val
));
177 /* Return a name (symbol) corresponding to PROP's NUMERIC value. If
178 no name is registered for NUMERIC in font_style_table, return a
179 symbol of integer name (e.g. `123'). PROP must be one of
180 FONT_{WEIGHT|SLANT|SWIDTH}_INDEX. */
183 prop_numeric_to_name (prop
, numeric
)
184 enum font_property_index prop
;
187 int table_index
= prop
- FONT_WEIGHT_INDEX
;
188 Lisp_Object table
= AREF (font_style_table
, table_index
);
191 while (! NILP (table
))
193 if (XINT (XCDR (XCAR (table
))) >= numeric
)
195 if (XINT (XCDR (XCAR (table
))) == numeric
)
196 return XCAR (XCAR (table
));
200 table
= XCDR (table
);
202 sprintf (buf
, "%d", numeric
);
207 /* Return a symbol whose name is STR (length LEN). If STR contains
208 uppercase letters, downcase them in advance. */
211 intern_downcase (str
, len
)
218 for (i
= 0; i
< len
; i
++)
219 if (isupper (str
[i
]))
222 return Fintern (make_unibyte_string (str
, len
), Qnil
);
225 return Fintern (null_string
, Qnil
);
226 bcopy (str
, buf
, len
);
228 if (isascii (buf
[i
]))
229 buf
[i
] = tolower (buf
[i
]);
230 return Fintern (make_unibyte_string (buf
, len
), Qnil
);
233 extern Lisp_Object Vface_alternative_font_family_alist
;
236 build_font_family_alist ()
238 Lisp_Object alist
= Vface_alternative_font_family_alist
;
240 for (; CONSP (alist
); alist
= XCDR (alist
))
242 Lisp_Object tail
, elt
;
244 for (tail
= XCAR (alist
), elt
= Qnil
; CONSP (tail
); tail
= XCDR (tail
))
245 elt
= nconc2 (elt
, Fcons (Fintern (XCAR (tail
), Qnil
), Qnil
));
246 font_family_alist
= Fcons (elt
, font_family_alist
);
251 /* Font property validater. */
253 static Lisp_Object font_prop_validate_symbol
P_ ((enum font_property_index
,
254 Lisp_Object
, Lisp_Object
));
255 static Lisp_Object font_prop_validate_style
P_ ((enum font_property_index
,
256 Lisp_Object
, Lisp_Object
));
257 static Lisp_Object font_prop_validate_non_neg
P_ ((enum font_property_index
,
258 Lisp_Object
, Lisp_Object
));
259 static Lisp_Object font_prop_validate_spacing
P_ ((enum font_property_index
,
260 Lisp_Object
, Lisp_Object
));
261 static int get_font_prop_index
P_ ((Lisp_Object
, int));
262 static Lisp_Object font_prop_validate
P_ ((Lisp_Object
));
265 font_prop_validate_symbol (prop_index
, prop
, val
)
266 enum font_property_index prop_index
;
267 Lisp_Object prop
, val
;
269 if (EQ (prop
, QCotf
))
270 return (SYMBOLP (val
) ? val
: Qerror
);
272 val
= (SCHARS (val
) == 0 ? null_string
273 : intern_downcase ((char *) SDATA (val
), SBYTES (val
)));
274 else if (SYMBOLP (val
))
276 if (SCHARS (SYMBOL_NAME (val
)) == 0)
285 font_prop_validate_style (prop_index
, prop
, val
)
286 enum font_property_index prop_index
;
287 Lisp_Object prop
, val
;
289 if (! INTEGERP (val
))
292 val
= intern_downcase ((char *) SDATA (val
), SBYTES (val
));
297 val
= prop_name_to_numeric (prop_index
, val
);
306 font_prop_validate_non_neg (prop_index
, prop
, val
)
307 enum font_property_index prop_index
;
308 Lisp_Object prop
, val
;
310 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
315 font_prop_validate_spacing (prop_index
, prop
, val
)
316 enum font_property_index prop_index
;
317 Lisp_Object prop
, val
;
319 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
322 return make_number (FONT_SPACING_CHARCELL
);
324 return make_number (FONT_SPACING_MONO
);
326 return make_number (FONT_SPACING_PROPORTIONAL
);
330 /* Structure of known font property keys and validater of the
334 /* Pointer to the key symbol. */
336 /* Function to validate the value VAL, or NULL if any value is ok. */
337 Lisp_Object (*validater
) P_ ((enum font_property_index prop_index
,
338 Lisp_Object prop
, Lisp_Object val
));
339 } font_property_table
[] =
340 { { &QCtype
, font_prop_validate_symbol
},
341 { &QCfoundry
, font_prop_validate_symbol
},
342 { &QCfamily
, font_prop_validate_symbol
},
343 { &QCadstyle
, font_prop_validate_symbol
},
344 { &QCregistry
, font_prop_validate_symbol
},
345 { &QCweight
, font_prop_validate_style
},
346 { &QCslant
, font_prop_validate_style
},
347 { &QCwidth
, font_prop_validate_style
},
348 { &QCsize
, font_prop_validate_non_neg
},
349 { &QClanguage
, font_prop_validate_symbol
},
350 { &QCscript
, font_prop_validate_symbol
},
351 { &QCdpi
, font_prop_validate_non_neg
},
352 { &QCspacing
, font_prop_validate_spacing
},
353 { &QCscalable
, NULL
},
354 { &QCotf
, font_prop_validate_symbol
}
357 #define FONT_PROPERTY_TABLE_SIZE \
358 ((sizeof font_property_table) / (sizeof *font_property_table))
361 get_font_prop_index (key
, from
)
365 for (; from
< FONT_PROPERTY_TABLE_SIZE
; from
++)
366 if (EQ (key
, *font_property_table
[from
].key
))
372 font_prop_validate (spec
)
376 Lisp_Object prop
, val
, extra
;
378 for (i
= FONT_TYPE_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
380 if (! NILP (AREF (spec
, i
)))
382 prop
= *font_property_table
[i
].key
;
383 val
= (font_property_table
[i
].validater
) (i
, prop
, AREF (spec
, i
));
384 if (EQ (val
, Qerror
))
385 Fsignal (Qfont
, list2 (build_string ("invalid font property"),
386 Fcons (prop
, AREF (spec
, i
))));
390 for (extra
= AREF (spec
, FONT_EXTRA_INDEX
);
391 CONSP (extra
); extra
= XCDR (extra
))
393 Lisp_Object elt
= XCAR (extra
);
396 i
= get_font_prop_index (prop
, FONT_EXTRA_INDEX
);
398 && font_property_table
[i
].validater
)
400 val
= (font_property_table
[i
].validater
) (i
, prop
, XCDR (elt
));
401 if (EQ (val
, Qerror
))
402 Fsignal (Qfont
, list2 (build_string ("invalid font property"),
411 font_put_extra (font
, prop
, val
)
412 Lisp_Object font
, prop
, val
;
414 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
415 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
419 extra
= Fcons (Fcons (prop
, val
), extra
);
420 ASET (font
, FONT_EXTRA_INDEX
, extra
);
428 /* Font name parser and unparser */
430 static Lisp_Object intern_font_field
P_ ((char *, int));
431 static int parse_matrix
P_ ((char *));
432 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
433 static int font_parse_name
P_ ((char *, Lisp_Object
));
435 /* An enumerator for each field of an XLFD font name. */
436 enum xlfd_field_index
455 /* An enumerator for mask bit corresponding to each XLFD field. */
458 XLFD_FOUNDRY_MASK
= 0x0001,
459 XLFD_FAMILY_MASK
= 0x0002,
460 XLFD_WEIGHT_MASK
= 0x0004,
461 XLFD_SLANT_MASK
= 0x0008,
462 XLFD_SWIDTH_MASK
= 0x0010,
463 XLFD_ADSTYLE_MASK
= 0x0020,
464 XLFD_PIXEL_MASK
= 0x0040,
465 XLFD_POINT_MASK
= 0x0080,
466 XLFD_RESX_MASK
= 0x0100,
467 XLFD_RESY_MASK
= 0x0200,
468 XLFD_SPACING_MASK
= 0x0400,
469 XLFD_AVGWIDTH_MASK
= 0x0800,
470 XLFD_REGISTRY_MASK
= 0x1000,
471 XLFD_ENCODING_MASK
= 0x2000
475 /* Return a Lispy value of a XLFD font field at STR and LEN bytes.
476 If LEN is zero, it returns `null_string'.
477 If STR is "*", it returns nil.
478 If all characters in STR are digits, it returns an integer.
479 Otherwise, it returns a symbol interned from downcased STR. */
482 intern_font_field (str
, len
)
490 if (*str
== '*' && len
== 1)
494 for (i
= 1; i
< len
; i
++)
495 if (! isdigit (str
[i
]))
498 return make_number (atoi (str
));
500 return intern_downcase (str
, len
);
503 /* Parse P pointing the pixel/point size field of the form
504 `[A B C D]' which specifies a transformation matrix:
510 by which all glyphs of the font are transformed. The spec says
511 that scalar value N for the pixel/point size is equivalent to:
512 A = N * resx/resy, B = C = 0, D = N.
514 Return the scalar value N if the form is valid. Otherwise return
525 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
528 matrix
[i
] = - strtod (p
+ 1, &end
);
530 matrix
[i
] = strtod (p
, &end
);
533 return (i
== 4 ? (int) matrix
[3] : -1);
536 /* Expand a wildcard field in FIELD (the first N fields are filled) to
537 multiple fields to fill in all 14 XLFD fields while restring a
538 field position by its contents. */
541 font_expand_wildcards (field
, n
)
542 Lisp_Object field
[XLFD_LAST_INDEX
];
546 Lisp_Object tmp
[XLFD_LAST_INDEX
];
547 /* Array of information about where this element can go. Nth
548 element is for Nth element of FIELD. */
550 /* Minimum possible field. */
552 /* Maxinum possible field. */
554 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
556 } range
[XLFD_LAST_INDEX
];
558 int range_from
, range_to
;
561 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
562 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
563 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
564 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
565 | XLFD_AVGWIDTH_MASK)
566 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
568 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
569 field. The value is shifted to left one bit by one in the
571 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
572 range_mask
= (range_mask
<< 1) | 1;
574 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
575 position-based retriction for FIELD[I]. */
576 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
577 i
++, range_from
++, range_to
++, range_mask
<<= 1)
579 Lisp_Object val
= field
[i
];
585 range
[i
].from
= range_from
;
586 range
[i
].to
= range_to
;
587 range
[i
].mask
= range_mask
;
591 /* The triplet FROM, TO, and MASK is a value-based
592 retriction for FIELD[I]. */
598 int numeric
= XINT (val
);
601 from
= to
= XLFD_ENCODING_INDEX
,
602 mask
= XLFD_ENCODING_MASK
;
603 else if (numeric
== 0)
604 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
605 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
606 else if (numeric
<= 48)
607 from
= to
= XLFD_PIXEL_INDEX
,
608 mask
= XLFD_PIXEL_MASK
;
610 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
611 mask
= XLFD_LARGENUM_MASK
;
613 else if (EQ (val
, null_string
))
614 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
615 mask
= XLFD_NULL_MASK
;
617 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
620 Lisp_Object name
= SYMBOL_NAME (val
);
622 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
623 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
624 mask
= XLFD_REGENC_MASK
;
626 from
= to
= XLFD_ENCODING_INDEX
,
627 mask
= XLFD_ENCODING_MASK
;
629 else if (range_from
<= XLFD_WEIGHT_INDEX
630 && range_to
>= XLFD_WEIGHT_INDEX
631 && !NILP (prop_name_to_numeric (FONT_WEIGHT_INDEX
, val
)))
632 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
633 else if (range_from
<= XLFD_SLANT_INDEX
634 && range_to
>= XLFD_SLANT_INDEX
635 && !NILP (prop_name_to_numeric (FONT_SLANT_INDEX
, val
)))
636 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
637 else if (range_from
<= XLFD_SWIDTH_INDEX
638 && range_to
>= XLFD_SWIDTH_INDEX
639 && !NILP (prop_name_to_numeric (FONT_WIDTH_INDEX
, val
)))
640 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
643 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
644 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
646 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
647 mask
= XLFD_SYMBOL_MASK
;
650 /* Merge position-based and value-based restrictions. */
652 while (from
< range_from
)
653 mask
&= ~(1 << from
++);
654 while (from
< 14 && ! (mask
& (1 << from
)))
656 while (to
> range_to
)
657 mask
&= ~(1 << to
--);
658 while (to
>= 0 && ! (mask
& (1 << to
)))
662 range
[i
].from
= from
;
664 range
[i
].mask
= mask
;
666 if (from
> range_from
|| to
< range_to
)
668 /* The range is narrowed by value-based restrictions.
669 Reflect it to the other fields. */
671 /* Following fields should be after FROM. */
673 /* Preceding fields should be before TO. */
674 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
676 /* Check FROM for non-wildcard field. */
677 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
679 while (range
[j
].from
< from
)
680 range
[j
].mask
&= ~(1 << range
[j
].from
++);
681 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
683 range
[j
].from
= from
;
686 from
= range
[j
].from
;
687 if (range
[j
].to
> to
)
689 while (range
[j
].to
> to
)
690 range
[j
].mask
&= ~(1 << range
[j
].to
--);
691 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
704 /* Decide all fileds from restrictions in RANGE. */
705 for (i
= j
= 0; i
< n
; i
++)
707 if (j
< range
[i
].from
)
709 if (i
== 0 || ! NILP (tmp
[i
- 1]))
710 /* None of TMP[X] corresponds to Jth field. */
712 for (; j
< range
[i
].from
; j
++)
717 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
719 for (; j
< XLFD_LAST_INDEX
; j
++)
721 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
722 field
[XLFD_ENCODING_INDEX
]
723 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
727 /* Parse NAME (null terminated) as XLFD and store information in FONT
728 (font-spec or font-entity). Size property of FONT is set as
730 specified XLFD fields FONT property
731 --------------------- -------------
732 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
733 POINT_SIZE and RESY calculated pixel size (Lisp integer)
734 POINT_SIZE POINT_SIZE/10 (Lisp float)
736 If NAME is successfully parsed, return 0. Otherwise return -1.
738 FONT is usually a font-spec, but when this function is called from
739 X font backend driver, it is a font-entity. In that case, NAME is
740 a fully specified XLFD, and we set FONT_EXTRA_INDEX of FONT to a
741 symbol RESX-RESY-SPACING-AVGWIDTH.
745 font_parse_xlfd (name
, font
)
749 int len
= strlen (name
);
751 Lisp_Object dpi
, spacing
;
753 char *f
[XLFD_LAST_INDEX
+ 1];
758 /* Maximum XLFD name length is 255. */
760 /* Accept "*-.." as a fully specified XLFD. */
761 if (name
[0] == '*' && name
[1] == '-')
762 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
765 for (p
= name
+ i
; *p
; p
++)
766 if (*p
== '-' && i
< XLFD_LAST_INDEX
)
770 dpi
= spacing
= Qnil
;
773 if (i
== XLFD_LAST_INDEX
)
777 /* Fully specified XLFD. */
778 for (i
= 0, j
= FONT_FOUNDRY_INDEX
; i
< XLFD_WEIGHT_INDEX
; i
++, j
++)
780 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
784 for (j
= FONT_WEIGHT_INDEX
; i
< XLFD_ADSTYLE_INDEX
; i
++, j
++)
786 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
789 Lisp_Object numeric
= prop_name_to_numeric (j
, val
);
791 if (INTEGERP (numeric
))
796 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
798 ASET (font
, FONT_ADSTYLE_INDEX
, val
);
799 i
= XLFD_REGISTRY_INDEX
;
800 val
= intern_font_field (f
[i
], f
[i
+ 2] - f
[i
]);
802 ASET (font
, FONT_REGISTRY_INDEX
, val
);
804 p
= f
[XLFD_PIXEL_INDEX
];
805 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
806 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
809 i
= XLFD_PIXEL_INDEX
;
810 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
812 ASET (font
, FONT_SIZE_INDEX
, val
);
815 double point_size
= -1;
817 xassert (FONT_SPEC_P (font
));
818 p
= f
[XLFD_POINT_INDEX
];
820 point_size
= parse_matrix (p
);
821 else if (isdigit (*p
))
822 point_size
= atoi (p
), point_size
/= 10;
824 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
827 i
= XLFD_PIXEL_INDEX
;
828 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
830 ASET (font
, FONT_SIZE_INDEX
, val
);
835 /* Parse RESX, RESY, SPACING, and AVGWIDTH. */
836 if (FONT_ENTITY_P (font
))
839 ASET (font
, FONT_EXTRA_INDEX
,
840 intern_font_field (f
[i
], f
[XLFD_REGISTRY_INDEX
] - 1 - f
[i
]));
844 /* Here we just setup DPI, SPACING, and AVGWIDTH. They are set
845 in FONT_EXTRA_INDEX later. */
847 dpi
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
848 i
= XLFD_SPACING_INDEX
;
849 spacing
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
850 p
= f
[XLFD_AVGWIDTH_INDEX
];
858 int wild_card_found
= 0;
859 Lisp_Object prop
[XLFD_LAST_INDEX
];
861 for (j
= 0; j
< i
; j
++)
865 if (f
[j
][1] && f
[j
][1] != '-')
870 else if (isdigit (*f
[j
]))
872 for (p
= f
[j
] + 1; isdigit (*p
); p
++);
874 prop
[j
] = intern_downcase (f
[j
], p
- f
[j
]);
876 prop
[j
] = make_number (atoi (f
[j
]));
879 prop
[j
] = intern_font_field (f
[j
], f
[j
+ 1] - 1 - f
[j
]);
881 prop
[j
] = intern_font_field (f
[j
], f
[i
] - f
[j
]);
883 if (! wild_card_found
)
885 if (font_expand_wildcards (prop
, i
) < 0)
888 for (i
= 0, j
= FONT_FOUNDRY_INDEX
; i
< XLFD_WEIGHT_INDEX
; i
++, j
++)
889 if (! NILP (prop
[i
]))
890 ASET (font
, j
, prop
[i
]);
891 for (j
= FONT_WEIGHT_INDEX
; i
< XLFD_ADSTYLE_INDEX
; i
++, j
++)
892 if (! NILP (prop
[i
]))
893 ASET (font
, j
, prop
[i
]);
894 if (! NILP (prop
[XLFD_ADSTYLE_INDEX
]))
895 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
896 val
= prop
[XLFD_REGISTRY_INDEX
];
899 val
= prop
[XLFD_ENCODING_INDEX
];
901 val
= Fintern (concat2 (build_string ("*-"), SYMBOL_NAME (val
)),
904 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
905 val
= Fintern (concat2 (SYMBOL_NAME (val
), build_string ("-*")),
908 val
= Fintern (concat3 (SYMBOL_NAME (val
), build_string ("-"),
909 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
])),
912 ASET (font
, FONT_REGISTRY_INDEX
, val
);
914 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
915 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
916 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
918 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
920 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
923 dpi
= prop
[XLFD_RESX_INDEX
];
924 spacing
= prop
[XLFD_SPACING_INDEX
];
925 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
926 avgwidth
= XINT (prop
[XLFD_AVGWIDTH_INDEX
]);
930 font_put_extra (font
, QCdpi
, dpi
);
931 if (! NILP (spacing
))
932 font_put_extra (font
, QCspacing
, spacing
);
934 font_put_extra (font
, QCscalable
, avgwidth
== 0 ? Qt
: Qnil
);
939 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
940 length), and return the name length. If FONT_SIZE_INDEX of FONT is
941 0, use PIXEL_SIZE instead. */
944 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
950 char *f
[XLFD_REGISTRY_INDEX
+ 1];
954 xassert (FONTP (font
));
956 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
959 if (i
== FONT_ADSTYLE_INDEX
)
960 j
= XLFD_ADSTYLE_INDEX
;
961 else if (i
== FONT_REGISTRY_INDEX
)
962 j
= XLFD_REGISTRY_INDEX
;
963 val
= AREF (font
, i
);
966 if (j
== XLFD_REGISTRY_INDEX
)
967 f
[j
] = "*-*", len
+= 4;
969 f
[j
] = "*", len
+= 2;
974 val
= SYMBOL_NAME (val
);
975 if (j
== XLFD_REGISTRY_INDEX
976 && ! strchr ((char *) SDATA (val
), '-'))
978 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
979 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
981 f
[j
] = alloca (SBYTES (val
) + 3);
982 sprintf (f
[j
], "%s-*", SDATA (val
));
983 len
+= SBYTES (val
) + 3;
987 f
[j
] = alloca (SBYTES (val
) + 4);
988 sprintf (f
[j
], "%s*-*", SDATA (val
));
989 len
+= SBYTES (val
) + 4;
993 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
997 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1000 val
= AREF (font
, i
);
1002 f
[j
] = "*", len
+= 2;
1006 val
= prop_numeric_to_name (i
, XINT (val
));
1008 val
= SYMBOL_NAME (val
);
1009 xassert (STRINGP (val
));
1010 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1014 val
= AREF (font
, FONT_SIZE_INDEX
);
1015 xassert (NUMBERP (val
) || NILP (val
));
1018 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1021 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1023 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", pixel_size
) + 1;
1025 else if (FLOATP (val
))
1027 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1028 i
= XFLOAT_DATA (val
) * 10;
1029 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1032 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1034 val
= AREF (font
, FONT_EXTRA_INDEX
);
1036 if (FONT_ENTITY_P (font
)
1037 && EQ (AREF (font
, FONT_TYPE_INDEX
), Qx
))
1039 /* Setup names for RESX-RESY-SPACING-AVWIDTH. */
1040 if (SYMBOLP (val
) && ! NILP (val
))
1042 val
= SYMBOL_NAME (val
);
1043 f
[XLFD_RESX_INDEX
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1046 f
[XLFD_RESX_INDEX
] = "*-*-*-*", len
+= 6;
1050 Lisp_Object dpi
= assq_no_quit (QCdpi
, val
);
1051 Lisp_Object spacing
= assq_no_quit (QCspacing
, val
);
1052 Lisp_Object scalable
= assq_no_quit (QCscalable
, val
);
1054 if (CONSP (dpi
) || CONSP (spacing
) || CONSP (scalable
))
1056 char *str
= alloca (24);
1059 if (CONSP (dpi
) && INTEGERP (XCDR (dpi
)))
1060 this_len
= sprintf (str
, "%d-%d",
1061 XINT (XCDR (dpi
)), XINT (XCDR (dpi
)));
1063 this_len
= sprintf (str
, "*-*");
1064 if (CONSP (spacing
) && ! NILP (XCDR (spacing
)))
1066 val
= XCDR (spacing
);
1069 if (XINT (val
) < FONT_SPACING_MONO
)
1071 else if (XINT (val
) < FONT_SPACING_CHARCELL
)
1076 xassert (SYMBOLP (val
));
1077 this_len
+= sprintf (str
+ this_len
, "-%c",
1078 SDATA (SYMBOL_NAME (val
))[0]);
1081 this_len
+= sprintf (str
+ this_len
, "-*");
1082 if (CONSP (scalable
) && ! NILP (XCDR (spacing
)))
1083 this_len
+= sprintf (str
+ this_len
, "-0");
1085 this_len
+= sprintf (str
+ this_len
, "-*");
1086 f
[XLFD_RESX_INDEX
] = str
;
1090 f
[XLFD_RESX_INDEX
] = "*-*-*-*", len
+= 8;
1093 len
++; /* for terminating '\0'. */
1096 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1097 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1098 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1099 f
[XLFD_SWIDTH_INDEX
],
1100 f
[XLFD_ADSTYLE_INDEX
], f
[XLFD_PIXEL_INDEX
],
1101 f
[XLFD_RESX_INDEX
], f
[XLFD_REGISTRY_INDEX
]);
1104 /* Parse NAME (null terminated) as Fonconfig's name format and store
1105 information in FONT (font-spec or font-entity). If NAME is
1106 successfully parsed, return 0. Otherwise return -1. */
1109 font_parse_fcname (name
, font
)
1114 int len
= strlen (name
);
1119 /* It is assured that (name[0] && name[0] != '-'). */
1127 for (p0
= name
+ 1; *p0
&& (*p0
!= '-' && *p0
!= ':'); p0
++)
1128 if (*p0
== '\\' && p0
[1])
1130 family
= intern_font_field (name
, p0
- name
);
1133 if (! isdigit (p0
[1]))
1135 point_size
= strtod (p0
+ 1, &p1
);
1136 if (*p1
&& *p1
!= ':')
1138 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1141 ASET (font
, FONT_FAMILY_INDEX
, family
);
1145 copy
= alloca (len
+ 1);
1150 /* Now parse ":KEY=VAL" patterns. Store known keys and values in
1151 extra, copy unknown ones to COPY. */
1154 Lisp_Object key
, val
;
1157 for (p1
= p0
+ 1; *p1
&& *p1
!= '=' && *p1
!= ':'; p1
++);
1160 /* Must be an enumerated value. */
1161 val
= intern_font_field (p0
+ 1, p1
- p0
- 1);
1162 if (memcmp (p0
+ 1, "light", 5) == 0
1163 || memcmp (p0
+ 1, "medium", 6) == 0
1164 || memcmp (p0
+ 1, "demibold", 8) == 0
1165 || memcmp (p0
+ 1, "bold", 4) == 0
1166 || memcmp (p0
+ 1, "black", 5) == 0)
1168 ASET (font
, FONT_WEIGHT_INDEX
, val
);
1170 else if (memcmp (p0
+ 1, "roman", 5) == 0
1171 || memcmp (p0
+ 1, "italic", 6) == 0
1172 || memcmp (p0
+ 1, "oblique", 7) == 0)
1174 ASET (font
, FONT_SLANT_INDEX
, val
);
1176 else if (memcmp (p0
+ 1, "charcell", 8) == 0
1177 || memcmp (p0
+ 1, "mono", 4) == 0
1178 || memcmp (p0
+ 1, "proportional", 12) == 0)
1180 font_put_extra (font
, QCspacing
,
1181 (p0
[1] == 'c' ? Qc
: p0
[1] == 'm' ? Qm
: Qp
));
1186 bcopy (p0
, copy
, p1
- p0
);
1192 if (memcmp (p0
+ 1, "pixelsize=", 10) == 0)
1193 prop
= FONT_SIZE_INDEX
;
1196 key
= intern_font_field (p0
, p1
- p0
);
1197 prop
= get_font_prop_index (key
, 0);
1200 for (p1
= p0
; *p1
&& *p1
!= ':'; p1
++);
1201 val
= intern_font_field (p0
, p1
- p0
);
1204 if (prop
>= 0 && prop
< FONT_EXTRA_INDEX
)
1206 ASET (font
, prop
, val
);
1209 font_put_extra (font
, key
, val
);
1218 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1219 NAME (NBYTES length), and return the name length. If
1220 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1223 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1231 int dpi
, spacing
, scalable
;
1234 Lisp_Object styles
[3];
1235 char *style_names
[3] = { "weight", "slant", "width" };
1237 val
= AREF (font
, FONT_FAMILY_INDEX
);
1238 if (SYMBOLP (val
) && ! NILP (val
))
1239 len
+= SBYTES (SYMBOL_NAME (val
));
1241 val
= AREF (font
, FONT_SIZE_INDEX
);
1244 if (XINT (val
) != 0)
1245 pixel_size
= XINT (val
);
1247 len
+= 21; /* for ":pixelsize=NUM" */
1249 else if (FLOATP (val
))
1252 point_size
= (int) XFLOAT_DATA (val
);
1253 len
+= 11; /* for "-NUM" */
1256 val
= AREF (font
, FONT_FOUNDRY_INDEX
);
1257 if (SYMBOLP (val
) && ! NILP (val
))
1258 /* ":foundry=NAME" */
1259 len
+= 9 + SBYTES (SYMBOL_NAME (val
));
1261 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
1263 val
= AREF (font
, i
);
1266 val
= prop_numeric_to_name (i
, XINT (val
));
1267 len
+= (strlen (style_names
[i
- FONT_WEIGHT_INDEX
])
1268 + 2 + SBYTES (SYMBOL_NAME (val
))); /* :xxx=NAME */
1270 styles
[i
- FONT_WEIGHT_INDEX
] = val
;
1273 val
= AREF (font
, FONT_EXTRA_INDEX
);
1274 if (FONT_ENTITY_P (font
)
1275 && EQ (AREF (font
, FONT_TYPE_INDEX
), Qx
))
1279 /* VAL is a symbol of name `RESX-RESY-SPACING-AVWIDTH'. */
1280 p
= (char *) SDATA (SYMBOL_NAME (val
));
1282 for (p
++; *p
!= '-'; p
++); /* skip RESX */
1283 for (p
++; *p
!= '-'; p
++); /* skip RESY */
1284 spacing
= (*p
== 'c' ? FONT_SPACING_CHARCELL
1285 : *p
== 'm' ? FONT_SPACING_MONO
1286 : FONT_SPACING_PROPORTIONAL
);
1287 for (p
++; *p
!= '-'; p
++); /* skip SPACING */
1288 scalable
= (atoi (p
) == 0);
1289 /* The longest pattern is ":dpi=NUM:scalable=False:spacing=100" */
1296 dpi
= spacing
= scalable
= -1;
1297 elt
= assq_no_quit (QCdpi
, val
);
1299 dpi
= XINT (XCDR (elt
)), len
+= 15; /* for ":dpi=NUM" */
1300 elt
= assq_no_quit (QCspacing
, val
);
1302 spacing
= XINT (XCDR (elt
)), len
+= 12; /* for ":spacing=100" */
1303 elt
= assq_no_quit (QCscalable
, val
);
1305 scalable
= ! NILP (XCDR (elt
)), len
+= 15; /* for ":scalable=False" */
1311 if (! NILP (AREF (font
, FONT_FAMILY_INDEX
)))
1312 p
+= sprintf(p
, "%s",
1313 SDATA (SYMBOL_NAME (AREF (font
, FONT_FAMILY_INDEX
))));
1317 p
+= sprintf (p
, "%d", point_size
);
1319 p
+= sprintf (p
, "-%d", point_size
);
1321 else if (pixel_size
> 0)
1322 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1323 if (SYMBOLP (AREF (font
, FONT_FOUNDRY_INDEX
))
1324 && ! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1325 p
+= sprintf (p
, ":foundry=%s",
1326 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1327 for (i
= 0; i
< 3; i
++)
1328 if (SYMBOLP (styles
[i
]) && ! NILP (styles
[i
]))
1329 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1330 SDATA (SYMBOL_NAME (styles
[i
])));
1332 p
+= sprintf (p
, ":dpi=%d", dpi
);
1334 p
+= sprintf (p
, ":spacing=%d", spacing
);
1336 p
+= sprintf (p
, ":scalable=True");
1337 else if (scalable
== 0)
1338 p
+= sprintf (p
, ":scalable=False");
1342 /* Parse NAME (null terminated) and store information in FONT
1343 (font-spec or font-entity). If NAME is successfully parsed, return
1344 0. Otherwise return -1.
1346 If NAME is XLFD and FONT is a font-entity, store
1347 RESX-RESY-SPACING-AVWIDTH information as a symbol in
1348 FONT_EXTRA_INDEX. */
1351 font_parse_name (name
, font
)
1355 if (name
[0] == '-' || index (name
, '*'))
1356 return font_parse_xlfd (name
, font
);
1357 return font_parse_fcname (name
, font
);
1361 font_merge_old_spec (name
, family
, registry
, spec
)
1362 Lisp_Object name
, family
, registry
, spec
;
1366 if (font_parse_xlfd ((char *) SDATA (name
), spec
) < 0)
1368 Lisp_Object extra
= Fcons (Fcons (QCname
, name
), Qnil
);
1370 ASET (spec
, FONT_EXTRA_INDEX
, extra
);
1375 if (! NILP (family
))
1380 xassert (STRINGP (family
));
1381 len
= SBYTES (family
);
1382 p0
= (char *) SDATA (family
);
1383 p1
= index (p0
, '-');
1386 if ((*p0
!= '*' || p1
- p0
> 1)
1387 && NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
1388 ASET (spec
, FONT_FOUNDRY_INDEX
,
1389 intern_downcase (p0
, p1
- p0
));
1390 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
1391 ASET (spec
, FONT_FAMILY_INDEX
,
1392 intern_downcase (p1
+ 1, len
- (p1
+ 1 - p0
)));
1394 else if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
1395 ASET (spec
, FONT_FAMILY_INDEX
, intern_downcase (p0
, len
));
1397 if (! NILP (registry
)
1398 && NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
1399 ASET (spec
, FONT_REGISTRY_INDEX
,
1400 intern_downcase ((char *) SDATA (registry
), SBYTES (registry
)));
1405 font_lispy_object (font
)
1408 Lisp_Object objlist
= AREF (font
->entity
, FONT_OBJLIST_INDEX
);
1410 for (; ! NILP (objlist
); objlist
= XCDR (objlist
))
1412 struct Lisp_Save_Value
*p
= XSAVE_VALUE (XCAR (objlist
));
1414 if (font
== (struct font
*) p
->pointer
)
1417 xassert (! NILP (objlist
));
1418 return XCAR (objlist
);
1421 #define LGSTRING_HEADER_SIZE 6
1422 #define LGSTRING_GLYPH_SIZE 8
1425 check_gstring (gstring
)
1426 Lisp_Object gstring
;
1431 CHECK_VECTOR (gstring
);
1432 val
= AREF (gstring
, 0);
1434 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1436 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1437 if (! NILP (LGSTRING_LBEARING (gstring
)))
1438 CHECK_NUMBER (LGSTRING_LBEARING (gstring
));
1439 if (! NILP (LGSTRING_RBEARING (gstring
)))
1440 CHECK_NUMBER (LGSTRING_RBEARING (gstring
));
1441 if (! NILP (LGSTRING_WIDTH (gstring
)))
1442 CHECK_NATNUM (LGSTRING_WIDTH (gstring
));
1443 if (! NILP (LGSTRING_ASCENT (gstring
)))
1444 CHECK_NUMBER (LGSTRING_ASCENT (gstring
));
1445 if (! NILP (LGSTRING_DESCENT (gstring
)))
1446 CHECK_NUMBER (LGSTRING_DESCENT(gstring
));
1448 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1450 val
= LGSTRING_GLYPH (gstring
, i
);
1452 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1454 if (NILP (LGLYPH_CHAR (val
)))
1456 CHECK_NATNUM (LGLYPH_FROM (val
));
1457 CHECK_NATNUM (LGLYPH_TO (val
));
1458 CHECK_CHARACTER (LGLYPH_CHAR (val
));
1459 if (! NILP (LGLYPH_CODE (val
)))
1460 CHECK_NATNUM (LGLYPH_CODE (val
));
1461 if (! NILP (LGLYPH_WIDTH (val
)))
1462 CHECK_NATNUM (LGLYPH_WIDTH (val
));
1463 if (! NILP (LGLYPH_ADJUSTMENT (val
)))
1465 val
= LGLYPH_ADJUSTMENT (val
);
1467 if (ASIZE (val
) < 3)
1469 for (j
= 0; j
< 3; j
++)
1470 CHECK_NUMBER (AREF (val
, j
));
1475 error ("Invalid glyph-string format");
1483 check_otf_features (otf_features
)
1484 Lisp_Object otf_features
;
1486 Lisp_Object val
, elt
;
1488 CHECK_CONS (otf_features
);
1489 CHECK_SYMBOL (XCAR (otf_features
));
1490 otf_features
= XCDR (otf_features
);
1491 CHECK_CONS (otf_features
);
1492 CHECK_SYMBOL (XCAR (otf_features
));
1493 otf_features
= XCDR (otf_features
);
1494 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1496 CHECK_SYMBOL (Fcar (val
));
1497 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1498 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1500 otf_features
= XCDR (otf_features
);
1501 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1503 CHECK_SYMBOL (Fcar (val
));
1504 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1505 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1512 Lisp_Object otf_list
;
1515 otf_tag_symbol (tag
)
1520 OTF_tag_name (tag
, name
);
1521 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1525 otf_open (entity
, file
)
1529 Lisp_Object val
= Fassoc (entity
, otf_list
);
1533 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1536 otf
= file
? OTF_open (file
) : NULL
;
1537 val
= make_save_value (otf
, 0);
1538 otf_list
= Fcons (Fcons (entity
, val
), otf_list
);
1544 /* Return a list describing which scripts/languages FONT supports by
1545 which GSUB/GPOS features of OpenType tables. See the comment of
1546 (sturct font_driver).otf_capability. */
1549 font_otf_capability (font
)
1553 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1556 otf
= otf_open (font
->entity
, font
->file_name
);
1559 for (i
= 0; i
< 2; i
++)
1561 OTF_GSUB_GPOS
*gsub_gpos
;
1562 Lisp_Object script_list
= Qnil
;
1565 if (OTF_get_features (otf
, i
== 0) < 0)
1567 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1568 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1570 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1571 Lisp_Object langsys_list
= Qnil
;
1572 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1575 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1577 OTF_LangSys
*langsys
;
1578 Lisp_Object feature_list
= Qnil
;
1579 Lisp_Object langsys_tag
;
1582 if (k
== script
->LangSysCount
)
1584 langsys
= &script
->DefaultLangSys
;
1589 langsys
= script
->LangSys
+ k
;
1591 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1593 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1595 OTF_Feature
*feature
1596 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1597 Lisp_Object feature_tag
1598 = otf_tag_symbol (feature
->FeatureTag
);
1600 feature_list
= Fcons (feature_tag
, feature_list
);
1602 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1605 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1610 XSETCAR (capability
, script_list
);
1612 XSETCDR (capability
, script_list
);
1618 /* Parse OTF features in SPEC and write a proper features spec string
1619 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1620 assured that the sufficient memory has already allocated for
1624 generate_otf_features (spec
, features
)
1634 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1640 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1645 else if (! asterisk
)
1647 val
= SYMBOL_NAME (val
);
1648 p
+= sprintf (p
, "%s", SDATA (val
));
1652 val
= SYMBOL_NAME (val
);
1653 p
+= sprintf (p
, "~%s", SDATA (val
));
1657 error ("OTF spec too long");
1660 #define DEVICE_DELTA(table, size) \
1661 (((size) >= (table).StartSize && (size) <= (table).EndSize) \
1662 ? (table).DeltaValue[(size) - (table).StartSize] \
1666 adjust_anchor (struct font
*font
, OTF_Anchor
*anchor
,
1667 unsigned code
, int size
, int *x
, int *y
)
1669 if (anchor
->AnchorFormat
== 2 && font
->driver
->anchor_point
)
1673 if (font
->driver
->anchor_point (font
, code
, anchor
->f
.f1
.AnchorPoint
,
1677 else if (anchor
->AnchorFormat
== 3)
1679 if (anchor
->f
.f2
.XDeviceTable
.offset
)
1680 *x
+= DEVICE_DELTA (anchor
->f
.f2
.XDeviceTable
, size
);
1681 if (anchor
->f
.f2
.YDeviceTable
.offset
)
1682 *y
+= DEVICE_DELTA (anchor
->f
.f2
.YDeviceTable
, size
);
1687 font_otf_DeviceTable (device_table
)
1688 OTF_DeviceTable
*device_table
;
1690 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1692 return Fcons (make_number (len
),
1693 make_unibyte_string (device_table
->DeltaValue
, len
));
1697 font_otf_ValueRecord (value_format
, value_record
)
1699 OTF_ValueRecord
*value_record
;
1701 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1703 if (value_format
& OTF_XPlacement
)
1704 ASET (val
, 0, value_record
->XPlacement
);
1705 if (value_format
& OTF_YPlacement
)
1706 ASET (val
, 1, value_record
->YPlacement
);
1707 if (value_format
& OTF_XAdvance
)
1708 ASET (val
, 2, value_record
->XAdvance
);
1709 if (value_format
& OTF_YAdvance
)
1710 ASET (val
, 3, value_record
->YAdvance
);
1711 if (value_format
& OTF_XPlaDevice
)
1712 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1713 if (value_format
& OTF_YPlaDevice
)
1714 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1715 if (value_format
& OTF_XAdvDevice
)
1716 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
1717 if (value_format
& OTF_YAdvDevice
)
1718 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
1723 font_otf_Anchor (anchor
)
1728 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
1729 ASET (val
, 0, make_number (anchor
->XCoordinate
));
1730 ASET (val
, 1, make_number (anchor
->YCoordinate
));
1731 if (anchor
->AnchorFormat
== 2)
1732 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
1735 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
1736 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
1741 #define REPLACEMENT_CHARACTER 0xFFFD
1743 /* Drive FONT's OpenType FEATURES. See the comment of (sturct
1744 font_driver).drive_otf. */
1747 font_drive_otf (font
, otf_features
, gstring_in
, from
, to
, gstring_out
, idx
,
1750 Lisp_Object otf_features
;
1751 Lisp_Object gstring_in
;
1753 Lisp_Object gstring_out
;
1754 int idx
, alternate_subst
;
1760 OTF_GlyphString otf_gstring
;
1762 char *script
, *langsys
= NULL
, *gsub_features
= NULL
, *gpos_features
= NULL
;
1765 val
= XCAR (otf_features
);
1766 script
= SDATA (SYMBOL_NAME (val
));
1767 otf_features
= XCDR (otf_features
);
1768 val
= XCAR (otf_features
);
1769 langsys
= NILP (val
) ? NULL
: SDATA (SYMBOL_NAME (val
));
1770 otf_features
= XCDR (otf_features
);
1771 val
= XCAR (otf_features
);
1774 gsub_features
= alloca (XINT (Flength (val
)) * 6);
1775 generate_otf_features (val
, &script
, &langsys
, gsub_features
);
1777 otf_features
= XCDR (otf_features
);
1778 val
= XCAR (otf_features
);
1781 gpos_features
= alloca (XINT (Flength (val
)) * 6);
1782 generate_otf_features (val
, &script
, &langsys
, gpos_features
);
1785 otf
= otf_open (font
->entity
, font
->file_name
);
1788 if (OTF_get_table (otf
, "head") < 0)
1790 if (OTF_get_table (otf
, "cmap") < 0)
1792 if ((! gsub_features
|| OTF_check_table (otf
, "GSUB") < 0)
1793 && (! gpos_features
|| OTF_check_table (otf
, "GPOS") < 0))
1797 otf_gstring
.size
= otf_gstring
.used
= len
;
1798 otf_gstring
.glyphs
= (OTF_Glyph
*) malloc (sizeof (OTF_Glyph
) * len
);
1799 memset (otf_gstring
.glyphs
, 0, sizeof (OTF_Glyph
) * len
);
1800 for (i
= 0, need_cmap
= 0; i
< len
; i
++)
1802 Lisp_Object g
= LGSTRING_GLYPH (gstring_in
, from
+ i
);
1804 otf_gstring
.glyphs
[i
].c
= XINT (LGLYPH_CHAR (g
));
1805 if (otf_gstring
.glyphs
[i
].c
== REPLACEMENT_CHARACTER
)
1806 otf_gstring
.glyphs
[i
].c
= 0;
1807 if (NILP (LGLYPH_CODE (g
)))
1809 otf_gstring
.glyphs
[i
].glyph_id
= 0;
1813 otf_gstring
.glyphs
[i
].glyph_id
= XINT (LGLYPH_CODE (g
));
1816 OTF_drive_cmap (otf
, &otf_gstring
);
1817 OTF_drive_gdef (otf
, &otf_gstring
);
1821 if ((alternate_subst
1822 ? OTF_drive_gsub_alternate (otf
, &otf_gstring
, script
, langsys
,
1824 : OTF_drive_gsub (otf
, &otf_gstring
, script
, langsys
,
1825 gsub_features
)) < 0)
1827 free (otf_gstring
.glyphs
);
1830 if (ASIZE (gstring_out
) < idx
+ otf_gstring
.used
)
1832 free (otf_gstring
.glyphs
);
1835 for (i
= 0, g
= otf_gstring
.glyphs
; i
< otf_gstring
.used
;)
1837 int i0
= g
->f
.index
.from
, i1
= g
->f
.index
.to
;
1838 Lisp_Object glyph
= LGSTRING_GLYPH (gstring_in
, from
+ i0
);
1839 Lisp_Object min_idx
= AREF (glyph
, 0);
1840 Lisp_Object max_idx
= AREF (glyph
, 1);
1844 int min_idx_i
= XINT (min_idx
), max_idx_i
= XINT (max_idx
);
1846 for (i0
++; i0
<= i1
; i0
++)
1848 glyph
= LGSTRING_GLYPH (gstring_in
, from
+ i0
);
1849 if (min_idx_i
> XINT (AREF (glyph
, 0)))
1850 min_idx_i
= XINT (AREF (glyph
, 0));
1851 if (max_idx_i
< XINT (AREF (glyph
, 1)))
1852 max_idx_i
= XINT (AREF (glyph
, 1));
1854 min_idx
= make_number (min_idx_i
);
1855 max_idx
= make_number (max_idx_i
);
1856 i0
= g
->f
.index
.from
;
1858 for (; i
< otf_gstring
.used
&& g
->f
.index
.from
== i0
; i
++, g
++)
1860 glyph
= LGSTRING_GLYPH (gstring_out
, idx
+ i
);
1861 ASET (glyph
, 0, min_idx
);
1862 ASET (glyph
, 1, max_idx
);
1864 LGLYPH_SET_CHAR (glyph
, make_number (g
->c
));
1866 LGLYPH_SET_CHAR (glyph
, make_number (REPLACEMENT_CHARACTER
));
1867 LGLYPH_SET_CODE (glyph
, make_number (g
->glyph_id
));
1875 int u
= otf
->head
->unitsPerEm
;
1876 int size
= font
->pixel_size
;
1877 Lisp_Object base
= Qnil
, mark
= Qnil
;
1879 if (OTF_drive_gpos (otf
, &otf_gstring
, script
, langsys
,
1882 free (otf_gstring
.glyphs
);
1885 for (i
= 0, g
= otf_gstring
.glyphs
; i
< otf_gstring
.used
; i
++, g
++)
1888 int xoff
= 0, yoff
= 0, width_adjust
= 0;
1893 switch (g
->positioning_type
)
1899 int format
= g
->f
.f1
.format
;
1901 if (format
& OTF_XPlacement
)
1902 xoff
= g
->f
.f1
.value
->XPlacement
* size
/ u
;
1903 if (format
& OTF_XPlaDevice
)
1904 xoff
+= DEVICE_DELTA (g
->f
.f1
.value
->XPlaDevice
, size
);
1905 if (format
& OTF_YPlacement
)
1906 yoff
= - (g
->f
.f1
.value
->YPlacement
* size
/ u
);
1907 if (format
& OTF_YPlaDevice
)
1908 yoff
-= DEVICE_DELTA (g
->f
.f1
.value
->YPlaDevice
, size
);
1909 if (format
& OTF_XAdvance
)
1910 width_adjust
+= g
->f
.f1
.value
->XAdvance
* size
/ u
;
1911 if (format
& OTF_XAdvDevice
)
1912 width_adjust
+= DEVICE_DELTA (g
->f
.f1
.value
->XAdvDevice
, size
);
1916 /* Not yet supported. */
1922 goto label_adjust_anchor
;
1923 default: /* i.e. case 6 */
1928 label_adjust_anchor
:
1930 int base_x
, base_y
, mark_x
, mark_y
, width
;
1933 base_x
= g
->f
.f4
.base_anchor
->XCoordinate
* size
/ u
;
1934 base_y
= g
->f
.f4
.base_anchor
->YCoordinate
* size
/ u
;
1935 mark_x
= g
->f
.f4
.mark_anchor
->XCoordinate
* size
/ u
;
1936 mark_y
= g
->f
.f4
.mark_anchor
->YCoordinate
* size
/ u
;
1938 code
= XINT (LGLYPH_CODE (prev
));
1939 if (g
->f
.f4
.base_anchor
->AnchorFormat
!= 1)
1940 adjust_anchor (font
, g
->f
.f4
.base_anchor
,
1941 code
, size
, &base_x
, &base_y
);
1942 if (g
->f
.f4
.mark_anchor
->AnchorFormat
!= 1)
1943 adjust_anchor (font
, g
->f
.f4
.mark_anchor
,
1944 code
, size
, &mark_x
, &mark_y
);
1946 if (NILP (LGLYPH_WIDTH (prev
)))
1948 width
= font
->driver
->text_extents (font
, &code
, 1, NULL
);
1949 LGLYPH_SET_WIDTH (prev
, make_number (width
));
1952 width
= XINT (LGLYPH_WIDTH (prev
));
1953 xoff
= XINT (LGLYPH_XOFF (prev
)) + (base_x
- width
) - mark_x
;
1954 yoff
= XINT (LGLYPH_YOFF (prev
)) + mark_y
- base_y
;
1957 if (xoff
|| yoff
|| width_adjust
)
1959 Lisp_Object adjustment
= Fmake_vector (make_number (3), Qnil
);
1961 ASET (adjustment
, 0, make_number (xoff
));
1962 ASET (adjustment
, 1, make_number (yoff
));
1963 ASET (adjustment
, 2, make_number (width_adjust
));
1964 LGLYPH_SET_ADJUSTMENT (glyph
, adjustment
);
1966 if (g
->GlyphClass
== OTF_GlyphClass0
)
1967 base
= mark
= glyph
;
1968 else if (g
->GlyphClass
== OTF_GlyphClassMark
)
1975 free (otf_gstring
.glyphs
);
1979 #endif /* HAVE_LIBOTF */
1982 /* G-string (glyph string) handler */
1984 /* G-string is a vector of the form [HEADER GLYPH ...].
1985 See the docstring of `font-make-gstring' for more detail. */
1988 font_prepare_composition (cmp
)
1989 struct composition
*cmp
;
1992 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
1993 cmp
->hash_index
* 2);
1994 struct font
*font
= XSAVE_VALUE (LGSTRING_FONT (gstring
))->pointer
;
1995 int len
= LGSTRING_LENGTH (gstring
);
1999 cmp
->lbearing
= cmp
->rbearing
= cmp
->pixel_width
= 0;
2000 cmp
->ascent
= font
->ascent
;
2001 cmp
->descent
= font
->descent
;
2003 for (i
= 0; i
< len
; i
++)
2005 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
2007 struct font_metrics metrics
;
2009 if (NILP (LGLYPH_FROM (g
)))
2011 code
= XINT (LGLYPH_CODE (g
));
2012 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
2013 LGLYPH_SET_WIDTH (g
, make_number (metrics
.width
));
2014 metrics
.lbearing
+= LGLYPH_XOFF (g
);
2015 metrics
.rbearing
+= LGLYPH_XOFF (g
);
2016 metrics
.ascent
+= LGLYPH_YOFF (g
);
2017 metrics
.descent
+= LGLYPH_YOFF (g
);
2019 if (cmp
->lbearing
> cmp
->pixel_width
+ metrics
.lbearing
)
2020 cmp
->lbearing
= cmp
->pixel_width
+ metrics
.lbearing
;
2021 if (cmp
->rbearing
< cmp
->pixel_width
+ metrics
.rbearing
)
2022 cmp
->rbearing
= cmp
->pixel_width
+ metrics
.rbearing
;
2023 if (cmp
->ascent
< metrics
.ascent
)
2024 cmp
->ascent
= metrics
.ascent
;
2025 if (cmp
->descent
< metrics
.descent
)
2026 cmp
->descent
= metrics
.descent
;
2027 cmp
->pixel_width
+= metrics
.width
+ LGLYPH_WADJUST (g
);
2030 LGSTRING_SET_LBEARING (gstring
, make_number (cmp
->lbearing
));
2031 LGSTRING_SET_RBEARING (gstring
, make_number (cmp
->rbearing
));
2032 LGSTRING_SET_WIDTH (gstring
, make_number (cmp
->pixel_width
));
2033 LGSTRING_SET_ASCENT (gstring
, make_number (cmp
->ascent
));
2034 LGSTRING_SET_DESCENT (gstring
, make_number (cmp
->descent
));
2040 font_gstring_produce (old
, from
, to
, new, idx
, code
, n
)
2048 Lisp_Object min_idx
, max_idx
;
2051 if (idx
+ n
> ASIZE (new))
2057 min_idx
= make_number (0);
2058 max_idx
= make_number (1);
2062 min_idx
= AREF (AREF (old
, from
- 1), 0);
2063 max_idx
= AREF (AREF (old
, from
- 1), 1);
2066 else if (from
+ 1 == to
)
2068 min_idx
= AREF (AREF (old
, from
), 0);
2069 max_idx
= AREF (AREF (old
, from
), 1);
2073 int min_idx_i
= XINT (AREF (AREF (old
, from
), 0));
2074 int max_idx_i
= XINT (AREF (AREF (old
, from
), 1));
2076 for (i
= from
+ 1; i
< to
; i
++)
2078 if (min_idx_i
> XINT (AREF (AREF (old
, i
), 0)))
2079 min_idx_i
= XINT (AREF (AREF (old
, i
), 0));
2080 if (max_idx_i
< XINT (AREF (AREF (old
, i
), 1)))
2081 max_idx_i
= XINT (AREF (AREF (old
, i
), 1));
2083 min_idx
= make_number (min_idx_i
);
2084 max_idx
= make_number (max_idx_i
);
2087 for (i
= 0; i
< n
; i
++)
2089 ASET (AREF (new, idx
+ i
), 0, min_idx
);
2090 ASET (AREF (new, idx
+ i
), 1, max_idx
);
2091 ASET (AREF (new, idx
+ i
), 2, make_number (code
[i
]));
2099 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2100 static int font_compare
P_ ((const void *, const void *));
2101 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
2102 Lisp_Object
, Lisp_Object
));
2104 /* We sort fonts by scoring each of them against a specified
2105 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2106 the value is, the closer the font is to the font-spec.
2108 Each 1-bit in the highest 4 bits of the score is used for atomic
2109 properties FOUNDRY, FAMILY, ADSTYLE, and REGISTRY.
2111 Each 7-bit in the lowest 28 bits are used for numeric properties
2112 WEIGHT, SLANT, WIDTH, and SIZE. */
2114 /* How many bits to shift to store the difference value of each font
2115 property in a score. */
2116 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2118 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2119 The return value indicates how different ENTITY is compared with
2123 font_score (entity
, spec_prop
)
2124 Lisp_Object entity
, *spec_prop
;
2128 /* Score four atomic fields. Maximum difference is 1. */
2129 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2130 if (! NILP (spec_prop
[i
])
2131 && ! EQ (spec_prop
[i
], AREF (entity
, i
)))
2132 score
|= 1 << sort_shift_bits
[i
];
2134 /* Score four numeric fields. Maximum difference is 127. */
2135 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2137 Lisp_Object entity_val
= AREF (entity
, i
);
2139 if (! NILP (spec_prop
[i
]) && ! EQ (spec_prop
[i
], entity_val
))
2141 if (! INTEGERP (entity_val
))
2142 score
|= 127 << sort_shift_bits
[i
];
2145 int diff
= XINT (entity_val
) - XINT (spec_prop
[i
]);
2149 if (i
== FONT_SIZE_INDEX
)
2151 if (XINT (entity_val
) > 0
2152 && diff
> FONT_PIXEL_SIZE_QUANTUM
)
2153 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2156 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2165 /* The comparison function for qsort. */
2168 font_compare (d1
, d2
)
2169 const void *d1
, *d2
;
2171 return (*(unsigned *) d1
< *(unsigned *) d2
2172 ? -1 : *(unsigned *) d1
> *(unsigned *) d2
);
2176 /* The structure for elements being sorted by qsort. */
2177 struct font_sort_data
2184 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2185 If PREFER specifies a point-size, calculate the corresponding
2186 pixel-size from QCdpi property of PREFER or from the Y-resolution
2187 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
2188 get the font-entities in VEC. */
2191 font_sort_entites (vec
, prefer
, frame
, spec
)
2192 Lisp_Object vec
, prefer
, frame
, spec
;
2194 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2196 struct font_sort_data
*data
;
2203 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2204 prefer_prop
[i
] = AREF (prefer
, i
);
2208 /* As it is assured that all fonts in VEC match with SPEC, we
2209 should ignore properties specified in SPEC. So, set the
2210 corresponding properties in PREFER_PROP to nil. */
2211 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2212 if (! NILP (AREF (spec
, i
)))
2213 prefer_prop
[i
++] = Qnil
;
2216 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2217 prefer_prop
[FONT_SIZE_INDEX
]
2218 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2220 /* Scoring and sorting. */
2221 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2222 for (i
= 0; i
< len
; i
++)
2224 data
[i
].entity
= AREF (vec
, i
);
2225 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
);
2227 qsort (data
, len
, sizeof *data
, font_compare
);
2228 for (i
= 0; i
< len
; i
++)
2229 ASET (vec
, i
, data
[i
].entity
);
2236 /* API of Font Service Layer. */
2239 font_update_sort_order (order
)
2242 int i
, shift_bits
= 21;
2244 for (i
= 0; i
< 4; i
++, shift_bits
-= 7)
2246 int xlfd_idx
= order
[i
];
2248 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2249 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2250 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2251 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2252 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2253 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2255 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2260 font_symbolic_weight (font
)
2263 Lisp_Object weight
= AREF (font
, FONT_WEIGHT_INDEX
);
2265 if (INTEGERP (weight
))
2266 weight
= prop_numeric_to_name (FONT_WEIGHT_INDEX
, XINT (weight
));
2271 font_symbolic_slant (font
)
2274 Lisp_Object slant
= AREF (font
, FONT_SLANT_INDEX
);
2276 if (INTEGERP (slant
))
2277 slant
= prop_numeric_to_name (FONT_SLANT_INDEX
, XINT (slant
));
2282 font_symbolic_width (font
)
2285 Lisp_Object width
= AREF (font
, FONT_WIDTH_INDEX
);
2287 if (INTEGERP (width
))
2288 width
= prop_numeric_to_name (FONT_WIDTH_INDEX
, XINT (width
));
2293 font_match_p (spec
, entity
)
2294 Lisp_Object spec
, entity
;
2298 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2299 if (! NILP (AREF (spec
, i
))
2300 && ! EQ (AREF (spec
, i
), AREF (entity
, i
)))
2302 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
))
2303 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0
2304 && (XINT (AREF (spec
, FONT_SIZE_INDEX
))
2305 != XINT (AREF (entity
, FONT_SIZE_INDEX
))))
2311 font_find_object (font
)
2314 Lisp_Object tail
, elt
;
2316 for (tail
= AREF (font
->entity
, FONT_OBJLIST_INDEX
); CONSP (tail
);
2320 if (font
== XSAVE_VALUE (elt
)->pointer
2321 && XSAVE_VALUE (elt
)->integer
> 0)
2328 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2330 /* Return a vector of font-entities matching with SPEC on frame F. */
2333 font_list_entities (frame
, spec
)
2334 Lisp_Object frame
, spec
;
2336 FRAME_PTR f
= XFRAME (frame
);
2337 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2338 Lisp_Object ftype
, family
, size
, alternate_familes
;
2339 Lisp_Object
*vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2345 family
= AREF (spec
, FONT_FAMILY_INDEX
);
2347 alternate_familes
= Qnil
;
2350 if (NILP (font_family_alist
)
2351 && !NILP (Vface_alternative_font_family_alist
))
2352 build_font_family_alist ();
2353 alternate_familes
= assq_no_quit (family
, font_family_alist
);
2354 if (! NILP (alternate_familes
))
2355 alternate_familes
= XCDR (alternate_familes
);
2357 size
= AREF (spec
, FONT_SIZE_INDEX
);
2359 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2361 xassert (ASIZE (spec
) == FONT_SPEC_MAX
);
2362 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2364 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2366 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2368 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
2369 Lisp_Object tail
= alternate_familes
;
2372 xassert (CONSP (cache
));
2373 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2374 ASET (spec
, FONT_FAMILY_INDEX
, family
);
2378 val
= assoc_no_quit (spec
, XCDR (cache
));
2383 val
= driver_list
->driver
->list (frame
, spec
);
2385 XSETCDR (cache
, Fcons (Fcons (Fcopy_sequence (spec
), val
),
2388 if (VECTORP (val
) && ASIZE (val
) > 0)
2395 ASET (spec
, FONT_FAMILY_INDEX
, XCAR (tail
));
2399 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2400 ASET (spec
, FONT_FAMILY_INDEX
, family
);
2401 ASET (spec
, FONT_SIZE_INDEX
, size
);
2402 return (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2406 font_matching_entity (frame
, spec
)
2407 Lisp_Object frame
, spec
;
2409 FRAME_PTR f
= XFRAME (frame
);
2410 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2411 Lisp_Object ftype
, size
, entity
;
2413 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2414 size
= AREF (spec
, FONT_SIZE_INDEX
);
2416 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2418 for (; driver_list
; driver_list
= driver_list
->next
)
2420 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2422 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
2425 xassert (CONSP (cache
));
2426 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2427 key
= Fcons (spec
, Qnil
);
2428 entity
= assoc_no_quit (key
, XCDR (cache
));
2430 entity
= XCDR (entity
);
2433 entity
= driver_list
->driver
->match (frame
, spec
);
2434 if (! NILP (entity
))
2436 XSETCAR (key
, Fcopy_sequence (spec
));
2437 XSETCDR (cache
, Fcons (Fcons (key
, entity
), XCDR (cache
)));
2440 if (! NILP (entity
))
2443 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2444 ASET (spec
, FONT_SIZE_INDEX
, size
);
2448 static int num_fonts
;
2451 font_open_entity (f
, entity
, pixel_size
)
2456 struct font_driver_list
*driver_list
;
2457 Lisp_Object objlist
, size
, val
;
2460 size
= AREF (entity
, FONT_SIZE_INDEX
);
2461 xassert (NATNUMP (size
));
2462 if (XINT (size
) != 0)
2463 pixel_size
= XINT (size
);
2465 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2466 objlist
= XCDR (objlist
))
2468 font
= XSAVE_VALUE (XCAR (objlist
))->pointer
;
2469 if (font
->pixel_size
== pixel_size
)
2471 XSAVE_VALUE (XCAR (objlist
))->integer
++;
2472 return XCAR (objlist
);
2476 xassert (FONT_ENTITY_P (entity
));
2477 val
= AREF (entity
, FONT_TYPE_INDEX
);
2478 for (driver_list
= f
->font_driver_list
;
2479 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2480 driver_list
= driver_list
->next
);
2484 font
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2487 font
->scalable
= XINT (size
) == 0;
2489 val
= make_save_value (font
, 1);
2490 ASET (entity
, FONT_OBJLIST_INDEX
,
2491 Fcons (val
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2497 font_close_object (f
, font_object
)
2499 Lisp_Object font_object
;
2501 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2502 Lisp_Object objlist
;
2503 Lisp_Object tail
, prev
= Qnil
;
2505 XSAVE_VALUE (font_object
)->integer
--;
2506 xassert (XSAVE_VALUE (font_object
)->integer
>= 0);
2507 if (XSAVE_VALUE (font_object
)->integer
> 0)
2510 objlist
= AREF (font
->entity
, FONT_OBJLIST_INDEX
);
2511 for (prev
= Qnil
, tail
= objlist
; CONSP (tail
);
2512 prev
= tail
, tail
= XCDR (tail
))
2513 if (EQ (font_object
, XCAR (tail
)))
2515 if (font
->driver
->close
)
2516 font
->driver
->close (f
, font
);
2517 XSAVE_VALUE (font_object
)->pointer
= NULL
;
2519 ASET (font
->entity
, FONT_OBJLIST_INDEX
, XCDR (objlist
));
2521 XSETCDR (prev
, XCDR (objlist
));
2528 font_has_char (f
, font
, c
)
2535 if (FONT_ENTITY_P (font
))
2537 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2538 struct font_driver_list
*driver_list
;
2540 for (driver_list
= f
->font_driver_list
;
2541 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2542 driver_list
= driver_list
->next
);
2545 if (! driver_list
->driver
->has_char
)
2547 return driver_list
->driver
->has_char (font
, c
);
2550 xassert (FONT_OBJECT_P (font
));
2551 fontp
= XSAVE_VALUE (font
)->pointer
;
2553 if (fontp
->driver
->has_char
)
2555 int result
= fontp
->driver
->has_char (fontp
->entity
, c
);
2560 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2564 font_encode_char (font_object
, c
)
2565 Lisp_Object font_object
;
2568 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2570 return font
->driver
->encode_char (font
, c
);
2574 font_get_name (font_object
)
2575 Lisp_Object font_object
;
2577 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2578 char *name
= (font
->font
.full_name
? font
->font
.full_name
2579 : font
->font
.name
? font
->font
.name
2582 return (name
? make_unibyte_string (name
, strlen (name
)) : null_string
);
2586 font_get_spec (font_object
)
2587 Lisp_Object font_object
;
2589 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2590 Lisp_Object spec
= Ffont_spec (0, NULL
);
2593 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2594 ASET (spec
, i
, AREF (font
->entity
, i
));
2595 ASET (spec
, FONT_SIZE_INDEX
, make_number (font
->pixel_size
));
2600 font_get_frame (font
)
2603 if (FONT_OBJECT_P (font
))
2604 font
= ((struct font
*) XSAVE_VALUE (font
)->pointer
)->entity
;
2605 xassert (FONT_ENTITY_P (font
));
2606 return AREF (font
, FONT_FRAME_INDEX
);
2609 /* Find a font entity best matching with LFACE. If SPEC is non-nil,
2610 the font must exactly match with it. */
2613 font_find_for_lface (f
, lface
, spec
)
2618 Lisp_Object frame
, entities
;
2621 XSETFRAME (frame
, f
);
2625 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2626 ASET (scratch_font_spec
, i
, Qnil
);
2627 ASET (scratch_font_spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2629 if (! NILP (lface
[LFACE_FAMILY_INDEX
]))
2630 font_merge_old_spec (Qnil
, lface
[LFACE_FAMILY_INDEX
], Qnil
,
2632 entities
= font_list_entities (frame
, scratch_font_spec
);
2633 while (ASIZE (entities
) == 0)
2635 /* Try without FOUNDRY or FAMILY. */
2636 if (! NILP (AREF (scratch_font_spec
, FONT_FOUNDRY_INDEX
)))
2638 ASET (scratch_font_spec
, FONT_FOUNDRY_INDEX
, Qnil
);
2639 entities
= font_list_entities (frame
, scratch_font_spec
);
2641 else if (! NILP (AREF (scratch_font_spec
, FONT_FAMILY_INDEX
)))
2643 ASET (scratch_font_spec
, FONT_FAMILY_INDEX
, Qnil
);
2644 entities
= font_list_entities (frame
, scratch_font_spec
);
2652 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2653 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2654 if (NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
2655 ASET (scratch_font_spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2656 entities
= font_list_entities (frame
, scratch_font_spec
);
2659 if (ASIZE (entities
) == 0)
2661 if (ASIZE (entities
) > 1)
2663 /* Sort fonts by properties specified in LFACE. */
2664 Lisp_Object prefer
= scratch_font_prefer
;
2667 if (! NILP (lface
[LFACE_FAMILY_INDEX
]))
2668 font_merge_old_spec (Qnil
, lface
[LFACE_FAMILY_INDEX
], Qnil
, prefer
);
2669 ASET (prefer
, FONT_WEIGHT_INDEX
,
2670 font_prop_validate_style (FONT_WEIGHT_INDEX
, QCweight
,
2671 lface
[LFACE_WEIGHT_INDEX
]));
2672 ASET (prefer
, FONT_SLANT_INDEX
,
2673 font_prop_validate_style (FONT_SLANT_INDEX
, QCslant
,
2674 lface
[LFACE_SLANT_INDEX
]));
2675 ASET (prefer
, FONT_WIDTH_INDEX
,
2676 font_prop_validate_style (FONT_WIDTH_INDEX
, QCwidth
,
2677 lface
[LFACE_SWIDTH_INDEX
]));
2678 pt
= XINT (lface
[LFACE_HEIGHT_INDEX
]);
2679 ASET (prefer
, FONT_SIZE_INDEX
, make_float (pt
/ 10));
2681 font_sort_entites (entities
, prefer
, frame
, spec
);
2684 return AREF (entities
, 0);
2688 font_open_for_lface (f
, entity
, lface
, spec
)
2696 if (FONT_SPEC_P (spec
) && INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2697 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2700 double pt
= XINT (lface
[LFACE_HEIGHT_INDEX
]);
2703 size
= POINT_TO_PIXEL (pt
, f
->resy
);
2705 return font_open_entity (f
, entity
, size
);
2709 font_load_for_face (f
, face
)
2713 Lisp_Object font_object
= face
->lface
[LFACE_FONT_INDEX
];
2715 if (NILP (font_object
))
2717 Lisp_Object entity
= font_find_for_lface (f
, face
->lface
, Qnil
);
2719 if (! NILP (entity
))
2720 font_object
= font_open_for_lface (f
, entity
, face
->lface
, Qnil
);
2723 if (! NILP (font_object
))
2725 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2727 face
->font
= font
->font
.font
;
2728 face
->font_info
= (struct font_info
*) font
;
2729 face
->font_info_id
= 0;
2730 face
->font_name
= font
->font
.full_name
;
2735 face
->font_info
= NULL
;
2736 face
->font_info_id
= -1;
2737 face
->font_name
= NULL
;
2738 add_to_log ("Unable to load font for a face%s", null_string
, Qnil
);
2743 font_prepare_for_face (f
, face
)
2747 struct font
*font
= (struct font
*) face
->font_info
;
2749 if (font
->driver
->prepare_face
)
2750 font
->driver
->prepare_face (f
, face
);
2754 font_done_for_face (f
, face
)
2758 struct font
*font
= (struct font
*) face
->font_info
;
2760 if (font
->driver
->done_face
)
2761 font
->driver
->done_face (f
, face
);
2766 font_open_by_name (f
, name
)
2770 Lisp_Object args
[2];
2771 Lisp_Object spec
, prefer
, size
, entity
, entity_list
;
2776 XSETFRAME (frame
, f
);
2779 args
[1] = make_unibyte_string (name
, strlen (name
));
2780 spec
= Ffont_spec (2, args
);
2781 prefer
= scratch_font_prefer
;
2782 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2783 if (NILP (AREF (spec
, i
)))
2784 ASET (prefer
, i
, make_number (100));
2785 size
= AREF (spec
, FONT_SIZE_INDEX
);
2788 else if (INTEGERP (size
))
2789 pixel_size
= XINT (size
);
2790 else /* FLOATP (size) */
2792 double pt
= XFLOAT_DATA (size
);
2794 pixel_size
= POINT_TO_PIXEL (pt
, f
->resy
);
2795 size
= make_number (pixel_size
);
2796 ASET (spec
, FONT_SIZE_INDEX
, size
);
2798 if (pixel_size
== 0)
2800 pixel_size
= POINT_TO_PIXEL (12.0, f
->resy
);
2801 size
= make_number (pixel_size
);
2803 ASET (prefer
, FONT_SIZE_INDEX
, size
);
2804 if (NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
2805 ASET (spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2807 entity_list
= Flist_fonts (spec
, frame
, make_number (1), prefer
);
2808 if (NILP (entity_list
))
2809 entity
= font_matching_entity (frame
, spec
);
2811 entity
= XCAR (entity_list
);
2812 return (NILP (entity
)
2814 : font_open_entity (f
, entity
, pixel_size
));
2818 /* Register font-driver DRIVER. This function is used in two ways.
2820 The first is with frame F non-NULL. In this case, make DRIVER
2821 available (but not yet activated) on F. All frame creaters
2822 (e.g. Fx_create_frame) must call this function at least once with
2823 an available font-driver.
2825 The second is with frame F NULL. In this case, DRIVER is globally
2826 registered in the variable `font_driver_list'. All font-driver
2827 implementations must call this function in its syms_of_XXXX
2828 (e.g. syms_of_xfont). */
2831 register_font_driver (driver
, f
)
2832 struct font_driver
*driver
;
2835 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
2836 struct font_driver_list
*prev
, *list
;
2838 if (f
&& ! driver
->draw
)
2839 error ("Unsable font driver for a frame: %s",
2840 SDATA (SYMBOL_NAME (driver
->type
)));
2842 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
2843 if (EQ (list
->driver
->type
, driver
->type
))
2844 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
2846 list
= malloc (sizeof (struct font_driver_list
));
2848 list
->driver
= driver
;
2853 f
->font_driver_list
= list
;
2855 font_driver_list
= list
;
2859 /* Free font-driver list on frame F. It doesn't free font-drivers
2863 free_font_driver_list (f
)
2866 while (f
->font_driver_list
)
2868 struct font_driver_list
*next
= f
->font_driver_list
->next
;
2870 free (f
->font_driver_list
);
2871 f
->font_driver_list
= next
;
2875 /* Make the frame F use font backends listed in NEW_BACKENDS (list of
2876 symbols). If NEW_BACKENDS is nil, make F use all available font
2877 drivers. If no backend is available, dont't alter
2878 f->font_driver_list.
2880 A caller must free all realized faces and clear all font caches if
2881 any in advance. The return value is a list of font backends
2882 actually made used for on F. */
2885 font_update_drivers (f
, new_drivers
)
2887 Lisp_Object new_drivers
;
2889 Lisp_Object active_drivers
= Qnil
;
2890 struct font_driver_list
*list
;
2892 /* At first check which font backends are available. */
2893 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
2894 if (NILP (new_drivers
)
2895 || ! NILP (Fmemq (list
->driver
->type
, new_drivers
)))
2898 active_drivers
= nconc2 (active_drivers
,
2899 Fcons (list
->driver
->type
, Qnil
));
2901 /* If at least one backend is available, update all list->on. */
2902 if (! NILP (active_drivers
))
2903 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
2904 list
->on
= (list
->on
== 2);
2906 return active_drivers
;
2911 font_at (c
, pos
, face
, w
, object
)
2922 f
= XFRAME (w
->frame
);
2923 if (! FRAME_WINDOW_P (f
))
2927 if (STRINGP (object
))
2928 face_id
= face_at_string_position (w
, object
, pos
, 0, -1, -1, &dummy
,
2929 DEFAULT_FACE_ID
, 0);
2931 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
,
2933 face
= FACE_FROM_ID (f
, face_id
);
2935 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, object
);
2936 face
= FACE_FROM_ID (f
, face_id
);
2937 if (! face
->font_info
)
2939 return font_lispy_object ((struct font
*) face
->font_info
);
2945 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 1, 0,
2946 doc
: /* Return t if OBJECT is a font-spec or font-entity. */)
2950 return (FONTP (object
) ? Qt
: Qnil
);
2953 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
2954 doc
: /* Return a newly created font-spec with specified arguments as properties.
2955 usage: (font-spec &rest properties) */)
2960 Lisp_Object spec
= Fmake_vector (make_number (FONT_SPEC_MAX
), Qnil
);
2963 for (i
= 0; i
< nargs
; i
+= 2)
2965 enum font_property_index prop
;
2966 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
2968 prop
= get_font_prop_index (key
, 0);
2969 if (prop
< FONT_EXTRA_INDEX
)
2970 ASET (spec
, prop
, val
);
2973 if (EQ (key
, QCname
))
2976 font_parse_name ((char *) SDATA (val
), spec
);
2978 font_put_extra (spec
, key
, val
);
2981 CHECK_VALIDATE_FONT_SPEC (spec
);
2986 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
2987 doc
: /* Return the value of FONT's PROP property.
2988 FONT is a font-spec, a font-entity, or a font-object. */)
2990 Lisp_Object font
, prop
;
2992 enum font_property_index idx
;
2994 if (FONT_OBJECT_P (font
))
2996 struct font
*fontp
= XSAVE_VALUE (font
)->pointer
;
2998 if (EQ (prop
, QCotf
))
3000 if (fontp
->driver
->otf_capability
)
3001 return fontp
->driver
->otf_capability (fontp
);
3005 font
= fontp
->entity
;
3009 idx
= get_font_prop_index (prop
, 0);
3010 if (idx
< FONT_EXTRA_INDEX
)
3011 return AREF (font
, idx
);
3012 if (FONT_ENTITY_P (font
))
3014 return Fcdr (Fassoc (AREF (font
, FONT_EXTRA_INDEX
), prop
));
3018 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3019 doc
: /* Set one property of FONT-SPEC: give property PROP value VALUE. */)
3020 (font_spec
, prop
, val
)
3021 Lisp_Object font_spec
, prop
, val
;
3023 enum font_property_index idx
;
3024 Lisp_Object extra
, slot
;
3026 CHECK_FONT_SPEC (font_spec
);
3027 idx
= get_font_prop_index (prop
, 0);
3028 if (idx
< FONT_EXTRA_INDEX
)
3029 return ASET (font_spec
, idx
, val
);
3030 extra
= AREF (font_spec
, FONT_EXTRA_INDEX
);
3031 slot
= Fassoc (extra
, prop
);
3033 extra
= Fcons (Fcons (prop
, val
), extra
);
3035 Fsetcdr (slot
, val
);
3039 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3040 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3041 Optional 2nd argument FRAME specifies the target frame.
3042 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3043 Optional 4th argument PREFER, if non-nil, is a font-spec
3044 to which closeness fonts are sorted. */)
3045 (font_spec
, frame
, num
, prefer
)
3046 Lisp_Object font_spec
, frame
, num
, prefer
;
3048 Lisp_Object vec
, list
, tail
;
3052 frame
= selected_frame
;
3053 CHECK_LIVE_FRAME (frame
);
3054 CHECK_VALIDATE_FONT_SPEC (font_spec
);
3062 if (! NILP (prefer
))
3063 CHECK_FONT (prefer
);
3065 vec
= font_list_entities (frame
, font_spec
);
3070 return Fcons (AREF (vec
, 0), Qnil
);
3072 if (! NILP (prefer
))
3073 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
);
3075 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3076 if (n
== 0 || n
> len
)
3078 for (i
= 1; i
< n
; i
++)
3080 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3082 XSETCDR (tail
, val
);
3088 DEFUN ("list-families", Flist_families
, Slist_families
, 0, 1, 0,
3089 doc
: /* List available font families on the current frame.
3090 Optional 2nd argument FRAME specifies the target frame. */)
3095 struct font_driver_list
*driver_list
;
3099 frame
= selected_frame
;
3100 CHECK_LIVE_FRAME (frame
);
3103 for (driver_list
= f
->font_driver_list
; driver_list
;
3104 driver_list
= driver_list
->next
)
3105 if (driver_list
->driver
->list_family
)
3107 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3113 Lisp_Object tail
= list
;
3115 for (; CONSP (val
); val
= XCDR (val
))
3116 if (NILP (Fmemq (XCAR (val
), tail
)))
3117 list
= Fcons (XCAR (val
), list
);
3123 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3124 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3125 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3127 Lisp_Object font_spec
, frame
;
3129 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3136 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 1, 0,
3137 doc
: /* Return XLFD name of FONT.
3138 FONT is a font-spec, font-entity, or font-object.
3139 If the name is too long for XLFD (maximum 255 chars), return nil. */)
3146 if (FONT_SPEC_P (font
))
3147 CHECK_VALIDATE_FONT_SPEC (font
);
3148 else if (FONT_ENTITY_P (font
))
3154 CHECK_FONT_GET_OBJECT (font
, fontp
);
3155 font
= fontp
->entity
;
3156 pixel_size
= fontp
->pixel_size
;
3159 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3161 return build_string (name
);
3164 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3165 doc
: /* Clear font cache. */)
3168 Lisp_Object list
, frame
;
3170 FOR_EACH_FRAME (list
, frame
)
3172 FRAME_PTR f
= XFRAME (frame
);
3173 struct font_driver_list
*driver_list
= f
->font_driver_list
;
3175 for (; driver_list
; driver_list
= driver_list
->next
)
3176 if (driver_list
->on
)
3178 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
3179 Lisp_Object tail
, elt
;
3181 for (tail
= XCDR (cache
); CONSP (tail
); tail
= XCDR (tail
))
3184 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
3186 Lisp_Object vec
= XCDR (elt
);
3189 for (i
= 0; i
< ASIZE (vec
); i
++)
3191 Lisp_Object entity
= AREF (vec
, i
);
3193 if (EQ (driver_list
->driver
->type
,
3194 AREF (entity
, FONT_TYPE_INDEX
)))
3197 = AREF (entity
, FONT_OBJLIST_INDEX
);
3199 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
3201 Lisp_Object val
= XCAR (objlist
);
3202 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
3203 struct font
*font
= p
->pointer
;
3205 xassert (font
&& (driver_list
->driver
3207 driver_list
->driver
->close (f
, font
);
3211 if (driver_list
->driver
->free_entity
)
3212 driver_list
->driver
->free_entity (entity
);
3217 XSETCDR (cache
, Qnil
);
3224 DEFUN ("internal-set-font-style-table", Finternal_set_font_style_table
,
3225 Sinternal_set_font_style_table
, 2, 2, 0,
3226 doc
: /* Set font style table for PROP to TABLE.
3227 PROP must be `:weight', `:slant', or `:width'.
3228 TABLE must be an alist of symbols vs the corresponding numeric values
3229 sorted by numeric values. */)
3231 Lisp_Object prop
, table
;
3235 Lisp_Object tail
, val
;
3237 CHECK_SYMBOL (prop
);
3238 table_index
= (EQ (prop
, QCweight
) ? 0
3239 : EQ (prop
, QCslant
) ? 1
3240 : EQ (prop
, QCwidth
) ? 2
3242 if (table_index
>= ASIZE (font_style_table
))
3243 error ("Invalid font style property: %s", SDATA (SYMBOL_NAME (prop
)));
3244 table
= Fcopy_sequence (table
);
3246 for (tail
= table
; ! NILP (tail
); tail
= Fcdr (tail
))
3248 prop
= Fcar (Fcar (tail
));
3249 val
= Fcdr (Fcar (tail
));
3250 CHECK_SYMBOL (prop
);
3252 if (numeric
> XINT (val
))
3253 error ("Numeric values not sorted for %s", SDATA (SYMBOL_NAME (prop
)));
3254 numeric
= XINT (val
);
3255 XSETCAR (tail
, Fcons (prop
, val
));
3257 ASET (font_style_table
, table_index
, table
);
3261 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
3262 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
3263 FONT-OBJECT may be nil if it is not yet known.
3265 G-string is sequence of glyphs of a specific font,
3266 and is a vector of this form:
3267 [ HEADER GLYPH ... ]
3268 HEADER is a vector of this form:
3269 [FONT-OBJECT LBEARING RBEARING WIDTH ASCENT DESCENT]
3271 FONT-OBJECT is a font-object for all glyphs in the g-string,
3272 LBEARING thry DESCENT is the metrics (in pixels) of the whole G-string.
3273 GLYPH is a vector of this form:
3274 [ FROM-IDX TO-IDX C CODE WIDTH [ [X-OFF Y-OFF WADJUST] | nil] ]
3276 FROM-IDX and TO-IDX are used internally and should not be touched.
3277 C is the character of the glyph.
3278 CODE is the glyph-code of C in FONT-OBJECT.
3279 X-OFF and Y-OFF are offests to the base position for the glyph.
3280 WIDTH is the normal width of the glyph.
3281 WADJUST is the adjustment to the normal width of the glyph. */)
3283 Lisp_Object font_object
, num
;
3285 Lisp_Object gstring
, g
;
3289 if (! NILP (font_object
))
3290 CHECK_FONT_OBJECT (font_object
);
3293 len
= XINT (num
) + 1;
3294 gstring
= Fmake_vector (make_number (len
), Qnil
);
3295 g
= Fmake_vector (make_number (6), Qnil
);
3296 ASET (g
, 0, font_object
);
3297 ASET (gstring
, 0, g
);
3298 for (i
= 1; i
< len
; i
++)
3299 ASET (gstring
, i
, Fmake_vector (make_number (8), Qnil
));
3303 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
3304 doc
: /* Fillin glyph-string GSTRING by characters for FONT-OBJECT.
3305 START and END specifies the region to extract characters.
3306 If optional 3rd argument OBJECT is non-nil, it is a buffer or a string from
3307 where to extract characters.
3308 FONT-OBJECT may be nil if GSTRING already already contains one. */)
3309 (gstring
, font_object
, start
, end
, object
)
3310 Lisp_Object gstring
, font_object
, start
, end
, object
;
3316 CHECK_VECTOR (gstring
);
3317 if (NILP (font_object
))
3318 font_object
= LGSTRING_FONT (gstring
);
3319 CHECK_FONT_GET_OBJECT (font_object
, font
);
3321 if (STRINGP (object
))
3323 const unsigned char *p
;
3325 CHECK_NATNUM (start
);
3327 if (XINT (start
) > XINT (end
)
3328 || XINT (end
) > ASIZE (object
)
3329 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3330 args_out_of_range (start
, end
);
3332 len
= XINT (end
) - XINT (start
);
3333 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
3334 for (i
= 0; i
< len
; i
++)
3336 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3338 c
= STRING_CHAR_ADVANCE (p
);
3339 code
= font
->driver
->encode_char (font
, c
);
3340 if (code
> MOST_POSITIVE_FIXNUM
)
3341 error ("Glyph code 0x%X is too large", code
);
3342 LGLYPH_SET_FROM (g
, make_number (i
));
3343 LGLYPH_SET_TO (g
, make_number (i
+ 1));
3344 LGLYPH_SET_CHAR (g
, make_number (c
));
3345 LGLYPH_SET_CODE (g
, make_number (code
));
3352 if (! NILP (object
))
3353 Fset_buffer (object
);
3354 validate_region (&start
, &end
);
3355 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3356 args_out_of_range (start
, end
);
3357 len
= XINT (end
) - XINT (start
);
3359 pos_byte
= CHAR_TO_BYTE (pos
);
3360 for (i
= 0; i
< len
; i
++)
3362 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3364 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
3365 code
= font
->driver
->encode_char (font
, c
);
3366 if (code
> MOST_POSITIVE_FIXNUM
)
3367 error ("Glyph code 0x%X is too large", code
);
3368 LGLYPH_SET_FROM (g
, make_number (i
));
3369 LGLYPH_SET_TO (g
, make_number (i
+ 1));
3370 LGLYPH_SET_CHAR (g
, make_number (c
));
3371 LGLYPH_SET_CODE (g
, make_number (code
));
3374 for (i
= LGSTRING_LENGTH (gstring
) - 1; i
>= len
; i
--)
3376 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3378 LGLYPH_SET_FROM (g
, Qnil
);
3383 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
3384 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
3385 OTF-SPEC specifies which featuress to apply in this format:
3386 (SCRIPT LANGSYS GSUB GPOS)
3388 SCRIPT is a symbol specifying a script tag of OpenType,
3389 LANGSYS is a symbol specifying a langsys tag of OpenType,
3390 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
3392 If LANGYS is nil, the default langsys is selected.
3394 The features are applied in the order appeared in the list. The
3395 symbol `*' means to apply all available features not appeared in this
3396 list, and the remaining features are ignored. For instance, (vatu
3397 pstf * haln) is to apply vatu and pstf in this order, then to apply
3398 all available features other than vatu, pstf, and haln.
3400 The features are applied to the glyphs in the range FROM and TO of
3401 the glyph-string GSTRING-IN.
3403 If some of a feature is actually applicable, the resulting glyphs are
3404 produced in the glyph-string GSTRING-OUT from the index INDEX. In
3405 this case, the value is the number of produced glyphs.
3407 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
3410 If GSTRING-OUT is too short to hold produced glyphs, no glyphs is
3411 produced in GSTRING-OUT, and the value is nil.
3413 See the documentation of `font-make-gstring' for the format of
3415 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
3416 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
3418 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
3423 check_otf_features (otf_features
);
3424 CHECK_FONT_GET_OBJECT (font_object
, font
);
3425 if (! font
->driver
->otf_drive
)
3426 error ("Font backend %s can't drive OpenType GSUB table",
3427 SDATA (SYMBOL_NAME (font
->driver
->type
)));
3428 CHECK_CONS (otf_features
);
3429 CHECK_SYMBOL (XCAR (otf_features
));
3430 val
= XCDR (otf_features
);
3431 CHECK_SYMBOL (XCAR (val
));
3432 val
= XCDR (otf_features
);
3435 len
= check_gstring (gstring_in
);
3436 CHECK_VECTOR (gstring_out
);
3437 CHECK_NATNUM (from
);
3439 CHECK_NATNUM (index
);
3441 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
3442 args_out_of_range_3 (from
, to
, make_number (len
));
3443 if (XINT (index
) >= ASIZE (gstring_out
))
3444 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
3445 num
= font
->driver
->otf_drive (font
, otf_features
,
3446 gstring_in
, XINT (from
), XINT (to
),
3447 gstring_out
, XINT (index
), 0);
3450 return make_number (num
);
3453 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
3455 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
3456 FEATURE-SPEC specifies which features of the font FONT-OBJECT to apply
3458 (SCRIPT LANGSYS FEATURE ...)
3459 See the documentation of `font-otf-gsub' for more detail.
3461 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
3462 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
3463 character code corresponding to the glyph or nil if there's no
3464 corresponding character. */)
3465 (font_object
, character
, otf_features
)
3466 Lisp_Object font_object
, character
, otf_features
;
3469 Lisp_Object gstring_in
, gstring_out
, g
;
3470 Lisp_Object alternates
;
3473 CHECK_FONT_GET_OBJECT (font_object
, font
);
3474 if (! font
->driver
->otf_drive
)
3475 error ("Font backend %s can't drive OpenType GSUB table",
3476 SDATA (SYMBOL_NAME (font
->driver
->type
)));
3477 CHECK_CHARACTER (character
);
3478 CHECK_CONS (otf_features
);
3480 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
3481 g
= LGSTRING_GLYPH (gstring_in
, 0);
3482 LGLYPH_SET_CHAR (g
, character
);
3483 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
3484 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
3485 gstring_out
, 0, 1)) < 0)
3486 gstring_out
= Ffont_make_gstring (font_object
,
3487 make_number (ASIZE (gstring_out
) * 2));
3489 for (i
= 0; i
< num
; i
++)
3491 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
3492 int c
= XINT (LGLYPH_CHAR (g
));
3493 unsigned code
= XUINT (LGLYPH_CODE (g
));
3495 alternates
= Fcons (Fcons (make_number (code
),
3496 c
> 0 ? make_number (c
) : Qnil
),
3499 return Fnreverse (alternates
);
3505 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
3506 doc
: /* Open FONT-ENTITY. */)
3507 (font_entity
, size
, frame
)
3508 Lisp_Object font_entity
;
3514 CHECK_FONT_ENTITY (font_entity
);
3516 size
= AREF (font_entity
, FONT_SIZE_INDEX
);
3517 CHECK_NUMBER (size
);
3519 frame
= selected_frame
;
3520 CHECK_LIVE_FRAME (frame
);
3522 isize
= XINT (size
);
3524 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
3526 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
3529 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
3530 doc
: /* Close FONT-OBJECT. */)
3531 (font_object
, frame
)
3532 Lisp_Object font_object
, frame
;
3534 CHECK_FONT_OBJECT (font_object
);
3536 frame
= selected_frame
;
3537 CHECK_LIVE_FRAME (frame
);
3538 font_close_object (XFRAME (frame
), font_object
);
3542 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
3543 doc
: /* Return information about FONT-OBJECT.
3544 The value is a vector:
3545 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
3548 NAME is a string of the font name (or nil if the font backend doesn't
3551 FILENAME is a string of the font file (or nil if the font backend
3552 doesn't provide a file name).
3554 PIXEL-SIZE is a pixel size by which the font is opened.
3556 SIZE is a maximum advance width of the font in pixel.
3558 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
3561 CAPABILITY is a list whose first element is a symbol representing the
3562 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
3563 remaining elements describes a detail of the font capability.
3565 If the font is OpenType font, the form of the list is
3566 \(opentype GSUB GPOS)
3567 where GSUB shows which "GSUB" features the font supports, and GPOS
3568 shows which "GPOS" features the font supports. Both GSUB and GPOS are
3569 lists of the format:
3570 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3572 If the font is not OpenType font, currently the length of the form is
3575 SCRIPT is a symbol representing OpenType script tag.
3577 LANGSYS is a symbol representing OpenType langsys tag, or nil
3578 representing the default langsys.
3580 FEATURE is a symbol representing OpenType feature tag.
3582 If the font is not OpenType font, OTF-CAPABILITY is nil. */)
3584 Lisp_Object font_object
;
3589 CHECK_FONT_GET_OBJECT (font_object
, font
);
3591 val
= Fmake_vector (make_number (9), Qnil
);
3592 if (font
->font
.full_name
)
3593 ASET (val
, 0, make_unibyte_string (font
->font
.full_name
,
3594 strlen (font
->font
.full_name
)));
3595 if (font
->file_name
)
3596 ASET (val
, 1, make_unibyte_string (font
->file_name
,
3597 strlen (font
->file_name
)));
3598 ASET (val
, 2, make_number (font
->pixel_size
));
3599 ASET (val
, 3, make_number (font
->font
.size
));
3600 ASET (val
, 4, make_number (font
->ascent
));
3601 ASET (val
, 5, make_number (font
->descent
));
3602 ASET (val
, 6, make_number (font
->font
.space_width
));
3603 ASET (val
, 7, make_number (font
->font
.average_width
));
3604 if (font
->driver
->otf_capability
)
3605 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
3607 ASET (val
, 8, Fcons (font
->format
, Qnil
));
3611 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
3612 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
3613 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
3614 (font_object
, string
)
3615 Lisp_Object font_object
, string
;
3621 CHECK_FONT_GET_OBJECT (font_object
, font
);
3622 CHECK_STRING (string
);
3623 len
= SCHARS (string
);
3624 vec
= Fmake_vector (make_number (len
), Qnil
);
3625 for (i
= 0; i
< len
; i
++)
3627 Lisp_Object ch
= Faref (string
, make_number (i
));
3631 struct font_metrics metrics
;
3633 code
= font
->driver
->encode_char (font
, c
);
3634 if (code
== FONT_INVALID_CODE
)
3636 val
= Fmake_vector (make_number (6), Qnil
);
3637 if (code
<= MOST_POSITIVE_FIXNUM
)
3638 ASET (val
, 0, make_number (code
));
3640 ASET (val
, 0, Fcons (make_number (code
>> 16),
3641 make_number (code
& 0xFFFF)));
3642 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
3643 ASET (val
, 1, make_number (metrics
.lbearing
));
3644 ASET (val
, 2, make_number (metrics
.rbearing
));
3645 ASET (val
, 3, make_number (metrics
.width
));
3646 ASET (val
, 4, make_number (metrics
.ascent
));
3647 ASET (val
, 5, make_number (metrics
.descent
));
3653 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
3654 doc
: /* Return t iff font-spec SPEC matches with FONT.
3655 FONT is a font-spec, font-entity, or font-object. */)
3657 Lisp_Object spec
, font
;
3659 CHECK_FONT_SPEC (spec
);
3660 if (FONT_OBJECT_P (font
))
3661 font
= ((struct font
*) XSAVE_VALUE (font
)->pointer
)->entity
;
3662 else if (! FONT_ENTITY_P (font
))
3663 CHECK_FONT_SPEC (font
);
3665 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
3668 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 2, 0,
3669 doc
: /* Return a font-object for displaying a character at POSISTION.
3670 Optional second arg WINDOW, if non-nil, is a window displaying
3671 the current buffer. It defaults to the currently selected window. */)
3673 Lisp_Object position
, window
;
3676 EMACS_INT pos
, pos_byte
;
3679 CHECK_NUMBER_COERCE_MARKER (position
);
3680 pos
= XINT (position
);
3681 if (pos
< BEGV
|| pos
>= ZV
)
3682 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
3683 pos_byte
= CHAR_TO_BYTE (pos
);
3684 c
= FETCH_CHAR (pos_byte
);
3686 window
= selected_window
;
3687 CHECK_LIVE_WINDOW (window
);
3688 w
= XWINDOW (selected_window
);
3690 return font_at (c
, pos
, NULL
, w
, Qnil
);
3694 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
3695 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
3696 The value is a number of glyphs drawn.
3697 Type C-l to recover what previously shown. */)
3698 (font_object
, string
)
3699 Lisp_Object font_object
, string
;
3701 Lisp_Object frame
= selected_frame
;
3702 FRAME_PTR f
= XFRAME (frame
);
3708 CHECK_FONT_GET_OBJECT (font_object
, font
);
3709 CHECK_STRING (string
);
3710 len
= SCHARS (string
);
3711 code
= alloca (sizeof (unsigned) * len
);
3712 for (i
= 0; i
< len
; i
++)
3714 Lisp_Object ch
= Faref (string
, make_number (i
));
3718 code
[i
] = font
->driver
->encode_char (font
, c
);
3719 if (code
[i
] == FONT_INVALID_CODE
)
3722 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3724 if (font
->driver
->prepare_face
)
3725 font
->driver
->prepare_face (f
, face
);
3726 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
3727 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
3728 if (font
->driver
->done_face
)
3729 font
->driver
->done_face (f
, face
);
3731 return make_number (len
);
3735 #endif /* FONT_DEBUG */
3738 extern void syms_of_ftfont
P_ (());
3739 extern void syms_of_xfont
P_ (());
3740 extern void syms_of_xftfont
P_ (());
3741 extern void syms_of_ftxfont
P_ (());
3742 extern void syms_of_bdffont
P_ (());
3743 extern void syms_of_w32font
P_ (());
3744 extern void syms_of_atmfont
P_ (());
3749 sort_shift_bits
[FONT_SLANT_INDEX
] = 0;
3750 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 7;
3751 sort_shift_bits
[FONT_SIZE_INDEX
] = 14;
3752 sort_shift_bits
[FONT_WIDTH_INDEX
] = 21;
3753 sort_shift_bits
[FONT_ADSTYLE_INDEX
] = 28;
3754 sort_shift_bits
[FONT_FOUNDRY_INDEX
] = 29;
3755 sort_shift_bits
[FONT_FAMILY_INDEX
] = 30;
3756 sort_shift_bits
[FONT_REGISTRY_INDEX
] = 31;
3757 /* Note that sort_shift_bits[FONT_TYPE_INDEX] is never used. */
3759 staticpro (&font_style_table
);
3760 font_style_table
= Fmake_vector (make_number (3), Qnil
);
3762 staticpro (&font_family_alist
);
3763 font_family_alist
= Qnil
;
3765 DEFSYM (Qfontp
, "fontp");
3766 DEFSYM (Qopentype
, "opentype");
3768 DEFSYM (Qiso8859_1
, "iso8859-1");
3769 DEFSYM (Qiso10646_1
, "iso10646-1");
3770 DEFSYM (Qunicode_bmp
, "unicode-bmp");
3771 DEFSYM (Qunicode_sip
, "unicode-sip");
3773 DEFSYM (QCotf
, ":otf");
3774 DEFSYM (QClanguage
, ":language");
3775 DEFSYM (QCscript
, ":script");
3777 DEFSYM (QCfoundry
, ":foundry");
3778 DEFSYM (QCadstyle
, ":adstyle");
3779 DEFSYM (QCregistry
, ":registry");
3780 DEFSYM (QCspacing
, ":spacing");
3781 DEFSYM (QCdpi
, ":dpi");
3782 DEFSYM (QCscalable
, ":scalable");
3783 DEFSYM (QCextra
, ":extra");
3790 staticpro (&null_string
);
3791 null_string
= build_string ("");
3792 staticpro (&null_vector
);
3793 null_vector
= Fmake_vector (make_number (0), Qnil
);
3795 staticpro (&scratch_font_spec
);
3796 scratch_font_spec
= Ffont_spec (0, NULL
);
3797 staticpro (&scratch_font_prefer
);
3798 scratch_font_prefer
= Ffont_spec (0, NULL
);
3801 staticpro (&otf_list
);
3806 defsubr (&Sfont_spec
);
3807 defsubr (&Sfont_get
);
3808 defsubr (&Sfont_put
);
3809 defsubr (&Slist_fonts
);
3810 defsubr (&Slist_families
);
3811 defsubr (&Sfind_font
);
3812 defsubr (&Sfont_xlfd_name
);
3813 defsubr (&Sclear_font_cache
);
3814 defsubr (&Sinternal_set_font_style_table
);
3815 defsubr (&Sfont_make_gstring
);
3816 defsubr (&Sfont_fill_gstring
);
3817 defsubr (&Sfont_drive_otf
);
3818 defsubr (&Sfont_otf_alternates
);
3821 defsubr (&Sopen_font
);
3822 defsubr (&Sclose_font
);
3823 defsubr (&Squery_font
);
3824 defsubr (&Sget_font_glyphs
);
3825 defsubr (&Sfont_match_p
);
3826 defsubr (&Sfont_at
);
3828 defsubr (&Sdraw_string
);
3830 #endif /* FONT_DEBUG */
3832 #ifdef HAVE_FREETYPE
3834 #ifdef HAVE_X_WINDOWS
3839 #endif /* HAVE_XFT */
3840 #endif /* HAVE_X_WINDOWS */
3841 #else /* not HAVE_FREETYPE */
3842 #ifdef HAVE_X_WINDOWS
3844 #endif /* HAVE_X_WINDOWS */
3845 #endif /* not HAVE_FREETYPE */
3848 #endif /* HAVE_BDFFONT */
3851 #endif /* WINDOWSNT */
3857 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
3858 (do not change this comment) */