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). Each 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. Each font-backend (XXXfont.c) calls
114 register_font_driver in syms_of_XXXfont to register its 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
;
235 /* Setup font_family_alist of the form:
236 ((FAMILY-SYMBOL ALIAS-SYMBOL ...) ...)
237 from Vface_alternative_font_family_alist of the form:
238 ((FAMILY-STRING ALIAS-STRING ...) ...) */
241 build_font_family_alist ()
243 Lisp_Object alist
= Vface_alternative_font_family_alist
;
245 for (; CONSP (alist
); alist
= XCDR (alist
))
247 Lisp_Object tail
, elt
;
249 for (tail
= XCAR (alist
), elt
= Qnil
; CONSP (tail
); tail
= XCDR (tail
))
250 elt
= nconc2 (elt
, Fcons (Fintern (XCAR (tail
), Qnil
), Qnil
));
251 font_family_alist
= Fcons (elt
, font_family_alist
);
256 /* Font property value validaters. See the comment of
257 font_property_table for the meaning of the arguments. */
259 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
260 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
261 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
262 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
263 static int get_font_prop_index
P_ ((Lisp_Object
, int));
264 static Lisp_Object font_prop_validate
P_ ((Lisp_Object
));
267 font_prop_validate_symbol (prop
, val
)
268 Lisp_Object prop
, val
;
270 if (EQ (prop
, QCotf
))
271 return (SYMBOLP (val
) ? val
: Qerror
);
273 val
= (SCHARS (val
) == 0 ? null_string
274 : intern_downcase ((char *) SDATA (val
), SBYTES (val
)));
275 else if (SYMBOLP (val
))
277 if (SCHARS (SYMBOL_NAME (val
)) == 0)
286 font_prop_validate_style (prop
, val
)
287 Lisp_Object prop
, val
;
289 if (! INTEGERP (val
))
292 val
= intern_downcase ((char *) SDATA (val
), SBYTES (val
));
297 enum font_property_index prop_index
298 = (EQ (prop
, QCweight
) ? FONT_WEIGHT_INDEX
299 : EQ (prop
, QCslant
) ? FONT_SLANT_INDEX
302 val
= prop_name_to_numeric (prop_index
, val
);
311 font_prop_validate_non_neg (prop
, val
)
312 Lisp_Object prop
, val
;
314 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
319 font_prop_validate_spacing (prop
, val
)
320 Lisp_Object prop
, val
;
322 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
325 return make_number (FONT_SPACING_CHARCELL
);
327 return make_number (FONT_SPACING_MONO
);
329 return make_number (FONT_SPACING_PROPORTIONAL
);
333 /* Structure of known font property keys and validater of the
337 /* Pointer to the key symbol. */
339 /* Function to validate PROP's value VAL, or NULL if any value is
340 ok. The value is VAL or its regularized value if VAL is valid,
341 and Qerror if not. */
342 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
343 } font_property_table
[] =
344 { { &QCtype
, font_prop_validate_symbol
},
345 { &QCfoundry
, font_prop_validate_symbol
},
346 { &QCfamily
, font_prop_validate_symbol
},
347 { &QCadstyle
, font_prop_validate_symbol
},
348 { &QCregistry
, font_prop_validate_symbol
},
349 { &QCweight
, font_prop_validate_style
},
350 { &QCslant
, font_prop_validate_style
},
351 { &QCwidth
, font_prop_validate_style
},
352 { &QCsize
, font_prop_validate_non_neg
},
353 { &QClanguage
, font_prop_validate_symbol
},
354 { &QCscript
, font_prop_validate_symbol
},
355 { &QCdpi
, font_prop_validate_non_neg
},
356 { &QCspacing
, font_prop_validate_spacing
},
357 { &QCscalable
, NULL
},
358 { &QCotf
, font_prop_validate_symbol
}
361 /* Size (number of elements) of the above table. */
362 #define FONT_PROPERTY_TABLE_SIZE \
363 ((sizeof font_property_table) / (sizeof *font_property_table))
365 /* Return an index number of font property KEY or -1 if KEY is not an
366 already known property. Start searching font_property_table from
367 index FROM (which is 0 or FONT_EXTRA_INDEX). */
370 get_font_prop_index (key
, from
)
374 for (; from
< FONT_PROPERTY_TABLE_SIZE
; from
++)
375 if (EQ (key
, *font_property_table
[from
].key
))
380 /* Validate font properties in SPEC (vector) while updating elements
381 to regularized values. Signal an error if an invalid property is
385 font_prop_validate (spec
)
389 Lisp_Object prop
, val
, extra
;
391 for (i
= FONT_TYPE_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
393 if (! NILP (AREF (spec
, i
)))
395 prop
= *font_property_table
[i
].key
;
396 val
= (font_property_table
[i
].validater
) (prop
, AREF (spec
, i
));
397 if (EQ (val
, Qerror
))
398 Fsignal (Qfont
, list2 (build_string ("invalid font property"),
399 Fcons (prop
, AREF (spec
, i
))));
403 for (extra
= AREF (spec
, FONT_EXTRA_INDEX
);
404 CONSP (extra
); extra
= XCDR (extra
))
406 Lisp_Object elt
= XCAR (extra
);
409 i
= get_font_prop_index (prop
, FONT_EXTRA_INDEX
);
411 && font_property_table
[i
].validater
)
413 val
= (font_property_table
[i
].validater
) (prop
, XCDR (elt
));
414 if (EQ (val
, Qerror
))
415 Fsignal (Qfont
, list2 (build_string ("invalid font property"),
423 /* Store VAL as a value of extra font property PROP in FONT. */
426 font_put_extra (font
, prop
, val
)
427 Lisp_Object font
, prop
, val
;
429 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
430 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
434 extra
= Fcons (Fcons (prop
, val
), extra
);
435 ASET (font
, FONT_EXTRA_INDEX
, extra
);
443 /* Font name parser and unparser */
445 static Lisp_Object intern_font_field
P_ ((char *, int));
446 static int parse_matrix
P_ ((char *));
447 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
448 static int font_parse_name
P_ ((char *, Lisp_Object
));
450 /* An enumerator for each field of an XLFD font name. */
451 enum xlfd_field_index
470 /* An enumerator for mask bit corresponding to each XLFD field. */
473 XLFD_FOUNDRY_MASK
= 0x0001,
474 XLFD_FAMILY_MASK
= 0x0002,
475 XLFD_WEIGHT_MASK
= 0x0004,
476 XLFD_SLANT_MASK
= 0x0008,
477 XLFD_SWIDTH_MASK
= 0x0010,
478 XLFD_ADSTYLE_MASK
= 0x0020,
479 XLFD_PIXEL_MASK
= 0x0040,
480 XLFD_POINT_MASK
= 0x0080,
481 XLFD_RESX_MASK
= 0x0100,
482 XLFD_RESY_MASK
= 0x0200,
483 XLFD_SPACING_MASK
= 0x0400,
484 XLFD_AVGWIDTH_MASK
= 0x0800,
485 XLFD_REGISTRY_MASK
= 0x1000,
486 XLFD_ENCODING_MASK
= 0x2000
490 /* Return a Lispy value of a XLFD font field at STR and LEN bytes.
491 If LEN is zero, it returns `null_string'.
492 If STR is "*", it returns nil.
493 If all characters in STR are digits, it returns an integer.
494 Otherwise, it returns a symbol interned from downcased STR. */
497 intern_font_field (str
, len
)
505 if (*str
== '*' && len
== 1)
509 for (i
= 1; i
< len
; i
++)
510 if (! isdigit (str
[i
]))
513 return make_number (atoi (str
));
515 return intern_downcase (str
, len
);
518 /* Parse P pointing the pixel/point size field of the form
519 `[A B C D]' which specifies a transformation matrix:
525 by which all glyphs of the font are transformed. The spec says
526 that scalar value N for the pixel/point size is equivalent to:
527 A = N * resx/resy, B = C = 0, D = N.
529 Return the scalar value N if the form is valid. Otherwise return
540 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
543 matrix
[i
] = - strtod (p
+ 1, &end
);
545 matrix
[i
] = strtod (p
, &end
);
548 return (i
== 4 ? (int) matrix
[3] : -1);
551 /* Expand a wildcard field in FIELD (the first N fields are filled) to
552 multiple fields to fill in all 14 XLFD fields while restring a
553 field position by its contents. */
556 font_expand_wildcards (field
, n
)
557 Lisp_Object field
[XLFD_LAST_INDEX
];
561 Lisp_Object tmp
[XLFD_LAST_INDEX
];
562 /* Array of information about where this element can go. Nth
563 element is for Nth element of FIELD. */
565 /* Minimum possible field. */
567 /* Maxinum possible field. */
569 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
571 } range
[XLFD_LAST_INDEX
];
573 int range_from
, range_to
;
576 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
577 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
578 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
579 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
580 | XLFD_AVGWIDTH_MASK)
581 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
583 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
584 field. The value is shifted to left one bit by one in the
586 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
587 range_mask
= (range_mask
<< 1) | 1;
589 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
590 position-based retriction for FIELD[I]. */
591 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
592 i
++, range_from
++, range_to
++, range_mask
<<= 1)
594 Lisp_Object val
= field
[i
];
600 range
[i
].from
= range_from
;
601 range
[i
].to
= range_to
;
602 range
[i
].mask
= range_mask
;
606 /* The triplet FROM, TO, and MASK is a value-based
607 retriction for FIELD[I]. */
613 int numeric
= XINT (val
);
616 from
= to
= XLFD_ENCODING_INDEX
,
617 mask
= XLFD_ENCODING_MASK
;
618 else if (numeric
== 0)
619 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
620 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
621 else if (numeric
<= 48)
622 from
= to
= XLFD_PIXEL_INDEX
,
623 mask
= XLFD_PIXEL_MASK
;
625 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
626 mask
= XLFD_LARGENUM_MASK
;
628 else if (EQ (val
, null_string
))
629 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
630 mask
= XLFD_NULL_MASK
;
632 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
635 Lisp_Object name
= SYMBOL_NAME (val
);
637 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
638 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
639 mask
= XLFD_REGENC_MASK
;
641 from
= to
= XLFD_ENCODING_INDEX
,
642 mask
= XLFD_ENCODING_MASK
;
644 else if (range_from
<= XLFD_WEIGHT_INDEX
645 && range_to
>= XLFD_WEIGHT_INDEX
646 && !NILP (prop_name_to_numeric (FONT_WEIGHT_INDEX
, val
)))
647 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
648 else if (range_from
<= XLFD_SLANT_INDEX
649 && range_to
>= XLFD_SLANT_INDEX
650 && !NILP (prop_name_to_numeric (FONT_SLANT_INDEX
, val
)))
651 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
652 else if (range_from
<= XLFD_SWIDTH_INDEX
653 && range_to
>= XLFD_SWIDTH_INDEX
654 && !NILP (prop_name_to_numeric (FONT_WIDTH_INDEX
, val
)))
655 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
658 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
659 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
661 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
662 mask
= XLFD_SYMBOL_MASK
;
665 /* Merge position-based and value-based restrictions. */
667 while (from
< range_from
)
668 mask
&= ~(1 << from
++);
669 while (from
< 14 && ! (mask
& (1 << from
)))
671 while (to
> range_to
)
672 mask
&= ~(1 << to
--);
673 while (to
>= 0 && ! (mask
& (1 << to
)))
677 range
[i
].from
= from
;
679 range
[i
].mask
= mask
;
681 if (from
> range_from
|| to
< range_to
)
683 /* The range is narrowed by value-based restrictions.
684 Reflect it to the other fields. */
686 /* Following fields should be after FROM. */
688 /* Preceding fields should be before TO. */
689 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
691 /* Check FROM for non-wildcard field. */
692 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
694 while (range
[j
].from
< from
)
695 range
[j
].mask
&= ~(1 << range
[j
].from
++);
696 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
698 range
[j
].from
= from
;
701 from
= range
[j
].from
;
702 if (range
[j
].to
> to
)
704 while (range
[j
].to
> to
)
705 range
[j
].mask
&= ~(1 << range
[j
].to
--);
706 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
719 /* Decide all fileds from restrictions in RANGE. */
720 for (i
= j
= 0; i
< n
; i
++)
722 if (j
< range
[i
].from
)
724 if (i
== 0 || ! NILP (tmp
[i
- 1]))
725 /* None of TMP[X] corresponds to Jth field. */
727 for (; j
< range
[i
].from
; j
++)
732 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
734 for (; j
< XLFD_LAST_INDEX
; j
++)
736 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
737 field
[XLFD_ENCODING_INDEX
]
738 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
742 /* Parse NAME (null terminated) as XLFD and store information in FONT
743 (font-spec or font-entity). Size property of FONT is set as
745 specified XLFD fields FONT property
746 --------------------- -------------
747 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
748 POINT_SIZE and RESY calculated pixel size (Lisp integer)
749 POINT_SIZE POINT_SIZE/10 (Lisp float)
751 If NAME is successfully parsed, return 0. Otherwise return -1.
753 FONT is usually a font-spec, but when this function is called from
754 X font backend driver, it is a font-entity. In that case, NAME is
755 a fully specified XLFD, and we set FONT_EXTRA_INDEX of FONT to a
756 symbol RESX-RESY-SPACING-AVGWIDTH.
760 font_parse_xlfd (name
, font
)
764 int len
= strlen (name
);
766 Lisp_Object dpi
, spacing
;
768 char *f
[XLFD_LAST_INDEX
+ 1];
773 /* Maximum XLFD name length is 255. */
775 /* Accept "*-.." as a fully specified XLFD. */
776 if (name
[0] == '*' && name
[1] == '-')
777 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
780 for (p
= name
+ i
; *p
; p
++)
781 if (*p
== '-' && i
< XLFD_LAST_INDEX
)
785 dpi
= spacing
= Qnil
;
788 if (i
== XLFD_LAST_INDEX
)
792 /* Fully specified XLFD. */
793 for (i
= 0, j
= FONT_FOUNDRY_INDEX
; i
< XLFD_WEIGHT_INDEX
; i
++, j
++)
795 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
799 for (j
= FONT_WEIGHT_INDEX
; i
< XLFD_ADSTYLE_INDEX
; i
++, j
++)
801 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
804 Lisp_Object numeric
= prop_name_to_numeric (j
, val
);
806 if (INTEGERP (numeric
))
811 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
813 ASET (font
, FONT_ADSTYLE_INDEX
, val
);
814 i
= XLFD_REGISTRY_INDEX
;
815 val
= intern_font_field (f
[i
], f
[i
+ 2] - f
[i
]);
817 ASET (font
, FONT_REGISTRY_INDEX
, val
);
819 p
= f
[XLFD_PIXEL_INDEX
];
820 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
821 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
824 i
= XLFD_PIXEL_INDEX
;
825 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
827 ASET (font
, FONT_SIZE_INDEX
, val
);
830 double point_size
= -1;
832 xassert (FONT_SPEC_P (font
));
833 p
= f
[XLFD_POINT_INDEX
];
835 point_size
= parse_matrix (p
);
836 else if (isdigit (*p
))
837 point_size
= atoi (p
), point_size
/= 10;
839 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
842 i
= XLFD_PIXEL_INDEX
;
843 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
845 ASET (font
, FONT_SIZE_INDEX
, val
);
850 /* Parse RESX, RESY, SPACING, and AVGWIDTH. */
851 if (FONT_ENTITY_P (font
))
854 ASET (font
, FONT_EXTRA_INDEX
,
855 intern_font_field (f
[i
], f
[XLFD_REGISTRY_INDEX
] - 1 - f
[i
]));
859 /* Here we just setup DPI, SPACING, and AVGWIDTH. They are set
860 in FONT_EXTRA_INDEX later. */
862 dpi
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
863 i
= XLFD_SPACING_INDEX
;
864 spacing
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
865 p
= f
[XLFD_AVGWIDTH_INDEX
];
873 int wild_card_found
= 0;
874 Lisp_Object prop
[XLFD_LAST_INDEX
];
876 for (j
= 0; j
< i
; j
++)
880 if (f
[j
][1] && f
[j
][1] != '-')
885 else if (isdigit (*f
[j
]))
887 for (p
= f
[j
] + 1; isdigit (*p
); p
++);
889 prop
[j
] = intern_downcase (f
[j
], p
- f
[j
]);
891 prop
[j
] = make_number (atoi (f
[j
]));
894 prop
[j
] = intern_font_field (f
[j
], f
[j
+ 1] - 1 - f
[j
]);
896 prop
[j
] = intern_font_field (f
[j
], f
[i
] - f
[j
]);
898 if (! wild_card_found
)
900 if (font_expand_wildcards (prop
, i
) < 0)
903 for (i
= 0, j
= FONT_FOUNDRY_INDEX
; i
< XLFD_WEIGHT_INDEX
; i
++, j
++)
904 if (! NILP (prop
[i
]))
905 ASET (font
, j
, prop
[i
]);
906 for (j
= FONT_WEIGHT_INDEX
; i
< XLFD_ADSTYLE_INDEX
; i
++, j
++)
907 if (! NILP (prop
[i
]))
908 ASET (font
, j
, prop
[i
]);
909 if (! NILP (prop
[XLFD_ADSTYLE_INDEX
]))
910 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
911 val
= prop
[XLFD_REGISTRY_INDEX
];
914 val
= prop
[XLFD_ENCODING_INDEX
];
916 val
= Fintern (concat2 (build_string ("*-"), SYMBOL_NAME (val
)),
919 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
920 val
= Fintern (concat2 (SYMBOL_NAME (val
), build_string ("-*")),
923 val
= Fintern (concat3 (SYMBOL_NAME (val
), build_string ("-"),
924 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
])),
927 ASET (font
, FONT_REGISTRY_INDEX
, val
);
929 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
930 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
931 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
933 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
935 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
938 dpi
= prop
[XLFD_RESX_INDEX
];
939 spacing
= prop
[XLFD_SPACING_INDEX
];
940 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
941 avgwidth
= XINT (prop
[XLFD_AVGWIDTH_INDEX
]);
945 font_put_extra (font
, QCdpi
, dpi
);
946 if (! NILP (spacing
))
947 font_put_extra (font
, QCspacing
, spacing
);
949 font_put_extra (font
, QCscalable
, avgwidth
== 0 ? Qt
: Qnil
);
954 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
955 length), and return the name length. If FONT_SIZE_INDEX of FONT is
956 0, use PIXEL_SIZE instead. */
959 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
965 char *f
[XLFD_REGISTRY_INDEX
+ 1];
969 xassert (FONTP (font
));
971 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
974 if (i
== FONT_ADSTYLE_INDEX
)
975 j
= XLFD_ADSTYLE_INDEX
;
976 else if (i
== FONT_REGISTRY_INDEX
)
977 j
= XLFD_REGISTRY_INDEX
;
978 val
= AREF (font
, i
);
981 if (j
== XLFD_REGISTRY_INDEX
)
982 f
[j
] = "*-*", len
+= 4;
984 f
[j
] = "*", len
+= 2;
989 val
= SYMBOL_NAME (val
);
990 if (j
== XLFD_REGISTRY_INDEX
991 && ! strchr ((char *) SDATA (val
), '-'))
993 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
994 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
996 f
[j
] = alloca (SBYTES (val
) + 3);
997 sprintf (f
[j
], "%s-*", SDATA (val
));
998 len
+= SBYTES (val
) + 3;
1002 f
[j
] = alloca (SBYTES (val
) + 4);
1003 sprintf (f
[j
], "%s*-*", SDATA (val
));
1004 len
+= SBYTES (val
) + 4;
1008 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1012 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1015 val
= AREF (font
, i
);
1017 f
[j
] = "*", len
+= 2;
1021 val
= prop_numeric_to_name (i
, XINT (val
));
1023 val
= SYMBOL_NAME (val
);
1024 xassert (STRINGP (val
));
1025 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1029 val
= AREF (font
, FONT_SIZE_INDEX
);
1030 xassert (NUMBERP (val
) || NILP (val
));
1033 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1036 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1038 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", pixel_size
) + 1;
1040 else if (FLOATP (val
))
1042 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1043 i
= XFLOAT_DATA (val
) * 10;
1044 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1047 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1049 val
= AREF (font
, FONT_EXTRA_INDEX
);
1051 if (FONT_ENTITY_P (font
)
1052 && EQ (AREF (font
, FONT_TYPE_INDEX
), Qx
))
1054 /* Setup names for RESX-RESY-SPACING-AVWIDTH. */
1055 if (SYMBOLP (val
) && ! NILP (val
))
1057 val
= SYMBOL_NAME (val
);
1058 f
[XLFD_RESX_INDEX
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1061 f
[XLFD_RESX_INDEX
] = "*-*-*-*", len
+= 6;
1065 Lisp_Object dpi
= assq_no_quit (QCdpi
, val
);
1066 Lisp_Object spacing
= assq_no_quit (QCspacing
, val
);
1067 Lisp_Object scalable
= assq_no_quit (QCscalable
, val
);
1069 if (CONSP (dpi
) || CONSP (spacing
) || CONSP (scalable
))
1071 char *str
= alloca (24);
1074 if (CONSP (dpi
) && INTEGERP (XCDR (dpi
)))
1075 this_len
= sprintf (str
, "%d-%d",
1076 XINT (XCDR (dpi
)), XINT (XCDR (dpi
)));
1078 this_len
= sprintf (str
, "*-*");
1079 if (CONSP (spacing
) && ! NILP (XCDR (spacing
)))
1081 val
= XCDR (spacing
);
1084 if (XINT (val
) < FONT_SPACING_MONO
)
1086 else if (XINT (val
) < FONT_SPACING_CHARCELL
)
1091 xassert (SYMBOLP (val
));
1092 this_len
+= sprintf (str
+ this_len
, "-%c",
1093 SDATA (SYMBOL_NAME (val
))[0]);
1096 this_len
+= sprintf (str
+ this_len
, "-*");
1097 if (CONSP (scalable
) && ! NILP (XCDR (spacing
)))
1098 this_len
+= sprintf (str
+ this_len
, "-0");
1100 this_len
+= sprintf (str
+ this_len
, "-*");
1101 f
[XLFD_RESX_INDEX
] = str
;
1105 f
[XLFD_RESX_INDEX
] = "*-*-*-*", len
+= 8;
1108 len
++; /* for terminating '\0'. */
1111 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1112 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1113 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1114 f
[XLFD_SWIDTH_INDEX
],
1115 f
[XLFD_ADSTYLE_INDEX
], f
[XLFD_PIXEL_INDEX
],
1116 f
[XLFD_RESX_INDEX
], f
[XLFD_REGISTRY_INDEX
]);
1119 /* Parse NAME (null terminated) as Fonconfig's name format and store
1120 information in FONT (font-spec or font-entity). If NAME is
1121 successfully parsed, return 0. Otherwise return -1. */
1124 font_parse_fcname (name
, font
)
1129 int len
= strlen (name
);
1134 /* It is assured that (name[0] && name[0] != '-'). */
1142 for (p0
= name
+ 1; *p0
&& (*p0
!= '-' && *p0
!= ':'); p0
++)
1143 if (*p0
== '\\' && p0
[1])
1145 family
= intern_font_field (name
, p0
- name
);
1148 if (! isdigit (p0
[1]))
1150 point_size
= strtod (p0
+ 1, &p1
);
1151 if (*p1
&& *p1
!= ':')
1153 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1156 ASET (font
, FONT_FAMILY_INDEX
, family
);
1160 copy
= alloca (len
+ 1);
1165 /* Now parse ":KEY=VAL" patterns. Store known keys and values in
1166 extra, copy unknown ones to COPY. */
1169 Lisp_Object key
, val
;
1172 for (p1
= p0
+ 1; *p1
&& *p1
!= '=' && *p1
!= ':'; p1
++);
1175 /* Must be an enumerated value. */
1176 val
= intern_font_field (p0
+ 1, p1
- p0
- 1);
1177 if (memcmp (p0
+ 1, "light", 5) == 0
1178 || memcmp (p0
+ 1, "medium", 6) == 0
1179 || memcmp (p0
+ 1, "demibold", 8) == 0
1180 || memcmp (p0
+ 1, "bold", 4) == 0
1181 || memcmp (p0
+ 1, "black", 5) == 0)
1183 ASET (font
, FONT_WEIGHT_INDEX
, val
);
1185 else if (memcmp (p0
+ 1, "roman", 5) == 0
1186 || memcmp (p0
+ 1, "italic", 6) == 0
1187 || memcmp (p0
+ 1, "oblique", 7) == 0)
1189 ASET (font
, FONT_SLANT_INDEX
, val
);
1191 else if (memcmp (p0
+ 1, "charcell", 8) == 0
1192 || memcmp (p0
+ 1, "mono", 4) == 0
1193 || memcmp (p0
+ 1, "proportional", 12) == 0)
1195 font_put_extra (font
, QCspacing
,
1196 (p0
[1] == 'c' ? Qc
: p0
[1] == 'm' ? Qm
: Qp
));
1201 bcopy (p0
, copy
, p1
- p0
);
1207 if (memcmp (p0
+ 1, "pixelsize=", 10) == 0)
1208 prop
= FONT_SIZE_INDEX
;
1211 key
= intern_font_field (p0
, p1
- p0
);
1212 prop
= get_font_prop_index (key
, 0);
1215 for (p1
= p0
; *p1
&& *p1
!= ':'; p1
++);
1216 val
= intern_font_field (p0
, p1
- p0
);
1219 if (prop
>= 0 && prop
< FONT_EXTRA_INDEX
)
1221 ASET (font
, prop
, val
);
1224 font_put_extra (font
, key
, val
);
1233 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1234 NAME (NBYTES length), and return the name length. If
1235 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1238 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1246 int dpi
, spacing
, scalable
;
1249 Lisp_Object styles
[3];
1250 char *style_names
[3] = { "weight", "slant", "width" };
1252 val
= AREF (font
, FONT_FAMILY_INDEX
);
1253 if (SYMBOLP (val
) && ! NILP (val
))
1254 len
+= SBYTES (SYMBOL_NAME (val
));
1256 val
= AREF (font
, FONT_SIZE_INDEX
);
1259 if (XINT (val
) != 0)
1260 pixel_size
= XINT (val
);
1262 len
+= 21; /* for ":pixelsize=NUM" */
1264 else if (FLOATP (val
))
1267 point_size
= (int) XFLOAT_DATA (val
);
1268 len
+= 11; /* for "-NUM" */
1271 val
= AREF (font
, FONT_FOUNDRY_INDEX
);
1272 if (SYMBOLP (val
) && ! NILP (val
))
1273 /* ":foundry=NAME" */
1274 len
+= 9 + SBYTES (SYMBOL_NAME (val
));
1276 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
1278 val
= AREF (font
, i
);
1281 val
= prop_numeric_to_name (i
, XINT (val
));
1282 len
+= (strlen (style_names
[i
- FONT_WEIGHT_INDEX
])
1283 + 2 + SBYTES (SYMBOL_NAME (val
))); /* :xxx=NAME */
1285 styles
[i
- FONT_WEIGHT_INDEX
] = val
;
1288 val
= AREF (font
, FONT_EXTRA_INDEX
);
1289 if (FONT_ENTITY_P (font
)
1290 && EQ (AREF (font
, FONT_TYPE_INDEX
), Qx
))
1294 /* VAL is a symbol of name `RESX-RESY-SPACING-AVWIDTH'. */
1295 p
= (char *) SDATA (SYMBOL_NAME (val
));
1297 for (p
++; *p
!= '-'; p
++); /* skip RESX */
1298 for (p
++; *p
!= '-'; p
++); /* skip RESY */
1299 spacing
= (*p
== 'c' ? FONT_SPACING_CHARCELL
1300 : *p
== 'm' ? FONT_SPACING_MONO
1301 : FONT_SPACING_PROPORTIONAL
);
1302 for (p
++; *p
!= '-'; p
++); /* skip SPACING */
1303 scalable
= (atoi (p
) == 0);
1304 /* The longest pattern is ":dpi=NUM:scalable=False:spacing=100" */
1311 dpi
= spacing
= scalable
= -1;
1312 elt
= assq_no_quit (QCdpi
, val
);
1314 dpi
= XINT (XCDR (elt
)), len
+= 15; /* for ":dpi=NUM" */
1315 elt
= assq_no_quit (QCspacing
, val
);
1317 spacing
= XINT (XCDR (elt
)), len
+= 12; /* for ":spacing=100" */
1318 elt
= assq_no_quit (QCscalable
, val
);
1320 scalable
= ! NILP (XCDR (elt
)), len
+= 15; /* for ":scalable=False" */
1326 if (! NILP (AREF (font
, FONT_FAMILY_INDEX
)))
1327 p
+= sprintf(p
, "%s",
1328 SDATA (SYMBOL_NAME (AREF (font
, FONT_FAMILY_INDEX
))));
1332 p
+= sprintf (p
, "%d", point_size
);
1334 p
+= sprintf (p
, "-%d", point_size
);
1336 else if (pixel_size
> 0)
1337 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1338 if (SYMBOLP (AREF (font
, FONT_FOUNDRY_INDEX
))
1339 && ! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1340 p
+= sprintf (p
, ":foundry=%s",
1341 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1342 for (i
= 0; i
< 3; i
++)
1343 if (SYMBOLP (styles
[i
]) && ! NILP (styles
[i
]))
1344 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1345 SDATA (SYMBOL_NAME (styles
[i
])));
1347 p
+= sprintf (p
, ":dpi=%d", dpi
);
1349 p
+= sprintf (p
, ":spacing=%d", spacing
);
1351 p
+= sprintf (p
, ":scalable=True");
1352 else if (scalable
== 0)
1353 p
+= sprintf (p
, ":scalable=False");
1357 /* Parse NAME (null terminated) and store information in FONT
1358 (font-spec or font-entity). If NAME is successfully parsed, return
1359 0. Otherwise return -1.
1361 If NAME is XLFD and FONT is a font-entity, store
1362 RESX-RESY-SPACING-AVWIDTH information as a symbol in
1363 FONT_EXTRA_INDEX. */
1366 font_parse_name (name
, font
)
1370 if (name
[0] == '-' || index (name
, '*'))
1371 return font_parse_xlfd (name
, font
);
1372 return font_parse_fcname (name
, font
);
1375 /* Merge old style font specification (either a font name NAME or a
1376 combination of a family name FAMILY and a registry name REGISTRY
1377 into the font specification SPEC. */
1380 font_merge_old_spec (name
, family
, registry
, spec
)
1381 Lisp_Object name
, family
, registry
, spec
;
1385 if (font_parse_xlfd ((char *) SDATA (name
), spec
) < 0)
1387 Lisp_Object extra
= Fcons (Fcons (QCname
, name
), Qnil
);
1389 ASET (spec
, FONT_EXTRA_INDEX
, extra
);
1394 if (! NILP (family
))
1399 xassert (STRINGP (family
));
1400 len
= SBYTES (family
);
1401 p0
= (char *) SDATA (family
);
1402 p1
= index (p0
, '-');
1405 if ((*p0
!= '*' || p1
- p0
> 1)
1406 && NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
1407 ASET (spec
, FONT_FOUNDRY_INDEX
,
1408 intern_downcase (p0
, p1
- p0
));
1409 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
1410 ASET (spec
, FONT_FAMILY_INDEX
,
1411 intern_downcase (p1
+ 1, len
- (p1
+ 1 - p0
)));
1413 else if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
1414 ASET (spec
, FONT_FAMILY_INDEX
, intern_downcase (p0
, len
));
1416 if (! NILP (registry
)
1417 && NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
1418 ASET (spec
, FONT_REGISTRY_INDEX
,
1419 intern_downcase ((char *) SDATA (registry
), SBYTES (registry
)));
1424 /* This part (through the next ^L) is still experimental and never
1425 tested. We may drastically change codes. */
1429 #define LGSTRING_HEADER_SIZE 6
1430 #define LGSTRING_GLYPH_SIZE 8
1433 check_gstring (gstring
)
1434 Lisp_Object gstring
;
1439 CHECK_VECTOR (gstring
);
1440 val
= AREF (gstring
, 0);
1442 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1444 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1445 if (! NILP (LGSTRING_LBEARING (gstring
)))
1446 CHECK_NUMBER (LGSTRING_LBEARING (gstring
));
1447 if (! NILP (LGSTRING_RBEARING (gstring
)))
1448 CHECK_NUMBER (LGSTRING_RBEARING (gstring
));
1449 if (! NILP (LGSTRING_WIDTH (gstring
)))
1450 CHECK_NATNUM (LGSTRING_WIDTH (gstring
));
1451 if (! NILP (LGSTRING_ASCENT (gstring
)))
1452 CHECK_NUMBER (LGSTRING_ASCENT (gstring
));
1453 if (! NILP (LGSTRING_DESCENT (gstring
)))
1454 CHECK_NUMBER (LGSTRING_DESCENT(gstring
));
1456 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1458 val
= LGSTRING_GLYPH (gstring
, i
);
1460 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1462 if (NILP (LGLYPH_CHAR (val
)))
1464 CHECK_NATNUM (LGLYPH_FROM (val
));
1465 CHECK_NATNUM (LGLYPH_TO (val
));
1466 CHECK_CHARACTER (LGLYPH_CHAR (val
));
1467 if (! NILP (LGLYPH_CODE (val
)))
1468 CHECK_NATNUM (LGLYPH_CODE (val
));
1469 if (! NILP (LGLYPH_WIDTH (val
)))
1470 CHECK_NATNUM (LGLYPH_WIDTH (val
));
1471 if (! NILP (LGLYPH_ADJUSTMENT (val
)))
1473 val
= LGLYPH_ADJUSTMENT (val
);
1475 if (ASIZE (val
) < 3)
1477 for (j
= 0; j
< 3; j
++)
1478 CHECK_NUMBER (AREF (val
, j
));
1483 error ("Invalid glyph-string format");
1488 check_otf_features (otf_features
)
1489 Lisp_Object otf_features
;
1491 Lisp_Object val
, elt
;
1493 CHECK_CONS (otf_features
);
1494 CHECK_SYMBOL (XCAR (otf_features
));
1495 otf_features
= XCDR (otf_features
);
1496 CHECK_CONS (otf_features
);
1497 CHECK_SYMBOL (XCAR (otf_features
));
1498 otf_features
= XCDR (otf_features
);
1499 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1501 CHECK_SYMBOL (Fcar (val
));
1502 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1503 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1505 otf_features
= XCDR (otf_features
);
1506 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1508 CHECK_SYMBOL (Fcar (val
));
1509 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1510 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1517 Lisp_Object otf_list
;
1520 otf_tag_symbol (tag
)
1525 OTF_tag_name (tag
, name
);
1526 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1530 otf_open (entity
, file
)
1534 Lisp_Object val
= Fassoc (entity
, otf_list
);
1538 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1541 otf
= file
? OTF_open (file
) : NULL
;
1542 val
= make_save_value (otf
, 0);
1543 otf_list
= Fcons (Fcons (entity
, val
), otf_list
);
1549 /* Return a list describing which scripts/languages FONT supports by
1550 which GSUB/GPOS features of OpenType tables. See the comment of
1551 (sturct font_driver).otf_capability. */
1554 font_otf_capability (font
)
1558 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1561 otf
= otf_open (font
->entity
, font
->file_name
);
1564 for (i
= 0; i
< 2; i
++)
1566 OTF_GSUB_GPOS
*gsub_gpos
;
1567 Lisp_Object script_list
= Qnil
;
1570 if (OTF_get_features (otf
, i
== 0) < 0)
1572 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1573 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1575 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1576 Lisp_Object langsys_list
= Qnil
;
1577 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1580 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1582 OTF_LangSys
*langsys
;
1583 Lisp_Object feature_list
= Qnil
;
1584 Lisp_Object langsys_tag
;
1587 if (k
== script
->LangSysCount
)
1589 langsys
= &script
->DefaultLangSys
;
1594 langsys
= script
->LangSys
+ k
;
1596 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1598 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1600 OTF_Feature
*feature
1601 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1602 Lisp_Object feature_tag
1603 = otf_tag_symbol (feature
->FeatureTag
);
1605 feature_list
= Fcons (feature_tag
, feature_list
);
1607 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1610 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1615 XSETCAR (capability
, script_list
);
1617 XSETCDR (capability
, script_list
);
1623 /* Parse OTF features in SPEC and write a proper features spec string
1624 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1625 assured that the sufficient memory has already allocated for
1629 generate_otf_features (spec
, features
)
1639 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1645 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1650 else if (! asterisk
)
1652 val
= SYMBOL_NAME (val
);
1653 p
+= sprintf (p
, "%s", SDATA (val
));
1657 val
= SYMBOL_NAME (val
);
1658 p
+= sprintf (p
, "~%s", SDATA (val
));
1662 error ("OTF spec too long");
1665 #define DEVICE_DELTA(table, size) \
1666 (((size) >= (table).StartSize && (size) <= (table).EndSize) \
1667 ? (table).DeltaValue[(size) - (table).StartSize] \
1671 adjust_anchor (struct font
*font
, OTF_Anchor
*anchor
,
1672 unsigned code
, int size
, int *x
, int *y
)
1674 if (anchor
->AnchorFormat
== 2 && font
->driver
->anchor_point
)
1678 if (font
->driver
->anchor_point (font
, code
, anchor
->f
.f1
.AnchorPoint
,
1682 else if (anchor
->AnchorFormat
== 3)
1684 if (anchor
->f
.f2
.XDeviceTable
.offset
)
1685 *x
+= DEVICE_DELTA (anchor
->f
.f2
.XDeviceTable
, size
);
1686 if (anchor
->f
.f2
.YDeviceTable
.offset
)
1687 *y
+= DEVICE_DELTA (anchor
->f
.f2
.YDeviceTable
, size
);
1692 font_otf_DeviceTable (device_table
)
1693 OTF_DeviceTable
*device_table
;
1695 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1697 return Fcons (make_number (len
),
1698 make_unibyte_string (device_table
->DeltaValue
, len
));
1702 font_otf_ValueRecord (value_format
, value_record
)
1704 OTF_ValueRecord
*value_record
;
1706 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1708 if (value_format
& OTF_XPlacement
)
1709 ASET (val
, 0, value_record
->XPlacement
);
1710 if (value_format
& OTF_YPlacement
)
1711 ASET (val
, 1, value_record
->YPlacement
);
1712 if (value_format
& OTF_XAdvance
)
1713 ASET (val
, 2, value_record
->XAdvance
);
1714 if (value_format
& OTF_YAdvance
)
1715 ASET (val
, 3, value_record
->YAdvance
);
1716 if (value_format
& OTF_XPlaDevice
)
1717 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1718 if (value_format
& OTF_YPlaDevice
)
1719 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1720 if (value_format
& OTF_XAdvDevice
)
1721 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
1722 if (value_format
& OTF_YAdvDevice
)
1723 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
1728 font_otf_Anchor (anchor
)
1733 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
1734 ASET (val
, 0, make_number (anchor
->XCoordinate
));
1735 ASET (val
, 1, make_number (anchor
->YCoordinate
));
1736 if (anchor
->AnchorFormat
== 2)
1737 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
1740 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
1741 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
1746 #define REPLACEMENT_CHARACTER 0xFFFD
1748 /* Drive FONT's OpenType FEATURES. See the comment of (sturct
1749 font_driver).drive_otf. */
1752 font_drive_otf (font
, otf_features
, gstring_in
, from
, to
, gstring_out
, idx
,
1755 Lisp_Object otf_features
;
1756 Lisp_Object gstring_in
;
1758 Lisp_Object gstring_out
;
1759 int idx
, alternate_subst
;
1765 OTF_GlyphString otf_gstring
;
1767 char *script
, *langsys
= NULL
, *gsub_features
= NULL
, *gpos_features
= NULL
;
1770 val
= XCAR (otf_features
);
1771 script
= SDATA (SYMBOL_NAME (val
));
1772 otf_features
= XCDR (otf_features
);
1773 val
= XCAR (otf_features
);
1774 langsys
= NILP (val
) ? NULL
: SDATA (SYMBOL_NAME (val
));
1775 otf_features
= XCDR (otf_features
);
1776 val
= XCAR (otf_features
);
1779 gsub_features
= alloca (XINT (Flength (val
)) * 6);
1780 generate_otf_features (val
, &script
, &langsys
, gsub_features
);
1782 otf_features
= XCDR (otf_features
);
1783 val
= XCAR (otf_features
);
1786 gpos_features
= alloca (XINT (Flength (val
)) * 6);
1787 generate_otf_features (val
, &script
, &langsys
, gpos_features
);
1790 otf
= otf_open (font
->entity
, font
->file_name
);
1793 if (OTF_get_table (otf
, "head") < 0)
1795 if (OTF_get_table (otf
, "cmap") < 0)
1797 if ((! gsub_features
|| OTF_check_table (otf
, "GSUB") < 0)
1798 && (! gpos_features
|| OTF_check_table (otf
, "GPOS") < 0))
1802 otf_gstring
.size
= otf_gstring
.used
= len
;
1803 otf_gstring
.glyphs
= (OTF_Glyph
*) malloc (sizeof (OTF_Glyph
) * len
);
1804 memset (otf_gstring
.glyphs
, 0, sizeof (OTF_Glyph
) * len
);
1805 for (i
= 0, need_cmap
= 0; i
< len
; i
++)
1807 Lisp_Object g
= LGSTRING_GLYPH (gstring_in
, from
+ i
);
1809 otf_gstring
.glyphs
[i
].c
= XINT (LGLYPH_CHAR (g
));
1810 if (otf_gstring
.glyphs
[i
].c
== REPLACEMENT_CHARACTER
)
1811 otf_gstring
.glyphs
[i
].c
= 0;
1812 if (NILP (LGLYPH_CODE (g
)))
1814 otf_gstring
.glyphs
[i
].glyph_id
= 0;
1818 otf_gstring
.glyphs
[i
].glyph_id
= XINT (LGLYPH_CODE (g
));
1821 OTF_drive_cmap (otf
, &otf_gstring
);
1822 OTF_drive_gdef (otf
, &otf_gstring
);
1826 if ((alternate_subst
1827 ? OTF_drive_gsub_alternate (otf
, &otf_gstring
, script
, langsys
,
1829 : OTF_drive_gsub (otf
, &otf_gstring
, script
, langsys
,
1830 gsub_features
)) < 0)
1832 free (otf_gstring
.glyphs
);
1835 if (ASIZE (gstring_out
) < idx
+ otf_gstring
.used
)
1837 free (otf_gstring
.glyphs
);
1840 for (i
= 0, g
= otf_gstring
.glyphs
; i
< otf_gstring
.used
;)
1842 int i0
= g
->f
.index
.from
, i1
= g
->f
.index
.to
;
1843 Lisp_Object glyph
= LGSTRING_GLYPH (gstring_in
, from
+ i0
);
1844 Lisp_Object min_idx
= AREF (glyph
, 0);
1845 Lisp_Object max_idx
= AREF (glyph
, 1);
1849 int min_idx_i
= XINT (min_idx
), max_idx_i
= XINT (max_idx
);
1851 for (i0
++; i0
<= i1
; i0
++)
1853 glyph
= LGSTRING_GLYPH (gstring_in
, from
+ i0
);
1854 if (min_idx_i
> XINT (AREF (glyph
, 0)))
1855 min_idx_i
= XINT (AREF (glyph
, 0));
1856 if (max_idx_i
< XINT (AREF (glyph
, 1)))
1857 max_idx_i
= XINT (AREF (glyph
, 1));
1859 min_idx
= make_number (min_idx_i
);
1860 max_idx
= make_number (max_idx_i
);
1861 i0
= g
->f
.index
.from
;
1863 for (; i
< otf_gstring
.used
&& g
->f
.index
.from
== i0
; i
++, g
++)
1865 glyph
= LGSTRING_GLYPH (gstring_out
, idx
+ i
);
1866 ASET (glyph
, 0, min_idx
);
1867 ASET (glyph
, 1, max_idx
);
1869 LGLYPH_SET_CHAR (glyph
, make_number (g
->c
));
1871 LGLYPH_SET_CHAR (glyph
, make_number (REPLACEMENT_CHARACTER
));
1872 LGLYPH_SET_CODE (glyph
, make_number (g
->glyph_id
));
1880 int u
= otf
->head
->unitsPerEm
;
1881 int size
= font
->pixel_size
;
1882 Lisp_Object base
= Qnil
, mark
= Qnil
;
1884 if (OTF_drive_gpos (otf
, &otf_gstring
, script
, langsys
,
1887 free (otf_gstring
.glyphs
);
1890 for (i
= 0, g
= otf_gstring
.glyphs
; i
< otf_gstring
.used
; i
++, g
++)
1893 int xoff
= 0, yoff
= 0, width_adjust
= 0;
1898 switch (g
->positioning_type
)
1904 int format
= g
->f
.f1
.format
;
1906 if (format
& OTF_XPlacement
)
1907 xoff
= g
->f
.f1
.value
->XPlacement
* size
/ u
;
1908 if (format
& OTF_XPlaDevice
)
1909 xoff
+= DEVICE_DELTA (g
->f
.f1
.value
->XPlaDevice
, size
);
1910 if (format
& OTF_YPlacement
)
1911 yoff
= - (g
->f
.f1
.value
->YPlacement
* size
/ u
);
1912 if (format
& OTF_YPlaDevice
)
1913 yoff
-= DEVICE_DELTA (g
->f
.f1
.value
->YPlaDevice
, size
);
1914 if (format
& OTF_XAdvance
)
1915 width_adjust
+= g
->f
.f1
.value
->XAdvance
* size
/ u
;
1916 if (format
& OTF_XAdvDevice
)
1917 width_adjust
+= DEVICE_DELTA (g
->f
.f1
.value
->XAdvDevice
, size
);
1921 /* Not yet supported. */
1927 goto label_adjust_anchor
;
1928 default: /* i.e. case 6 */
1933 label_adjust_anchor
:
1935 int base_x
, base_y
, mark_x
, mark_y
, width
;
1938 base_x
= g
->f
.f4
.base_anchor
->XCoordinate
* size
/ u
;
1939 base_y
= g
->f
.f4
.base_anchor
->YCoordinate
* size
/ u
;
1940 mark_x
= g
->f
.f4
.mark_anchor
->XCoordinate
* size
/ u
;
1941 mark_y
= g
->f
.f4
.mark_anchor
->YCoordinate
* size
/ u
;
1943 code
= XINT (LGLYPH_CODE (prev
));
1944 if (g
->f
.f4
.base_anchor
->AnchorFormat
!= 1)
1945 adjust_anchor (font
, g
->f
.f4
.base_anchor
,
1946 code
, size
, &base_x
, &base_y
);
1947 if (g
->f
.f4
.mark_anchor
->AnchorFormat
!= 1)
1948 adjust_anchor (font
, g
->f
.f4
.mark_anchor
,
1949 code
, size
, &mark_x
, &mark_y
);
1951 if (NILP (LGLYPH_WIDTH (prev
)))
1953 width
= font
->driver
->text_extents (font
, &code
, 1, NULL
);
1954 LGLYPH_SET_WIDTH (prev
, make_number (width
));
1957 width
= XINT (LGLYPH_WIDTH (prev
));
1958 xoff
= XINT (LGLYPH_XOFF (prev
)) + (base_x
- width
) - mark_x
;
1959 yoff
= XINT (LGLYPH_YOFF (prev
)) + mark_y
- base_y
;
1962 if (xoff
|| yoff
|| width_adjust
)
1964 Lisp_Object adjustment
= Fmake_vector (make_number (3), Qnil
);
1966 ASET (adjustment
, 0, make_number (xoff
));
1967 ASET (adjustment
, 1, make_number (yoff
));
1968 ASET (adjustment
, 2, make_number (width_adjust
));
1969 LGLYPH_SET_ADJUSTMENT (glyph
, adjustment
);
1971 if (g
->GlyphClass
== OTF_GlyphClass0
)
1972 base
= mark
= glyph
;
1973 else if (g
->GlyphClass
== OTF_GlyphClassMark
)
1980 free (otf_gstring
.glyphs
);
1984 #endif /* HAVE_LIBOTF */
1986 /* G-string (glyph string) handler */
1988 /* G-string is a vector of the form [HEADER GLYPH ...].
1989 See the docstring of `font-make-gstring' for more detail. */
1992 font_prepare_composition (cmp
)
1993 struct composition
*cmp
;
1996 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
1997 cmp
->hash_index
* 2);
1998 struct font
*font
= XSAVE_VALUE (LGSTRING_FONT (gstring
))->pointer
;
1999 int len
= LGSTRING_LENGTH (gstring
);
2003 cmp
->lbearing
= cmp
->rbearing
= cmp
->pixel_width
= 0;
2004 cmp
->ascent
= font
->ascent
;
2005 cmp
->descent
= font
->descent
;
2007 for (i
= 0; i
< len
; i
++)
2009 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
2011 struct font_metrics metrics
;
2013 if (NILP (LGLYPH_FROM (g
)))
2015 code
= XINT (LGLYPH_CODE (g
));
2016 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
2017 LGLYPH_SET_WIDTH (g
, make_number (metrics
.width
));
2018 metrics
.lbearing
+= LGLYPH_XOFF (g
);
2019 metrics
.rbearing
+= LGLYPH_XOFF (g
);
2020 metrics
.ascent
+= LGLYPH_YOFF (g
);
2021 metrics
.descent
+= LGLYPH_YOFF (g
);
2023 if (cmp
->lbearing
> cmp
->pixel_width
+ metrics
.lbearing
)
2024 cmp
->lbearing
= cmp
->pixel_width
+ metrics
.lbearing
;
2025 if (cmp
->rbearing
< cmp
->pixel_width
+ metrics
.rbearing
)
2026 cmp
->rbearing
= cmp
->pixel_width
+ metrics
.rbearing
;
2027 if (cmp
->ascent
< metrics
.ascent
)
2028 cmp
->ascent
= metrics
.ascent
;
2029 if (cmp
->descent
< metrics
.descent
)
2030 cmp
->descent
= metrics
.descent
;
2031 cmp
->pixel_width
+= metrics
.width
+ LGLYPH_WADJUST (g
);
2034 LGSTRING_SET_LBEARING (gstring
, make_number (cmp
->lbearing
));
2035 LGSTRING_SET_RBEARING (gstring
, make_number (cmp
->rbearing
));
2036 LGSTRING_SET_WIDTH (gstring
, make_number (cmp
->pixel_width
));
2037 LGSTRING_SET_ASCENT (gstring
, make_number (cmp
->ascent
));
2038 LGSTRING_SET_DESCENT (gstring
, make_number (cmp
->descent
));
2044 font_gstring_produce (old
, from
, to
, new, idx
, code
, n
)
2052 Lisp_Object min_idx
, max_idx
;
2055 if (idx
+ n
> ASIZE (new))
2061 min_idx
= make_number (0);
2062 max_idx
= make_number (1);
2066 min_idx
= AREF (AREF (old
, from
- 1), 0);
2067 max_idx
= AREF (AREF (old
, from
- 1), 1);
2070 else if (from
+ 1 == to
)
2072 min_idx
= AREF (AREF (old
, from
), 0);
2073 max_idx
= AREF (AREF (old
, from
), 1);
2077 int min_idx_i
= XINT (AREF (AREF (old
, from
), 0));
2078 int max_idx_i
= XINT (AREF (AREF (old
, from
), 1));
2080 for (i
= from
+ 1; i
< to
; i
++)
2082 if (min_idx_i
> XINT (AREF (AREF (old
, i
), 0)))
2083 min_idx_i
= XINT (AREF (AREF (old
, i
), 0));
2084 if (max_idx_i
< XINT (AREF (AREF (old
, i
), 1)))
2085 max_idx_i
= XINT (AREF (AREF (old
, i
), 1));
2087 min_idx
= make_number (min_idx_i
);
2088 max_idx
= make_number (max_idx_i
);
2091 for (i
= 0; i
< n
; i
++)
2093 ASET (AREF (new, idx
+ i
), 0, min_idx
);
2094 ASET (AREF (new, idx
+ i
), 1, max_idx
);
2095 ASET (AREF (new, idx
+ i
), 2, make_number (code
[i
]));
2103 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2104 static int font_compare
P_ ((const void *, const void *));
2105 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
2106 Lisp_Object
, Lisp_Object
));
2108 /* We sort fonts by scoring each of them against a specified
2109 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2110 the value is, the closer the font is to the font-spec.
2112 Each 1-bit of the highest 4 bits of the score is used for atomic
2113 properties FOUNDRY, FAMILY, ADSTYLE, and REGISTRY.
2115 Each 7-bit in the lowest 28 bits are used for numeric properties
2116 WEIGHT, SLANT, WIDTH, and SIZE. */
2118 /* How many bits to shift to store the difference value of each font
2119 property in a score. */
2120 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2122 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2123 The return value indicates how different ENTITY is compared with
2127 font_score (entity
, spec_prop
)
2128 Lisp_Object entity
, *spec_prop
;
2132 /* Score four atomic fields. Maximum difference is 1. */
2133 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2134 if (! NILP (spec_prop
[i
])
2135 && ! EQ (spec_prop
[i
], AREF (entity
, i
)))
2136 score
|= 1 << sort_shift_bits
[i
];
2138 /* Score four numeric fields. Maximum difference is 127. */
2139 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2141 Lisp_Object entity_val
= AREF (entity
, i
);
2143 if (! NILP (spec_prop
[i
]) && ! EQ (spec_prop
[i
], entity_val
))
2145 if (! INTEGERP (entity_val
))
2146 score
|= 127 << sort_shift_bits
[i
];
2149 int diff
= XINT (entity_val
) - XINT (spec_prop
[i
]);
2153 if (i
== FONT_SIZE_INDEX
)
2155 if (XINT (entity_val
) > 0
2156 && diff
> FONT_PIXEL_SIZE_QUANTUM
)
2157 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2160 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2169 /* The comparison function for qsort. */
2172 font_compare (d1
, d2
)
2173 const void *d1
, *d2
;
2175 return (*(unsigned *) d1
< *(unsigned *) d2
2176 ? -1 : *(unsigned *) d1
> *(unsigned *) d2
);
2180 /* The structure for elements being sorted by qsort. */
2181 struct font_sort_data
2188 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2189 If PREFER specifies a point-size, calculate the corresponding
2190 pixel-size from QCdpi property of PREFER or from the Y-resolution
2191 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
2192 get the font-entities in VEC. */
2195 font_sort_entites (vec
, prefer
, frame
, spec
)
2196 Lisp_Object vec
, prefer
, frame
, spec
;
2198 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2200 struct font_sort_data
*data
;
2207 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2208 prefer_prop
[i
] = AREF (prefer
, i
);
2212 /* As it is assured that all fonts in VEC match with SPEC, we
2213 should ignore properties specified in SPEC. So, set the
2214 corresponding properties in PREFER_PROP to nil. */
2215 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2216 if (! NILP (AREF (spec
, i
)))
2217 prefer_prop
[i
++] = Qnil
;
2220 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2221 prefer_prop
[FONT_SIZE_INDEX
]
2222 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2224 /* Scoring and sorting. */
2225 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2226 for (i
= 0; i
< len
; i
++)
2228 data
[i
].entity
= AREF (vec
, i
);
2229 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
);
2231 qsort (data
, len
, sizeof *data
, font_compare
);
2232 for (i
= 0; i
< len
; i
++)
2233 ASET (vec
, i
, data
[i
].entity
);
2240 /* API of Font Service Layer. */
2242 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2243 sort_shift_bits. Finternal_set_font_selection_order calls this
2244 function with font_sort_order after setting up it. */
2247 font_update_sort_order (order
)
2250 int i
, shift_bits
= 21;
2252 for (i
= 0; i
< 4; i
++, shift_bits
-= 7)
2254 int xlfd_idx
= order
[i
];
2256 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2257 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2258 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2259 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2260 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2261 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2263 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2268 /* Return weight property of FONT as symbol. */
2271 font_symbolic_weight (font
)
2274 Lisp_Object weight
= AREF (font
, FONT_WEIGHT_INDEX
);
2276 if (INTEGERP (weight
))
2277 weight
= prop_numeric_to_name (FONT_WEIGHT_INDEX
, XINT (weight
));
2282 /* Return slant property of FONT as symbol. */
2285 font_symbolic_slant (font
)
2288 Lisp_Object slant
= AREF (font
, FONT_SLANT_INDEX
);
2290 if (INTEGERP (slant
))
2291 slant
= prop_numeric_to_name (FONT_SLANT_INDEX
, XINT (slant
));
2296 /* Return width property of FONT as symbol. */
2299 font_symbolic_width (font
)
2302 Lisp_Object width
= AREF (font
, FONT_WIDTH_INDEX
);
2304 if (INTEGERP (width
))
2305 width
= prop_numeric_to_name (FONT_WIDTH_INDEX
, XINT (width
));
2310 /* Check if ENTITY matches with the font specification SPEC. */
2313 font_match_p (spec
, entity
)
2314 Lisp_Object spec
, entity
;
2318 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2319 if (! NILP (AREF (spec
, i
))
2320 && ! EQ (AREF (spec
, i
), AREF (entity
, i
)))
2322 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
))
2323 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0
2324 && (XINT (AREF (spec
, FONT_SIZE_INDEX
))
2325 != XINT (AREF (entity
, FONT_SIZE_INDEX
))))
2331 /* Return a lispy font object corresponding to FONT. */
2334 font_find_object (font
)
2337 Lisp_Object tail
, elt
;
2339 for (tail
= AREF (font
->entity
, FONT_OBJLIST_INDEX
); CONSP (tail
);
2343 if (font
== XSAVE_VALUE (elt
)->pointer
2344 && XSAVE_VALUE (elt
)->integer
> 0)
2351 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2354 /* Return a vector of font-entities matching with SPEC on frame F. */
2357 font_list_entities (frame
, spec
)
2358 Lisp_Object frame
, spec
;
2360 FRAME_PTR f
= XFRAME (frame
);
2361 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2362 Lisp_Object ftype
, family
, size
, alternate_familes
;
2363 Lisp_Object
*vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2369 family
= AREF (spec
, FONT_FAMILY_INDEX
);
2371 alternate_familes
= Qnil
;
2374 if (NILP (font_family_alist
)
2375 && !NILP (Vface_alternative_font_family_alist
))
2376 build_font_family_alist ();
2377 alternate_familes
= assq_no_quit (family
, font_family_alist
);
2378 if (! NILP (alternate_familes
))
2379 alternate_familes
= XCDR (alternate_familes
);
2381 size
= AREF (spec
, FONT_SIZE_INDEX
);
2383 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2385 xassert (ASIZE (spec
) == FONT_SPEC_MAX
);
2386 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2388 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2390 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2392 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
2393 Lisp_Object tail
= alternate_familes
;
2396 xassert (CONSP (cache
));
2397 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2398 ASET (spec
, FONT_FAMILY_INDEX
, family
);
2402 val
= assoc_no_quit (spec
, XCDR (cache
));
2407 val
= driver_list
->driver
->list (frame
, spec
);
2409 XSETCDR (cache
, Fcons (Fcons (Fcopy_sequence (spec
), val
),
2412 if (VECTORP (val
) && ASIZE (val
) > 0)
2419 ASET (spec
, FONT_FAMILY_INDEX
, XCAR (tail
));
2423 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2424 ASET (spec
, FONT_FAMILY_INDEX
, family
);
2425 ASET (spec
, FONT_SIZE_INDEX
, size
);
2426 return (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2430 /* Return a font entity matching with SPEC on FRAME. */
2433 font_matching_entity (frame
, spec
)
2434 Lisp_Object frame
, spec
;
2436 FRAME_PTR f
= XFRAME (frame
);
2437 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2438 Lisp_Object ftype
, size
, entity
;
2440 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2441 size
= AREF (spec
, FONT_SIZE_INDEX
);
2443 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2445 for (; driver_list
; driver_list
= driver_list
->next
)
2447 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2449 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
2452 xassert (CONSP (cache
));
2453 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2454 key
= Fcons (spec
, Qnil
);
2455 entity
= assoc_no_quit (key
, XCDR (cache
));
2457 entity
= XCDR (entity
);
2460 entity
= driver_list
->driver
->match (frame
, spec
);
2461 if (! NILP (entity
))
2463 XSETCAR (key
, Fcopy_sequence (spec
));
2464 XSETCDR (cache
, Fcons (Fcons (key
, entity
), XCDR (cache
)));
2467 if (! NILP (entity
))
2470 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2471 ASET (spec
, FONT_SIZE_INDEX
, size
);
2475 static int num_fonts
;
2478 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2479 opened font object. */
2482 font_open_entity (f
, entity
, pixel_size
)
2487 struct font_driver_list
*driver_list
;
2488 Lisp_Object objlist
, size
, val
;
2491 size
= AREF (entity
, FONT_SIZE_INDEX
);
2492 xassert (NATNUMP (size
));
2493 if (XINT (size
) != 0)
2494 pixel_size
= XINT (size
);
2496 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2497 objlist
= XCDR (objlist
))
2499 font
= XSAVE_VALUE (XCAR (objlist
))->pointer
;
2500 if (font
->pixel_size
== pixel_size
)
2502 XSAVE_VALUE (XCAR (objlist
))->integer
++;
2503 return XCAR (objlist
);
2507 xassert (FONT_ENTITY_P (entity
));
2508 val
= AREF (entity
, FONT_TYPE_INDEX
);
2509 for (driver_list
= f
->font_driver_list
;
2510 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2511 driver_list
= driver_list
->next
);
2515 font
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2518 font
->scalable
= XINT (size
) == 0;
2520 val
= make_save_value (font
, 1);
2521 ASET (entity
, FONT_OBJLIST_INDEX
,
2522 Fcons (val
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2528 /* Close FONT_OBJECT that is opened on frame F. */
2531 font_close_object (f
, font_object
)
2533 Lisp_Object font_object
;
2535 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2536 Lisp_Object objlist
;
2537 Lisp_Object tail
, prev
= Qnil
;
2539 XSAVE_VALUE (font_object
)->integer
--;
2540 xassert (XSAVE_VALUE (font_object
)->integer
>= 0);
2541 if (XSAVE_VALUE (font_object
)->integer
> 0)
2544 objlist
= AREF (font
->entity
, FONT_OBJLIST_INDEX
);
2545 for (prev
= Qnil
, tail
= objlist
; CONSP (tail
);
2546 prev
= tail
, tail
= XCDR (tail
))
2547 if (EQ (font_object
, XCAR (tail
)))
2549 if (font
->driver
->close
)
2550 font
->driver
->close (f
, font
);
2551 XSAVE_VALUE (font_object
)->pointer
= NULL
;
2553 ASET (font
->entity
, FONT_OBJLIST_INDEX
, XCDR (objlist
));
2555 XSETCDR (prev
, XCDR (objlist
));
2562 /* Return 1 iff FONT on F has a glyph for character C. */
2565 font_has_char (f
, font
, c
)
2572 if (FONT_ENTITY_P (font
))
2574 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2575 struct font_driver_list
*driver_list
;
2577 for (driver_list
= f
->font_driver_list
;
2578 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2579 driver_list
= driver_list
->next
);
2582 if (! driver_list
->driver
->has_char
)
2584 return driver_list
->driver
->has_char (font
, c
);
2587 xassert (FONT_OBJECT_P (font
));
2588 fontp
= XSAVE_VALUE (font
)->pointer
;
2590 if (fontp
->driver
->has_char
)
2592 int result
= fontp
->driver
->has_char (fontp
->entity
, c
);
2597 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2601 /* Return the glyph ID of FONT_OBJECT for character C. */
2604 font_encode_char (font_object
, c
)
2605 Lisp_Object font_object
;
2608 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2610 return font
->driver
->encode_char (font
, c
);
2614 /* Return the name of FONT_OBJECT. */
2617 font_get_name (font_object
)
2618 Lisp_Object font_object
;
2620 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2621 char *name
= (font
->font
.full_name
? font
->font
.full_name
2622 : font
->font
.name
? font
->font
.name
2625 return (name
? make_unibyte_string (name
, strlen (name
)) : null_string
);
2629 /* Return the specification of FONT_OBJECT. */
2632 font_get_spec (font_object
)
2633 Lisp_Object font_object
;
2635 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2636 Lisp_Object spec
= Ffont_spec (0, NULL
);
2639 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2640 ASET (spec
, i
, AREF (font
->entity
, i
));
2641 ASET (spec
, FONT_SIZE_INDEX
, make_number (font
->pixel_size
));
2646 /* Return the frame on which FONT exists. FONT is a font object or a
2650 font_get_frame (font
)
2653 if (FONT_OBJECT_P (font
))
2654 font
= ((struct font
*) XSAVE_VALUE (font
)->pointer
)->entity
;
2655 xassert (FONT_ENTITY_P (font
));
2656 return AREF (font
, FONT_FRAME_INDEX
);
2660 /* Find a font entity best matching with LFACE. If SPEC is non-nil,
2661 the font must exactly match with it. */
2664 font_find_for_lface (f
, lface
, spec
)
2669 Lisp_Object frame
, entities
;
2672 XSETFRAME (frame
, f
);
2676 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2677 ASET (scratch_font_spec
, i
, Qnil
);
2678 ASET (scratch_font_spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2680 if (! NILP (lface
[LFACE_FAMILY_INDEX
]))
2681 font_merge_old_spec (Qnil
, lface
[LFACE_FAMILY_INDEX
], Qnil
,
2683 entities
= font_list_entities (frame
, scratch_font_spec
);
2684 while (ASIZE (entities
) == 0)
2686 /* Try without FOUNDRY or FAMILY. */
2687 if (! NILP (AREF (scratch_font_spec
, FONT_FOUNDRY_INDEX
)))
2689 ASET (scratch_font_spec
, FONT_FOUNDRY_INDEX
, Qnil
);
2690 entities
= font_list_entities (frame
, scratch_font_spec
);
2692 else if (! NILP (AREF (scratch_font_spec
, FONT_FAMILY_INDEX
)))
2694 ASET (scratch_font_spec
, FONT_FAMILY_INDEX
, Qnil
);
2695 entities
= font_list_entities (frame
, scratch_font_spec
);
2703 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2704 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2705 if (NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
2706 ASET (scratch_font_spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2707 entities
= font_list_entities (frame
, scratch_font_spec
);
2710 if (ASIZE (entities
) == 0)
2712 if (ASIZE (entities
) > 1)
2714 /* Sort fonts by properties specified in LFACE. */
2715 Lisp_Object prefer
= scratch_font_prefer
;
2718 if (! NILP (lface
[LFACE_FAMILY_INDEX
]))
2719 font_merge_old_spec (Qnil
, lface
[LFACE_FAMILY_INDEX
], Qnil
, prefer
);
2720 ASET (prefer
, FONT_WEIGHT_INDEX
,
2721 font_prop_validate_style (QCweight
, lface
[LFACE_WEIGHT_INDEX
]));
2722 ASET (prefer
, FONT_SLANT_INDEX
,
2723 font_prop_validate_style (QCslant
, lface
[LFACE_SLANT_INDEX
]));
2724 ASET (prefer
, FONT_WIDTH_INDEX
,
2725 font_prop_validate_style (QCwidth
, lface
[LFACE_SWIDTH_INDEX
]));
2726 pt
= XINT (lface
[LFACE_HEIGHT_INDEX
]);
2727 ASET (prefer
, FONT_SIZE_INDEX
, make_float (pt
/ 10));
2729 font_sort_entites (entities
, prefer
, frame
, spec
);
2732 return AREF (entities
, 0);
2739 font_open_for_lface (f
, entity
, lface
, spec
)
2747 if (FONT_SPEC_P (spec
) && INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2748 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2751 double pt
= XINT (lface
[LFACE_HEIGHT_INDEX
]);
2754 size
= POINT_TO_PIXEL (pt
, f
->resy
);
2756 return font_open_entity (f
, entity
, size
);
2760 /* Load a font best matching with FACE's font-related properties into
2761 FACE on frame F. If no proper font is found, record that FACE has
2765 font_load_for_face (f
, face
)
2769 Lisp_Object font_object
= face
->lface
[LFACE_FONT_INDEX
];
2771 if (NILP (font_object
))
2773 Lisp_Object entity
= font_find_for_lface (f
, face
->lface
, Qnil
);
2775 if (! NILP (entity
))
2776 font_object
= font_open_for_lface (f
, entity
, face
->lface
, Qnil
);
2779 if (! NILP (font_object
))
2781 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2783 face
->font
= font
->font
.font
;
2784 face
->font_info
= (struct font_info
*) font
;
2785 face
->font_info_id
= 0;
2786 face
->font_name
= font
->font
.full_name
;
2791 face
->font_info
= NULL
;
2792 face
->font_info_id
= -1;
2793 face
->font_name
= NULL
;
2794 add_to_log ("Unable to load font for a face%s", null_string
, Qnil
);
2799 /* Make FACE on frame F ready to use the font opened for FACE. */
2802 font_prepare_for_face (f
, face
)
2806 struct font
*font
= (struct font
*) face
->font_info
;
2808 if (font
->driver
->prepare_face
)
2809 font
->driver
->prepare_face (f
, face
);
2813 /* Make FACE on frame F stop using the font opened for FACE. */
2816 font_done_for_face (f
, face
)
2820 struct font
*font
= (struct font
*) face
->font_info
;
2822 if (font
->driver
->done_face
)
2823 font
->driver
->done_face (f
, face
);
2828 /* Open a font best matching with NAME on frame F. If no proper font
2829 is found, return Qnil. */
2832 font_open_by_name (f
, name
)
2836 Lisp_Object args
[2];
2837 Lisp_Object spec
, prefer
, size
, entity
, entity_list
;
2842 XSETFRAME (frame
, f
);
2845 args
[1] = make_unibyte_string (name
, strlen (name
));
2846 spec
= Ffont_spec (2, args
);
2847 prefer
= scratch_font_prefer
;
2848 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2849 if (NILP (AREF (spec
, i
)))
2850 ASET (prefer
, i
, make_number (100));
2851 size
= AREF (spec
, FONT_SIZE_INDEX
);
2854 else if (INTEGERP (size
))
2855 pixel_size
= XINT (size
);
2856 else /* FLOATP (size) */
2858 double pt
= XFLOAT_DATA (size
);
2860 pixel_size
= POINT_TO_PIXEL (pt
, f
->resy
);
2861 size
= make_number (pixel_size
);
2862 ASET (spec
, FONT_SIZE_INDEX
, size
);
2864 if (pixel_size
== 0)
2866 pixel_size
= POINT_TO_PIXEL (12.0, f
->resy
);
2867 size
= make_number (pixel_size
);
2869 ASET (prefer
, FONT_SIZE_INDEX
, size
);
2870 if (NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
2871 ASET (spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2873 entity_list
= Flist_fonts (spec
, frame
, make_number (1), prefer
);
2874 if (NILP (entity_list
))
2875 entity
= font_matching_entity (frame
, spec
);
2877 entity
= XCAR (entity_list
);
2878 return (NILP (entity
)
2880 : font_open_entity (f
, entity
, pixel_size
));
2884 /* Register font-driver DRIVER. This function is used in two ways.
2886 The first is with frame F non-NULL. In this case, make DRIVER
2887 available (but not yet activated) on F. All frame creaters
2888 (e.g. Fx_create_frame) must call this function at least once with
2889 an available font-driver.
2891 The second is with frame F NULL. In this case, DRIVER is globally
2892 registered in the variable `font_driver_list'. All font-driver
2893 implementations must call this function in its syms_of_XXXX
2894 (e.g. syms_of_xfont). */
2897 register_font_driver (driver
, f
)
2898 struct font_driver
*driver
;
2901 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
2902 struct font_driver_list
*prev
, *list
;
2904 if (f
&& ! driver
->draw
)
2905 error ("Unsable font driver for a frame: %s",
2906 SDATA (SYMBOL_NAME (driver
->type
)));
2908 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
2909 if (EQ (list
->driver
->type
, driver
->type
))
2910 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
2912 list
= malloc (sizeof (struct font_driver_list
));
2914 list
->driver
= driver
;
2919 f
->font_driver_list
= list
;
2921 font_driver_list
= list
;
2926 /* Free font-driver list on frame F. It doesn't free font-drivers
2930 free_font_driver_list (f
)
2933 while (f
->font_driver_list
)
2935 struct font_driver_list
*next
= f
->font_driver_list
->next
;
2937 free (f
->font_driver_list
);
2938 f
->font_driver_list
= next
;
2943 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
2944 symbols, e.g. xft, x). If NEW_DRIVERS is nil, make F use all
2945 available font drivers. If no backend is available, dont't alter
2946 F->font_driver_list.
2948 A caller must free all realized faces and clear all font caches if
2949 any in advance. The return value is a list of font backends
2950 actually made used on F. */
2953 font_update_drivers (f
, new_drivers
)
2955 Lisp_Object new_drivers
;
2957 Lisp_Object active_drivers
= Qnil
;
2958 struct font_driver_list
*list
;
2960 /* At first, finialize all font drivers for F. */
2961 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
2964 if (list
->driver
->end_for_frame
)
2965 list
->driver
->end_for_frame (f
);
2969 /* Then start the requested drivers. */
2970 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
2971 if (NILP (new_drivers
)
2972 || ! NILP (Fmemq (list
->driver
->type
, new_drivers
)))
2974 if (! list
->driver
->start_for_frame
2975 || list
->driver
->start_for_frame (f
) == 0);
2978 active_drivers
= nconc2 (active_drivers
,
2979 Fcons (list
->driver
->type
, Qnil
));
2983 return active_drivers
;
2987 font_put_frame_data (f
, driver
, data
)
2989 struct font_driver
*driver
;
2992 struct font_data_list
*list
, *prev
;
2994 for (prev
= NULL
, list
= f
->font_data_list
; list
;
2995 prev
= list
, list
= list
->next
)
2996 if (list
->driver
== driver
)
3003 prev
->next
= list
->next
;
3005 f
->font_data_list
= list
->next
;
3013 list
= malloc (sizeof (struct font_data_list
));
3016 list
->driver
= driver
;
3017 list
->next
= f
->font_data_list
;
3018 f
->font_data_list
= list
;
3026 font_get_frame_data (f
, driver
)
3028 struct font_driver
*driver
;
3030 struct font_data_list
*list
;
3032 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3033 if (list
->driver
== driver
)
3041 /* Return the font used to draw character C by FACE at buffer position
3042 POS in window W. If OBJECT is non-nil, it is a string containing C
3046 font_at (c
, pos
, face
, w
, object
)
3057 f
= XFRAME (w
->frame
);
3058 if (! FRAME_WINDOW_P (f
))
3062 if (STRINGP (object
))
3063 face_id
= face_at_string_position (w
, object
, pos
, 0, -1, -1, &dummy
,
3064 DEFAULT_FACE_ID
, 0);
3066 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
,
3068 face
= FACE_FROM_ID (f
, face_id
);
3070 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, object
);
3071 face
= FACE_FROM_ID (f
, face_id
);
3072 if (! face
->font_info
)
3074 return font_find_object ((struct font
*) face
->font_info
);
3080 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 1, 0,
3081 doc
: /* Return t if OBJECT is a font-spec or font-entity.
3082 Return nil otherwise. */)
3086 return (FONTP (object
) ? Qt
: Qnil
);
3089 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3090 doc
: /* Return a newly created font-spec with arguments as properties.
3092 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3093 valid font property name listed below:
3095 `:family', `:weight', `:slant', `:width'
3097 They are the same as face attributes of the same name. See
3098 `set-face-attribute.
3102 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3106 VALUE must be a string or a symbol specifying the additional
3107 typographic style information of a font, e.g. ``sans''. Usually null.
3111 VALUE must be a string or a symbol specifying the charset registry and
3112 encoding of a font, e.g. ``iso8859-1''.
3116 VALUE must be a non-negative integer or a floating point number
3117 specifying the font size. It specifies the font size in 1/10 pixels
3118 (if VALUE is an integer), or in points (if VALUE is a float).
3119 usage: (font-spec ARGS ...) */)
3124 Lisp_Object spec
= Fmake_vector (make_number (FONT_SPEC_MAX
), Qnil
);
3127 for (i
= 0; i
< nargs
; i
+= 2)
3129 enum font_property_index prop
;
3130 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3132 prop
= get_font_prop_index (key
, 0);
3133 if (prop
< FONT_EXTRA_INDEX
)
3134 ASET (spec
, prop
, val
);
3137 if (EQ (key
, QCname
))
3140 font_parse_name ((char *) SDATA (val
), spec
);
3142 font_put_extra (spec
, key
, val
);
3145 CHECK_VALIDATE_FONT_SPEC (spec
);
3150 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3151 doc
: /* Return the value of FONT's property KEY.
3152 FONT is a font-spec, a font-entity, or a font-object. */)
3154 Lisp_Object font
, key
;
3156 enum font_property_index idx
;
3158 if (FONT_OBJECT_P (font
))
3160 struct font
*fontp
= XSAVE_VALUE (font
)->pointer
;
3162 if (EQ (key
, QCotf
))
3164 if (fontp
->driver
->otf_capability
)
3165 return fontp
->driver
->otf_capability (fontp
);
3169 font
= fontp
->entity
;
3173 idx
= get_font_prop_index (key
, 0);
3174 if (idx
< FONT_EXTRA_INDEX
)
3175 return AREF (font
, idx
);
3176 if (FONT_ENTITY_P (font
))
3178 return Fcdr (Fassoc (AREF (font
, FONT_EXTRA_INDEX
), key
));
3182 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3183 doc
: /* Set one property of FONT-SPEC: give property KEY value VALUE. */)
3184 (font_spec
, prop
, val
)
3185 Lisp_Object font_spec
, prop
, val
;
3187 enum font_property_index idx
;
3188 Lisp_Object extra
, slot
;
3190 CHECK_FONT_SPEC (font_spec
);
3191 idx
= get_font_prop_index (prop
, 0);
3192 if (idx
< FONT_EXTRA_INDEX
)
3193 return ASET (font_spec
, idx
, val
);
3194 extra
= AREF (font_spec
, FONT_EXTRA_INDEX
);
3195 slot
= Fassoc (extra
, prop
);
3197 extra
= Fcons (Fcons (prop
, val
), extra
);
3199 Fsetcdr (slot
, val
);
3203 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3204 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3205 Optional 2nd argument FRAME specifies the target frame.
3206 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3207 Optional 4th argument PREFER, if non-nil, is a font-spec to
3208 control the order of the returned list. Fonts are sorted by
3209 how they are close to PREFER. */)
3210 (font_spec
, frame
, num
, prefer
)
3211 Lisp_Object font_spec
, frame
, num
, prefer
;
3213 Lisp_Object vec
, list
, tail
;
3217 frame
= selected_frame
;
3218 CHECK_LIVE_FRAME (frame
);
3219 CHECK_VALIDATE_FONT_SPEC (font_spec
);
3227 if (! NILP (prefer
))
3228 CHECK_FONT (prefer
);
3230 vec
= font_list_entities (frame
, font_spec
);
3235 return Fcons (AREF (vec
, 0), Qnil
);
3237 if (! NILP (prefer
))
3238 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
);
3240 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3241 if (n
== 0 || n
> len
)
3243 for (i
= 1; i
< n
; i
++)
3245 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3247 XSETCDR (tail
, val
);
3253 DEFUN ("list-families", Flist_families
, Slist_families
, 0, 1, 0,
3254 doc
: /* List available font families on the current frame.
3255 Optional 2nd argument FRAME specifies the target frame. */)
3260 struct font_driver_list
*driver_list
;
3264 frame
= selected_frame
;
3265 CHECK_LIVE_FRAME (frame
);
3268 for (driver_list
= f
->font_driver_list
; driver_list
;
3269 driver_list
= driver_list
->next
)
3270 if (driver_list
->driver
->list_family
)
3272 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3278 Lisp_Object tail
= list
;
3280 for (; CONSP (val
); val
= XCDR (val
))
3281 if (NILP (Fmemq (XCAR (val
), tail
)))
3282 list
= Fcons (XCAR (val
), list
);
3288 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3289 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3290 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3292 Lisp_Object font_spec
, frame
;
3294 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3301 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 1, 0,
3302 doc
: /* Return XLFD name of FONT.
3303 FONT is a font-spec, font-entity, or font-object.
3304 If the name is too long for XLFD (maximum 255 chars), return nil. */)
3311 if (FONT_SPEC_P (font
))
3312 CHECK_VALIDATE_FONT_SPEC (font
);
3313 else if (FONT_ENTITY_P (font
))
3319 CHECK_FONT_GET_OBJECT (font
, fontp
);
3320 font
= fontp
->entity
;
3321 pixel_size
= fontp
->pixel_size
;
3324 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3326 return build_string (name
);
3329 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3330 doc
: /* Clear font cache. */)
3333 Lisp_Object list
, frame
;
3335 FOR_EACH_FRAME (list
, frame
)
3337 FRAME_PTR f
= XFRAME (frame
);
3338 struct font_driver_list
*driver_list
= f
->font_driver_list
;
3340 for (; driver_list
; driver_list
= driver_list
->next
)
3341 if (driver_list
->on
)
3343 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
3344 Lisp_Object tail
, elt
;
3346 for (tail
= XCDR (cache
); CONSP (tail
); tail
= XCDR (tail
))
3349 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
3351 Lisp_Object vec
= XCDR (elt
);
3354 for (i
= 0; i
< ASIZE (vec
); i
++)
3356 Lisp_Object entity
= AREF (vec
, i
);
3358 if (EQ (driver_list
->driver
->type
,
3359 AREF (entity
, FONT_TYPE_INDEX
)))
3362 = AREF (entity
, FONT_OBJLIST_INDEX
);
3364 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
3366 Lisp_Object val
= XCAR (objlist
);
3367 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
3368 struct font
*font
= p
->pointer
;
3370 xassert (font
&& (driver_list
->driver
3372 driver_list
->driver
->close (f
, font
);
3376 if (driver_list
->driver
->free_entity
)
3377 driver_list
->driver
->free_entity (entity
);
3382 XSETCDR (cache
, Qnil
);
3389 DEFUN ("internal-set-font-style-table", Finternal_set_font_style_table
,
3390 Sinternal_set_font_style_table
, 2, 2, 0,
3391 doc
: /* Set font style table for PROP to TABLE.
3392 PROP must be `:weight', `:slant', or `:width'.
3393 TABLE must be an alist of symbols vs the corresponding numeric values
3394 sorted by numeric values. */)
3396 Lisp_Object prop
, table
;
3400 Lisp_Object tail
, val
;
3402 CHECK_SYMBOL (prop
);
3403 table_index
= (EQ (prop
, QCweight
) ? 0
3404 : EQ (prop
, QCslant
) ? 1
3405 : EQ (prop
, QCwidth
) ? 2
3407 if (table_index
>= ASIZE (font_style_table
))
3408 error ("Invalid font style property: %s", SDATA (SYMBOL_NAME (prop
)));
3409 table
= Fcopy_sequence (table
);
3411 for (tail
= table
; ! NILP (tail
); tail
= Fcdr (tail
))
3413 prop
= Fcar (Fcar (tail
));
3414 val
= Fcdr (Fcar (tail
));
3415 CHECK_SYMBOL (prop
);
3417 if (numeric
> XINT (val
))
3418 error ("Numeric values not sorted for %s", SDATA (SYMBOL_NAME (prop
)));
3419 numeric
= XINT (val
);
3420 XSETCAR (tail
, Fcons (prop
, val
));
3422 ASET (font_style_table
, table_index
, table
);
3426 /* The following three functions are still expremental. */
3428 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
3429 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
3430 FONT-OBJECT may be nil if it is not yet known.
3432 G-string is sequence of glyphs of a specific font,
3433 and is a vector of this form:
3434 [ HEADER GLYPH ... ]
3435 HEADER is a vector of this form:
3436 [FONT-OBJECT LBEARING RBEARING WIDTH ASCENT DESCENT]
3438 FONT-OBJECT is a font-object for all glyphs in the g-string,
3439 LBEARING thry DESCENT is the metrics (in pixels) of the whole G-string.
3440 GLYPH is a vector of this form:
3441 [ FROM-IDX TO-IDX C CODE WIDTH [ [X-OFF Y-OFF WADJUST] | nil] ]
3443 FROM-IDX and TO-IDX are used internally and should not be touched.
3444 C is the character of the glyph.
3445 CODE is the glyph-code of C in FONT-OBJECT.
3446 X-OFF and Y-OFF are offests to the base position for the glyph.
3447 WIDTH is the normal width of the glyph.
3448 WADJUST is the adjustment to the normal width of the glyph. */)
3450 Lisp_Object font_object
, num
;
3452 Lisp_Object gstring
, g
;
3456 if (! NILP (font_object
))
3457 CHECK_FONT_OBJECT (font_object
);
3460 len
= XINT (num
) + 1;
3461 gstring
= Fmake_vector (make_number (len
), Qnil
);
3462 g
= Fmake_vector (make_number (6), Qnil
);
3463 ASET (g
, 0, font_object
);
3464 ASET (gstring
, 0, g
);
3465 for (i
= 1; i
< len
; i
++)
3466 ASET (gstring
, i
, Fmake_vector (make_number (8), Qnil
));
3470 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
3471 doc
: /* Fillin glyph-string GSTRING by characters for FONT-OBJECT.
3472 START and END specifies the region to extract characters.
3473 If optional 3rd argument OBJECT is non-nil, it is a buffer or a string from
3474 where to extract characters.
3475 FONT-OBJECT may be nil if GSTRING already already contains one. */)
3476 (gstring
, font_object
, start
, end
, object
)
3477 Lisp_Object gstring
, font_object
, start
, end
, object
;
3483 CHECK_VECTOR (gstring
);
3484 if (NILP (font_object
))
3485 font_object
= LGSTRING_FONT (gstring
);
3486 CHECK_FONT_GET_OBJECT (font_object
, font
);
3488 if (STRINGP (object
))
3490 const unsigned char *p
;
3492 CHECK_NATNUM (start
);
3494 if (XINT (start
) > XINT (end
)
3495 || XINT (end
) > ASIZE (object
)
3496 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3497 args_out_of_range (start
, end
);
3499 len
= XINT (end
) - XINT (start
);
3500 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
3501 for (i
= 0; i
< len
; i
++)
3503 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3505 c
= STRING_CHAR_ADVANCE (p
);
3506 code
= font
->driver
->encode_char (font
, c
);
3507 if (code
> MOST_POSITIVE_FIXNUM
)
3508 error ("Glyph code 0x%X is too large", code
);
3509 LGLYPH_SET_FROM (g
, make_number (i
));
3510 LGLYPH_SET_TO (g
, make_number (i
+ 1));
3511 LGLYPH_SET_CHAR (g
, make_number (c
));
3512 LGLYPH_SET_CODE (g
, make_number (code
));
3519 if (! NILP (object
))
3520 Fset_buffer (object
);
3521 validate_region (&start
, &end
);
3522 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3523 args_out_of_range (start
, end
);
3524 len
= XINT (end
) - XINT (start
);
3526 pos_byte
= CHAR_TO_BYTE (pos
);
3527 for (i
= 0; i
< len
; i
++)
3529 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3531 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
3532 code
= font
->driver
->encode_char (font
, c
);
3533 if (code
> MOST_POSITIVE_FIXNUM
)
3534 error ("Glyph code 0x%X is too large", code
);
3535 LGLYPH_SET_FROM (g
, make_number (i
));
3536 LGLYPH_SET_TO (g
, make_number (i
+ 1));
3537 LGLYPH_SET_CHAR (g
, make_number (c
));
3538 LGLYPH_SET_CODE (g
, make_number (code
));
3541 for (i
= LGSTRING_LENGTH (gstring
) - 1; i
>= len
; i
--)
3543 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3545 LGLYPH_SET_FROM (g
, Qnil
);
3550 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
3551 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
3552 OTF-SPEC specifies which featuress to apply in this format:
3553 (SCRIPT LANGSYS GSUB GPOS)
3555 SCRIPT is a symbol specifying a script tag of OpenType,
3556 LANGSYS is a symbol specifying a langsys tag of OpenType,
3557 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
3559 If LANGYS is nil, the default langsys is selected.
3561 The features are applied in the order appeared in the list. The
3562 symbol `*' means to apply all available features not appeared in this
3563 list, and the remaining features are ignored. For instance, (vatu
3564 pstf * haln) is to apply vatu and pstf in this order, then to apply
3565 all available features other than vatu, pstf, and haln.
3567 The features are applied to the glyphs in the range FROM and TO of
3568 the glyph-string GSTRING-IN.
3570 If some of a feature is actually applicable, the resulting glyphs are
3571 produced in the glyph-string GSTRING-OUT from the index INDEX. In
3572 this case, the value is the number of produced glyphs.
3574 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
3577 If GSTRING-OUT is too short to hold produced glyphs, no glyphs is
3578 produced in GSTRING-OUT, and the value is nil.
3580 See the documentation of `font-make-gstring' for the format of
3582 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
3583 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
3585 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
3590 check_otf_features (otf_features
);
3591 CHECK_FONT_GET_OBJECT (font_object
, font
);
3592 if (! font
->driver
->otf_drive
)
3593 error ("Font backend %s can't drive OpenType GSUB table",
3594 SDATA (SYMBOL_NAME (font
->driver
->type
)));
3595 CHECK_CONS (otf_features
);
3596 CHECK_SYMBOL (XCAR (otf_features
));
3597 val
= XCDR (otf_features
);
3598 CHECK_SYMBOL (XCAR (val
));
3599 val
= XCDR (otf_features
);
3602 len
= check_gstring (gstring_in
);
3603 CHECK_VECTOR (gstring_out
);
3604 CHECK_NATNUM (from
);
3606 CHECK_NATNUM (index
);
3608 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
3609 args_out_of_range_3 (from
, to
, make_number (len
));
3610 if (XINT (index
) >= ASIZE (gstring_out
))
3611 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
3612 num
= font
->driver
->otf_drive (font
, otf_features
,
3613 gstring_in
, XINT (from
), XINT (to
),
3614 gstring_out
, XINT (index
), 0);
3617 return make_number (num
);
3620 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
3622 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
3623 FEATURE-SPEC specifies which features of the font FONT-OBJECT to apply
3625 (SCRIPT LANGSYS FEATURE ...)
3626 See the documentation of `font-otf-gsub' for more detail.
3628 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
3629 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
3630 character code corresponding to the glyph or nil if there's no
3631 corresponding character. */)
3632 (font_object
, character
, otf_features
)
3633 Lisp_Object font_object
, character
, otf_features
;
3636 Lisp_Object gstring_in
, gstring_out
, g
;
3637 Lisp_Object alternates
;
3640 CHECK_FONT_GET_OBJECT (font_object
, font
);
3641 if (! font
->driver
->otf_drive
)
3642 error ("Font backend %s can't drive OpenType GSUB table",
3643 SDATA (SYMBOL_NAME (font
->driver
->type
)));
3644 CHECK_CHARACTER (character
);
3645 CHECK_CONS (otf_features
);
3647 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
3648 g
= LGSTRING_GLYPH (gstring_in
, 0);
3649 LGLYPH_SET_CHAR (g
, character
);
3650 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
3651 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
3652 gstring_out
, 0, 1)) < 0)
3653 gstring_out
= Ffont_make_gstring (font_object
,
3654 make_number (ASIZE (gstring_out
) * 2));
3656 for (i
= 0; i
< num
; i
++)
3658 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
3659 int c
= XINT (LGLYPH_CHAR (g
));
3660 unsigned code
= XUINT (LGLYPH_CODE (g
));
3662 alternates
= Fcons (Fcons (make_number (code
),
3663 c
> 0 ? make_number (c
) : Qnil
),
3666 return Fnreverse (alternates
);
3672 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
3673 doc
: /* Open FONT-ENTITY. */)
3674 (font_entity
, size
, frame
)
3675 Lisp_Object font_entity
;
3681 CHECK_FONT_ENTITY (font_entity
);
3683 size
= AREF (font_entity
, FONT_SIZE_INDEX
);
3684 CHECK_NUMBER (size
);
3686 frame
= selected_frame
;
3687 CHECK_LIVE_FRAME (frame
);
3689 isize
= XINT (size
);
3691 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
3693 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
3696 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
3697 doc
: /* Close FONT-OBJECT. */)
3698 (font_object
, frame
)
3699 Lisp_Object font_object
, frame
;
3701 CHECK_FONT_OBJECT (font_object
);
3703 frame
= selected_frame
;
3704 CHECK_LIVE_FRAME (frame
);
3705 font_close_object (XFRAME (frame
), font_object
);
3709 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
3710 doc
: /* Return information about FONT-OBJECT.
3711 The value is a vector:
3712 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
3715 NAME is a string of the font name (or nil if the font backend doesn't
3718 FILENAME is a string of the font file (or nil if the font backend
3719 doesn't provide a file name).
3721 PIXEL-SIZE is a pixel size by which the font is opened.
3723 SIZE is a maximum advance width of the font in pixel.
3725 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
3728 CAPABILITY is a list whose first element is a symbol representing the
3729 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
3730 remaining elements describes a detail of the font capability.
3732 If the font is OpenType font, the form of the list is
3733 \(opentype GSUB GPOS)
3734 where GSUB shows which "GSUB" features the font supports, and GPOS
3735 shows which "GPOS" features the font supports. Both GSUB and GPOS are
3736 lists of the format:
3737 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3739 If the font is not OpenType font, currently the length of the form is
3742 SCRIPT is a symbol representing OpenType script tag.
3744 LANGSYS is a symbol representing OpenType langsys tag, or nil
3745 representing the default langsys.
3747 FEATURE is a symbol representing OpenType feature tag.
3749 If the font is not OpenType font, OTF-CAPABILITY is nil. */)
3751 Lisp_Object font_object
;
3756 CHECK_FONT_GET_OBJECT (font_object
, font
);
3758 val
= Fmake_vector (make_number (9), Qnil
);
3759 if (font
->font
.full_name
)
3760 ASET (val
, 0, make_unibyte_string (font
->font
.full_name
,
3761 strlen (font
->font
.full_name
)));
3762 if (font
->file_name
)
3763 ASET (val
, 1, make_unibyte_string (font
->file_name
,
3764 strlen (font
->file_name
)));
3765 ASET (val
, 2, make_number (font
->pixel_size
));
3766 ASET (val
, 3, make_number (font
->font
.size
));
3767 ASET (val
, 4, make_number (font
->ascent
));
3768 ASET (val
, 5, make_number (font
->descent
));
3769 ASET (val
, 6, make_number (font
->font
.space_width
));
3770 ASET (val
, 7, make_number (font
->font
.average_width
));
3771 if (font
->driver
->otf_capability
)
3772 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
3774 ASET (val
, 8, Fcons (font
->format
, Qnil
));
3778 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
3779 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
3780 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
3781 (font_object
, string
)
3782 Lisp_Object font_object
, string
;
3788 CHECK_FONT_GET_OBJECT (font_object
, font
);
3789 CHECK_STRING (string
);
3790 len
= SCHARS (string
);
3791 vec
= Fmake_vector (make_number (len
), Qnil
);
3792 for (i
= 0; i
< len
; i
++)
3794 Lisp_Object ch
= Faref (string
, make_number (i
));
3798 struct font_metrics metrics
;
3800 code
= font
->driver
->encode_char (font
, c
);
3801 if (code
== FONT_INVALID_CODE
)
3803 val
= Fmake_vector (make_number (6), Qnil
);
3804 if (code
<= MOST_POSITIVE_FIXNUM
)
3805 ASET (val
, 0, make_number (code
));
3807 ASET (val
, 0, Fcons (make_number (code
>> 16),
3808 make_number (code
& 0xFFFF)));
3809 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
3810 ASET (val
, 1, make_number (metrics
.lbearing
));
3811 ASET (val
, 2, make_number (metrics
.rbearing
));
3812 ASET (val
, 3, make_number (metrics
.width
));
3813 ASET (val
, 4, make_number (metrics
.ascent
));
3814 ASET (val
, 5, make_number (metrics
.descent
));
3820 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
3821 doc
: /* Return t iff font-spec SPEC matches with FONT.
3822 FONT is a font-spec, font-entity, or font-object. */)
3824 Lisp_Object spec
, font
;
3826 CHECK_FONT_SPEC (spec
);
3827 if (FONT_OBJECT_P (font
))
3828 font
= ((struct font
*) XSAVE_VALUE (font
)->pointer
)->entity
;
3829 else if (! FONT_ENTITY_P (font
))
3830 CHECK_FONT_SPEC (font
);
3832 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
3835 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 2, 0,
3836 doc
: /* Return a font-object for displaying a character at POSISTION.
3837 Optional second arg WINDOW, if non-nil, is a window displaying
3838 the current buffer. It defaults to the currently selected window. */)
3840 Lisp_Object position
, window
;
3843 EMACS_INT pos
, pos_byte
;
3846 CHECK_NUMBER_COERCE_MARKER (position
);
3847 pos
= XINT (position
);
3848 if (pos
< BEGV
|| pos
>= ZV
)
3849 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
3850 pos_byte
= CHAR_TO_BYTE (pos
);
3851 c
= FETCH_CHAR (pos_byte
);
3853 window
= selected_window
;
3854 CHECK_LIVE_WINDOW (window
);
3855 w
= XWINDOW (selected_window
);
3857 return font_at (c
, pos
, NULL
, w
, Qnil
);
3861 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
3862 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
3863 The value is a number of glyphs drawn.
3864 Type C-l to recover what previously shown. */)
3865 (font_object
, string
)
3866 Lisp_Object font_object
, string
;
3868 Lisp_Object frame
= selected_frame
;
3869 FRAME_PTR f
= XFRAME (frame
);
3875 CHECK_FONT_GET_OBJECT (font_object
, font
);
3876 CHECK_STRING (string
);
3877 len
= SCHARS (string
);
3878 code
= alloca (sizeof (unsigned) * len
);
3879 for (i
= 0; i
< len
; i
++)
3881 Lisp_Object ch
= Faref (string
, make_number (i
));
3885 code
[i
] = font
->driver
->encode_char (font
, c
);
3886 if (code
[i
] == FONT_INVALID_CODE
)
3889 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3891 if (font
->driver
->prepare_face
)
3892 font
->driver
->prepare_face (f
, face
);
3893 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
3894 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
3895 if (font
->driver
->done_face
)
3896 font
->driver
->done_face (f
, face
);
3898 return make_number (len
);
3902 #endif /* FONT_DEBUG */
3905 extern void syms_of_ftfont
P_ (());
3906 extern void syms_of_xfont
P_ (());
3907 extern void syms_of_xftfont
P_ (());
3908 extern void syms_of_ftxfont
P_ (());
3909 extern void syms_of_bdffont
P_ (());
3910 extern void syms_of_w32font
P_ (());
3911 extern void syms_of_atmfont
P_ (());
3916 sort_shift_bits
[FONT_SLANT_INDEX
] = 0;
3917 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 7;
3918 sort_shift_bits
[FONT_SIZE_INDEX
] = 14;
3919 sort_shift_bits
[FONT_WIDTH_INDEX
] = 21;
3920 sort_shift_bits
[FONT_ADSTYLE_INDEX
] = 28;
3921 sort_shift_bits
[FONT_FOUNDRY_INDEX
] = 29;
3922 sort_shift_bits
[FONT_FAMILY_INDEX
] = 30;
3923 sort_shift_bits
[FONT_REGISTRY_INDEX
] = 31;
3924 /* Note that sort_shift_bits[FONT_TYPE_INDEX] is never used. */
3926 staticpro (&font_style_table
);
3927 font_style_table
= Fmake_vector (make_number (3), Qnil
);
3929 staticpro (&font_family_alist
);
3930 font_family_alist
= Qnil
;
3932 DEFSYM (Qfontp
, "fontp");
3933 DEFSYM (Qopentype
, "opentype");
3935 DEFSYM (Qiso8859_1
, "iso8859-1");
3936 DEFSYM (Qiso10646_1
, "iso10646-1");
3937 DEFSYM (Qunicode_bmp
, "unicode-bmp");
3938 DEFSYM (Qunicode_sip
, "unicode-sip");
3940 DEFSYM (QCotf
, ":otf");
3941 DEFSYM (QClanguage
, ":language");
3942 DEFSYM (QCscript
, ":script");
3944 DEFSYM (QCfoundry
, ":foundry");
3945 DEFSYM (QCadstyle
, ":adstyle");
3946 DEFSYM (QCregistry
, ":registry");
3947 DEFSYM (QCspacing
, ":spacing");
3948 DEFSYM (QCdpi
, ":dpi");
3949 DEFSYM (QCscalable
, ":scalable");
3950 DEFSYM (QCextra
, ":extra");
3957 staticpro (&null_string
);
3958 null_string
= build_string ("");
3959 staticpro (&null_vector
);
3960 null_vector
= Fmake_vector (make_number (0), Qnil
);
3962 staticpro (&scratch_font_spec
);
3963 scratch_font_spec
= Ffont_spec (0, NULL
);
3964 staticpro (&scratch_font_prefer
);
3965 scratch_font_prefer
= Ffont_spec (0, NULL
);
3968 staticpro (&otf_list
);
3973 defsubr (&Sfont_spec
);
3974 defsubr (&Sfont_get
);
3975 defsubr (&Sfont_put
);
3976 defsubr (&Slist_fonts
);
3977 defsubr (&Slist_families
);
3978 defsubr (&Sfind_font
);
3979 defsubr (&Sfont_xlfd_name
);
3980 defsubr (&Sclear_font_cache
);
3981 defsubr (&Sinternal_set_font_style_table
);
3982 defsubr (&Sfont_make_gstring
);
3983 defsubr (&Sfont_fill_gstring
);
3984 defsubr (&Sfont_drive_otf
);
3985 defsubr (&Sfont_otf_alternates
);
3988 defsubr (&Sopen_font
);
3989 defsubr (&Sclose_font
);
3990 defsubr (&Squery_font
);
3991 defsubr (&Sget_font_glyphs
);
3992 defsubr (&Sfont_match_p
);
3993 defsubr (&Sfont_at
);
3995 defsubr (&Sdraw_string
);
3997 #endif /* FONT_DEBUG */
3999 #ifdef HAVE_FREETYPE
4001 #ifdef HAVE_X_WINDOWS
4006 #endif /* HAVE_XFT */
4007 #endif /* HAVE_X_WINDOWS */
4008 #else /* not HAVE_FREETYPE */
4009 #ifdef HAVE_X_WINDOWS
4011 #endif /* HAVE_X_WINDOWS */
4012 #endif /* not HAVE_FREETYPE */
4015 #endif /* HAVE_BDFFONT */
4018 #endif /* WINDOWSNT */
4024 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
4025 (do not change this comment) */