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 /* Important character set symbols. */
56 Lisp_Object Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
58 /* Like CHECK_FONT_SPEC but also validate properties of the font-spec,
59 and set X to the validated result. */
61 #define CHECK_VALIDATE_FONT_SPEC(x) \
63 if (! FONT_SPEC_P (x)) x = wrong_type_argument (Qfont, x); \
64 x = font_prop_validate (x); \
67 /* Number of pt per inch (from the TeXbook). */
68 #define PT_PER_INCH 72.27
70 /* Return a pixel size (integer) corresponding to POINT size (double)
72 #define POINT_TO_PIXEL(POINT, DPI) ((POINT) * (DPI) / PT_PER_INCH + 0.5)
74 /* Return a point size (double) corresponding to POINT size (integer)
76 #define PIXEL_TO_POINT(PIXEL, DPI) ((PIXEL) * PT_PER_INCH * 10 / (DPI) + 0.5)
78 /* Special string of zero length. It is used to specify a NULL name
79 in a font properties (e.g. adstyle). We don't use the symbol of
80 NULL name because it's confusing (Lisp printer prints nothing for
82 Lisp_Object null_string
;
84 /* Special vector of zero length. This is repeatedly used by (struct
85 font_driver *)->list when a specified font is not found. */
86 Lisp_Object null_vector
;
88 /* Vector of 3 elements. Each element is an alist for one of font
89 style properties (weight, slant, width). The alist contains a
90 mapping between symbolic property values (e.g. `medium' for weight)
91 and numeric property values (e.g. 100). So, it looks like this:
92 [((thin . 0) ... (heavy . 210))
93 ((ro . 0) ... (ot . 210))
94 ((ultracondensed . 50) ... (wide . 200))] */
95 static Lisp_Object font_style_table
;
97 /* Alist of font family vs the corresponding aliases.
98 Each element has this form:
99 (FAMILY ALIAS1 ALIAS2 ...) */
101 static Lisp_Object font_family_alist
;
103 /* Symbols representing keys of normal font properties. */
104 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
, QCsize
, QCname
;
105 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
, QCextra
;
106 /* Symbols representing keys of font extra info. */
107 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClanguage
, QCscript
;
108 /* Symbols representing values of font spacing property. */
109 Lisp_Object Qc
, Qm
, Qp
, Qd
;
111 /* List of all font drivers. All font-backends (XXXfont.c) call
112 add_font_driver in syms_of_XXXfont to register the font-driver
114 static struct font_driver_list
*font_driver_list
;
116 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
117 static Lisp_Object prop_name_to_numeric
P_ ((enum font_property_index
,
119 static Lisp_Object prop_numeric_to_name
P_ ((enum font_property_index
, int));
120 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
121 static void build_font_family_alist
P_ ((void));
123 /* Number of registered font drivers. */
124 static int num_font_drivers
;
126 /* Return a pixel size of font-spec SPEC on frame F. */
129 font_pixel_size (f
, spec
)
133 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
136 Lisp_Object extra
, val
;
142 point_size
= XFLOAT_DATA (size
);
143 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
144 val
= assq_no_quit (extra
, QCdpi
);
147 if (INTEGERP (XCDR (val
)))
148 dpi
= XINT (XCDR (val
));
150 dpi
= XFLOAT_DATA (XCDR (val
)) + 0.5;
154 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
158 /* Return a numeric value corresponding to PROP's NAME (symbol). If
159 NAME is not registered in font_style_table, return Qnil. PROP must
160 be one of FONT_{WEIGHT|SLANT|SWIDTH}_INDEX. */
163 prop_name_to_numeric (prop
, name
)
164 enum font_property_index prop
;
167 int table_index
= prop
- FONT_WEIGHT_INDEX
;
170 val
= assq_no_quit (name
, AREF (font_style_table
, table_index
));
171 return (NILP (val
) ? Qnil
: XCDR (val
));
175 /* Return a name (symbol) corresponding to PROP's NUMERIC value. If
176 no name is registered for NUMERIC in font_style_table, return a
177 symbol of integer name (e.g. `123'). PROP must be one of
178 FONT_{WEIGHT|SLANT|SWIDTH}_INDEX. */
181 prop_numeric_to_name (prop
, numeric
)
182 enum font_property_index prop
;
185 int table_index
= prop
- FONT_WEIGHT_INDEX
;
186 Lisp_Object table
= AREF (font_style_table
, table_index
);
189 while (! NILP (table
))
191 if (XINT (XCDR (XCAR (table
))) >= numeric
)
193 if (XINT (XCDR (XCAR (table
))) == numeric
)
194 return XCAR (XCAR (table
));
198 table
= XCDR (table
);
200 sprintf (buf
, "%d", numeric
);
205 /* Return a symbol whose name is STR (length LEN). If STR contains
206 uppercase letters, downcase them in advance. */
209 intern_downcase (str
, len
)
216 for (i
= 0; i
< len
; i
++)
217 if (isupper (str
[i
]))
220 return Fintern (make_unibyte_string (str
, len
), Qnil
);
223 return Fintern (null_string
, Qnil
);
224 bcopy (str
, buf
, len
);
226 if (isascii (buf
[i
]))
227 buf
[i
] = tolower (buf
[i
]);
228 return Fintern (make_unibyte_string (buf
, len
), Qnil
);
231 extern Lisp_Object Vface_alternative_font_family_alist
;
234 build_font_family_alist ()
236 Lisp_Object alist
= Vface_alternative_font_family_alist
;
238 for (; CONSP (alist
); alist
= XCDR (alist
))
240 Lisp_Object tail
, elt
;
242 for (tail
= XCAR (alist
), elt
= Qnil
; CONSP (tail
); tail
= XCDR (tail
))
243 elt
= nconc2 (elt
, Fcons (Fintern (XCAR (tail
), Qnil
), Qnil
));
244 font_family_alist
= Fcons (elt
, font_family_alist
);
249 /* Font property validater. */
251 static Lisp_Object font_prop_validate_symbol
P_ ((enum font_property_index
,
252 Lisp_Object
, Lisp_Object
));
253 static Lisp_Object font_prop_validate_style
P_ ((enum font_property_index
,
254 Lisp_Object
, Lisp_Object
));
255 static Lisp_Object font_prop_validate_non_neg
P_ ((enum font_property_index
,
256 Lisp_Object
, Lisp_Object
));
257 static Lisp_Object font_prop_validate_spacing
P_ ((enum font_property_index
,
258 Lisp_Object
, Lisp_Object
));
259 static int get_font_prop_index
P_ ((Lisp_Object
, int));
260 static Lisp_Object font_prop_validate
P_ ((Lisp_Object
));
261 static Lisp_Object font_put_extra
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
264 font_prop_validate_symbol (prop_index
, prop
, val
)
265 enum font_property_index prop_index
;
266 Lisp_Object prop
, val
;
268 if (EQ (prop
, QCotf
))
269 return (SYMBOLP (val
) ? val
: Qerror
);
271 val
= (SCHARS (val
) == 0 ? null_string
272 : intern_downcase ((char *) SDATA (val
), SBYTES (val
)));
273 else if (SYMBOLP (val
))
275 if (SCHARS (SYMBOL_NAME (val
)) == 0)
284 font_prop_validate_style (prop_index
, prop
, val
)
285 enum font_property_index prop_index
;
286 Lisp_Object prop
, val
;
288 if (! INTEGERP (val
))
291 val
= intern_downcase ((char *) SDATA (val
), SBYTES (val
));
296 val
= prop_name_to_numeric (prop_index
, val
);
305 font_prop_validate_non_neg (prop_index
, prop
, val
)
306 enum font_property_index prop_index
;
307 Lisp_Object prop
, val
;
309 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
314 font_prop_validate_spacing (prop_index
, prop
, val
)
315 enum font_property_index prop_index
;
316 Lisp_Object prop
, val
;
318 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
321 return make_number (FONT_SPACING_CHARCELL
);
323 return make_number (FONT_SPACING_MONO
);
325 return make_number (FONT_SPACING_PROPORTIONAL
);
329 /* Structure of known font property keys and validater of the
333 /* Pointer to the key symbol. */
335 /* Function to validate the value VAL, or NULL if any value is ok. */
336 Lisp_Object (*validater
) P_ ((enum font_property_index prop_index
,
337 Lisp_Object prop
, Lisp_Object val
));
338 } font_property_table
[] =
339 { { &QCtype
, font_prop_validate_symbol
},
340 { &QCfoundry
, font_prop_validate_symbol
},
341 { &QCfamily
, font_prop_validate_symbol
},
342 { &QCadstyle
, font_prop_validate_symbol
},
343 { &QCregistry
, font_prop_validate_symbol
},
344 { &QCweight
, font_prop_validate_style
},
345 { &QCslant
, font_prop_validate_style
},
346 { &QCwidth
, font_prop_validate_style
},
347 { &QCsize
, font_prop_validate_non_neg
},
348 { &QClanguage
, font_prop_validate_symbol
},
349 { &QCscript
, font_prop_validate_symbol
},
350 { &QCdpi
, font_prop_validate_non_neg
},
351 { &QCspacing
, font_prop_validate_spacing
},
352 { &QCscalable
, NULL
},
353 { &QCotf
, font_prop_validate_symbol
}
356 #define FONT_PROPERTY_TABLE_SIZE \
357 ((sizeof font_property_table) / (sizeof *font_property_table))
360 get_font_prop_index (key
, from
)
364 for (; from
< FONT_PROPERTY_TABLE_SIZE
; from
++)
365 if (EQ (key
, *font_property_table
[from
].key
))
371 font_prop_validate (spec
)
375 Lisp_Object prop
, val
, extra
;
377 for (i
= FONT_TYPE_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
379 if (! NILP (AREF (spec
, i
)))
381 prop
= *font_property_table
[i
].key
;
382 val
= (font_property_table
[i
].validater
) (i
, prop
, AREF (spec
, i
));
383 if (EQ (val
, Qerror
))
384 Fsignal (Qfont
, list2 (build_string ("invalid font property"),
385 Fcons (prop
, AREF (spec
, i
))));
389 for (extra
= AREF (spec
, FONT_EXTRA_INDEX
);
390 CONSP (extra
); extra
= XCDR (extra
))
392 Lisp_Object elt
= XCAR (extra
);
395 i
= get_font_prop_index (prop
, FONT_EXTRA_INDEX
);
397 && font_property_table
[i
].validater
)
399 val
= (font_property_table
[i
].validater
) (i
, prop
, XCDR (elt
));
400 if (EQ (val
, Qerror
))
401 Fsignal (Qfont
, list2 (build_string ("invalid font property"),
410 font_put_extra (font
, prop
, val
)
411 Lisp_Object font
, prop
, val
;
413 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
414 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
418 extra
= Fcons (Fcons (prop
, val
), extra
);
419 ASET (font
, FONT_EXTRA_INDEX
, extra
);
427 /* Font name parser and unparser */
429 static Lisp_Object intern_font_field
P_ ((char *, int));
430 static int parse_matrix
P_ ((char *));
431 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
432 static int font_parse_name
P_ ((char *, Lisp_Object
));
434 /* An enumerator for each field of an XLFD font name. */
435 enum xlfd_field_index
454 /* An enumerator for mask bit corresponding to each XLFD field. */
457 XLFD_FOUNDRY_MASK
= 0x0001,
458 XLFD_FAMILY_MASK
= 0x0002,
459 XLFD_WEIGHT_MASK
= 0x0004,
460 XLFD_SLANT_MASK
= 0x0008,
461 XLFD_SWIDTH_MASK
= 0x0010,
462 XLFD_ADSTYLE_MASK
= 0x0020,
463 XLFD_PIXEL_MASK
= 0x0040,
464 XLFD_POINT_MASK
= 0x0080,
465 XLFD_RESX_MASK
= 0x0100,
466 XLFD_RESY_MASK
= 0x0200,
467 XLFD_SPACING_MASK
= 0x0400,
468 XLFD_AVGWIDTH_MASK
= 0x0800,
469 XLFD_REGISTRY_MASK
= 0x1000,
470 XLFD_ENCODING_MASK
= 0x2000
474 /* Return a Lispy value of a XLFD font field at STR and LEN bytes.
475 If LEN is zero, it returns `null_string'.
476 If STR is "*", it returns nil.
477 If all characters in STR are digits, it returns an integer.
478 Otherwise, it returns a symbol interned from downcased STR. */
481 intern_font_field (str
, len
)
489 if (*str
== '*' && len
== 1)
493 for (i
= 1; i
< len
; i
++)
494 if (! isdigit (str
[i
]))
497 return make_number (atoi (str
));
499 return intern_downcase (str
, len
);
502 /* Parse P pointing the pixel/point size field of the form
503 `[A B C D]' which specifies a transformation matrix:
509 by which all glyphs of the font are transformed. The spec says
510 that scalar value N for the pixel/point size is equivalent to:
511 A = N * resx/resy, B = C = 0, D = N.
513 Return the scalar value N if the form is valid. Otherwise return
524 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
527 matrix
[i
] = - strtod (p
+ 1, &end
);
529 matrix
[i
] = strtod (p
, &end
);
532 return (i
== 4 ? (int) matrix
[3] : -1);
535 /* Expand a wildcard field in FIELD (the first N fields are filled) to
536 multiple fields to fill in all 14 XLFD fields while restring a
537 field position by its contents. */
540 font_expand_wildcards (field
, n
)
541 Lisp_Object field
[XLFD_LAST_INDEX
];
545 Lisp_Object tmp
[XLFD_LAST_INDEX
];
546 /* Array of information about where this element can go. Nth
547 element is for Nth element of FIELD. */
549 /* Minimum possible field. */
551 /* Maxinum possible field. */
553 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
555 } range
[XLFD_LAST_INDEX
];
557 int range_from
, range_to
;
560 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
561 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
562 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
563 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
564 | XLFD_AVGWIDTH_MASK)
565 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
567 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
568 field. The value is shifted to left one bit by one in the
570 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
571 range_mask
= (range_mask
<< 1) | 1;
573 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
574 position-based retriction for FIELD[I]. */
575 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
576 i
++, range_from
++, range_to
++, range_mask
<<= 1)
578 Lisp_Object val
= field
[i
];
584 range
[i
].from
= range_from
;
585 range
[i
].to
= range_to
;
586 range
[i
].mask
= range_mask
;
590 /* The triplet FROM, TO, and MASK is a value-based
591 retriction for FIELD[I]. */
597 int numeric
= XINT (val
);
600 from
= to
= XLFD_ENCODING_INDEX
,
601 mask
= XLFD_ENCODING_MASK
;
602 else if (numeric
== 0)
603 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
604 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
605 else if (numeric
<= 48)
606 from
= to
= XLFD_PIXEL_INDEX
,
607 mask
= XLFD_PIXEL_MASK
;
609 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
610 mask
= XLFD_LARGENUM_MASK
;
612 else if (EQ (val
, null_string
))
613 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
614 mask
= XLFD_NULL_MASK
;
616 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
619 Lisp_Object name
= SYMBOL_NAME (val
);
621 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
622 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
623 mask
= XLFD_REGENC_MASK
;
625 from
= to
= XLFD_ENCODING_INDEX
,
626 mask
= XLFD_ENCODING_MASK
;
628 else if (range_from
<= XLFD_WEIGHT_INDEX
629 && range_to
>= XLFD_WEIGHT_INDEX
630 && !NILP (prop_name_to_numeric (FONT_WEIGHT_INDEX
, val
)))
631 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
632 else if (range_from
<= XLFD_SLANT_INDEX
633 && range_to
>= XLFD_SLANT_INDEX
634 && !NILP (prop_name_to_numeric (FONT_SLANT_INDEX
, val
)))
635 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
636 else if (range_from
<= XLFD_SWIDTH_INDEX
637 && range_to
>= XLFD_SWIDTH_INDEX
638 && !NILP (prop_name_to_numeric (FONT_WIDTH_INDEX
, val
)))
639 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
642 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
643 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
645 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
646 mask
= XLFD_SYMBOL_MASK
;
649 /* Merge position-based and value-based restrictions. */
651 while (from
< range_from
)
652 mask
&= ~(1 << from
++);
653 while (from
< 14 && ! (mask
& (1 << from
)))
655 while (to
> range_to
)
656 mask
&= ~(1 << to
--);
657 while (to
>= 0 && ! (mask
& (1 << to
)))
661 range
[i
].from
= from
;
663 range
[i
].mask
= mask
;
665 if (from
> range_from
|| to
< range_to
)
667 /* The range is narrowed by value-based restrictions.
668 Reflect it to the other fields. */
670 /* Following fields should be after FROM. */
672 /* Preceding fields should be before TO. */
673 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
675 /* Check FROM for non-wildcard field. */
676 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
678 while (range
[j
].from
< from
)
679 range
[j
].mask
&= ~(1 << range
[j
].from
++);
680 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
682 range
[j
].from
= from
;
685 from
= range
[j
].from
;
686 if (range
[j
].to
> to
)
688 while (range
[j
].to
> to
)
689 range
[j
].mask
&= ~(1 << range
[j
].to
--);
690 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
703 /* Decide all fileds from restrictions in RANGE. */
704 for (i
= j
= 0; i
< n
; i
++)
706 if (j
< range
[i
].from
)
708 if (i
== 0 || ! NILP (tmp
[i
- 1]))
709 /* None of TMP[X] corresponds to Jth field. */
711 for (; j
< range
[i
].from
; j
++)
716 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
718 for (; j
< XLFD_LAST_INDEX
; j
++)
720 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
721 field
[XLFD_ENCODING_INDEX
]
722 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
726 /* Parse NAME (null terminated) as XLFD and store information in FONT
727 (font-spec or font-entity). Size property of FONT is set as
729 specified XLFD fields FONT property
730 --------------------- -------------
731 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
732 POINT_SIZE and RESY calculated pixel size (Lisp integer)
733 POINT_SIZE POINT_SIZE/10 (Lisp float)
735 If NAME is successfully parsed, return 0. Otherwise return -1.
737 FONT is usually a font-spec, but when this function is called from
738 X font backend driver, it is a font-entity. In that case, NAME is
739 a fully specified XLFD, and we set FONT_EXTRA_INDEX of FONT to a
740 symbol RESX-RESY-SPACING-AVGWIDTH.
744 font_parse_xlfd (name
, font
)
748 int len
= strlen (name
);
750 Lisp_Object dpi
, spacing
;
752 char *f
[XLFD_LAST_INDEX
];
757 /* Maximum XLFD name length is 255. */
759 /* Accept "*-.." as a fully specified XLFD. */
760 if (name
[0] == '*' && name
[1] == '-')
761 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
764 for (p
= name
+ i
; *p
; p
++)
765 if (*p
== '-' && i
< XLFD_LAST_INDEX
)
769 dpi
= spacing
= Qnil
;
772 if (i
== XLFD_LAST_INDEX
)
776 /* Fully specified XLFD. */
777 for (i
= 0, j
= FONT_FOUNDRY_INDEX
; i
< XLFD_WEIGHT_INDEX
; i
++, j
++)
779 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
783 for (j
= FONT_WEIGHT_INDEX
; i
< XLFD_ADSTYLE_INDEX
; i
++, j
++)
785 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
788 Lisp_Object numeric
= prop_name_to_numeric (j
, val
);
790 if (INTEGERP (numeric
))
795 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
797 ASET (font
, FONT_ADSTYLE_INDEX
, val
);
798 i
= XLFD_REGISTRY_INDEX
;
799 val
= intern_font_field (f
[i
], f
[i
+ 2] - f
[i
]);
801 ASET (font
, FONT_REGISTRY_INDEX
, val
);
803 p
= f
[XLFD_PIXEL_INDEX
];
804 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
805 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
808 i
= XLFD_PIXEL_INDEX
;
809 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
811 ASET (font
, FONT_SIZE_INDEX
, val
);
814 double point_size
= -1;
816 xassert (FONT_SPEC_P (font
));
817 p
= f
[XLFD_POINT_INDEX
];
819 point_size
= parse_matrix (p
);
820 else if (isdigit (*p
))
821 point_size
= atoi (p
), point_size
/= 10;
823 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
826 i
= XLFD_PIXEL_INDEX
;
827 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
829 ASET (font
, FONT_SIZE_INDEX
, val
);
834 /* Parse RESX, RESY, SPACING, and AVGWIDTH. */
835 if (FONT_ENTITY_P (font
))
838 ASET (font
, FONT_EXTRA_INDEX
,
839 intern_font_field (f
[i
], f
[XLFD_REGISTRY_INDEX
] - 1 - f
[i
]));
843 /* Here we just setup DPI, SPACING, and AVGWIDTH. They are set
844 in FONT_EXTRA_INDEX later. */
846 dpi
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
847 i
= XLFD_SPACING_INDEX
;
848 spacing
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
849 p
= f
[XLFD_AVGWIDTH_INDEX
];
857 int wild_card_found
= 0;
858 Lisp_Object prop
[XLFD_LAST_INDEX
];
860 for (j
= 0; j
< i
; j
++)
864 if (f
[j
][1] && f
[j
][1] != '-')
869 else if (isdigit (*f
[j
]))
871 for (p
= f
[j
] + 1; isdigit (*p
); p
++);
873 prop
[j
] = intern_downcase (f
[j
], p
- f
[j
]);
875 prop
[j
] = make_number (atoi (f
[j
]));
878 prop
[j
] = intern_font_field (f
[j
], f
[j
+ 1] - 1 - f
[j
]);
880 prop
[j
] = intern_font_field (f
[j
], f
[i
] - f
[j
]);
882 if (! wild_card_found
)
884 if (font_expand_wildcards (prop
, i
) < 0)
887 for (i
= 0, j
= FONT_FOUNDRY_INDEX
; i
< XLFD_WEIGHT_INDEX
; i
++, j
++)
888 if (! NILP (prop
[i
]))
889 ASET (font
, j
, prop
[i
]);
890 for (j
= FONT_WEIGHT_INDEX
; i
< XLFD_ADSTYLE_INDEX
; i
++, j
++)
891 if (! NILP (prop
[i
]))
892 ASET (font
, j
, prop
[i
]);
893 if (! NILP (prop
[XLFD_ADSTYLE_INDEX
]))
894 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
895 val
= prop
[XLFD_REGISTRY_INDEX
];
898 val
= prop
[XLFD_ENCODING_INDEX
];
900 val
= Fintern (concat2 (build_string ("*-"), SYMBOL_NAME (val
)),
903 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
904 val
= Fintern (concat2 (SYMBOL_NAME (val
), build_string ("-*")),
907 val
= Fintern (concat3 (SYMBOL_NAME (val
), build_string ("-"),
908 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
])),
911 ASET (font
, FONT_REGISTRY_INDEX
, val
);
913 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
914 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
915 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
917 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
919 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
922 dpi
= prop
[XLFD_RESX_INDEX
];
923 spacing
= prop
[XLFD_SPACING_INDEX
];
924 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
925 avgwidth
= XINT (prop
[XLFD_AVGWIDTH_INDEX
]);
929 font_put_extra (font
, QCdpi
, dpi
);
930 if (! NILP (spacing
))
931 font_put_extra (font
, QCspacing
, spacing
);
933 font_put_extra (font
, QCscalable
, avgwidth
== 0 ? Qt
: Qnil
);
938 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
939 length), and return the name length. If FONT_SIZE_INDEX of FONT is
940 0, use PIXEL_SIZE instead. */
943 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
949 char *f
[XLFD_REGISTRY_INDEX
+ 1];
953 xassert (FONTP (font
));
955 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
958 if (i
== FONT_ADSTYLE_INDEX
)
959 j
= XLFD_ADSTYLE_INDEX
;
960 else if (i
== FONT_REGISTRY_INDEX
)
961 j
= XLFD_REGISTRY_INDEX
;
962 val
= AREF (font
, i
);
965 if (j
== XLFD_REGISTRY_INDEX
)
966 f
[j
] = "*-*", len
+= 4;
968 f
[j
] = "*", len
+= 2;
973 val
= SYMBOL_NAME (val
);
974 if (j
== XLFD_REGISTRY_INDEX
975 && ! strchr ((char *) SDATA (val
), '-'))
977 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
978 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
980 f
[j
] = alloca (SBYTES (val
) + 3);
981 sprintf (f
[j
], "%s-*", SDATA (val
));
982 len
+= SBYTES (val
) + 3;
986 f
[j
] = alloca (SBYTES (val
) + 4);
987 sprintf (f
[j
], "%s*-*", SDATA (val
));
988 len
+= SBYTES (val
) + 4;
992 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
996 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
999 val
= AREF (font
, i
);
1001 f
[j
] = "*", len
+= 2;
1005 val
= prop_numeric_to_name (i
, XINT (val
));
1007 val
= SYMBOL_NAME (val
);
1008 xassert (STRINGP (val
));
1009 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1013 val
= AREF (font
, FONT_SIZE_INDEX
);
1014 xassert (NUMBERP (val
) || NILP (val
));
1017 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1020 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1022 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", pixel_size
) + 1;
1024 else if (FLOATP (val
))
1026 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1027 i
= XFLOAT_DATA (val
) * 10;
1028 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1031 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1033 val
= AREF (font
, FONT_EXTRA_INDEX
);
1035 if (FONT_ENTITY_P (font
)
1036 && EQ (AREF (font
, FONT_TYPE_INDEX
), Qx
))
1038 /* Setup names for RESX-RESY-SPACING-AVWIDTH. */
1039 if (SYMBOLP (val
) && ! NILP (val
))
1041 val
= SYMBOL_NAME (val
);
1042 f
[XLFD_RESX_INDEX
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1045 f
[XLFD_RESX_INDEX
] = "*-*-*-*", len
+= 6;
1049 Lisp_Object dpi
= assq_no_quit (QCdpi
, val
);
1050 Lisp_Object spacing
= assq_no_quit (QCspacing
, val
);
1051 Lisp_Object scalable
= assq_no_quit (QCscalable
, val
);
1053 if (CONSP (dpi
) || CONSP (spacing
) || CONSP (scalable
))
1055 char *str
= alloca (24);
1058 if (CONSP (dpi
) && INTEGERP (XCDR (dpi
)))
1059 this_len
= sprintf (str
, "%d-%d",
1060 XINT (XCDR (dpi
)), XINT (XCDR (dpi
)));
1062 this_len
= sprintf (str
, "*-*");
1063 if (CONSP (spacing
) && ! NILP (XCDR (spacing
)))
1065 val
= XCDR (spacing
);
1068 if (XINT (val
) < FONT_SPACING_MONO
)
1070 else if (XINT (val
) < FONT_SPACING_CHARCELL
)
1075 xassert (SYMBOLP (val
));
1076 this_len
+= sprintf (str
+ this_len
, "-%c",
1077 SDATA (SYMBOL_NAME (val
))[0]);
1080 this_len
+= sprintf (str
+ this_len
, "-*");
1081 if (CONSP (scalable
) && ! NILP (XCDR (spacing
)))
1082 this_len
+= sprintf (str
+ this_len
, "-0");
1084 this_len
+= sprintf (str
+ this_len
, "-*");
1085 f
[XLFD_RESX_INDEX
] = str
;
1089 f
[XLFD_RESX_INDEX
] = "*-*-*-*", len
+= 8;
1092 len
++; /* for terminating '\0'. */
1095 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1096 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1097 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1098 f
[XLFD_SWIDTH_INDEX
],
1099 f
[XLFD_ADSTYLE_INDEX
], f
[XLFD_PIXEL_INDEX
],
1100 f
[XLFD_RESX_INDEX
], f
[XLFD_REGISTRY_INDEX
]);
1103 /* Parse NAME (null terminated) as Fonconfig's name format and store
1104 information in FONT (font-spec or font-entity). If NAME is
1105 successfully parsed, return 0. Otherwise return -1. */
1108 font_parse_fcname (name
, font
)
1113 int len
= strlen (name
);
1118 /* It is assured that (name[0] && name[0] != '-'). */
1126 for (p0
= name
+ 1; *p0
&& (*p0
!= '-' && *p0
!= ':'); p0
++)
1127 if (*p0
== '\\' && p0
[1])
1129 family
= intern_font_field (name
, p0
- name
);
1132 if (! isdigit (p0
[1]))
1134 point_size
= strtod (p0
+ 1, &p1
);
1135 if (*p1
&& *p1
!= ':')
1137 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1140 ASET (font
, FONT_FAMILY_INDEX
, family
);
1144 copy
= alloca (len
+ 1);
1149 /* Now parse ":KEY=VAL" patterns. Store known keys and values in
1150 extra, copy unknown ones to COPY. */
1153 Lisp_Object key
, val
;
1156 for (p1
= p0
+ 1; *p1
&& *p1
!= '=' && *p1
!= ':'; p1
++);
1159 /* Must be an enumerated value. */
1160 val
= intern_font_field (p0
+ 1, p1
- p0
- 1);
1161 if (memcmp (p0
+ 1, "light", 5) == 0
1162 || memcmp (p0
+ 1, "medium", 6) == 0
1163 || memcmp (p0
+ 1, "demibold", 8) == 0
1164 || memcmp (p0
+ 1, "bold", 4) == 0
1165 || memcmp (p0
+ 1, "black", 5) == 0)
1167 ASET (font
, FONT_WEIGHT_INDEX
, val
);
1169 else if (memcmp (p0
+ 1, "roman", 5) == 0
1170 || memcmp (p0
+ 1, "italic", 6) == 0
1171 || memcmp (p0
+ 1, "oblique", 7) == 0)
1173 ASET (font
, FONT_SLANT_INDEX
, val
);
1175 else if (memcmp (p0
+ 1, "charcell", 8) == 0
1176 || memcmp (p0
+ 1, "mono", 4) == 0
1177 || memcmp (p0
+ 1, "proportional", 12) == 0)
1179 font_put_extra (font
, QCspacing
,
1180 (p0
[1] == 'c' ? Qc
: p0
[1] == 'm' ? Qm
: Qp
));
1185 bcopy (p0
, copy
, p1
- p0
);
1191 if (memcmp (p0
+ 1, "pixelsize=", 10) == 0)
1192 prop
= FONT_SIZE_INDEX
;
1195 key
= intern_font_field (p0
, p1
- p0
);
1196 prop
= get_font_prop_index (key
, 0);
1199 for (p1
= p0
; *p1
&& *p1
!= ':'; p1
++);
1200 val
= intern_font_field (p0
, p1
- p0
);
1203 if (prop
>= 0 && prop
< FONT_EXTRA_INDEX
)
1205 ASET (font
, prop
, val
);
1208 font_put_extra (font
, key
, val
);
1217 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1218 NAME (NBYTES length), and return the name length. If
1219 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1222 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1230 int dpi
, spacing
, scalable
;
1233 Lisp_Object styles
[3];
1234 char *style_names
[3] = { "weight", "slant", "width" };
1236 val
= AREF (font
, FONT_FAMILY_INDEX
);
1237 if (SYMBOLP (val
) && ! NILP (val
))
1238 len
+= SBYTES (SYMBOL_NAME (val
));
1240 val
= AREF (font
, FONT_SIZE_INDEX
);
1243 if (XINT (val
) != 0)
1244 pixel_size
= XINT (val
);
1246 len
+= 21; /* for ":pixelsize=NUM" */
1248 else if (FLOATP (val
))
1251 point_size
= (int) XFLOAT_DATA (val
);
1252 len
+= 11; /* for "-NUM" */
1255 val
= AREF (font
, FONT_FOUNDRY_INDEX
);
1256 if (SYMBOLP (val
) && ! NILP (val
))
1257 /* ":foundry=NAME" */
1258 len
+= 9 + SBYTES (SYMBOL_NAME (val
));
1260 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
1262 val
= AREF (font
, i
);
1265 val
= prop_numeric_to_name (i
, XINT (val
));
1266 len
+= (strlen (style_names
[i
- FONT_WEIGHT_INDEX
])
1267 + 2 + SBYTES (SYMBOL_NAME (val
))); /* :xxx=NAME */
1269 styles
[i
- FONT_WEIGHT_INDEX
] = val
;
1272 val
= AREF (font
, FONT_EXTRA_INDEX
);
1273 if (FONT_ENTITY_P (font
)
1274 && EQ (AREF (font
, FONT_TYPE_INDEX
), Qx
))
1278 /* VAL is a symbol of name `RESX-RESY-SPACING-AVWIDTH'. */
1279 p
= (char *) SDATA (SYMBOL_NAME (val
));
1281 for (p
++; *p
!= '-'; p
++); /* skip RESX */
1282 for (p
++; *p
!= '-'; p
++); /* skip RESY */
1283 spacing
= (*p
== 'c' ? FONT_SPACING_CHARCELL
1284 : *p
== 'm' ? FONT_SPACING_MONO
1285 : FONT_SPACING_PROPORTIONAL
);
1286 for (p
++; *p
!= '-'; p
++); /* skip SPACING */
1287 scalable
= (atoi (p
) == 0);
1288 /* The longest pattern is ":dpi=NUM:scalable=False:spacing=100" */
1295 dpi
= spacing
= scalable
= -1;
1296 elt
= assq_no_quit (QCdpi
, val
);
1298 dpi
= XINT (XCDR (elt
)), len
+= 15; /* for ":dpi=NUM" */
1299 elt
= assq_no_quit (QCspacing
, val
);
1301 spacing
= XINT (XCDR (elt
)), len
+= 12; /* for ":spacing=100" */
1302 elt
= assq_no_quit (QCscalable
, val
);
1304 scalable
= ! NILP (XCDR (elt
)), len
+= 15; /* for ":scalable=False" */
1310 if (! NILP (AREF (font
, FONT_FAMILY_INDEX
)))
1311 p
+= sprintf(p
, "%s",
1312 SDATA (SYMBOL_NAME (AREF (font
, FONT_FAMILY_INDEX
))));
1316 p
+= sprintf (p
, "%d", point_size
);
1318 p
+= sprintf (p
, "-%d", point_size
);
1320 else if (pixel_size
> 0)
1321 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1322 if (SYMBOLP (AREF (font
, FONT_FOUNDRY_INDEX
))
1323 && ! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1324 p
+= sprintf (p
, ":foundry=%s",
1325 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1326 for (i
= 0; i
< 3; i
++)
1327 if (! NILP (styles
[i
]))
1328 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1329 SDATA (SYMBOL_NAME (styles
[i
])));
1331 p
+= sprintf (p
, ":dpi=%d", dpi
);
1333 p
+= sprintf (p
, ":spacing=%d", spacing
);
1335 p
+= sprintf (p
, ":scalable=True");
1336 else if (scalable
== 0)
1337 p
+= sprintf (p
, ":scalable=False");
1341 /* Parse NAME (null terminated) and store information in FONT
1342 (font-spec or font-entity). If NAME is successfully parsed, return
1343 0. Otherwise return -1.
1345 If NAME is XLFD and FONT is a font-entity, store
1346 RESX-RESY-SPACING-AVWIDTH information as a symbol in
1347 FONT_EXTRA_INDEX. */
1350 font_parse_name (name
, font
)
1354 if (name
[0] == '-' || index (name
, '*'))
1355 return font_parse_xlfd (name
, font
);
1356 return font_parse_fcname (name
, font
);
1360 font_merge_old_spec (name
, family
, registry
, spec
)
1361 Lisp_Object name
, family
, registry
, spec
;
1365 if (font_parse_xlfd ((char *) SDATA (name
), spec
) < 0)
1367 Lisp_Object extra
= Fcons (Fcons (QCname
, name
), Qnil
);
1369 ASET (spec
, FONT_EXTRA_INDEX
, extra
);
1374 if (! NILP (family
))
1379 xassert (STRINGP (family
));
1380 len
= SBYTES (family
);
1381 p0
= (char *) SDATA (family
);
1382 p1
= index (p0
, '-');
1385 if ((*p0
!= '*' || p1
- p0
> 1)
1386 && NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
1387 ASET (spec
, FONT_FOUNDRY_INDEX
,
1388 intern_downcase (p0
, p1
- p0
));
1389 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
1390 ASET (spec
, FONT_FAMILY_INDEX
,
1391 intern_downcase (p1
+ 1, len
- (p1
+ 1 - p0
)));
1393 else if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
1394 ASET (spec
, FONT_FAMILY_INDEX
, intern_downcase (p0
, len
));
1396 if (! NILP (registry
)
1397 && NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
1398 ASET (spec
, FONT_REGISTRY_INDEX
,
1399 intern_downcase ((char *) SDATA (registry
), SBYTES (registry
)));
1404 font_lispy_object (font
)
1407 Lisp_Object objlist
= AREF (font
->entity
, FONT_OBJLIST_INDEX
);
1409 for (; ! NILP (objlist
); objlist
= XCDR (objlist
))
1411 struct Lisp_Save_Value
*p
= XSAVE_VALUE (XCAR (objlist
));
1413 if (font
== (struct font
*) p
->pointer
)
1416 xassert (! NILP (objlist
));
1417 return XCAR (objlist
);
1420 #define LGSTRING_HEADER_SIZE 6
1421 #define LGSTRING_GLYPH_SIZE 8
1424 check_gstring (gstring
)
1425 Lisp_Object gstring
;
1430 CHECK_VECTOR (gstring
);
1431 val
= AREF (gstring
, 0);
1433 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1435 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1436 if (! NILP (LGSTRING_LBEARING (gstring
)))
1437 CHECK_NUMBER (LGSTRING_LBEARING (gstring
));
1438 if (! NILP (LGSTRING_RBEARING (gstring
)))
1439 CHECK_NUMBER (LGSTRING_RBEARING (gstring
));
1440 if (! NILP (LGSTRING_WIDTH (gstring
)))
1441 CHECK_NATNUM (LGSTRING_WIDTH (gstring
));
1442 if (! NILP (LGSTRING_ASCENT (gstring
)))
1443 CHECK_NUMBER (LGSTRING_ASCENT (gstring
));
1444 if (! NILP (LGSTRING_DESCENT (gstring
)))
1445 CHECK_NUMBER (LGSTRING_DESCENT(gstring
));
1447 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1449 val
= LGSTRING_GLYPH (gstring
, i
);
1451 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1453 if (NILP (LGLYPH_CHAR (val
)))
1455 CHECK_NATNUM (LGLYPH_FROM (val
));
1456 CHECK_NATNUM (LGLYPH_TO (val
));
1457 CHECK_CHARACTER (LGLYPH_CHAR (val
));
1458 if (! NILP (LGLYPH_CODE (val
)))
1459 CHECK_NATNUM (LGLYPH_CODE (val
));
1460 if (! NILP (LGLYPH_WIDTH (val
)))
1461 CHECK_NATNUM (LGLYPH_WIDTH (val
));
1462 if (! NILP (LGLYPH_ADJUSTMENT (val
)))
1464 val
= LGLYPH_ADJUSTMENT (val
);
1466 if (ASIZE (val
) < 3)
1468 for (j
= 0; j
< 3; j
++)
1469 CHECK_NUMBER (AREF (val
, j
));
1474 error ("Invalid glyph-string format");
1488 struct otf_list
*next
;
1491 static struct otf_list
*otf_list
;
1494 otf_tag_symbol (tag
)
1499 OTF_tag_name (tag
, name
);
1500 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1504 otf_open (entity
, file
)
1508 struct otf_list
*list
= otf_list
;
1510 while (list
&& ! EQ (list
->entity
, entity
))
1514 list
= malloc (sizeof (struct otf_list
));
1515 list
->entity
= entity
;
1516 list
->otf
= file
? OTF_open (file
) : NULL
;
1517 list
->next
= otf_list
;
1524 /* Return a list describing which scripts/languages FONT supports by
1525 which GSUB/GPOS features of OpenType tables. See the comment of
1526 (sturct font_driver).otf_capability. */
1529 font_otf_capability (font
)
1533 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1536 otf
= otf_open (font
->entity
, font
->file_name
);
1539 for (i
= 0; i
< 2; i
++)
1541 OTF_GSUB_GPOS
*gsub_gpos
;
1542 Lisp_Object script_list
= Qnil
;
1545 if (OTF_get_features (otf
, i
== 0) < 0)
1547 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1548 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1550 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1551 Lisp_Object langsys_list
= Qnil
;
1552 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1555 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1557 OTF_LangSys
*langsys
;
1558 Lisp_Object feature_list
= Qnil
;
1559 Lisp_Object langsys_tag
;
1562 if (k
== script
->LangSysCount
)
1564 langsys
= &script
->DefaultLangSys
;
1569 langsys
= script
->LangSys
+ k
;
1571 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1573 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1575 OTF_Feature
*feature
1576 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1577 Lisp_Object feature_tag
1578 = otf_tag_symbol (feature
->FeatureTag
);
1580 feature_list
= Fcons (feature_tag
, feature_list
);
1582 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1585 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1590 XSETCAR (capability
, script_list
);
1592 XSETCDR (capability
, script_list
);
1599 parse_gsub_gpos_spec (spec
, script
, langsys
, features
, nbytes
)
1601 char **script
, **langsys
, *features
;
1611 *script
= (char *) SDATA (SYMBOL_NAME (val
));
1616 *langsys
= NILP (val
) ? NULL
: (char *) SDATA (SYMBOL_NAME (val
));
1619 p
= features
, pend
= p
+ nbytes
- 1;
1621 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1631 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1638 else if (! asterisk
)
1640 val
= SYMBOL_NAME (val
);
1641 if (p
+ SBYTES (val
) >= pend
)
1643 p
+= sprintf (p
, "%s", SDATA (val
));
1647 val
= SYMBOL_NAME (val
);
1648 if (p
+ 1 + SBYTES (val
)>= pend
)
1650 p
+= sprintf (p
, "~%s", SDATA (val
));
1654 error ("OTF spec too long");
1657 #define DEVICE_DELTA(table, size) \
1658 (((size) >= (table).StartSize && (size) <= (table).EndSize) \
1659 ? (table).DeltaValue[(size) - (table).StartSize] \
1663 adjust_anchor (struct font
*font
, OTF_Anchor
*anchor
,
1664 unsigned code
, int size
, int *x
, int *y
)
1666 if (anchor
->AnchorFormat
== 2)
1670 if (font
->driver
->anchor_point (font
, code
, anchor
->f
.f1
.AnchorPoint
,
1674 else if (anchor
->AnchorFormat
== 3)
1676 if (anchor
->f
.f2
.XDeviceTable
.offset
)
1677 *x
+= DEVICE_DELTA (anchor
->f
.f2
.XDeviceTable
, size
);
1678 if (anchor
->f
.f2
.YDeviceTable
.offset
)
1679 *y
+= DEVICE_DELTA (anchor
->f
.f2
.YDeviceTable
, size
);
1683 #define REPLACEMENT_CHARACTER 0xFFFD
1685 /* Drive FONT's OTF GSUB features according to GSUB_SPEC. See the
1686 comment of (sturct font_driver).otf_gsub. */
1689 font_otf_gsub (font
, gsub_spec
, gstring_in
, from
, to
, gstring_out
, idx
,
1692 Lisp_Object gsub_spec
;
1693 Lisp_Object gstring_in
;
1695 Lisp_Object gstring_out
;
1696 int idx
, alternate_subst
;
1701 OTF_GlyphString otf_gstring
;
1703 char *script
, *langsys
, features
[256];
1706 parse_gsub_gpos_spec (gsub_spec
, &script
, &langsys
, features
, 256);
1708 otf
= otf_open (font
->entity
, font
->file_name
);
1711 if (OTF_get_table (otf
, "head") < 0)
1713 if (OTF_get_table (otf
, "cmap") < 0)
1715 if (OTF_check_table (otf
, "GSUB") < 0)
1718 otf_gstring
.size
= otf_gstring
.used
= len
;
1719 otf_gstring
.glyphs
= (OTF_Glyph
*) malloc (sizeof (OTF_Glyph
) * len
);
1720 memset (otf_gstring
.glyphs
, 0, sizeof (OTF_Glyph
) * len
);
1721 for (i
= 0, need_cmap
= 0; i
< len
; i
++)
1723 Lisp_Object g
= LGSTRING_GLYPH (gstring_in
, from
+ i
);
1725 otf_gstring
.glyphs
[i
].c
= XINT (LGLYPH_CHAR (g
));
1726 if (otf_gstring
.glyphs
[i
].c
== REPLACEMENT_CHARACTER
)
1727 otf_gstring
.glyphs
[i
].c
= 0;
1728 if (NILP (LGLYPH_CODE (g
)))
1730 otf_gstring
.glyphs
[i
].glyph_id
= 0;
1734 otf_gstring
.glyphs
[i
].glyph_id
= XINT (LGLYPH_CODE (g
));
1738 OTF_drive_cmap (otf
, &otf_gstring
);
1739 OTF_drive_gdef (otf
, &otf_gstring
);
1740 if ((alternate_subst
1741 ? OTF_drive_gsub_alternate (otf
, &otf_gstring
, script
, langsys
, features
)
1742 : OTF_drive_gsub (otf
, &otf_gstring
, script
, langsys
, features
)) < 0)
1744 free (otf_gstring
.glyphs
);
1747 if (ASIZE (gstring_out
) < idx
+ otf_gstring
.used
)
1749 free (otf_gstring
.glyphs
);
1753 for (i
= 0, g
= otf_gstring
.glyphs
; i
< otf_gstring
.used
;)
1755 int i0
= g
->f
.index
.from
, i1
= g
->f
.index
.to
;
1756 Lisp_Object glyph
= LGSTRING_GLYPH (gstring_in
, from
+ i0
);
1757 Lisp_Object min_idx
= AREF (glyph
, 0);
1758 Lisp_Object max_idx
= AREF (glyph
, 1);
1762 int min_idx_i
= XINT (min_idx
), max_idx_i
= XINT (max_idx
);
1764 for (i0
++; i0
<= i1
; i0
++)
1766 glyph
= LGSTRING_GLYPH (gstring_in
, from
+ i0
);
1767 if (min_idx_i
> XINT (AREF (glyph
, 0)))
1768 min_idx_i
= XINT (AREF (glyph
, 0));
1769 if (max_idx_i
< XINT (AREF (glyph
, 1)))
1770 max_idx_i
= XINT (AREF (glyph
, 1));
1772 min_idx
= make_number (min_idx_i
);
1773 max_idx
= make_number (max_idx_i
);
1774 i0
= g
->f
.index
.from
;
1776 for (; i
< otf_gstring
.used
&& g
->f
.index
.from
== i0
; i
++, g
++)
1778 glyph
= LGSTRING_GLYPH (gstring_out
, idx
+ i
);
1779 ASET (glyph
, 0, min_idx
);
1780 ASET (glyph
, 1, max_idx
);
1782 LGLYPH_SET_CHAR (glyph
, make_number (g
->c
));
1784 LGLYPH_SET_CHAR (glyph
, make_number (REPLACEMENT_CHARACTER
));
1785 LGLYPH_SET_CODE (glyph
, make_number (g
->glyph_id
));
1789 free (otf_gstring
.glyphs
);
1793 /* Drive FONT's OTF GPOS features according to GPOS_SPEC. See the
1794 comment of (sturct font_driver).otf_gpos. */
1797 font_otf_gpos (font
, gpos_spec
, gstring
, from
, to
)
1799 Lisp_Object gpos_spec
;
1800 Lisp_Object gstring
;
1806 OTF_GlyphString otf_gstring
;
1808 char *script
, *langsys
, features
[256];
1812 Lisp_Object base
, mark
;
1814 parse_gsub_gpos_spec (gpos_spec
, &script
, &langsys
, features
, 256);
1816 otf
= otf_open (font
->entity
, font
->file_name
);
1819 if (OTF_get_table (otf
, "head") < 0)
1821 if (OTF_get_table (otf
, "cmap") < 0)
1823 if (OTF_check_table (otf
, "GPOS") < 0)
1826 otf_gstring
.size
= otf_gstring
.used
= len
;
1827 otf_gstring
.glyphs
= (OTF_Glyph
*) malloc (sizeof (OTF_Glyph
) * len
);
1828 memset (otf_gstring
.glyphs
, 0, sizeof (OTF_Glyph
) * len
);
1829 for (i
= 0, need_cmap
= 0; i
< len
; i
++)
1831 glyph
= LGSTRING_GLYPH (gstring
, from
+ i
);
1832 otf_gstring
.glyphs
[i
].c
= XINT (LGLYPH_CHAR (glyph
));
1833 if (otf_gstring
.glyphs
[i
].c
== REPLACEMENT_CHARACTER
)
1834 otf_gstring
.glyphs
[i
].c
= 0;
1835 if (NILP (LGLYPH_CODE (glyph
)))
1837 otf_gstring
.glyphs
[i
].glyph_id
= 0;
1841 otf_gstring
.glyphs
[i
].glyph_id
= XINT (LGLYPH_CODE (glyph
));
1844 OTF_drive_cmap (otf
, &otf_gstring
);
1845 OTF_drive_gdef (otf
, &otf_gstring
);
1847 if (OTF_drive_gpos (otf
, &otf_gstring
, script
, langsys
, features
) < 0)
1849 free (otf_gstring
.glyphs
);
1853 u
= otf
->head
->unitsPerEm
;
1854 size
= font
->pixel_size
;
1856 for (i
= 0, g
= otf_gstring
.glyphs
; i
< otf_gstring
.used
; i
++, g
++)
1859 int xoff
= 0, yoff
= 0, width_adjust
= 0;
1864 glyph
= LGSTRING_GLYPH (gstring
, from
+ i
);
1865 switch (g
->positioning_type
)
1871 int format
= g
->f
.f1
.format
;
1873 if (format
& OTF_XPlacement
)
1874 xoff
= g
->f
.f1
.value
->XPlacement
* size
/ u
;
1875 if (format
& OTF_XPlaDevice
)
1876 xoff
+= DEVICE_DELTA (g
->f
.f1
.value
->XPlaDevice
, size
);
1877 if (format
& OTF_YPlacement
)
1878 yoff
= - (g
->f
.f1
.value
->YPlacement
* size
/ u
);
1879 if (format
& OTF_YPlaDevice
)
1880 yoff
-= DEVICE_DELTA (g
->f
.f1
.value
->YPlaDevice
, size
);
1881 if (format
& OTF_XAdvance
)
1882 width_adjust
+= g
->f
.f1
.value
->XAdvance
* size
/ u
;
1883 if (format
& OTF_XAdvDevice
)
1884 width_adjust
+= DEVICE_DELTA (g
->f
.f1
.value
->XAdvDevice
, size
);
1888 /* Not yet supported. */
1894 goto label_adjust_anchor
;
1895 default: /* i.e. case 6 */
1900 label_adjust_anchor
:
1902 int base_x
, base_y
, mark_x
, mark_y
, width
;
1905 base_x
= g
->f
.f4
.base_anchor
->XCoordinate
* size
/ u
;
1906 base_y
= g
->f
.f4
.base_anchor
->YCoordinate
* size
/ u
;
1907 mark_x
= g
->f
.f4
.mark_anchor
->XCoordinate
* size
/ u
;
1908 mark_y
= g
->f
.f4
.mark_anchor
->YCoordinate
* size
/ u
;
1910 code
= XINT (LGLYPH_CODE (prev
));
1911 if (g
->f
.f4
.base_anchor
->AnchorFormat
!= 1)
1912 adjust_anchor (font
, g
->f
.f4
.base_anchor
,
1913 code
, size
, &base_x
, &base_y
);
1914 if (g
->f
.f4
.mark_anchor
->AnchorFormat
!= 1)
1915 adjust_anchor (font
, g
->f
.f4
.mark_anchor
,
1916 code
, size
, &mark_x
, &mark_y
);
1918 if (NILP (LGLYPH_WIDTH (prev
)))
1920 width
= font
->driver
->text_extents (font
, &code
, 1, NULL
);
1921 LGLYPH_SET_WIDTH (prev
, make_number (width
));
1924 width
= XINT (LGLYPH_WIDTH (prev
));
1925 xoff
= XINT (LGLYPH_XOFF (prev
)) + (base_x
- width
) - mark_x
;
1926 yoff
= XINT (LGLYPH_YOFF (prev
)) + mark_y
- base_y
;
1930 if (xoff
|| yoff
|| width_adjust
)
1932 Lisp_Object adjustment
= Fmake_vector (make_number (3), Qnil
);
1934 ASET (adjustment
, 0, make_number (xoff
));
1935 ASET (adjustment
, 1, make_number (yoff
));
1936 ASET (adjustment
, 2, make_number (width_adjust
));
1937 LGLYPH_SET_ADJUSTMENT (glyph
, adjustment
);
1940 if (g
->GlyphClass
== OTF_GlyphClass0
)
1941 base
= mark
= glyph
;
1942 else if (g
->GlyphClass
== OTF_GlyphClassMark
)
1948 free (otf_gstring
.glyphs
);
1952 #endif /* HAVE_LIBOTF */
1955 /* G-string (glyph string) handler */
1957 /* G-string is a vector of the form [HEADER GLYPH ...].
1958 See the docstring of `font-make-gstring' for more detail. */
1961 font_prepare_composition (cmp
)
1962 struct composition
*cmp
;
1965 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
1966 cmp
->hash_index
* 2);
1967 struct font
*font
= XSAVE_VALUE (LGSTRING_FONT (gstring
))->pointer
;
1968 int len
= LGSTRING_LENGTH (gstring
);
1972 cmp
->lbearing
= cmp
->rbearing
= cmp
->pixel_width
= 0;
1973 cmp
->ascent
= font
->ascent
;
1974 cmp
->descent
= font
->descent
;
1976 for (i
= 0; i
< len
; i
++)
1978 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
1980 struct font_metrics metrics
;
1982 if (NILP (LGLYPH_FROM (g
)))
1984 code
= XINT (LGLYPH_CODE (g
));
1985 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
1986 LGLYPH_SET_WIDTH (g
, make_number (metrics
.width
));
1987 metrics
.lbearing
+= LGLYPH_XOFF (g
);
1988 metrics
.rbearing
+= LGLYPH_XOFF (g
);
1989 metrics
.ascent
+= LGLYPH_YOFF (g
);
1990 metrics
.descent
+= LGLYPH_YOFF (g
);
1992 if (cmp
->lbearing
> cmp
->pixel_width
+ metrics
.lbearing
)
1993 cmp
->lbearing
= cmp
->pixel_width
+ metrics
.lbearing
;
1994 if (cmp
->rbearing
< cmp
->pixel_width
+ metrics
.rbearing
)
1995 cmp
->rbearing
= cmp
->pixel_width
+ metrics
.rbearing
;
1996 if (cmp
->ascent
< metrics
.ascent
)
1997 cmp
->ascent
= metrics
.ascent
;
1998 if (cmp
->descent
< metrics
.descent
)
1999 cmp
->descent
= metrics
.descent
;
2000 cmp
->pixel_width
+= metrics
.width
+ LGLYPH_WADJUST (g
);
2003 LGSTRING_SET_LBEARING (gstring
, make_number (cmp
->lbearing
));
2004 LGSTRING_SET_RBEARING (gstring
, make_number (cmp
->rbearing
));
2005 LGSTRING_SET_WIDTH (gstring
, make_number (cmp
->pixel_width
));
2006 LGSTRING_SET_ASCENT (gstring
, make_number (cmp
->ascent
));
2007 LGSTRING_SET_DESCENT (gstring
, make_number (cmp
->descent
));
2013 font_gstring_produce (old
, from
, to
, new, idx
, code
, n
)
2021 Lisp_Object min_idx
, max_idx
;
2024 if (idx
+ n
> ASIZE (new))
2030 min_idx
= make_number (0);
2031 max_idx
= make_number (1);
2035 min_idx
= AREF (AREF (old
, from
- 1), 0);
2036 max_idx
= AREF (AREF (old
, from
- 1), 1);
2039 else if (from
+ 1 == to
)
2041 min_idx
= AREF (AREF (old
, from
), 0);
2042 max_idx
= AREF (AREF (old
, from
), 1);
2046 int min_idx_i
= XINT (AREF (AREF (old
, from
), 0));
2047 int max_idx_i
= XINT (AREF (AREF (old
, from
), 1));
2049 for (i
= from
+ 1; i
< to
; i
++)
2051 if (min_idx_i
> XINT (AREF (AREF (old
, i
), 0)))
2052 min_idx_i
= XINT (AREF (AREF (old
, i
), 0));
2053 if (max_idx_i
< XINT (AREF (AREF (old
, i
), 1)))
2054 max_idx_i
= XINT (AREF (AREF (old
, i
), 1));
2056 min_idx
= make_number (min_idx_i
);
2057 max_idx
= make_number (max_idx_i
);
2060 for (i
= 0; i
< n
; i
++)
2062 ASET (AREF (new, idx
+ i
), 0, min_idx
);
2063 ASET (AREF (new, idx
+ i
), 1, max_idx
);
2064 ASET (AREF (new, idx
+ i
), 2, make_number (code
[i
]));
2072 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2073 static int font_compare
P_ ((const void *, const void *));
2074 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
2075 Lisp_Object
, Lisp_Object
));
2077 /* We sort fonts by scoring each of them against a specified
2078 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2079 the value is, the closer the font is to the font-spec.
2081 Each 1-bit in the highest 4 bits of the score is used for atomic
2082 properties FOUNDRY, FAMILY, ADSTYLE, and REGISTRY.
2084 Each 7-bit in the lowest 28 bits are used for numeric properties
2085 WEIGHT, SLANT, WIDTH, and SIZE. */
2087 /* How many bits to shift to store the difference value of each font
2088 property in a score. */
2089 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2091 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2092 The return value indicates how different ENTITY is compared with
2096 font_score (entity
, spec_prop
)
2097 Lisp_Object entity
, *spec_prop
;
2101 /* Score four atomic fields. Maximum difference is 1. */
2102 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2103 if (! NILP (spec_prop
[i
])
2104 && ! EQ (spec_prop
[i
], AREF (entity
, i
)))
2105 score
|= 1 << sort_shift_bits
[i
];
2107 /* Score four numeric fields. Maximum difference is 127. */
2108 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2110 Lisp_Object entity_val
= AREF (entity
, i
);
2112 if (! NILP (spec_prop
[i
]) && ! EQ (spec_prop
[i
], entity_val
))
2114 if (! INTEGERP (entity_val
))
2115 score
|= 127 << sort_shift_bits
[i
];
2118 int diff
= XINT (entity_val
) - XINT (spec_prop
[i
]);
2122 if (i
== FONT_SIZE_INDEX
)
2124 if (XINT (entity_val
) > 0
2125 && diff
> FONT_PIXEL_SIZE_QUANTUM
)
2126 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2129 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2138 /* The comparison function for qsort. */
2141 font_compare (d1
, d2
)
2142 const void *d1
, *d2
;
2144 return (*(unsigned *) d1
< *(unsigned *) d2
2145 ? -1 : *(unsigned *) d1
> *(unsigned *) d2
);
2149 /* The structure for elements being sorted by qsort. */
2150 struct font_sort_data
2157 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2158 If PREFER specifies a point-size, calculate the corresponding
2159 pixel-size from QCdpi property of PREFER or from the Y-resolution
2160 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
2161 get the font-entities in VEC. */
2164 font_sort_entites (vec
, prefer
, frame
, spec
)
2165 Lisp_Object vec
, prefer
, frame
, spec
;
2167 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2169 struct font_sort_data
*data
;
2176 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2177 prefer_prop
[i
] = AREF (prefer
, i
);
2181 /* As it is assured that all fonts in VEC match with SPEC, we
2182 should ignore properties specified in SPEC. So, set the
2183 corresponding properties in PREFER_PROP to nil. */
2184 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2185 if (! NILP (AREF (spec
, i
)))
2186 prefer_prop
[i
++] = Qnil
;
2189 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2190 prefer_prop
[FONT_SIZE_INDEX
]
2191 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2193 /* Scoring and sorting. */
2194 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2195 for (i
= 0; i
< len
; i
++)
2197 data
[i
].entity
= AREF (vec
, i
);
2198 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
);
2200 qsort (data
, len
, sizeof *data
, font_compare
);
2201 for (i
= 0; i
< len
; i
++)
2202 ASET (vec
, i
, data
[i
].entity
);
2209 /* API of Font Service Layer. */
2212 font_update_sort_order (order
)
2215 int i
, shift_bits
= 21;
2217 for (i
= 0; i
< 4; i
++, shift_bits
-= 7)
2219 int xlfd_idx
= order
[i
];
2221 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2222 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2223 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2224 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2225 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2226 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2228 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2233 font_symbolic_weight (font
)
2236 Lisp_Object weight
= AREF (font
, FONT_WEIGHT_INDEX
);
2238 if (INTEGERP (weight
))
2239 weight
= prop_numeric_to_name (FONT_WEIGHT_INDEX
, XINT (weight
));
2244 font_symbolic_slant (font
)
2247 Lisp_Object slant
= AREF (font
, FONT_SLANT_INDEX
);
2249 if (INTEGERP (slant
))
2250 slant
= prop_numeric_to_name (FONT_SLANT_INDEX
, XINT (slant
));
2255 font_symbolic_width (font
)
2258 Lisp_Object width
= AREF (font
, FONT_WIDTH_INDEX
);
2260 if (INTEGERP (width
))
2261 width
= prop_numeric_to_name (FONT_WIDTH_INDEX
, XINT (width
));
2266 font_match_p (spec
, entity
)
2267 Lisp_Object spec
, entity
;
2271 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2272 if (! NILP (AREF (spec
, i
))
2273 && ! EQ (AREF (spec
, i
), AREF (entity
, i
)))
2275 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
))
2276 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0
2277 && (XINT (AREF (spec
, FONT_SIZE_INDEX
))
2278 != XINT (AREF (entity
, FONT_SIZE_INDEX
))))
2284 font_find_object (font
)
2287 Lisp_Object tail
, elt
;
2289 for (tail
= AREF (font
->entity
, FONT_OBJLIST_INDEX
); CONSP (tail
);
2293 if (font
== XSAVE_VALUE (elt
)->pointer
2294 && XSAVE_VALUE (elt
)->integer
> 0)
2301 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2303 /* Return a vector of font-entities matching with SPEC on frame F. */
2306 font_list_entities (frame
, spec
)
2307 Lisp_Object frame
, spec
;
2309 FRAME_PTR f
= XFRAME (frame
);
2310 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2311 Lisp_Object ftype
, family
, size
, alternate_familes
;
2312 Lisp_Object
*vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2318 family
= AREF (spec
, FONT_FAMILY_INDEX
);
2320 alternate_familes
= Qnil
;
2323 if (NILP (font_family_alist
)
2324 && !NILP (Vface_alternative_font_family_alist
))
2325 build_font_family_alist ();
2326 alternate_familes
= assq_no_quit (family
, font_family_alist
);
2327 if (! NILP (alternate_familes
))
2328 alternate_familes
= XCDR (alternate_familes
);
2330 size
= AREF (spec
, FONT_SIZE_INDEX
);
2332 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2334 xassert (ASIZE (spec
) == FONT_SPEC_MAX
);
2335 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2337 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2339 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2341 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
2342 Lisp_Object tail
= alternate_familes
;
2345 xassert (CONSP (cache
));
2346 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2347 ASET (spec
, FONT_FAMILY_INDEX
, family
);
2351 val
= assoc_no_quit (spec
, XCDR (cache
));
2356 val
= driver_list
->driver
->list (frame
, spec
);
2358 XSETCDR (cache
, Fcons (Fcons (Fcopy_sequence (spec
), val
),
2361 if (VECTORP (val
) && ASIZE (val
) > 0)
2368 ASET (spec
, FONT_FAMILY_INDEX
, XCAR (tail
));
2372 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2373 ASET (spec
, FONT_FAMILY_INDEX
, family
);
2374 ASET (spec
, FONT_SIZE_INDEX
, size
);
2375 return (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2379 font_matching_entity (frame
, spec
)
2380 Lisp_Object frame
, spec
;
2382 FRAME_PTR f
= XFRAME (frame
);
2383 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2384 Lisp_Object ftype
, size
, entity
;
2386 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2387 size
= AREF (spec
, FONT_SIZE_INDEX
);
2389 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2391 for (; driver_list
; driver_list
= driver_list
->next
)
2393 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2395 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
2398 xassert (CONSP (cache
));
2399 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2400 key
= Fcons (spec
, Qnil
);
2401 entity
= assoc_no_quit (key
, XCDR (cache
));
2403 entity
= XCDR (entity
);
2406 entity
= driver_list
->driver
->match (frame
, spec
);
2407 if (! NILP (entity
))
2409 XSETCAR (key
, Fcopy_sequence (spec
));
2410 XSETCDR (cache
, Fcons (Fcons (key
, entity
), XCDR (cache
)));
2413 if (! NILP (entity
))
2416 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2417 ASET (spec
, FONT_SIZE_INDEX
, size
);
2421 static int num_fonts
;
2424 font_open_entity (f
, entity
, pixel_size
)
2429 struct font_driver_list
*driver_list
;
2430 Lisp_Object objlist
, size
, val
;
2433 size
= AREF (entity
, FONT_SIZE_INDEX
);
2434 xassert (NATNUMP (size
));
2435 if (XINT (size
) != 0)
2436 pixel_size
= XINT (size
);
2438 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2439 objlist
= XCDR (objlist
))
2441 font
= XSAVE_VALUE (XCAR (objlist
))->pointer
;
2442 if (font
->pixel_size
== pixel_size
)
2444 XSAVE_VALUE (XCAR (objlist
))->integer
++;
2445 return XCAR (objlist
);
2449 xassert (FONT_ENTITY_P (entity
));
2450 val
= AREF (entity
, FONT_TYPE_INDEX
);
2451 for (driver_list
= f
->font_driver_list
;
2452 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2453 driver_list
= driver_list
->next
);
2457 font
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2460 font
->scalable
= XINT (size
) == 0;
2462 val
= make_save_value (font
, 1);
2463 ASET (entity
, FONT_OBJLIST_INDEX
,
2464 Fcons (val
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2470 font_close_object (f
, font_object
)
2472 Lisp_Object font_object
;
2474 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2475 Lisp_Object objlist
;
2476 Lisp_Object tail
, prev
= Qnil
;
2478 XSAVE_VALUE (font_object
)->integer
--;
2479 xassert (XSAVE_VALUE (font_object
)->integer
>= 0);
2480 if (XSAVE_VALUE (font_object
)->integer
> 0)
2483 objlist
= AREF (font
->entity
, FONT_OBJLIST_INDEX
);
2484 for (prev
= Qnil
, tail
= objlist
; CONSP (tail
);
2485 prev
= tail
, tail
= XCDR (tail
))
2486 if (EQ (font_object
, XCAR (tail
)))
2488 if (font
->driver
->close
)
2489 font
->driver
->close (f
, font
);
2490 XSAVE_VALUE (font_object
)->pointer
= NULL
;
2492 ASET (font
->entity
, FONT_OBJLIST_INDEX
, XCDR (objlist
));
2494 XSETCDR (prev
, XCDR (objlist
));
2501 font_has_char (f
, font
, c
)
2508 if (FONT_ENTITY_P (font
))
2510 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2511 struct font_driver_list
*driver_list
;
2513 for (driver_list
= f
->font_driver_list
;
2514 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2515 driver_list
= driver_list
->next
);
2518 if (! driver_list
->driver
->has_char
)
2520 return driver_list
->driver
->has_char (font
, c
);
2523 xassert (FONT_OBJECT_P (font
));
2524 fontp
= XSAVE_VALUE (font
)->pointer
;
2526 if (fontp
->driver
->has_char
)
2528 int result
= fontp
->driver
->has_char (fontp
->entity
, c
);
2533 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2537 font_encode_char (font_object
, c
)
2538 Lisp_Object font_object
;
2541 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2543 return font
->driver
->encode_char (font
, c
);
2547 font_get_name (font_object
)
2548 Lisp_Object font_object
;
2550 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2551 char *name
= (font
->font
.full_name
? font
->font
.full_name
2552 : font
->font
.name
? font
->font
.name
2555 return (name
? make_unibyte_string (name
, strlen (name
)) : null_string
);
2559 font_get_spec (font_object
)
2560 Lisp_Object font_object
;
2562 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2563 Lisp_Object spec
= Ffont_spec (0, NULL
);
2566 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2567 ASET (spec
, i
, AREF (font
->entity
, i
));
2568 ASET (spec
, FONT_SIZE_INDEX
, make_number (font
->pixel_size
));
2573 font_get_frame (font
)
2576 if (FONT_OBJECT_P (font
))
2577 font
= ((struct font
*) XSAVE_VALUE (font
)->pointer
)->entity
;
2578 xassert (FONT_ENTITY_P (font
));
2579 return AREF (font
, FONT_FRAME_INDEX
);
2582 /* Find a font entity best matching with LFACE. If SPEC is non-nil,
2583 the font must exactly match with it. */
2586 font_find_for_lface (f
, lface
, spec
)
2591 Lisp_Object frame
, entities
;
2594 XSETFRAME (frame
, f
);
2598 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2599 ASET (scratch_font_spec
, i
, Qnil
);
2600 ASET (scratch_font_spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2602 if (! NILP (lface
[LFACE_FAMILY_INDEX
]))
2603 font_merge_old_spec (Qnil
, lface
[LFACE_FAMILY_INDEX
], Qnil
,
2605 entities
= font_list_entities (frame
, scratch_font_spec
);
2606 while (ASIZE (entities
) == 0)
2608 /* Try without FOUNDRY or FAMILY. */
2609 if (! NILP (AREF (scratch_font_spec
, FONT_FOUNDRY_INDEX
)))
2611 ASET (scratch_font_spec
, FONT_FOUNDRY_INDEX
, Qnil
);
2612 entities
= font_list_entities (frame
, scratch_font_spec
);
2614 else if (! NILP (AREF (scratch_font_spec
, FONT_FAMILY_INDEX
)))
2616 ASET (scratch_font_spec
, FONT_FAMILY_INDEX
, Qnil
);
2617 entities
= font_list_entities (frame
, scratch_font_spec
);
2625 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2626 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2627 if (NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
2628 ASET (scratch_font_spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2629 entities
= font_list_entities (frame
, scratch_font_spec
);
2632 if (ASIZE (entities
) == 0)
2634 if (ASIZE (entities
) > 1)
2636 /* Sort fonts by properties specified in LFACE. */
2637 Lisp_Object prefer
= scratch_font_prefer
;
2640 if (! NILP (lface
[LFACE_FAMILY_INDEX
]))
2641 font_merge_old_spec (Qnil
, lface
[LFACE_FAMILY_INDEX
], Qnil
, prefer
);
2642 ASET (prefer
, FONT_WEIGHT_INDEX
,
2643 font_prop_validate_style (FONT_WEIGHT_INDEX
, QCweight
,
2644 lface
[LFACE_WEIGHT_INDEX
]));
2645 ASET (prefer
, FONT_SLANT_INDEX
,
2646 font_prop_validate_style (FONT_SLANT_INDEX
, QCslant
,
2647 lface
[LFACE_SLANT_INDEX
]));
2648 ASET (prefer
, FONT_WIDTH_INDEX
,
2649 font_prop_validate_style (FONT_WIDTH_INDEX
, QCwidth
,
2650 lface
[LFACE_SWIDTH_INDEX
]));
2651 pt
= XINT (lface
[LFACE_HEIGHT_INDEX
]);
2652 ASET (prefer
, FONT_SIZE_INDEX
, make_float (pt
/ 10));
2654 font_sort_entites (entities
, prefer
, frame
, spec
);
2657 return AREF (entities
, 0);
2661 font_open_for_lface (f
, lface
, entity
)
2666 double pt
= XINT (lface
[LFACE_HEIGHT_INDEX
]);
2670 size
= POINT_TO_PIXEL (pt
, f
->resy
);
2671 return font_open_entity (f
, entity
, size
);
2675 font_load_for_face (f
, face
)
2679 Lisp_Object font_object
= face
->lface
[LFACE_FONT_INDEX
];
2681 if (NILP (font_object
))
2683 Lisp_Object entity
= font_find_for_lface (f
, face
->lface
, Qnil
);
2685 if (! NILP (entity
))
2686 font_object
= font_open_for_lface (f
, face
->lface
, entity
);
2689 if (! NILP (font_object
))
2691 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2693 face
->font
= font
->font
.font
;
2694 face
->font_info
= (struct font_info
*) font
;
2695 face
->font_info_id
= 0;
2696 face
->font_name
= font
->font
.full_name
;
2701 face
->font_info
= NULL
;
2702 face
->font_info_id
= -1;
2703 face
->font_name
= NULL
;
2704 add_to_log ("Unable to load font for a face%s", null_string
, Qnil
);
2709 font_prepare_for_face (f
, face
)
2713 struct font
*font
= (struct font
*) face
->font_info
;
2715 if (font
->driver
->prepare_face
)
2716 font
->driver
->prepare_face (f
, face
);
2720 font_done_for_face (f
, face
)
2724 struct font
*font
= (struct font
*) face
->font_info
;
2726 if (font
->driver
->done_face
)
2727 font
->driver
->done_face (f
, face
);
2732 font_open_by_name (f
, name
)
2736 Lisp_Object args
[2];
2737 Lisp_Object spec
, prefer
, size
, entity
, entity_list
;
2742 XSETFRAME (frame
, f
);
2745 args
[1] = make_unibyte_string (name
, strlen (name
));
2746 spec
= Ffont_spec (2, args
);
2747 prefer
= scratch_font_prefer
;
2748 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2749 if (NILP (AREF (spec
, i
)))
2750 ASET (prefer
, i
, make_number (100));
2751 size
= AREF (spec
, FONT_SIZE_INDEX
);
2754 else if (INTEGERP (size
))
2755 pixel_size
= XINT (size
);
2756 else /* FLOATP (size) */
2758 double pt
= XFLOAT_DATA (size
);
2760 pixel_size
= POINT_TO_PIXEL (pt
, f
->resy
);
2761 size
= make_number (pixel_size
);
2762 ASET (spec
, FONT_SIZE_INDEX
, size
);
2764 if (pixel_size
== 0)
2766 pixel_size
= POINT_TO_PIXEL (12.0, f
->resy
);
2767 size
= make_number (pixel_size
);
2769 ASET (prefer
, FONT_SIZE_INDEX
, size
);
2770 if (NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
2771 ASET (spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2773 entity_list
= Flist_fonts (spec
, frame
, make_number (1), prefer
);
2774 if (NILP (entity_list
))
2775 entity
= font_matching_entity (frame
, spec
);
2777 entity
= XCAR (entity_list
);
2778 return (NILP (entity
)
2780 : font_open_entity (f
, entity
, pixel_size
));
2784 /* Register font-driver DRIVER. This function is used in two ways.
2786 The first is with frame F non-NULL. In this case, make DRIVER
2787 available (but not yet activated) on F. All frame creaters
2788 (e.g. Fx_create_frame) must call this function at least once with
2789 an available font-driver.
2791 The second is with frame F NULL. In this case, DRIVER is globally
2792 registered in the variable `font_driver_list'. All font-driver
2793 implementations must call this function in its syms_of_XXXX
2794 (e.g. syms_of_xfont). */
2797 register_font_driver (driver
, f
)
2798 struct font_driver
*driver
;
2801 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
2802 struct font_driver_list
*prev
, *list
;
2804 if (f
&& ! driver
->draw
)
2805 error ("Unsable font driver for a frame: %s",
2806 SDATA (SYMBOL_NAME (driver
->type
)));
2808 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
2809 if (list
->driver
->type
== driver
->type
)
2810 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
2812 list
= malloc (sizeof (struct font_driver_list
));
2814 list
->driver
= driver
;
2819 f
->font_driver_list
= list
;
2821 font_driver_list
= list
;
2825 /* Free font-driver list on frame F. It doesn't free font-drivers
2829 free_font_driver_list (f
)
2832 while (f
->font_driver_list
)
2834 struct font_driver_list
*next
= f
->font_driver_list
->next
;
2836 free (f
->font_driver_list
);
2837 f
->font_driver_list
= next
;
2841 /* Make the frame F use font backends listed in NEW_BACKENDS (list of
2842 symbols). If NEW_BACKENDS is nil, make F use all available font
2843 drivers. If no backend is available, dont't alter
2844 f->font_driver_list.
2846 A caller must free all realized faces and clear all font caches if
2847 any in advance. The return value is a list of font backends
2848 actually made used for on F. */
2851 font_update_drivers (f
, new_drivers
)
2853 Lisp_Object new_drivers
;
2855 Lisp_Object active_drivers
= Qnil
;
2856 struct font_driver_list
*list
;
2858 /* At first check which font backends are available. */
2859 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
2860 if (NILP (new_drivers
)
2861 || ! NILP (Fmemq (list
->driver
->type
, new_drivers
)))
2864 active_drivers
= nconc2 (active_drivers
,
2865 Fcons (list
->driver
->type
, Qnil
));
2867 /* If at least one backend is available, update all list->on. */
2868 if (! NILP (active_drivers
))
2869 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
2870 list
->on
= (list
->on
== 2);
2872 return active_drivers
;
2877 font_at (c
, pos
, face
, w
, object
)
2888 f
= XFRAME (w
->frame
);
2891 if (STRINGP (object
))
2892 face_id
= face_at_string_position (w
, object
, pos
, 0, -1, -1, &dummy
,
2893 DEFAULT_FACE_ID
, 0);
2895 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
,
2897 face
= FACE_FROM_ID (f
, face_id
);
2899 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, object
);
2900 face
= FACE_FROM_ID (f
, face_id
);
2901 if (! face
->font_info
)
2903 return font_lispy_object ((struct font
*) face
->font_info
);
2909 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 1, 0,
2910 doc
: /* Return t if object is a font-spec or font-entity. */)
2914 return (FONTP (object
) ? Qt
: Qnil
);
2917 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
2918 doc
: /* Return a newly created font-spec with specified arguments as properties.
2919 usage: (font-spec &rest properties) */)
2924 Lisp_Object spec
= Fmake_vector (make_number (FONT_SPEC_MAX
), Qnil
);
2927 for (i
= 0; i
< nargs
; i
+= 2)
2929 enum font_property_index prop
;
2930 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
2932 prop
= get_font_prop_index (key
, 0);
2933 if (prop
< FONT_EXTRA_INDEX
)
2934 ASET (spec
, prop
, val
);
2937 if (EQ (key
, QCname
))
2940 font_parse_name ((char *) SDATA (val
), spec
);
2942 font_put_extra (spec
, key
, val
);
2945 CHECK_VALIDATE_FONT_SPEC (spec
);
2950 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
2951 doc
: /* Return the value of FONT's PROP property.
2952 FONT is a font-spec, a font-entity, or a font-object. */)
2954 Lisp_Object font
, prop
;
2956 enum font_property_index idx
;
2958 if (FONT_OBJECT_P (font
))
2960 struct font
*fontp
= XSAVE_VALUE (font
)->pointer
;
2962 if (EQ (prop
, QCotf
))
2965 return font_otf_capability (fontp
);
2966 #else /* not HAVE_LIBOTF */
2968 #endif /* not HAVE_LIBOTF */
2970 font
= fontp
->entity
;
2974 idx
= get_font_prop_index (prop
, 0);
2975 if (idx
< FONT_EXTRA_INDEX
)
2976 return AREF (font
, idx
);
2977 if (FONT_ENTITY_P (font
))
2979 return Fcdr (Fassoc (AREF (font
, FONT_EXTRA_INDEX
), prop
));
2983 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
2984 doc
: /* Set one property of FONT-SPEC: give property PROP value VALUE. */)
2985 (font_spec
, prop
, val
)
2986 Lisp_Object font_spec
, prop
, val
;
2988 enum font_property_index idx
;
2989 Lisp_Object extra
, slot
;
2991 CHECK_FONT_SPEC (font_spec
);
2992 idx
= get_font_prop_index (prop
, 0);
2993 if (idx
< FONT_EXTRA_INDEX
)
2994 return ASET (font_spec
, idx
, val
);
2995 extra
= AREF (font_spec
, FONT_EXTRA_INDEX
);
2996 slot
= Fassoc (extra
, prop
);
2998 extra
= Fcons (Fcons (prop
, val
), extra
);
3000 Fsetcdr (slot
, val
);
3004 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3005 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3006 Optional 2nd argument FRAME specifies the target frame.
3007 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3008 Optional 4th argument PREFER, if non-nil, is a font-spec
3009 to which closeness fonts are sorted. */)
3010 (font_spec
, frame
, num
, prefer
)
3011 Lisp_Object font_spec
, frame
, num
, prefer
;
3013 Lisp_Object vec
, list
, tail
;
3017 frame
= selected_frame
;
3018 CHECK_LIVE_FRAME (frame
);
3019 CHECK_VALIDATE_FONT_SPEC (font_spec
);
3027 if (! NILP (prefer
))
3028 CHECK_FONT (prefer
);
3030 vec
= font_list_entities (frame
, font_spec
);
3035 return Fcons (AREF (vec
, 0), Qnil
);
3037 if (! NILP (prefer
))
3038 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
);
3040 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3041 if (n
== 0 || n
> len
)
3043 for (i
= 1; i
< n
; i
++)
3045 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3047 XSETCDR (tail
, val
);
3053 DEFUN ("list-families", Flist_families
, Slist_families
, 0, 1, 0,
3054 doc
: /* List available font families on the current frame.
3055 Optional 2nd argument FRAME specifies the target frame. */)
3060 struct font_driver_list
*driver_list
;
3064 frame
= selected_frame
;
3065 CHECK_LIVE_FRAME (frame
);
3068 for (driver_list
= f
->font_driver_list
; driver_list
;
3069 driver_list
= driver_list
->next
)
3070 if (driver_list
->driver
->list_family
)
3072 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3078 Lisp_Object tail
= list
;
3080 for (; CONSP (val
); val
= XCDR (val
))
3081 if (NILP (Fmemq (XCAR (val
), tail
)))
3082 list
= Fcons (XCAR (val
), list
);
3088 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3089 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3090 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3092 Lisp_Object font_spec
, frame
;
3094 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3101 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 1, 0,
3102 doc
: /* Return XLFD name of FONT.
3103 FONT is a font-spec, font-entity, or font-object.
3104 If the name is too long for XLFD (maximum 255 chars), return nil. */)
3111 if (FONT_SPEC_P (font
))
3112 CHECK_VALIDATE_FONT_SPEC (font
);
3113 else if (FONT_ENTITY_P (font
))
3119 CHECK_FONT_GET_OBJECT (font
, fontp
);
3120 font
= fontp
->entity
;
3121 pixel_size
= fontp
->pixel_size
;
3124 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3126 return build_string (name
);
3129 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3130 doc
: /* Clear font cache. */)
3133 Lisp_Object list
, frame
;
3135 FOR_EACH_FRAME (list
, frame
)
3137 FRAME_PTR f
= XFRAME (frame
);
3138 struct font_driver_list
*driver_list
= f
->font_driver_list
;
3140 for (; driver_list
; driver_list
= driver_list
->next
)
3141 if (driver_list
->on
)
3143 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
3144 Lisp_Object tail
, elt
;
3146 for (tail
= XCDR (cache
); CONSP (tail
); tail
= XCDR (tail
))
3149 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
3151 Lisp_Object vec
= XCDR (elt
);
3154 for (i
= 0; i
< ASIZE (vec
); i
++)
3156 Lisp_Object entity
= AREF (vec
, i
);
3158 if (EQ (driver_list
->driver
->type
,
3159 AREF (entity
, FONT_TYPE_INDEX
)))
3162 = AREF (entity
, FONT_OBJLIST_INDEX
);
3164 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
3166 Lisp_Object val
= XCAR (objlist
);
3167 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
3168 struct font
*font
= p
->pointer
;
3170 xassert (font
&& (driver_list
->driver
3172 driver_list
->driver
->close (f
, font
);
3176 if (driver_list
->driver
->free_entity
)
3177 driver_list
->driver
->free_entity (entity
);
3182 XSETCDR (cache
, Qnil
);
3189 DEFUN ("internal-set-font-style-table", Finternal_set_font_style_table
,
3190 Sinternal_set_font_style_table
, 2, 2, 0,
3191 doc
: /* Set font style table for PROP to TABLE.
3192 PROP must be `:weight', `:slant', or `:width'.
3193 TABLE must be an alist of symbols vs the corresponding numeric values
3194 sorted by numeric values. */)
3196 Lisp_Object prop
, table
;
3200 Lisp_Object tail
, val
;
3202 CHECK_SYMBOL (prop
);
3203 table_index
= (EQ (prop
, QCweight
) ? 0
3204 : EQ (prop
, QCslant
) ? 1
3205 : EQ (prop
, QCwidth
) ? 2
3207 if (table_index
>= ASIZE (font_style_table
))
3208 error ("Invalid font style property: %s", SDATA (SYMBOL_NAME (prop
)));
3209 table
= Fcopy_sequence (table
);
3211 for (tail
= table
; ! NILP (tail
); tail
= Fcdr (tail
))
3213 prop
= Fcar (Fcar (tail
));
3214 val
= Fcdr (Fcar (tail
));
3215 CHECK_SYMBOL (prop
);
3217 if (numeric
> XINT (val
))
3218 error ("Numeric values not sorted for %s", SDATA (SYMBOL_NAME (prop
)));
3219 numeric
= XINT (val
);
3220 XSETCAR (tail
, Fcons (prop
, val
));
3222 ASET (font_style_table
, table_index
, table
);
3226 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
3227 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
3228 FONT-OBJECT may be nil if it is not yet known.
3230 G-string is sequence of glyphs of a specific font,
3231 and is a vector of this form:
3232 [ HEADER GLYPH ... ]
3233 HEADER is a vector of this form:
3234 [FONT-OBJECT LBEARING RBEARING WIDTH ASCENT DESCENT]
3236 FONT-OBJECT is a font-object for all glyphs in the G-string,
3237 LBEARING thry DESCENT is the metrics (in pixels) of the whole G-string.
3238 GLYPH is a vector of this form:
3239 [ FROM-IDX TO-IDX C CODE WIDTH [ [X-OFF Y-OFF WADJUST] | nil] ]
3241 FROM-IDX and TO-IDX are used internally and should not be touched.
3242 C is the character of the glyph.
3243 CODE is the glyph-code of C in FONT-OBJECT.
3244 X-OFF and Y-OFF are offests to the base position for the glyph.
3245 WIDTH is the normal width of the glyph.
3246 WADJUST is the adjustment to the normal width of the glyph. */)
3248 Lisp_Object font_object
, num
;
3250 Lisp_Object gstring
, g
;
3254 if (! NILP (font_object
))
3255 CHECK_FONT_OBJECT (font_object
);
3258 len
= XINT (num
) + 1;
3259 gstring
= Fmake_vector (make_number (len
), Qnil
);
3260 g
= Fmake_vector (make_number (6), Qnil
);
3261 ASET (g
, 0, font_object
);
3262 ASET (gstring
, 0, g
);
3263 for (i
= 1; i
< len
; i
++)
3264 ASET (gstring
, i
, Fmake_vector (make_number (8), Qnil
));
3268 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
3269 doc
: /* Fillin glyph-string GSTRING by characters for FONT-OBJECT.
3270 START and END specifies the region to extract characters.
3271 If optional 3rd argument OBJECT is non-nil, it is a buffer or a string from
3272 where to extract characters.
3273 FONT-OBJECT may be nil if GSTRING already already contains one. */)
3274 (gstring
, font_object
, start
, end
, object
)
3275 Lisp_Object gstring
, font_object
, start
, end
, object
;
3281 CHECK_VECTOR (gstring
);
3282 if (NILP (font_object
))
3283 font_object
= LGSTRING_FONT (gstring
);
3284 CHECK_FONT_GET_OBJECT (font_object
, font
);
3286 if (STRINGP (object
))
3288 const unsigned char *p
;
3290 CHECK_NATNUM (start
);
3292 if (XINT (start
) > XINT (end
)
3293 || XINT (end
) > ASIZE (object
)
3294 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3295 args_out_of_range (start
, end
);
3297 len
= XINT (end
) - XINT (start
);
3298 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
3299 for (i
= 0; i
< len
; i
++)
3301 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3303 c
= STRING_CHAR_ADVANCE (p
);
3304 code
= font
->driver
->encode_char (font
, c
);
3305 if (code
> MOST_POSITIVE_FIXNUM
)
3306 error ("Glyph code 0x%X is too large", code
);
3307 LGLYPH_SET_FROM (g
, make_number (i
));
3308 LGLYPH_SET_TO (g
, make_number (i
+ 1));
3309 LGLYPH_SET_CHAR (g
, make_number (c
));
3310 LGLYPH_SET_CODE (g
, make_number (code
));
3317 if (! NILP (object
))
3318 Fset_buffer (object
);
3319 validate_region (&start
, &end
);
3320 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3321 args_out_of_range (start
, end
);
3322 len
= XINT (end
) - XINT (start
);
3324 pos_byte
= CHAR_TO_BYTE (pos
);
3325 for (i
= 0; i
< len
; i
++)
3327 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3329 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
3330 code
= font
->driver
->encode_char (font
, c
);
3331 if (code
> MOST_POSITIVE_FIXNUM
)
3332 error ("Glyph code 0x%X is too large", code
);
3333 LGLYPH_SET_FROM (g
, make_number (i
));
3334 LGLYPH_SET_TO (g
, make_number (i
+ 1));
3335 LGLYPH_SET_CHAR (g
, make_number (c
));
3336 LGLYPH_SET_CODE (g
, make_number (code
));
3339 for (i
= LGSTRING_LENGTH (gstring
) - 1; i
>= len
; i
--)
3341 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3343 LGLYPH_SET_FROM (g
, Qnil
);
3348 DEFUN ("font-otf-gsub", Ffont_otf_gsub
, Sfont_otf_gsub
, 6, 6, 0,
3349 doc
: /* Apply OpenType "GSUB" features on glyph-string GSTRING-IN.
3350 FEATURE-SPEC specifies which featuress to apply in this format:
3351 (SCRIPT LANGSYS FEATURE ...)
3353 SCRIPT is a symbol specifying a script tag of OpenType,
3354 LANGSYS is a symbol specifying a langsys tag of OpenType,
3355 FEATURE is a symbol specifying a feature tag of Opentype.
3357 If LANGYS is nil, the default langsys is selected.
3359 The features are applied in the order appeared in the list. FEATURE
3360 may be a symbol `*', in which case all available features not appeared
3361 in this list are applied, and the remaining FEATUREs are not ignored.
3362 For instance, (mlym nil vatu pstf * haln) means to apply vatu and pstf
3363 in this order, then to apply all available features other than vatu,
3366 The features are applied to the glyphs in the range FROM and TO of
3369 If some of a feature is actually applicable, the resulting glyphs are
3370 produced in the glyph-string GSTRING-OUT from the index INDEX. In
3371 this case, the value is the number of produced glyphs.
3373 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
3376 If GSTRING-OUT is too short to hold produced glyphs, no glyphs is
3377 produced in GSTRING-OUT, and the value is nil.
3379 See the documentation of `font-make-gstring' for the format of
3381 (feature_spec
, gstring_in
, from
, to
, gstring_out
, index
)
3382 Lisp_Object feature_spec
, gstring_in
, from
, to
, gstring_out
, index
;
3384 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
3385 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
3388 CHECK_FONT_GET_OBJECT (font_object
, font
);
3389 if (! font
->driver
->otf_gsub
)
3390 error ("Font backend %s can't drive OpenType GSUB table",
3391 SDATA (SYMBOL_NAME (font
->driver
->type
)));
3392 CHECK_CONS (feature_spec
);
3393 len
= check_gstring (gstring_in
);
3394 CHECK_VECTOR (gstring_out
);
3395 CHECK_NATNUM (from
);
3397 CHECK_NATNUM (index
);
3399 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
3400 args_out_of_range_3 (from
, to
, make_number (len
));
3401 if (XINT (index
) >= ASIZE (gstring_out
))
3402 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
3403 num
= font
->driver
->otf_gsub (font
, feature_spec
,
3404 gstring_in
, XINT (from
), XINT (to
),
3405 gstring_out
, XINT (index
), 0);
3408 return make_number (num
);
3412 DEFUN ("font-otf-gpos", Ffont_otf_gpos
, Sfont_otf_gpos
, 4, 4, 0,
3413 doc
: /* Apply OpenType "GPOS" features on glyph-string GSTRING.
3414 FEATURE-SPEC specifies which features to apply in this format:
3415 (SCRIPT LANGSYS FEATURE ...)
3416 See the documentation of `font-otf-gsub' for more detail.
3418 The features are applied to the glyphs in the range FROM and TO of
3420 (gpos_spec
, gstring
, from
, to
)
3421 Lisp_Object gpos_spec
, gstring
, from
, to
;
3423 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
3427 CHECK_FONT_GET_OBJECT (font_object
, font
);
3428 if (! font
->driver
->otf_gpos
)
3429 error ("Font backend %s can't drive OpenType GPOS table",
3430 SDATA (SYMBOL_NAME (font
->driver
->type
)));
3431 CHECK_CONS (gpos_spec
);
3432 len
= check_gstring (gstring
);
3433 CHECK_NATNUM (from
);
3436 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
3437 args_out_of_range_3 (from
, to
, make_number (len
));
3438 num
= font
->driver
->otf_gpos (font
, gpos_spec
,
3439 gstring
, XINT (from
), XINT (to
));
3440 return (num
<= 0 ? Qnil
: Qt
);
3444 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
3446 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
3447 FEATURE-SPEC specifies which features of the font FONT-OBJECT to apply
3449 (SCRIPT LANGSYS FEATURE ...)
3450 See the documentation of `font-otf-gsub' for more detail.
3452 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
3453 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
3454 character code corresponding to the glyph or nil if there's no
3455 corresponding character. */)
3456 (font_object
, character
, feature_spec
)
3457 Lisp_Object font_object
, character
, feature_spec
;
3460 Lisp_Object gstring_in
, gstring_out
, g
;
3461 Lisp_Object alternates
;
3464 CHECK_FONT_GET_OBJECT (font_object
, font
);
3465 if (! font
->driver
->otf_gsub
)
3466 error ("Font backend %s can't drive OpenType GSUB table",
3467 SDATA (SYMBOL_NAME (font
->driver
->type
)));
3468 CHECK_CHARACTER (character
);
3469 CHECK_CONS (feature_spec
);
3471 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
3472 g
= LGSTRING_GLYPH (gstring_in
, 0);
3473 LGLYPH_SET_CHAR (g
, character
);
3474 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
3475 while ((num
= font
->driver
->otf_gsub (font
, feature_spec
, gstring_in
, 0, 1,
3476 gstring_out
, 0, 1)) < 0)
3477 gstring_out
= Ffont_make_gstring (font_object
,
3478 make_number (ASIZE (gstring_out
) * 2));
3480 for (i
= 0; i
< num
; i
++)
3482 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
3483 int c
= XINT (LGLYPH_CHAR (g
));
3484 unsigned code
= XUINT (LGLYPH_CODE (g
));
3486 alternates
= Fcons (Fcons (make_number (code
),
3487 c
> 0 ? make_number (c
) : Qnil
),
3490 return Fnreverse (alternates
);
3496 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
3497 doc
: /* Open FONT-ENTITY. */)
3498 (font_entity
, size
, frame
)
3499 Lisp_Object font_entity
;
3505 CHECK_FONT_ENTITY (font_entity
);
3507 size
= AREF (font_entity
, FONT_SIZE_INDEX
);
3508 CHECK_NUMBER (size
);
3510 frame
= selected_frame
;
3511 CHECK_LIVE_FRAME (frame
);
3513 isize
= XINT (size
);
3515 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
3517 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
3520 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
3521 doc
: /* Close FONT-OBJECT. */)
3522 (font_object
, frame
)
3523 Lisp_Object font_object
, frame
;
3525 CHECK_FONT_OBJECT (font_object
);
3527 frame
= selected_frame
;
3528 CHECK_LIVE_FRAME (frame
);
3529 font_close_object (XFRAME (frame
), font_object
);
3533 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
3534 doc
: /* Return information about FONT-OBJECT.
3535 The value is a vector:
3536 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
3539 NAME is a string of the font name (or nil if the font backend doesn't
3542 FILENAME is a string of the font file (or nil if the font backend
3543 doesn't provide a file name).
3545 PIXEL-SIZE is a pixel size by which the font is opened.
3547 SIZE is a maximum advance width of the font in pixel.
3549 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
3552 OTF-CAPABILITY is a cons (GSUB . GPOS), where GSUB shows which "GSUB"
3553 features the font supports, and GPOS shows which "GPOS" features the
3554 font supports. Both GSUB and GPOS are lists of the format:
3555 ((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3557 SCRIPT is a symbol representing OpenType script tag.
3559 LANGSYS is a symbol representing OpenType langsys tag, or nil
3560 representing the default langsys.
3562 FEATURE is a symbol representing OpenType feature tag.
3564 If the font is not OpenType font, OTF-CAPABILITY is nil. */)
3566 Lisp_Object font_object
;
3571 CHECK_FONT_GET_OBJECT (font_object
, font
);
3573 val
= Fmake_vector (make_number (9), Qnil
);
3574 if (font
->font
.full_name
)
3575 ASET (val
, 0, make_unibyte_string (font
->font
.full_name
,
3576 strlen (font
->font
.full_name
)));
3577 if (font
->file_name
)
3578 ASET (val
, 1, make_unibyte_string (font
->file_name
,
3579 strlen (font
->file_name
)));
3580 ASET (val
, 2, make_number (font
->pixel_size
));
3581 ASET (val
, 3, make_number (font
->font
.size
));
3582 ASET (val
, 4, make_number (font
->ascent
));
3583 ASET (val
, 5, make_number (font
->descent
));
3584 ASET (val
, 6, make_number (font
->font
.space_width
));
3585 ASET (val
, 7, make_number (font
->font
.average_width
));
3586 if (font
->driver
->otf_capability
)
3587 ASET (val
, 8, font
->driver
->otf_capability (font
));
3591 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
3592 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
3593 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
3594 (font_object
, string
)
3595 Lisp_Object font_object
, string
;
3601 CHECK_FONT_GET_OBJECT (font_object
, font
);
3602 CHECK_STRING (string
);
3603 len
= SCHARS (string
);
3604 vec
= Fmake_vector (make_number (len
), Qnil
);
3605 for (i
= 0; i
< len
; i
++)
3607 Lisp_Object ch
= Faref (string
, make_number (i
));
3611 struct font_metrics metrics
;
3613 code
= font
->driver
->encode_char (font
, c
);
3614 if (code
== FONT_INVALID_CODE
)
3616 val
= Fmake_vector (make_number (6), Qnil
);
3617 if (code
<= MOST_POSITIVE_FIXNUM
)
3618 ASET (val
, 0, make_number (code
));
3620 ASET (val
, 0, Fcons (make_number (code
>> 16),
3621 make_number (code
& 0xFFFF)));
3622 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
3623 ASET (val
, 1, make_number (metrics
.lbearing
));
3624 ASET (val
, 2, make_number (metrics
.rbearing
));
3625 ASET (val
, 3, make_number (metrics
.width
));
3626 ASET (val
, 4, make_number (metrics
.ascent
));
3627 ASET (val
, 5, make_number (metrics
.descent
));
3633 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
3634 doc
: /* Return t iff font-spec SPEC matches with FONT.
3635 FONT is a font-spec, font-entity, or font-object. */)
3637 Lisp_Object spec
, font
;
3639 CHECK_FONT_SPEC (spec
);
3640 if (FONT_OBJECT_P (font
))
3641 font
= ((struct font
*) XSAVE_VALUE (font
)->pointer
)->entity
;
3642 else if (! FONT_ENTITY_P (font
))
3643 CHECK_FONT_SPEC (font
);
3645 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
3648 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 2, 0,
3649 doc
: /* Return a font-object for displaying a character at POSISTION.
3650 Optional second arg WINDOW, if non-nil, is a window displaying
3651 the current buffer. It defaults to the currently selected window. */)
3653 Lisp_Object position
, window
;
3656 EMACS_INT pos
, pos_byte
;
3659 CHECK_NUMBER_COERCE_MARKER (position
);
3660 pos
= XINT (position
);
3661 if (pos
< BEGV
|| pos
>= ZV
)
3662 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
3663 pos_byte
= CHAR_TO_BYTE (pos
);
3664 c
= FETCH_CHAR (pos_byte
);
3666 window
= selected_window
;
3667 CHECK_LIVE_WINDOW (window
);
3668 w
= XWINDOW (selected_window
);
3670 return font_at (c
, pos
, NULL
, w
, Qnil
);
3674 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
3675 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
3676 The value is a number of glyphs drawn.
3677 Type C-l to recover what previously shown. */)
3678 (font_object
, string
)
3679 Lisp_Object font_object
, string
;
3681 Lisp_Object frame
= selected_frame
;
3682 FRAME_PTR f
= XFRAME (frame
);
3688 CHECK_FONT_GET_OBJECT (font_object
, font
);
3689 CHECK_STRING (string
);
3690 len
= SCHARS (string
);
3691 code
= alloca (sizeof (unsigned) * len
);
3692 for (i
= 0; i
< len
; i
++)
3694 Lisp_Object ch
= Faref (string
, make_number (i
));
3698 code
[i
] = font
->driver
->encode_char (font
, c
);
3699 if (code
[i
] == FONT_INVALID_CODE
)
3702 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3704 if (font
->driver
->prepare_face
)
3705 font
->driver
->prepare_face (f
, face
);
3706 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
3707 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
3708 if (font
->driver
->done_face
)
3709 font
->driver
->done_face (f
, face
);
3711 return make_number (len
);
3715 #endif /* FONT_DEBUG */
3718 extern void syms_of_ftfont
P_ (());
3719 extern void syms_of_xfont
P_ (());
3720 extern void syms_of_xftfont
P_ (());
3721 extern void syms_of_ftxfont
P_ (());
3722 extern void syms_of_bdffont
P_ (());
3723 extern void syms_of_w32font
P_ (());
3724 extern void syms_of_atmfont
P_ (());
3729 sort_shift_bits
[FONT_SLANT_INDEX
] = 0;
3730 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 7;
3731 sort_shift_bits
[FONT_SIZE_INDEX
] = 14;
3732 sort_shift_bits
[FONT_WIDTH_INDEX
] = 21;
3733 sort_shift_bits
[FONT_ADSTYLE_INDEX
] = 28;
3734 sort_shift_bits
[FONT_FOUNDRY_INDEX
] = 29;
3735 sort_shift_bits
[FONT_FAMILY_INDEX
] = 30;
3736 sort_shift_bits
[FONT_REGISTRY_INDEX
] = 31;
3737 /* Note that sort_shift_bits[FONT_TYPE_INDEX] is never used. */
3739 staticpro (&font_style_table
);
3740 font_style_table
= Fmake_vector (make_number (3), Qnil
);
3742 staticpro (&font_family_alist
);
3743 font_family_alist
= Qnil
;
3745 DEFSYM (Qfontp
, "fontp");
3747 DEFSYM (Qiso8859_1
, "iso8859-1");
3748 DEFSYM (Qiso10646_1
, "iso10646-1");
3749 DEFSYM (Qunicode_bmp
, "unicode-bmp");
3750 DEFSYM (Qunicode_sip
, "unicode-sip");
3752 DEFSYM (QCotf
, ":otf");
3753 DEFSYM (QClanguage
, ":language");
3754 DEFSYM (QCscript
, ":script");
3756 DEFSYM (QCfoundry
, ":foundry");
3757 DEFSYM (QCadstyle
, ":adstyle");
3758 DEFSYM (QCregistry
, ":registry");
3759 DEFSYM (QCspacing
, ":spacing");
3760 DEFSYM (QCdpi
, ":dpi");
3761 DEFSYM (QCscalable
, ":scalable");
3762 DEFSYM (QCextra
, ":extra");
3769 staticpro (&null_string
);
3770 null_string
= build_string ("");
3771 staticpro (&null_vector
);
3772 null_vector
= Fmake_vector (make_number (0), Qnil
);
3774 staticpro (&scratch_font_spec
);
3775 scratch_font_spec
= Ffont_spec (0, NULL
);
3776 staticpro (&scratch_font_prefer
);
3777 scratch_font_prefer
= Ffont_spec (0, NULL
);
3780 defsubr (&Sfont_spec
);
3781 defsubr (&Sfont_get
);
3782 defsubr (&Sfont_put
);
3783 defsubr (&Slist_fonts
);
3784 defsubr (&Slist_families
);
3785 defsubr (&Sfind_font
);
3786 defsubr (&Sfont_xlfd_name
);
3787 defsubr (&Sclear_font_cache
);
3788 defsubr (&Sinternal_set_font_style_table
);
3789 defsubr (&Sfont_make_gstring
);
3790 defsubr (&Sfont_fill_gstring
);
3791 defsubr (&Sfont_otf_gsub
);
3792 defsubr (&Sfont_otf_gpos
);
3793 defsubr (&Sfont_otf_alternates
);
3796 defsubr (&Sopen_font
);
3797 defsubr (&Sclose_font
);
3798 defsubr (&Squery_font
);
3799 defsubr (&Sget_font_glyphs
);
3800 defsubr (&Sfont_match_p
);
3801 defsubr (&Sfont_at
);
3803 defsubr (&Sdraw_string
);
3805 #endif /* FONT_DEBUG */
3807 #ifdef HAVE_FREETYPE
3809 #ifdef HAVE_X_WINDOWS
3814 #endif /* HAVE_XFT */
3815 #endif /* HAVE_X_WINDOWS */
3816 #else /* not HAVE_FREETYPE */
3817 #ifdef HAVE_X_WINDOWS
3819 #endif /* HAVE_X_WINDOWS */
3820 #endif /* not HAVE_FREETYPE */
3823 #endif /* HAVE_BDFFONT */
3826 #endif /* WINDOWSNT */
3832 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
3833 (do not change this comment) */