1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006 Free Software Foundation, Inc.
4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H13PRO009
7 This file is part of GNU Emacs.
9 GNU Emacs is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 2, or (at your option)
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs; see the file COPYING. If not, write to
21 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
22 Boston, MA 02110-1301, USA. */
33 #include "dispextern.h"
35 #include "character.h"
36 #include "composite.h"
46 #define xassert(X) do {if (!(X)) abort ();} while (0)
48 #define xassert(X) (void) 0
51 int enable_font_backend
;
55 Lisp_Object Qopentype
;
57 /* Important character set symbols. */
58 Lisp_Object Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
60 /* Like CHECK_FONT_SPEC but also validate properties of the font-spec,
61 and set X to the validated result. */
63 #define CHECK_VALIDATE_FONT_SPEC(x) \
65 if (! FONT_SPEC_P (x)) x = wrong_type_argument (Qfont, x); \
66 x = font_prop_validate (x); \
69 /* Number of pt per inch (from the TeXbook). */
70 #define PT_PER_INCH 72.27
72 /* Return a pixel size (integer) corresponding to POINT size (double)
74 #define POINT_TO_PIXEL(POINT, DPI) ((POINT) * (DPI) / PT_PER_INCH + 0.5)
76 /* Return a point size (double) corresponding to POINT size (integer)
78 #define PIXEL_TO_POINT(PIXEL, DPI) ((PIXEL) * PT_PER_INCH * 10 / (DPI) + 0.5)
80 /* Special string of zero length. It is used to specify a NULL name
81 in a font properties (e.g. adstyle). We don't use the symbol of
82 NULL name because it's confusing (Lisp printer prints nothing for
84 Lisp_Object null_string
;
86 /* Special vector of zero length. This is repeatedly used by (struct
87 font_driver *)->list when a specified font is not found. */
88 Lisp_Object null_vector
;
90 /* Vector of 3 elements. Each element is an alist for one of font
91 style properties (weight, slant, width). The alist contains a
92 mapping between symbolic property values (e.g. `medium' for weight)
93 and numeric property values (e.g. 100). So, it looks like this:
94 [((thin . 0) ... (heavy . 210))
95 ((ro . 0) ... (ot . 210))
96 ((ultracondensed . 50) ... (wide . 200))] */
97 static Lisp_Object font_style_table
;
99 /* Alist of font family vs the corresponding aliases.
100 Each element has this form:
101 (FAMILY ALIAS1 ALIAS2 ...) */
103 static Lisp_Object font_family_alist
;
105 /* Symbols representing keys of normal font properties. */
106 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
, QCsize
, QCname
;
107 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
, QCextra
;
108 /* Symbols representing keys of font extra info. */
109 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClanguage
, QCscript
;
110 /* Symbols representing values of font spacing property. */
111 Lisp_Object Qc
, Qm
, Qp
, Qd
;
113 /* List of all font drivers. All font-backends (XXXfont.c) call
114 add_font_driver in syms_of_XXXfont to register the font-driver
116 static struct font_driver_list
*font_driver_list
;
118 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
119 static Lisp_Object prop_name_to_numeric
P_ ((enum font_property_index
,
121 static Lisp_Object prop_numeric_to_name
P_ ((enum font_property_index
, int));
122 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
123 static void build_font_family_alist
P_ ((void));
125 /* Number of registered font drivers. */
126 static int num_font_drivers
;
128 /* Return a pixel size of font-spec SPEC on frame F. */
131 font_pixel_size (f
, spec
)
135 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
138 Lisp_Object extra
, val
;
144 point_size
= XFLOAT_DATA (size
);
145 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
146 val
= assq_no_quit (extra
, QCdpi
);
149 if (INTEGERP (XCDR (val
)))
150 dpi
= XINT (XCDR (val
));
152 dpi
= XFLOAT_DATA (XCDR (val
)) + 0.5;
156 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
160 /* Return a numeric value corresponding to PROP's NAME (symbol). If
161 NAME is not registered in font_style_table, return Qnil. PROP must
162 be one of FONT_{WEIGHT|SLANT|SWIDTH}_INDEX. */
165 prop_name_to_numeric (prop
, name
)
166 enum font_property_index prop
;
169 int table_index
= prop
- FONT_WEIGHT_INDEX
;
172 val
= assq_no_quit (name
, AREF (font_style_table
, table_index
));
173 return (NILP (val
) ? Qnil
: XCDR (val
));
177 /* Return a name (symbol) corresponding to PROP's NUMERIC value. If
178 no name is registered for NUMERIC in font_style_table, return a
179 symbol of integer name (e.g. `123'). PROP must be one of
180 FONT_{WEIGHT|SLANT|SWIDTH}_INDEX. */
183 prop_numeric_to_name (prop
, numeric
)
184 enum font_property_index prop
;
187 int table_index
= prop
- FONT_WEIGHT_INDEX
;
188 Lisp_Object table
= AREF (font_style_table
, table_index
);
191 while (! NILP (table
))
193 if (XINT (XCDR (XCAR (table
))) >= numeric
)
195 if (XINT (XCDR (XCAR (table
))) == numeric
)
196 return XCAR (XCAR (table
));
200 table
= XCDR (table
);
202 sprintf (buf
, "%d", numeric
);
207 /* Return a symbol whose name is STR (length LEN). If STR contains
208 uppercase letters, downcase them in advance. */
211 intern_downcase (str
, len
)
218 for (i
= 0; i
< len
; i
++)
219 if (isupper (str
[i
]))
222 return Fintern (make_unibyte_string (str
, len
), Qnil
);
225 return Fintern (null_string
, Qnil
);
226 bcopy (str
, buf
, len
);
228 if (isascii (buf
[i
]))
229 buf
[i
] = tolower (buf
[i
]);
230 return Fintern (make_unibyte_string (buf
, len
), Qnil
);
233 extern Lisp_Object Vface_alternative_font_family_alist
;
236 build_font_family_alist ()
238 Lisp_Object alist
= Vface_alternative_font_family_alist
;
240 for (; CONSP (alist
); alist
= XCDR (alist
))
242 Lisp_Object tail
, elt
;
244 for (tail
= XCAR (alist
), elt
= Qnil
; CONSP (tail
); tail
= XCDR (tail
))
245 elt
= nconc2 (elt
, Fcons (Fintern (XCAR (tail
), Qnil
), Qnil
));
246 font_family_alist
= Fcons (elt
, font_family_alist
);
251 /* Font property validater. */
253 static Lisp_Object font_prop_validate_symbol
P_ ((enum font_property_index
,
254 Lisp_Object
, Lisp_Object
));
255 static Lisp_Object font_prop_validate_style
P_ ((enum font_property_index
,
256 Lisp_Object
, Lisp_Object
));
257 static Lisp_Object font_prop_validate_non_neg
P_ ((enum font_property_index
,
258 Lisp_Object
, Lisp_Object
));
259 static Lisp_Object font_prop_validate_spacing
P_ ((enum font_property_index
,
260 Lisp_Object
, Lisp_Object
));
261 static int get_font_prop_index
P_ ((Lisp_Object
, int));
262 static Lisp_Object font_prop_validate
P_ ((Lisp_Object
));
263 static Lisp_Object font_put_extra
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
266 font_prop_validate_symbol (prop_index
, prop
, val
)
267 enum font_property_index prop_index
;
268 Lisp_Object prop
, val
;
270 if (EQ (prop
, QCotf
))
271 return (SYMBOLP (val
) ? val
: Qerror
);
273 val
= (SCHARS (val
) == 0 ? null_string
274 : intern_downcase ((char *) SDATA (val
), SBYTES (val
)));
275 else if (SYMBOLP (val
))
277 if (SCHARS (SYMBOL_NAME (val
)) == 0)
286 font_prop_validate_style (prop_index
, prop
, val
)
287 enum font_property_index prop_index
;
288 Lisp_Object prop
, val
;
290 if (! INTEGERP (val
))
293 val
= intern_downcase ((char *) SDATA (val
), SBYTES (val
));
298 val
= prop_name_to_numeric (prop_index
, val
);
307 font_prop_validate_non_neg (prop_index
, prop
, val
)
308 enum font_property_index prop_index
;
309 Lisp_Object prop
, val
;
311 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
316 font_prop_validate_spacing (prop_index
, prop
, val
)
317 enum font_property_index prop_index
;
318 Lisp_Object prop
, val
;
320 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
323 return make_number (FONT_SPACING_CHARCELL
);
325 return make_number (FONT_SPACING_MONO
);
327 return make_number (FONT_SPACING_PROPORTIONAL
);
331 /* Structure of known font property keys and validater of the
335 /* Pointer to the key symbol. */
337 /* Function to validate the value VAL, or NULL if any value is ok. */
338 Lisp_Object (*validater
) P_ ((enum font_property_index prop_index
,
339 Lisp_Object prop
, Lisp_Object val
));
340 } font_property_table
[] =
341 { { &QCtype
, font_prop_validate_symbol
},
342 { &QCfoundry
, font_prop_validate_symbol
},
343 { &QCfamily
, font_prop_validate_symbol
},
344 { &QCadstyle
, font_prop_validate_symbol
},
345 { &QCregistry
, font_prop_validate_symbol
},
346 { &QCweight
, font_prop_validate_style
},
347 { &QCslant
, font_prop_validate_style
},
348 { &QCwidth
, font_prop_validate_style
},
349 { &QCsize
, font_prop_validate_non_neg
},
350 { &QClanguage
, font_prop_validate_symbol
},
351 { &QCscript
, font_prop_validate_symbol
},
352 { &QCdpi
, font_prop_validate_non_neg
},
353 { &QCspacing
, font_prop_validate_spacing
},
354 { &QCscalable
, NULL
},
355 { &QCotf
, font_prop_validate_symbol
}
358 #define FONT_PROPERTY_TABLE_SIZE \
359 ((sizeof font_property_table) / (sizeof *font_property_table))
362 get_font_prop_index (key
, from
)
366 for (; from
< FONT_PROPERTY_TABLE_SIZE
; from
++)
367 if (EQ (key
, *font_property_table
[from
].key
))
373 font_prop_validate (spec
)
377 Lisp_Object prop
, val
, extra
;
379 for (i
= FONT_TYPE_INDEX
; i
< FONT_EXTRA_INDEX
; i
++)
381 if (! NILP (AREF (spec
, i
)))
383 prop
= *font_property_table
[i
].key
;
384 val
= (font_property_table
[i
].validater
) (i
, prop
, AREF (spec
, i
));
385 if (EQ (val
, Qerror
))
386 Fsignal (Qfont
, list2 (build_string ("invalid font property"),
387 Fcons (prop
, AREF (spec
, i
))));
391 for (extra
= AREF (spec
, FONT_EXTRA_INDEX
);
392 CONSP (extra
); extra
= XCDR (extra
))
394 Lisp_Object elt
= XCAR (extra
);
397 i
= get_font_prop_index (prop
, FONT_EXTRA_INDEX
);
399 && font_property_table
[i
].validater
)
401 val
= (font_property_table
[i
].validater
) (i
, prop
, XCDR (elt
));
402 if (EQ (val
, Qerror
))
403 Fsignal (Qfont
, list2 (build_string ("invalid font property"),
412 font_put_extra (font
, prop
, val
)
413 Lisp_Object font
, prop
, val
;
415 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
416 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
420 extra
= Fcons (Fcons (prop
, val
), extra
);
421 ASET (font
, FONT_EXTRA_INDEX
, extra
);
429 /* Font name parser and unparser */
431 static Lisp_Object intern_font_field
P_ ((char *, int));
432 static int parse_matrix
P_ ((char *));
433 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
434 static int font_parse_name
P_ ((char *, Lisp_Object
));
436 /* An enumerator for each field of an XLFD font name. */
437 enum xlfd_field_index
456 /* An enumerator for mask bit corresponding to each XLFD field. */
459 XLFD_FOUNDRY_MASK
= 0x0001,
460 XLFD_FAMILY_MASK
= 0x0002,
461 XLFD_WEIGHT_MASK
= 0x0004,
462 XLFD_SLANT_MASK
= 0x0008,
463 XLFD_SWIDTH_MASK
= 0x0010,
464 XLFD_ADSTYLE_MASK
= 0x0020,
465 XLFD_PIXEL_MASK
= 0x0040,
466 XLFD_POINT_MASK
= 0x0080,
467 XLFD_RESX_MASK
= 0x0100,
468 XLFD_RESY_MASK
= 0x0200,
469 XLFD_SPACING_MASK
= 0x0400,
470 XLFD_AVGWIDTH_MASK
= 0x0800,
471 XLFD_REGISTRY_MASK
= 0x1000,
472 XLFD_ENCODING_MASK
= 0x2000
476 /* Return a Lispy value of a XLFD font field at STR and LEN bytes.
477 If LEN is zero, it returns `null_string'.
478 If STR is "*", it returns nil.
479 If all characters in STR are digits, it returns an integer.
480 Otherwise, it returns a symbol interned from downcased STR. */
483 intern_font_field (str
, len
)
491 if (*str
== '*' && len
== 1)
495 for (i
= 1; i
< len
; i
++)
496 if (! isdigit (str
[i
]))
499 return make_number (atoi (str
));
501 return intern_downcase (str
, len
);
504 /* Parse P pointing the pixel/point size field of the form
505 `[A B C D]' which specifies a transformation matrix:
511 by which all glyphs of the font are transformed. The spec says
512 that scalar value N for the pixel/point size is equivalent to:
513 A = N * resx/resy, B = C = 0, D = N.
515 Return the scalar value N if the form is valid. Otherwise return
526 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
529 matrix
[i
] = - strtod (p
+ 1, &end
);
531 matrix
[i
] = strtod (p
, &end
);
534 return (i
== 4 ? (int) matrix
[3] : -1);
537 /* Expand a wildcard field in FIELD (the first N fields are filled) to
538 multiple fields to fill in all 14 XLFD fields while restring a
539 field position by its contents. */
542 font_expand_wildcards (field
, n
)
543 Lisp_Object field
[XLFD_LAST_INDEX
];
547 Lisp_Object tmp
[XLFD_LAST_INDEX
];
548 /* Array of information about where this element can go. Nth
549 element is for Nth element of FIELD. */
551 /* Minimum possible field. */
553 /* Maxinum possible field. */
555 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
557 } range
[XLFD_LAST_INDEX
];
559 int range_from
, range_to
;
562 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
563 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
564 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
565 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
566 | XLFD_AVGWIDTH_MASK)
567 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
569 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
570 field. The value is shifted to left one bit by one in the
572 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
573 range_mask
= (range_mask
<< 1) | 1;
575 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
576 position-based retriction for FIELD[I]. */
577 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
578 i
++, range_from
++, range_to
++, range_mask
<<= 1)
580 Lisp_Object val
= field
[i
];
586 range
[i
].from
= range_from
;
587 range
[i
].to
= range_to
;
588 range
[i
].mask
= range_mask
;
592 /* The triplet FROM, TO, and MASK is a value-based
593 retriction for FIELD[I]. */
599 int numeric
= XINT (val
);
602 from
= to
= XLFD_ENCODING_INDEX
,
603 mask
= XLFD_ENCODING_MASK
;
604 else if (numeric
== 0)
605 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
606 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
607 else if (numeric
<= 48)
608 from
= to
= XLFD_PIXEL_INDEX
,
609 mask
= XLFD_PIXEL_MASK
;
611 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
612 mask
= XLFD_LARGENUM_MASK
;
614 else if (EQ (val
, null_string
))
615 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
616 mask
= XLFD_NULL_MASK
;
618 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
621 Lisp_Object name
= SYMBOL_NAME (val
);
623 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
624 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
625 mask
= XLFD_REGENC_MASK
;
627 from
= to
= XLFD_ENCODING_INDEX
,
628 mask
= XLFD_ENCODING_MASK
;
630 else if (range_from
<= XLFD_WEIGHT_INDEX
631 && range_to
>= XLFD_WEIGHT_INDEX
632 && !NILP (prop_name_to_numeric (FONT_WEIGHT_INDEX
, val
)))
633 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
634 else if (range_from
<= XLFD_SLANT_INDEX
635 && range_to
>= XLFD_SLANT_INDEX
636 && !NILP (prop_name_to_numeric (FONT_SLANT_INDEX
, val
)))
637 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
638 else if (range_from
<= XLFD_SWIDTH_INDEX
639 && range_to
>= XLFD_SWIDTH_INDEX
640 && !NILP (prop_name_to_numeric (FONT_WIDTH_INDEX
, val
)))
641 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
644 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
645 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
647 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
648 mask
= XLFD_SYMBOL_MASK
;
651 /* Merge position-based and value-based restrictions. */
653 while (from
< range_from
)
654 mask
&= ~(1 << from
++);
655 while (from
< 14 && ! (mask
& (1 << from
)))
657 while (to
> range_to
)
658 mask
&= ~(1 << to
--);
659 while (to
>= 0 && ! (mask
& (1 << to
)))
663 range
[i
].from
= from
;
665 range
[i
].mask
= mask
;
667 if (from
> range_from
|| to
< range_to
)
669 /* The range is narrowed by value-based restrictions.
670 Reflect it to the other fields. */
672 /* Following fields should be after FROM. */
674 /* Preceding fields should be before TO. */
675 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
677 /* Check FROM for non-wildcard field. */
678 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
680 while (range
[j
].from
< from
)
681 range
[j
].mask
&= ~(1 << range
[j
].from
++);
682 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
684 range
[j
].from
= from
;
687 from
= range
[j
].from
;
688 if (range
[j
].to
> to
)
690 while (range
[j
].to
> to
)
691 range
[j
].mask
&= ~(1 << range
[j
].to
--);
692 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
705 /* Decide all fileds from restrictions in RANGE. */
706 for (i
= j
= 0; i
< n
; i
++)
708 if (j
< range
[i
].from
)
710 if (i
== 0 || ! NILP (tmp
[i
- 1]))
711 /* None of TMP[X] corresponds to Jth field. */
713 for (; j
< range
[i
].from
; j
++)
718 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
720 for (; j
< XLFD_LAST_INDEX
; j
++)
722 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
723 field
[XLFD_ENCODING_INDEX
]
724 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
728 /* Parse NAME (null terminated) as XLFD and store information in FONT
729 (font-spec or font-entity). Size property of FONT is set as
731 specified XLFD fields FONT property
732 --------------------- -------------
733 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
734 POINT_SIZE and RESY calculated pixel size (Lisp integer)
735 POINT_SIZE POINT_SIZE/10 (Lisp float)
737 If NAME is successfully parsed, return 0. Otherwise return -1.
739 FONT is usually a font-spec, but when this function is called from
740 X font backend driver, it is a font-entity. In that case, NAME is
741 a fully specified XLFD, and we set FONT_EXTRA_INDEX of FONT to a
742 symbol RESX-RESY-SPACING-AVGWIDTH.
746 font_parse_xlfd (name
, font
)
750 int len
= strlen (name
);
752 Lisp_Object dpi
, spacing
;
754 char *f
[XLFD_LAST_INDEX
+ 1];
759 /* Maximum XLFD name length is 255. */
761 /* Accept "*-.." as a fully specified XLFD. */
762 if (name
[0] == '*' && name
[1] == '-')
763 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
766 for (p
= name
+ i
; *p
; p
++)
767 if (*p
== '-' && i
< XLFD_LAST_INDEX
)
771 dpi
= spacing
= Qnil
;
774 if (i
== XLFD_LAST_INDEX
)
778 /* Fully specified XLFD. */
779 for (i
= 0, j
= FONT_FOUNDRY_INDEX
; i
< XLFD_WEIGHT_INDEX
; i
++, j
++)
781 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
785 for (j
= FONT_WEIGHT_INDEX
; i
< XLFD_ADSTYLE_INDEX
; i
++, j
++)
787 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
790 Lisp_Object numeric
= prop_name_to_numeric (j
, val
);
792 if (INTEGERP (numeric
))
797 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
799 ASET (font
, FONT_ADSTYLE_INDEX
, val
);
800 i
= XLFD_REGISTRY_INDEX
;
801 val
= intern_font_field (f
[i
], f
[i
+ 2] - f
[i
]);
803 ASET (font
, FONT_REGISTRY_INDEX
, val
);
805 p
= f
[XLFD_PIXEL_INDEX
];
806 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
807 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
810 i
= XLFD_PIXEL_INDEX
;
811 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
813 ASET (font
, FONT_SIZE_INDEX
, val
);
816 double point_size
= -1;
818 xassert (FONT_SPEC_P (font
));
819 p
= f
[XLFD_POINT_INDEX
];
821 point_size
= parse_matrix (p
);
822 else if (isdigit (*p
))
823 point_size
= atoi (p
), point_size
/= 10;
825 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
828 i
= XLFD_PIXEL_INDEX
;
829 val
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
831 ASET (font
, FONT_SIZE_INDEX
, val
);
836 /* Parse RESX, RESY, SPACING, and AVGWIDTH. */
837 if (FONT_ENTITY_P (font
))
840 ASET (font
, FONT_EXTRA_INDEX
,
841 intern_font_field (f
[i
], f
[XLFD_REGISTRY_INDEX
] - 1 - f
[i
]));
845 /* Here we just setup DPI, SPACING, and AVGWIDTH. They are set
846 in FONT_EXTRA_INDEX later. */
848 dpi
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
849 i
= XLFD_SPACING_INDEX
;
850 spacing
= intern_font_field (f
[i
], f
[i
+ 1] - 1 - f
[i
]);
851 p
= f
[XLFD_AVGWIDTH_INDEX
];
859 int wild_card_found
= 0;
860 Lisp_Object prop
[XLFD_LAST_INDEX
];
862 for (j
= 0; j
< i
; j
++)
866 if (f
[j
][1] && f
[j
][1] != '-')
871 else if (isdigit (*f
[j
]))
873 for (p
= f
[j
] + 1; isdigit (*p
); p
++);
875 prop
[j
] = intern_downcase (f
[j
], p
- f
[j
]);
877 prop
[j
] = make_number (atoi (f
[j
]));
880 prop
[j
] = intern_font_field (f
[j
], f
[j
+ 1] - 1 - f
[j
]);
882 prop
[j
] = intern_font_field (f
[j
], f
[i
] - f
[j
]);
884 if (! wild_card_found
)
886 if (font_expand_wildcards (prop
, i
) < 0)
889 for (i
= 0, j
= FONT_FOUNDRY_INDEX
; i
< XLFD_WEIGHT_INDEX
; i
++, j
++)
890 if (! NILP (prop
[i
]))
891 ASET (font
, j
, prop
[i
]);
892 for (j
= FONT_WEIGHT_INDEX
; i
< XLFD_ADSTYLE_INDEX
; i
++, j
++)
893 if (! NILP (prop
[i
]))
894 ASET (font
, j
, prop
[i
]);
895 if (! NILP (prop
[XLFD_ADSTYLE_INDEX
]))
896 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
897 val
= prop
[XLFD_REGISTRY_INDEX
];
900 val
= prop
[XLFD_ENCODING_INDEX
];
902 val
= Fintern (concat2 (build_string ("*-"), SYMBOL_NAME (val
)),
905 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
906 val
= Fintern (concat2 (SYMBOL_NAME (val
), build_string ("-*")),
909 val
= Fintern (concat3 (SYMBOL_NAME (val
), build_string ("-"),
910 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
])),
913 ASET (font
, FONT_REGISTRY_INDEX
, val
);
915 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
916 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
917 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
919 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
921 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
924 dpi
= prop
[XLFD_RESX_INDEX
];
925 spacing
= prop
[XLFD_SPACING_INDEX
];
926 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
927 avgwidth
= XINT (prop
[XLFD_AVGWIDTH_INDEX
]);
931 font_put_extra (font
, QCdpi
, dpi
);
932 if (! NILP (spacing
))
933 font_put_extra (font
, QCspacing
, spacing
);
935 font_put_extra (font
, QCscalable
, avgwidth
== 0 ? Qt
: Qnil
);
940 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
941 length), and return the name length. If FONT_SIZE_INDEX of FONT is
942 0, use PIXEL_SIZE instead. */
945 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
951 char *f
[XLFD_REGISTRY_INDEX
+ 1];
955 xassert (FONTP (font
));
957 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
960 if (i
== FONT_ADSTYLE_INDEX
)
961 j
= XLFD_ADSTYLE_INDEX
;
962 else if (i
== FONT_REGISTRY_INDEX
)
963 j
= XLFD_REGISTRY_INDEX
;
964 val
= AREF (font
, i
);
967 if (j
== XLFD_REGISTRY_INDEX
)
968 f
[j
] = "*-*", len
+= 4;
970 f
[j
] = "*", len
+= 2;
975 val
= SYMBOL_NAME (val
);
976 if (j
== XLFD_REGISTRY_INDEX
977 && ! strchr ((char *) SDATA (val
), '-'))
979 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
980 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
982 f
[j
] = alloca (SBYTES (val
) + 3);
983 sprintf (f
[j
], "%s-*", SDATA (val
));
984 len
+= SBYTES (val
) + 3;
988 f
[j
] = alloca (SBYTES (val
) + 4);
989 sprintf (f
[j
], "%s*-*", SDATA (val
));
990 len
+= SBYTES (val
) + 4;
994 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
998 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1001 val
= AREF (font
, i
);
1003 f
[j
] = "*", len
+= 2;
1007 val
= prop_numeric_to_name (i
, XINT (val
));
1009 val
= SYMBOL_NAME (val
);
1010 xassert (STRINGP (val
));
1011 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1015 val
= AREF (font
, FONT_SIZE_INDEX
);
1016 xassert (NUMBERP (val
) || NILP (val
));
1019 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1022 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1024 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", pixel_size
) + 1;
1026 else if (FLOATP (val
))
1028 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1029 i
= XFLOAT_DATA (val
) * 10;
1030 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1033 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1035 val
= AREF (font
, FONT_EXTRA_INDEX
);
1037 if (FONT_ENTITY_P (font
)
1038 && EQ (AREF (font
, FONT_TYPE_INDEX
), Qx
))
1040 /* Setup names for RESX-RESY-SPACING-AVWIDTH. */
1041 if (SYMBOLP (val
) && ! NILP (val
))
1043 val
= SYMBOL_NAME (val
);
1044 f
[XLFD_RESX_INDEX
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1047 f
[XLFD_RESX_INDEX
] = "*-*-*-*", len
+= 6;
1051 Lisp_Object dpi
= assq_no_quit (QCdpi
, val
);
1052 Lisp_Object spacing
= assq_no_quit (QCspacing
, val
);
1053 Lisp_Object scalable
= assq_no_quit (QCscalable
, val
);
1055 if (CONSP (dpi
) || CONSP (spacing
) || CONSP (scalable
))
1057 char *str
= alloca (24);
1060 if (CONSP (dpi
) && INTEGERP (XCDR (dpi
)))
1061 this_len
= sprintf (str
, "%d-%d",
1062 XINT (XCDR (dpi
)), XINT (XCDR (dpi
)));
1064 this_len
= sprintf (str
, "*-*");
1065 if (CONSP (spacing
) && ! NILP (XCDR (spacing
)))
1067 val
= XCDR (spacing
);
1070 if (XINT (val
) < FONT_SPACING_MONO
)
1072 else if (XINT (val
) < FONT_SPACING_CHARCELL
)
1077 xassert (SYMBOLP (val
));
1078 this_len
+= sprintf (str
+ this_len
, "-%c",
1079 SDATA (SYMBOL_NAME (val
))[0]);
1082 this_len
+= sprintf (str
+ this_len
, "-*");
1083 if (CONSP (scalable
) && ! NILP (XCDR (spacing
)))
1084 this_len
+= sprintf (str
+ this_len
, "-0");
1086 this_len
+= sprintf (str
+ this_len
, "-*");
1087 f
[XLFD_RESX_INDEX
] = str
;
1091 f
[XLFD_RESX_INDEX
] = "*-*-*-*", len
+= 8;
1094 len
++; /* for terminating '\0'. */
1097 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1098 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1099 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1100 f
[XLFD_SWIDTH_INDEX
],
1101 f
[XLFD_ADSTYLE_INDEX
], f
[XLFD_PIXEL_INDEX
],
1102 f
[XLFD_RESX_INDEX
], f
[XLFD_REGISTRY_INDEX
]);
1105 /* Parse NAME (null terminated) as Fonconfig's name format and store
1106 information in FONT (font-spec or font-entity). If NAME is
1107 successfully parsed, return 0. Otherwise return -1. */
1110 font_parse_fcname (name
, font
)
1115 int len
= strlen (name
);
1120 /* It is assured that (name[0] && name[0] != '-'). */
1128 for (p0
= name
+ 1; *p0
&& (*p0
!= '-' && *p0
!= ':'); p0
++)
1129 if (*p0
== '\\' && p0
[1])
1131 family
= intern_font_field (name
, p0
- name
);
1134 if (! isdigit (p0
[1]))
1136 point_size
= strtod (p0
+ 1, &p1
);
1137 if (*p1
&& *p1
!= ':')
1139 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1142 ASET (font
, FONT_FAMILY_INDEX
, family
);
1146 copy
= alloca (len
+ 1);
1151 /* Now parse ":KEY=VAL" patterns. Store known keys and values in
1152 extra, copy unknown ones to COPY. */
1155 Lisp_Object key
, val
;
1158 for (p1
= p0
+ 1; *p1
&& *p1
!= '=' && *p1
!= ':'; p1
++);
1161 /* Must be an enumerated value. */
1162 val
= intern_font_field (p0
+ 1, p1
- p0
- 1);
1163 if (memcmp (p0
+ 1, "light", 5) == 0
1164 || memcmp (p0
+ 1, "medium", 6) == 0
1165 || memcmp (p0
+ 1, "demibold", 8) == 0
1166 || memcmp (p0
+ 1, "bold", 4) == 0
1167 || memcmp (p0
+ 1, "black", 5) == 0)
1169 ASET (font
, FONT_WEIGHT_INDEX
, val
);
1171 else if (memcmp (p0
+ 1, "roman", 5) == 0
1172 || memcmp (p0
+ 1, "italic", 6) == 0
1173 || memcmp (p0
+ 1, "oblique", 7) == 0)
1175 ASET (font
, FONT_SLANT_INDEX
, val
);
1177 else if (memcmp (p0
+ 1, "charcell", 8) == 0
1178 || memcmp (p0
+ 1, "mono", 4) == 0
1179 || memcmp (p0
+ 1, "proportional", 12) == 0)
1181 font_put_extra (font
, QCspacing
,
1182 (p0
[1] == 'c' ? Qc
: p0
[1] == 'm' ? Qm
: Qp
));
1187 bcopy (p0
, copy
, p1
- p0
);
1193 if (memcmp (p0
+ 1, "pixelsize=", 10) == 0)
1194 prop
= FONT_SIZE_INDEX
;
1197 key
= intern_font_field (p0
, p1
- p0
);
1198 prop
= get_font_prop_index (key
, 0);
1201 for (p1
= p0
; *p1
&& *p1
!= ':'; p1
++);
1202 val
= intern_font_field (p0
, p1
- p0
);
1205 if (prop
>= 0 && prop
< FONT_EXTRA_INDEX
)
1207 ASET (font
, prop
, val
);
1210 font_put_extra (font
, key
, val
);
1219 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1220 NAME (NBYTES length), and return the name length. If
1221 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1224 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1232 int dpi
, spacing
, scalable
;
1235 Lisp_Object styles
[3];
1236 char *style_names
[3] = { "weight", "slant", "width" };
1238 val
= AREF (font
, FONT_FAMILY_INDEX
);
1239 if (SYMBOLP (val
) && ! NILP (val
))
1240 len
+= SBYTES (SYMBOL_NAME (val
));
1242 val
= AREF (font
, FONT_SIZE_INDEX
);
1245 if (XINT (val
) != 0)
1246 pixel_size
= XINT (val
);
1248 len
+= 21; /* for ":pixelsize=NUM" */
1250 else if (FLOATP (val
))
1253 point_size
= (int) XFLOAT_DATA (val
);
1254 len
+= 11; /* for "-NUM" */
1257 val
= AREF (font
, FONT_FOUNDRY_INDEX
);
1258 if (SYMBOLP (val
) && ! NILP (val
))
1259 /* ":foundry=NAME" */
1260 len
+= 9 + SBYTES (SYMBOL_NAME (val
));
1262 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
1264 val
= AREF (font
, i
);
1267 val
= prop_numeric_to_name (i
, XINT (val
));
1268 len
+= (strlen (style_names
[i
- FONT_WEIGHT_INDEX
])
1269 + 2 + SBYTES (SYMBOL_NAME (val
))); /* :xxx=NAME */
1271 styles
[i
- FONT_WEIGHT_INDEX
] = val
;
1274 val
= AREF (font
, FONT_EXTRA_INDEX
);
1275 if (FONT_ENTITY_P (font
)
1276 && EQ (AREF (font
, FONT_TYPE_INDEX
), Qx
))
1280 /* VAL is a symbol of name `RESX-RESY-SPACING-AVWIDTH'. */
1281 p
= (char *) SDATA (SYMBOL_NAME (val
));
1283 for (p
++; *p
!= '-'; p
++); /* skip RESX */
1284 for (p
++; *p
!= '-'; p
++); /* skip RESY */
1285 spacing
= (*p
== 'c' ? FONT_SPACING_CHARCELL
1286 : *p
== 'm' ? FONT_SPACING_MONO
1287 : FONT_SPACING_PROPORTIONAL
);
1288 for (p
++; *p
!= '-'; p
++); /* skip SPACING */
1289 scalable
= (atoi (p
) == 0);
1290 /* The longest pattern is ":dpi=NUM:scalable=False:spacing=100" */
1297 dpi
= spacing
= scalable
= -1;
1298 elt
= assq_no_quit (QCdpi
, val
);
1300 dpi
= XINT (XCDR (elt
)), len
+= 15; /* for ":dpi=NUM" */
1301 elt
= assq_no_quit (QCspacing
, val
);
1303 spacing
= XINT (XCDR (elt
)), len
+= 12; /* for ":spacing=100" */
1304 elt
= assq_no_quit (QCscalable
, val
);
1306 scalable
= ! NILP (XCDR (elt
)), len
+= 15; /* for ":scalable=False" */
1312 if (! NILP (AREF (font
, FONT_FAMILY_INDEX
)))
1313 p
+= sprintf(p
, "%s",
1314 SDATA (SYMBOL_NAME (AREF (font
, FONT_FAMILY_INDEX
))));
1318 p
+= sprintf (p
, "%d", point_size
);
1320 p
+= sprintf (p
, "-%d", point_size
);
1322 else if (pixel_size
> 0)
1323 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1324 if (SYMBOLP (AREF (font
, FONT_FOUNDRY_INDEX
))
1325 && ! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1326 p
+= sprintf (p
, ":foundry=%s",
1327 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1328 for (i
= 0; i
< 3; i
++)
1329 if (SYMBOLP (styles
[i
]) && ! NILP (styles
[i
]))
1330 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1331 SDATA (SYMBOL_NAME (styles
[i
])));
1333 p
+= sprintf (p
, ":dpi=%d", dpi
);
1335 p
+= sprintf (p
, ":spacing=%d", spacing
);
1337 p
+= sprintf (p
, ":scalable=True");
1338 else if (scalable
== 0)
1339 p
+= sprintf (p
, ":scalable=False");
1343 /* Parse NAME (null terminated) and store information in FONT
1344 (font-spec or font-entity). If NAME is successfully parsed, return
1345 0. Otherwise return -1.
1347 If NAME is XLFD and FONT is a font-entity, store
1348 RESX-RESY-SPACING-AVWIDTH information as a symbol in
1349 FONT_EXTRA_INDEX. */
1352 font_parse_name (name
, font
)
1356 if (name
[0] == '-' || index (name
, '*'))
1357 return font_parse_xlfd (name
, font
);
1358 return font_parse_fcname (name
, font
);
1362 font_merge_old_spec (name
, family
, registry
, spec
)
1363 Lisp_Object name
, family
, registry
, spec
;
1367 if (font_parse_xlfd ((char *) SDATA (name
), spec
) < 0)
1369 Lisp_Object extra
= Fcons (Fcons (QCname
, name
), Qnil
);
1371 ASET (spec
, FONT_EXTRA_INDEX
, extra
);
1376 if (! NILP (family
))
1381 xassert (STRINGP (family
));
1382 len
= SBYTES (family
);
1383 p0
= (char *) SDATA (family
);
1384 p1
= index (p0
, '-');
1387 if ((*p0
!= '*' || p1
- p0
> 1)
1388 && NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
1389 ASET (spec
, FONT_FOUNDRY_INDEX
,
1390 intern_downcase (p0
, p1
- p0
));
1391 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
1392 ASET (spec
, FONT_FAMILY_INDEX
,
1393 intern_downcase (p1
+ 1, len
- (p1
+ 1 - p0
)));
1395 else if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
1396 ASET (spec
, FONT_FAMILY_INDEX
, intern_downcase (p0
, len
));
1398 if (! NILP (registry
)
1399 && NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
1400 ASET (spec
, FONT_REGISTRY_INDEX
,
1401 intern_downcase ((char *) SDATA (registry
), SBYTES (registry
)));
1406 font_lispy_object (font
)
1409 Lisp_Object objlist
= AREF (font
->entity
, FONT_OBJLIST_INDEX
);
1411 for (; ! NILP (objlist
); objlist
= XCDR (objlist
))
1413 struct Lisp_Save_Value
*p
= XSAVE_VALUE (XCAR (objlist
));
1415 if (font
== (struct font
*) p
->pointer
)
1418 xassert (! NILP (objlist
));
1419 return XCAR (objlist
);
1422 #define LGSTRING_HEADER_SIZE 6
1423 #define LGSTRING_GLYPH_SIZE 8
1426 check_gstring (gstring
)
1427 Lisp_Object gstring
;
1432 CHECK_VECTOR (gstring
);
1433 val
= AREF (gstring
, 0);
1435 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1437 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1438 if (! NILP (LGSTRING_LBEARING (gstring
)))
1439 CHECK_NUMBER (LGSTRING_LBEARING (gstring
));
1440 if (! NILP (LGSTRING_RBEARING (gstring
)))
1441 CHECK_NUMBER (LGSTRING_RBEARING (gstring
));
1442 if (! NILP (LGSTRING_WIDTH (gstring
)))
1443 CHECK_NATNUM (LGSTRING_WIDTH (gstring
));
1444 if (! NILP (LGSTRING_ASCENT (gstring
)))
1445 CHECK_NUMBER (LGSTRING_ASCENT (gstring
));
1446 if (! NILP (LGSTRING_DESCENT (gstring
)))
1447 CHECK_NUMBER (LGSTRING_DESCENT(gstring
));
1449 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1451 val
= LGSTRING_GLYPH (gstring
, i
);
1453 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1455 if (NILP (LGLYPH_CHAR (val
)))
1457 CHECK_NATNUM (LGLYPH_FROM (val
));
1458 CHECK_NATNUM (LGLYPH_TO (val
));
1459 CHECK_CHARACTER (LGLYPH_CHAR (val
));
1460 if (! NILP (LGLYPH_CODE (val
)))
1461 CHECK_NATNUM (LGLYPH_CODE (val
));
1462 if (! NILP (LGLYPH_WIDTH (val
)))
1463 CHECK_NATNUM (LGLYPH_WIDTH (val
));
1464 if (! NILP (LGLYPH_ADJUSTMENT (val
)))
1466 val
= LGLYPH_ADJUSTMENT (val
);
1468 if (ASIZE (val
) < 3)
1470 for (j
= 0; j
< 3; j
++)
1471 CHECK_NUMBER (AREF (val
, j
));
1476 error ("Invalid glyph-string format");
1490 struct otf_list
*next
;
1493 static struct otf_list
*otf_list
;
1496 otf_tag_symbol (tag
)
1501 OTF_tag_name (tag
, name
);
1502 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1506 otf_open (entity
, file
)
1510 struct otf_list
*list
= otf_list
;
1512 while (list
&& ! EQ (list
->entity
, entity
))
1516 list
= malloc (sizeof (struct otf_list
));
1517 list
->entity
= entity
;
1518 list
->otf
= file
? OTF_open (file
) : NULL
;
1519 list
->next
= otf_list
;
1526 /* Return a list describing which scripts/languages FONT supports by
1527 which GSUB/GPOS features of OpenType tables. See the comment of
1528 (sturct font_driver).otf_capability. */
1531 font_otf_capability (font
)
1535 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1538 otf
= otf_open (font
->entity
, font
->file_name
);
1541 for (i
= 0; i
< 2; i
++)
1543 OTF_GSUB_GPOS
*gsub_gpos
;
1544 Lisp_Object script_list
= Qnil
;
1547 if (OTF_get_features (otf
, i
== 0) < 0)
1549 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1550 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1552 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1553 Lisp_Object langsys_list
= Qnil
;
1554 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1557 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1559 OTF_LangSys
*langsys
;
1560 Lisp_Object feature_list
= Qnil
;
1561 Lisp_Object langsys_tag
;
1564 if (k
== script
->LangSysCount
)
1566 langsys
= &script
->DefaultLangSys
;
1571 langsys
= script
->LangSys
+ k
;
1573 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1575 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1577 OTF_Feature
*feature
1578 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1579 Lisp_Object feature_tag
1580 = otf_tag_symbol (feature
->FeatureTag
);
1582 feature_list
= Fcons (feature_tag
, feature_list
);
1584 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1587 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1592 XSETCAR (capability
, script_list
);
1594 XSETCDR (capability
, script_list
);
1601 parse_gsub_gpos_spec (spec
, script
, langsys
, features
, nbytes
)
1603 char **script
, **langsys
, *features
;
1613 *script
= (char *) SDATA (SYMBOL_NAME (val
));
1618 *langsys
= NILP (val
) ? NULL
: (char *) SDATA (SYMBOL_NAME (val
));
1621 p
= features
, pend
= p
+ nbytes
- 1;
1623 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1633 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1640 else if (! asterisk
)
1642 val
= SYMBOL_NAME (val
);
1643 if (p
+ SBYTES (val
) >= pend
)
1645 p
+= sprintf (p
, "%s", SDATA (val
));
1649 val
= SYMBOL_NAME (val
);
1650 if (p
+ 1 + SBYTES (val
)>= pend
)
1652 p
+= sprintf (p
, "~%s", SDATA (val
));
1656 error ("OTF spec too long");
1659 #define DEVICE_DELTA(table, size) \
1660 (((size) >= (table).StartSize && (size) <= (table).EndSize) \
1661 ? (table).DeltaValue[(size) - (table).StartSize] \
1665 adjust_anchor (struct font
*font
, OTF_Anchor
*anchor
,
1666 unsigned code
, int size
, int *x
, int *y
)
1668 if (anchor
->AnchorFormat
== 2)
1672 if (font
->driver
->anchor_point (font
, code
, anchor
->f
.f1
.AnchorPoint
,
1676 else if (anchor
->AnchorFormat
== 3)
1678 if (anchor
->f
.f2
.XDeviceTable
.offset
)
1679 *x
+= DEVICE_DELTA (anchor
->f
.f2
.XDeviceTable
, size
);
1680 if (anchor
->f
.f2
.YDeviceTable
.offset
)
1681 *y
+= DEVICE_DELTA (anchor
->f
.f2
.YDeviceTable
, size
);
1685 #define REPLACEMENT_CHARACTER 0xFFFD
1687 /* Drive FONT's OTF GSUB features according to GSUB_SPEC. See the
1688 comment of (sturct font_driver).otf_gsub. */
1691 font_otf_gsub (font
, gsub_spec
, gstring_in
, from
, to
, gstring_out
, idx
,
1694 Lisp_Object gsub_spec
;
1695 Lisp_Object gstring_in
;
1697 Lisp_Object gstring_out
;
1698 int idx
, alternate_subst
;
1703 OTF_GlyphString otf_gstring
;
1705 char *script
, *langsys
, features
[256];
1708 parse_gsub_gpos_spec (gsub_spec
, &script
, &langsys
, features
, 256);
1710 otf
= otf_open (font
->entity
, font
->file_name
);
1713 if (OTF_get_table (otf
, "head") < 0)
1715 if (OTF_get_table (otf
, "cmap") < 0)
1717 if (OTF_check_table (otf
, "GSUB") < 0)
1720 otf_gstring
.size
= otf_gstring
.used
= len
;
1721 otf_gstring
.glyphs
= (OTF_Glyph
*) malloc (sizeof (OTF_Glyph
) * len
);
1722 memset (otf_gstring
.glyphs
, 0, sizeof (OTF_Glyph
) * len
);
1723 for (i
= 0, need_cmap
= 0; i
< len
; i
++)
1725 Lisp_Object g
= LGSTRING_GLYPH (gstring_in
, from
+ i
);
1727 otf_gstring
.glyphs
[i
].c
= XINT (LGLYPH_CHAR (g
));
1728 if (otf_gstring
.glyphs
[i
].c
== REPLACEMENT_CHARACTER
)
1729 otf_gstring
.glyphs
[i
].c
= 0;
1730 if (NILP (LGLYPH_CODE (g
)))
1732 otf_gstring
.glyphs
[i
].glyph_id
= 0;
1736 otf_gstring
.glyphs
[i
].glyph_id
= XINT (LGLYPH_CODE (g
));
1740 OTF_drive_cmap (otf
, &otf_gstring
);
1741 OTF_drive_gdef (otf
, &otf_gstring
);
1742 if ((alternate_subst
1743 ? OTF_drive_gsub_alternate (otf
, &otf_gstring
, script
, langsys
, features
)
1744 : OTF_drive_gsub (otf
, &otf_gstring
, script
, langsys
, features
)) < 0)
1746 free (otf_gstring
.glyphs
);
1749 if (ASIZE (gstring_out
) < idx
+ otf_gstring
.used
)
1751 free (otf_gstring
.glyphs
);
1755 for (i
= 0, g
= otf_gstring
.glyphs
; i
< otf_gstring
.used
;)
1757 int i0
= g
->f
.index
.from
, i1
= g
->f
.index
.to
;
1758 Lisp_Object glyph
= LGSTRING_GLYPH (gstring_in
, from
+ i0
);
1759 Lisp_Object min_idx
= AREF (glyph
, 0);
1760 Lisp_Object max_idx
= AREF (glyph
, 1);
1764 int min_idx_i
= XINT (min_idx
), max_idx_i
= XINT (max_idx
);
1766 for (i0
++; i0
<= i1
; i0
++)
1768 glyph
= LGSTRING_GLYPH (gstring_in
, from
+ i0
);
1769 if (min_idx_i
> XINT (AREF (glyph
, 0)))
1770 min_idx_i
= XINT (AREF (glyph
, 0));
1771 if (max_idx_i
< XINT (AREF (glyph
, 1)))
1772 max_idx_i
= XINT (AREF (glyph
, 1));
1774 min_idx
= make_number (min_idx_i
);
1775 max_idx
= make_number (max_idx_i
);
1776 i0
= g
->f
.index
.from
;
1778 for (; i
< otf_gstring
.used
&& g
->f
.index
.from
== i0
; i
++, g
++)
1780 glyph
= LGSTRING_GLYPH (gstring_out
, idx
+ i
);
1781 ASET (glyph
, 0, min_idx
);
1782 ASET (glyph
, 1, max_idx
);
1784 LGLYPH_SET_CHAR (glyph
, make_number (g
->c
));
1786 LGLYPH_SET_CHAR (glyph
, make_number (REPLACEMENT_CHARACTER
));
1787 LGLYPH_SET_CODE (glyph
, make_number (g
->glyph_id
));
1791 free (otf_gstring
.glyphs
);
1795 /* Drive FONT's OTF GPOS features according to GPOS_SPEC. See the
1796 comment of (sturct font_driver).otf_gpos. */
1799 font_otf_gpos (font
, gpos_spec
, gstring
, from
, to
)
1801 Lisp_Object gpos_spec
;
1802 Lisp_Object gstring
;
1808 OTF_GlyphString otf_gstring
;
1810 char *script
, *langsys
, features
[256];
1814 Lisp_Object base
, mark
;
1816 parse_gsub_gpos_spec (gpos_spec
, &script
, &langsys
, features
, 256);
1818 otf
= otf_open (font
->entity
, font
->file_name
);
1821 if (OTF_get_table (otf
, "head") < 0)
1823 if (OTF_get_table (otf
, "cmap") < 0)
1825 if (OTF_check_table (otf
, "GPOS") < 0)
1828 otf_gstring
.size
= otf_gstring
.used
= len
;
1829 otf_gstring
.glyphs
= (OTF_Glyph
*) malloc (sizeof (OTF_Glyph
) * len
);
1830 memset (otf_gstring
.glyphs
, 0, sizeof (OTF_Glyph
) * len
);
1831 for (i
= 0, need_cmap
= 0; i
< len
; i
++)
1833 glyph
= LGSTRING_GLYPH (gstring
, from
+ i
);
1834 otf_gstring
.glyphs
[i
].c
= XINT (LGLYPH_CHAR (glyph
));
1835 if (otf_gstring
.glyphs
[i
].c
== REPLACEMENT_CHARACTER
)
1836 otf_gstring
.glyphs
[i
].c
= 0;
1837 if (NILP (LGLYPH_CODE (glyph
)))
1839 otf_gstring
.glyphs
[i
].glyph_id
= 0;
1843 otf_gstring
.glyphs
[i
].glyph_id
= XINT (LGLYPH_CODE (glyph
));
1846 OTF_drive_cmap (otf
, &otf_gstring
);
1847 OTF_drive_gdef (otf
, &otf_gstring
);
1849 if (OTF_drive_gpos (otf
, &otf_gstring
, script
, langsys
, features
) < 0)
1851 free (otf_gstring
.glyphs
);
1855 u
= otf
->head
->unitsPerEm
;
1856 size
= font
->pixel_size
;
1858 for (i
= 0, g
= otf_gstring
.glyphs
; i
< otf_gstring
.used
; i
++, g
++)
1861 int xoff
= 0, yoff
= 0, width_adjust
= 0;
1866 glyph
= LGSTRING_GLYPH (gstring
, from
+ i
);
1867 switch (g
->positioning_type
)
1873 int format
= g
->f
.f1
.format
;
1875 if (format
& OTF_XPlacement
)
1876 xoff
= g
->f
.f1
.value
->XPlacement
* size
/ u
;
1877 if (format
& OTF_XPlaDevice
)
1878 xoff
+= DEVICE_DELTA (g
->f
.f1
.value
->XPlaDevice
, size
);
1879 if (format
& OTF_YPlacement
)
1880 yoff
= - (g
->f
.f1
.value
->YPlacement
* size
/ u
);
1881 if (format
& OTF_YPlaDevice
)
1882 yoff
-= DEVICE_DELTA (g
->f
.f1
.value
->YPlaDevice
, size
);
1883 if (format
& OTF_XAdvance
)
1884 width_adjust
+= g
->f
.f1
.value
->XAdvance
* size
/ u
;
1885 if (format
& OTF_XAdvDevice
)
1886 width_adjust
+= DEVICE_DELTA (g
->f
.f1
.value
->XAdvDevice
, size
);
1890 /* Not yet supported. */
1896 goto label_adjust_anchor
;
1897 default: /* i.e. case 6 */
1902 label_adjust_anchor
:
1904 int base_x
, base_y
, mark_x
, mark_y
, width
;
1907 base_x
= g
->f
.f4
.base_anchor
->XCoordinate
* size
/ u
;
1908 base_y
= g
->f
.f4
.base_anchor
->YCoordinate
* size
/ u
;
1909 mark_x
= g
->f
.f4
.mark_anchor
->XCoordinate
* size
/ u
;
1910 mark_y
= g
->f
.f4
.mark_anchor
->YCoordinate
* size
/ u
;
1912 code
= XINT (LGLYPH_CODE (prev
));
1913 if (g
->f
.f4
.base_anchor
->AnchorFormat
!= 1)
1914 adjust_anchor (font
, g
->f
.f4
.base_anchor
,
1915 code
, size
, &base_x
, &base_y
);
1916 if (g
->f
.f4
.mark_anchor
->AnchorFormat
!= 1)
1917 adjust_anchor (font
, g
->f
.f4
.mark_anchor
,
1918 code
, size
, &mark_x
, &mark_y
);
1920 if (NILP (LGLYPH_WIDTH (prev
)))
1922 width
= font
->driver
->text_extents (font
, &code
, 1, NULL
);
1923 LGLYPH_SET_WIDTH (prev
, make_number (width
));
1926 width
= XINT (LGLYPH_WIDTH (prev
));
1927 xoff
= XINT (LGLYPH_XOFF (prev
)) + (base_x
- width
) - mark_x
;
1928 yoff
= XINT (LGLYPH_YOFF (prev
)) + mark_y
- base_y
;
1932 if (xoff
|| yoff
|| width_adjust
)
1934 Lisp_Object adjustment
= Fmake_vector (make_number (3), Qnil
);
1936 ASET (adjustment
, 0, make_number (xoff
));
1937 ASET (adjustment
, 1, make_number (yoff
));
1938 ASET (adjustment
, 2, make_number (width_adjust
));
1939 LGLYPH_SET_ADJUSTMENT (glyph
, adjustment
);
1942 if (g
->GlyphClass
== OTF_GlyphClass0
)
1943 base
= mark
= glyph
;
1944 else if (g
->GlyphClass
== OTF_GlyphClassMark
)
1950 free (otf_gstring
.glyphs
);
1954 #endif /* HAVE_LIBOTF */
1957 /* G-string (glyph string) handler */
1959 /* G-string is a vector of the form [HEADER GLYPH ...].
1960 See the docstring of `font-make-gstring' for more detail. */
1963 font_prepare_composition (cmp
)
1964 struct composition
*cmp
;
1967 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
1968 cmp
->hash_index
* 2);
1969 struct font
*font
= XSAVE_VALUE (LGSTRING_FONT (gstring
))->pointer
;
1970 int len
= LGSTRING_LENGTH (gstring
);
1974 cmp
->lbearing
= cmp
->rbearing
= cmp
->pixel_width
= 0;
1975 cmp
->ascent
= font
->ascent
;
1976 cmp
->descent
= font
->descent
;
1978 for (i
= 0; i
< len
; i
++)
1980 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
1982 struct font_metrics metrics
;
1984 if (NILP (LGLYPH_FROM (g
)))
1986 code
= XINT (LGLYPH_CODE (g
));
1987 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
1988 LGLYPH_SET_WIDTH (g
, make_number (metrics
.width
));
1989 metrics
.lbearing
+= LGLYPH_XOFF (g
);
1990 metrics
.rbearing
+= LGLYPH_XOFF (g
);
1991 metrics
.ascent
+= LGLYPH_YOFF (g
);
1992 metrics
.descent
+= LGLYPH_YOFF (g
);
1994 if (cmp
->lbearing
> cmp
->pixel_width
+ metrics
.lbearing
)
1995 cmp
->lbearing
= cmp
->pixel_width
+ metrics
.lbearing
;
1996 if (cmp
->rbearing
< cmp
->pixel_width
+ metrics
.rbearing
)
1997 cmp
->rbearing
= cmp
->pixel_width
+ metrics
.rbearing
;
1998 if (cmp
->ascent
< metrics
.ascent
)
1999 cmp
->ascent
= metrics
.ascent
;
2000 if (cmp
->descent
< metrics
.descent
)
2001 cmp
->descent
= metrics
.descent
;
2002 cmp
->pixel_width
+= metrics
.width
+ LGLYPH_WADJUST (g
);
2005 LGSTRING_SET_LBEARING (gstring
, make_number (cmp
->lbearing
));
2006 LGSTRING_SET_RBEARING (gstring
, make_number (cmp
->rbearing
));
2007 LGSTRING_SET_WIDTH (gstring
, make_number (cmp
->pixel_width
));
2008 LGSTRING_SET_ASCENT (gstring
, make_number (cmp
->ascent
));
2009 LGSTRING_SET_DESCENT (gstring
, make_number (cmp
->descent
));
2015 font_gstring_produce (old
, from
, to
, new, idx
, code
, n
)
2023 Lisp_Object min_idx
, max_idx
;
2026 if (idx
+ n
> ASIZE (new))
2032 min_idx
= make_number (0);
2033 max_idx
= make_number (1);
2037 min_idx
= AREF (AREF (old
, from
- 1), 0);
2038 max_idx
= AREF (AREF (old
, from
- 1), 1);
2041 else if (from
+ 1 == to
)
2043 min_idx
= AREF (AREF (old
, from
), 0);
2044 max_idx
= AREF (AREF (old
, from
), 1);
2048 int min_idx_i
= XINT (AREF (AREF (old
, from
), 0));
2049 int max_idx_i
= XINT (AREF (AREF (old
, from
), 1));
2051 for (i
= from
+ 1; i
< to
; i
++)
2053 if (min_idx_i
> XINT (AREF (AREF (old
, i
), 0)))
2054 min_idx_i
= XINT (AREF (AREF (old
, i
), 0));
2055 if (max_idx_i
< XINT (AREF (AREF (old
, i
), 1)))
2056 max_idx_i
= XINT (AREF (AREF (old
, i
), 1));
2058 min_idx
= make_number (min_idx_i
);
2059 max_idx
= make_number (max_idx_i
);
2062 for (i
= 0; i
< n
; i
++)
2064 ASET (AREF (new, idx
+ i
), 0, min_idx
);
2065 ASET (AREF (new, idx
+ i
), 1, max_idx
);
2066 ASET (AREF (new, idx
+ i
), 2, make_number (code
[i
]));
2074 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
2075 static int font_compare
P_ ((const void *, const void *));
2076 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
2077 Lisp_Object
, Lisp_Object
));
2079 /* We sort fonts by scoring each of them against a specified
2080 font-spec. The score value is 32 bit (`unsigned'), and the smaller
2081 the value is, the closer the font is to the font-spec.
2083 Each 1-bit in the highest 4 bits of the score is used for atomic
2084 properties FOUNDRY, FAMILY, ADSTYLE, and REGISTRY.
2086 Each 7-bit in the lowest 28 bits are used for numeric properties
2087 WEIGHT, SLANT, WIDTH, and SIZE. */
2089 /* How many bits to shift to store the difference value of each font
2090 property in a score. */
2091 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
2093 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
2094 The return value indicates how different ENTITY is compared with
2098 font_score (entity
, spec_prop
)
2099 Lisp_Object entity
, *spec_prop
;
2103 /* Score four atomic fields. Maximum difference is 1. */
2104 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2105 if (! NILP (spec_prop
[i
])
2106 && ! EQ (spec_prop
[i
], AREF (entity
, i
)))
2107 score
|= 1 << sort_shift_bits
[i
];
2109 /* Score four numeric fields. Maximum difference is 127. */
2110 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2112 Lisp_Object entity_val
= AREF (entity
, i
);
2114 if (! NILP (spec_prop
[i
]) && ! EQ (spec_prop
[i
], entity_val
))
2116 if (! INTEGERP (entity_val
))
2117 score
|= 127 << sort_shift_bits
[i
];
2120 int diff
= XINT (entity_val
) - XINT (spec_prop
[i
]);
2124 if (i
== FONT_SIZE_INDEX
)
2126 if (XINT (entity_val
) > 0
2127 && diff
> FONT_PIXEL_SIZE_QUANTUM
)
2128 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2131 score
|= min (diff
, 127) << sort_shift_bits
[i
];
2140 /* The comparison function for qsort. */
2143 font_compare (d1
, d2
)
2144 const void *d1
, *d2
;
2146 return (*(unsigned *) d1
< *(unsigned *) d2
2147 ? -1 : *(unsigned *) d1
> *(unsigned *) d2
);
2151 /* The structure for elements being sorted by qsort. */
2152 struct font_sort_data
2159 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2160 If PREFER specifies a point-size, calculate the corresponding
2161 pixel-size from QCdpi property of PREFER or from the Y-resolution
2162 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
2163 get the font-entities in VEC. */
2166 font_sort_entites (vec
, prefer
, frame
, spec
)
2167 Lisp_Object vec
, prefer
, frame
, spec
;
2169 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2171 struct font_sort_data
*data
;
2178 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2179 prefer_prop
[i
] = AREF (prefer
, i
);
2183 /* As it is assured that all fonts in VEC match with SPEC, we
2184 should ignore properties specified in SPEC. So, set the
2185 corresponding properties in PREFER_PROP to nil. */
2186 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2187 if (! NILP (AREF (spec
, i
)))
2188 prefer_prop
[i
++] = Qnil
;
2191 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2192 prefer_prop
[FONT_SIZE_INDEX
]
2193 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2195 /* Scoring and sorting. */
2196 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2197 for (i
= 0; i
< len
; i
++)
2199 data
[i
].entity
= AREF (vec
, i
);
2200 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
);
2202 qsort (data
, len
, sizeof *data
, font_compare
);
2203 for (i
= 0; i
< len
; i
++)
2204 ASET (vec
, i
, data
[i
].entity
);
2211 /* API of Font Service Layer. */
2214 font_update_sort_order (order
)
2217 int i
, shift_bits
= 21;
2219 for (i
= 0; i
< 4; i
++, shift_bits
-= 7)
2221 int xlfd_idx
= order
[i
];
2223 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2224 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2225 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2226 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2227 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2228 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2230 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2235 font_symbolic_weight (font
)
2238 Lisp_Object weight
= AREF (font
, FONT_WEIGHT_INDEX
);
2240 if (INTEGERP (weight
))
2241 weight
= prop_numeric_to_name (FONT_WEIGHT_INDEX
, XINT (weight
));
2246 font_symbolic_slant (font
)
2249 Lisp_Object slant
= AREF (font
, FONT_SLANT_INDEX
);
2251 if (INTEGERP (slant
))
2252 slant
= prop_numeric_to_name (FONT_SLANT_INDEX
, XINT (slant
));
2257 font_symbolic_width (font
)
2260 Lisp_Object width
= AREF (font
, FONT_WIDTH_INDEX
);
2262 if (INTEGERP (width
))
2263 width
= prop_numeric_to_name (FONT_WIDTH_INDEX
, XINT (width
));
2268 font_match_p (spec
, entity
)
2269 Lisp_Object spec
, entity
;
2273 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2274 if (! NILP (AREF (spec
, i
))
2275 && ! EQ (AREF (spec
, i
), AREF (entity
, i
)))
2277 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
))
2278 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0
2279 && (XINT (AREF (spec
, FONT_SIZE_INDEX
))
2280 != XINT (AREF (entity
, FONT_SIZE_INDEX
))))
2286 font_find_object (font
)
2289 Lisp_Object tail
, elt
;
2291 for (tail
= AREF (font
->entity
, FONT_OBJLIST_INDEX
); CONSP (tail
);
2295 if (font
== XSAVE_VALUE (elt
)->pointer
2296 && XSAVE_VALUE (elt
)->integer
> 0)
2303 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2305 /* Return a vector of font-entities matching with SPEC on frame F. */
2308 font_list_entities (frame
, spec
)
2309 Lisp_Object frame
, spec
;
2311 FRAME_PTR f
= XFRAME (frame
);
2312 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2313 Lisp_Object ftype
, family
, size
, alternate_familes
;
2314 Lisp_Object
*vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2320 family
= AREF (spec
, FONT_FAMILY_INDEX
);
2322 alternate_familes
= Qnil
;
2325 if (NILP (font_family_alist
)
2326 && !NILP (Vface_alternative_font_family_alist
))
2327 build_font_family_alist ();
2328 alternate_familes
= assq_no_quit (family
, font_family_alist
);
2329 if (! NILP (alternate_familes
))
2330 alternate_familes
= XCDR (alternate_familes
);
2332 size
= AREF (spec
, FONT_SIZE_INDEX
);
2334 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2336 xassert (ASIZE (spec
) == FONT_SPEC_MAX
);
2337 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2339 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2341 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2343 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
2344 Lisp_Object tail
= alternate_familes
;
2347 xassert (CONSP (cache
));
2348 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2349 ASET (spec
, FONT_FAMILY_INDEX
, family
);
2353 val
= assoc_no_quit (spec
, XCDR (cache
));
2358 val
= driver_list
->driver
->list (frame
, spec
);
2360 XSETCDR (cache
, Fcons (Fcons (Fcopy_sequence (spec
), val
),
2363 if (VECTORP (val
) && ASIZE (val
) > 0)
2370 ASET (spec
, FONT_FAMILY_INDEX
, XCAR (tail
));
2374 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2375 ASET (spec
, FONT_FAMILY_INDEX
, family
);
2376 ASET (spec
, FONT_SIZE_INDEX
, size
);
2377 return (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2381 font_matching_entity (frame
, spec
)
2382 Lisp_Object frame
, spec
;
2384 FRAME_PTR f
= XFRAME (frame
);
2385 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2386 Lisp_Object ftype
, size
, entity
;
2388 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2389 size
= AREF (spec
, FONT_SIZE_INDEX
);
2391 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2393 for (; driver_list
; driver_list
= driver_list
->next
)
2395 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2397 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
2400 xassert (CONSP (cache
));
2401 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2402 key
= Fcons (spec
, Qnil
);
2403 entity
= assoc_no_quit (key
, XCDR (cache
));
2405 entity
= XCDR (entity
);
2408 entity
= driver_list
->driver
->match (frame
, spec
);
2409 if (! NILP (entity
))
2411 XSETCAR (key
, Fcopy_sequence (spec
));
2412 XSETCDR (cache
, Fcons (Fcons (key
, entity
), XCDR (cache
)));
2415 if (! NILP (entity
))
2418 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2419 ASET (spec
, FONT_SIZE_INDEX
, size
);
2423 static int num_fonts
;
2426 font_open_entity (f
, entity
, pixel_size
)
2431 struct font_driver_list
*driver_list
;
2432 Lisp_Object objlist
, size
, val
;
2435 size
= AREF (entity
, FONT_SIZE_INDEX
);
2436 xassert (NATNUMP (size
));
2437 if (XINT (size
) != 0)
2438 pixel_size
= XINT (size
);
2440 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2441 objlist
= XCDR (objlist
))
2443 font
= XSAVE_VALUE (XCAR (objlist
))->pointer
;
2444 if (font
->pixel_size
== pixel_size
)
2446 XSAVE_VALUE (XCAR (objlist
))->integer
++;
2447 return XCAR (objlist
);
2451 xassert (FONT_ENTITY_P (entity
));
2452 val
= AREF (entity
, FONT_TYPE_INDEX
);
2453 for (driver_list
= f
->font_driver_list
;
2454 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2455 driver_list
= driver_list
->next
);
2459 font
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2462 font
->scalable
= XINT (size
) == 0;
2464 val
= make_save_value (font
, 1);
2465 ASET (entity
, FONT_OBJLIST_INDEX
,
2466 Fcons (val
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2472 font_close_object (f
, font_object
)
2474 Lisp_Object font_object
;
2476 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2477 Lisp_Object objlist
;
2478 Lisp_Object tail
, prev
= Qnil
;
2480 XSAVE_VALUE (font_object
)->integer
--;
2481 xassert (XSAVE_VALUE (font_object
)->integer
>= 0);
2482 if (XSAVE_VALUE (font_object
)->integer
> 0)
2485 objlist
= AREF (font
->entity
, FONT_OBJLIST_INDEX
);
2486 for (prev
= Qnil
, tail
= objlist
; CONSP (tail
);
2487 prev
= tail
, tail
= XCDR (tail
))
2488 if (EQ (font_object
, XCAR (tail
)))
2490 if (font
->driver
->close
)
2491 font
->driver
->close (f
, font
);
2492 XSAVE_VALUE (font_object
)->pointer
= NULL
;
2494 ASET (font
->entity
, FONT_OBJLIST_INDEX
, XCDR (objlist
));
2496 XSETCDR (prev
, XCDR (objlist
));
2503 font_has_char (f
, font
, c
)
2510 if (FONT_ENTITY_P (font
))
2512 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2513 struct font_driver_list
*driver_list
;
2515 for (driver_list
= f
->font_driver_list
;
2516 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2517 driver_list
= driver_list
->next
);
2520 if (! driver_list
->driver
->has_char
)
2522 return driver_list
->driver
->has_char (font
, c
);
2525 xassert (FONT_OBJECT_P (font
));
2526 fontp
= XSAVE_VALUE (font
)->pointer
;
2528 if (fontp
->driver
->has_char
)
2530 int result
= fontp
->driver
->has_char (fontp
->entity
, c
);
2535 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2539 font_encode_char (font_object
, c
)
2540 Lisp_Object font_object
;
2543 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2545 return font
->driver
->encode_char (font
, c
);
2549 font_get_name (font_object
)
2550 Lisp_Object font_object
;
2552 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2553 char *name
= (font
->font
.full_name
? font
->font
.full_name
2554 : font
->font
.name
? font
->font
.name
2557 return (name
? make_unibyte_string (name
, strlen (name
)) : null_string
);
2561 font_get_spec (font_object
)
2562 Lisp_Object font_object
;
2564 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2565 Lisp_Object spec
= Ffont_spec (0, NULL
);
2568 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2569 ASET (spec
, i
, AREF (font
->entity
, i
));
2570 ASET (spec
, FONT_SIZE_INDEX
, make_number (font
->pixel_size
));
2575 font_get_frame (font
)
2578 if (FONT_OBJECT_P (font
))
2579 font
= ((struct font
*) XSAVE_VALUE (font
)->pointer
)->entity
;
2580 xassert (FONT_ENTITY_P (font
));
2581 return AREF (font
, FONT_FRAME_INDEX
);
2584 /* Find a font entity best matching with LFACE. If SPEC is non-nil,
2585 the font must exactly match with it. */
2588 font_find_for_lface (f
, lface
, spec
)
2593 Lisp_Object frame
, entities
;
2596 XSETFRAME (frame
, f
);
2600 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2601 ASET (scratch_font_spec
, i
, Qnil
);
2602 ASET (scratch_font_spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2604 if (! NILP (lface
[LFACE_FAMILY_INDEX
]))
2605 font_merge_old_spec (Qnil
, lface
[LFACE_FAMILY_INDEX
], Qnil
,
2607 entities
= font_list_entities (frame
, scratch_font_spec
);
2608 while (ASIZE (entities
) == 0)
2610 /* Try without FOUNDRY or FAMILY. */
2611 if (! NILP (AREF (scratch_font_spec
, FONT_FOUNDRY_INDEX
)))
2613 ASET (scratch_font_spec
, FONT_FOUNDRY_INDEX
, Qnil
);
2614 entities
= font_list_entities (frame
, scratch_font_spec
);
2616 else if (! NILP (AREF (scratch_font_spec
, FONT_FAMILY_INDEX
)))
2618 ASET (scratch_font_spec
, FONT_FAMILY_INDEX
, Qnil
);
2619 entities
= font_list_entities (frame
, scratch_font_spec
);
2627 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2628 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2629 if (NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
2630 ASET (scratch_font_spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2631 entities
= font_list_entities (frame
, scratch_font_spec
);
2634 if (ASIZE (entities
) == 0)
2636 if (ASIZE (entities
) > 1)
2638 /* Sort fonts by properties specified in LFACE. */
2639 Lisp_Object prefer
= scratch_font_prefer
;
2642 if (! NILP (lface
[LFACE_FAMILY_INDEX
]))
2643 font_merge_old_spec (Qnil
, lface
[LFACE_FAMILY_INDEX
], Qnil
, prefer
);
2644 ASET (prefer
, FONT_WEIGHT_INDEX
,
2645 font_prop_validate_style (FONT_WEIGHT_INDEX
, QCweight
,
2646 lface
[LFACE_WEIGHT_INDEX
]));
2647 ASET (prefer
, FONT_SLANT_INDEX
,
2648 font_prop_validate_style (FONT_SLANT_INDEX
, QCslant
,
2649 lface
[LFACE_SLANT_INDEX
]));
2650 ASET (prefer
, FONT_WIDTH_INDEX
,
2651 font_prop_validate_style (FONT_WIDTH_INDEX
, QCwidth
,
2652 lface
[LFACE_SWIDTH_INDEX
]));
2653 pt
= XINT (lface
[LFACE_HEIGHT_INDEX
]);
2654 ASET (prefer
, FONT_SIZE_INDEX
, make_float (pt
/ 10));
2656 font_sort_entites (entities
, prefer
, frame
, spec
);
2659 return AREF (entities
, 0);
2663 font_open_for_lface (f
, lface
, entity
)
2668 double pt
= XINT (lface
[LFACE_HEIGHT_INDEX
]);
2672 size
= POINT_TO_PIXEL (pt
, f
->resy
);
2673 return font_open_entity (f
, entity
, size
);
2677 font_load_for_face (f
, face
)
2681 Lisp_Object font_object
= face
->lface
[LFACE_FONT_INDEX
];
2683 if (NILP (font_object
))
2685 Lisp_Object entity
= font_find_for_lface (f
, face
->lface
, Qnil
);
2687 if (! NILP (entity
))
2688 font_object
= font_open_for_lface (f
, face
->lface
, entity
);
2691 if (! NILP (font_object
))
2693 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2695 face
->font
= font
->font
.font
;
2696 face
->font_info
= (struct font_info
*) font
;
2697 face
->font_info_id
= 0;
2698 face
->font_name
= font
->font
.full_name
;
2703 face
->font_info
= NULL
;
2704 face
->font_info_id
= -1;
2705 face
->font_name
= NULL
;
2706 add_to_log ("Unable to load font for a face%s", null_string
, Qnil
);
2711 font_prepare_for_face (f
, face
)
2715 struct font
*font
= (struct font
*) face
->font_info
;
2717 if (font
->driver
->prepare_face
)
2718 font
->driver
->prepare_face (f
, face
);
2722 font_done_for_face (f
, face
)
2726 struct font
*font
= (struct font
*) face
->font_info
;
2728 if (font
->driver
->done_face
)
2729 font
->driver
->done_face (f
, face
);
2734 font_open_by_name (f
, name
)
2738 Lisp_Object args
[2];
2739 Lisp_Object spec
, prefer
, size
, entity
, entity_list
;
2744 XSETFRAME (frame
, f
);
2747 args
[1] = make_unibyte_string (name
, strlen (name
));
2748 spec
= Ffont_spec (2, args
);
2749 prefer
= scratch_font_prefer
;
2750 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2751 if (NILP (AREF (spec
, i
)))
2752 ASET (prefer
, i
, make_number (100));
2753 size
= AREF (spec
, FONT_SIZE_INDEX
);
2756 else if (INTEGERP (size
))
2757 pixel_size
= XINT (size
);
2758 else /* FLOATP (size) */
2760 double pt
= XFLOAT_DATA (size
);
2762 pixel_size
= POINT_TO_PIXEL (pt
, f
->resy
);
2763 size
= make_number (pixel_size
);
2764 ASET (spec
, FONT_SIZE_INDEX
, size
);
2766 if (pixel_size
== 0)
2768 pixel_size
= POINT_TO_PIXEL (12.0, f
->resy
);
2769 size
= make_number (pixel_size
);
2771 ASET (prefer
, FONT_SIZE_INDEX
, size
);
2772 if (NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
2773 ASET (spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2775 entity_list
= Flist_fonts (spec
, frame
, make_number (1), prefer
);
2776 if (NILP (entity_list
))
2777 entity
= font_matching_entity (frame
, spec
);
2779 entity
= XCAR (entity_list
);
2780 return (NILP (entity
)
2782 : font_open_entity (f
, entity
, pixel_size
));
2786 /* Register font-driver DRIVER. This function is used in two ways.
2788 The first is with frame F non-NULL. In this case, make DRIVER
2789 available (but not yet activated) on F. All frame creaters
2790 (e.g. Fx_create_frame) must call this function at least once with
2791 an available font-driver.
2793 The second is with frame F NULL. In this case, DRIVER is globally
2794 registered in the variable `font_driver_list'. All font-driver
2795 implementations must call this function in its syms_of_XXXX
2796 (e.g. syms_of_xfont). */
2799 register_font_driver (driver
, f
)
2800 struct font_driver
*driver
;
2803 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
2804 struct font_driver_list
*prev
, *list
;
2806 if (f
&& ! driver
->draw
)
2807 error ("Unsable font driver for a frame: %s",
2808 SDATA (SYMBOL_NAME (driver
->type
)));
2810 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
2811 if (EQ (list
->driver
->type
, driver
->type
))
2812 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
2814 list
= malloc (sizeof (struct font_driver_list
));
2816 list
->driver
= driver
;
2821 f
->font_driver_list
= list
;
2823 font_driver_list
= list
;
2827 /* Free font-driver list on frame F. It doesn't free font-drivers
2831 free_font_driver_list (f
)
2834 while (f
->font_driver_list
)
2836 struct font_driver_list
*next
= f
->font_driver_list
->next
;
2838 free (f
->font_driver_list
);
2839 f
->font_driver_list
= next
;
2843 /* Make the frame F use font backends listed in NEW_BACKENDS (list of
2844 symbols). If NEW_BACKENDS is nil, make F use all available font
2845 drivers. If no backend is available, dont't alter
2846 f->font_driver_list.
2848 A caller must free all realized faces and clear all font caches if
2849 any in advance. The return value is a list of font backends
2850 actually made used for on F. */
2853 font_update_drivers (f
, new_drivers
)
2855 Lisp_Object new_drivers
;
2857 Lisp_Object active_drivers
= Qnil
;
2858 struct font_driver_list
*list
;
2860 /* At first check which font backends are available. */
2861 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
2862 if (NILP (new_drivers
)
2863 || ! NILP (Fmemq (list
->driver
->type
, new_drivers
)))
2866 active_drivers
= nconc2 (active_drivers
,
2867 Fcons (list
->driver
->type
, Qnil
));
2869 /* If at least one backend is available, update all list->on. */
2870 if (! NILP (active_drivers
))
2871 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
2872 list
->on
= (list
->on
== 2);
2874 return active_drivers
;
2879 font_at (c
, pos
, face
, w
, object
)
2890 f
= XFRAME (w
->frame
);
2891 if (! FRAME_WINDOW_P (f
))
2895 if (STRINGP (object
))
2896 face_id
= face_at_string_position (w
, object
, pos
, 0, -1, -1, &dummy
,
2897 DEFAULT_FACE_ID
, 0);
2899 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
,
2901 face
= FACE_FROM_ID (f
, face_id
);
2903 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, object
);
2904 face
= FACE_FROM_ID (f
, face_id
);
2905 if (! face
->font_info
)
2907 return font_lispy_object ((struct font
*) face
->font_info
);
2913 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 1, 0,
2914 doc
: /* Return t if object is a font-spec or font-entity. */)
2918 return (FONTP (object
) ? Qt
: Qnil
);
2921 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
2922 doc
: /* Return a newly created font-spec with specified arguments as properties.
2923 usage: (font-spec &rest properties) */)
2928 Lisp_Object spec
= Fmake_vector (make_number (FONT_SPEC_MAX
), Qnil
);
2931 for (i
= 0; i
< nargs
; i
+= 2)
2933 enum font_property_index prop
;
2934 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
2936 prop
= get_font_prop_index (key
, 0);
2937 if (prop
< FONT_EXTRA_INDEX
)
2938 ASET (spec
, prop
, val
);
2941 if (EQ (key
, QCname
))
2944 font_parse_name ((char *) SDATA (val
), spec
);
2946 font_put_extra (spec
, key
, val
);
2949 CHECK_VALIDATE_FONT_SPEC (spec
);
2954 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
2955 doc
: /* Return the value of FONT's PROP property.
2956 FONT is a font-spec, a font-entity, or a font-object. */)
2958 Lisp_Object font
, prop
;
2960 enum font_property_index idx
;
2962 if (FONT_OBJECT_P (font
))
2964 struct font
*fontp
= XSAVE_VALUE (font
)->pointer
;
2966 if (EQ (prop
, QCotf
))
2969 return font_otf_capability (fontp
);
2970 #else /* not HAVE_LIBOTF */
2972 #endif /* not HAVE_LIBOTF */
2974 font
= fontp
->entity
;
2978 idx
= get_font_prop_index (prop
, 0);
2979 if (idx
< FONT_EXTRA_INDEX
)
2980 return AREF (font
, idx
);
2981 if (FONT_ENTITY_P (font
))
2983 return Fcdr (Fassoc (AREF (font
, FONT_EXTRA_INDEX
), prop
));
2987 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
2988 doc
: /* Set one property of FONT-SPEC: give property PROP value VALUE. */)
2989 (font_spec
, prop
, val
)
2990 Lisp_Object font_spec
, prop
, val
;
2992 enum font_property_index idx
;
2993 Lisp_Object extra
, slot
;
2995 CHECK_FONT_SPEC (font_spec
);
2996 idx
= get_font_prop_index (prop
, 0);
2997 if (idx
< FONT_EXTRA_INDEX
)
2998 return ASET (font_spec
, idx
, val
);
2999 extra
= AREF (font_spec
, FONT_EXTRA_INDEX
);
3000 slot
= Fassoc (extra
, prop
);
3002 extra
= Fcons (Fcons (prop
, val
), extra
);
3004 Fsetcdr (slot
, val
);
3008 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3009 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3010 Optional 2nd argument FRAME specifies the target frame.
3011 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3012 Optional 4th argument PREFER, if non-nil, is a font-spec
3013 to which closeness fonts are sorted. */)
3014 (font_spec
, frame
, num
, prefer
)
3015 Lisp_Object font_spec
, frame
, num
, prefer
;
3017 Lisp_Object vec
, list
, tail
;
3021 frame
= selected_frame
;
3022 CHECK_LIVE_FRAME (frame
);
3023 CHECK_VALIDATE_FONT_SPEC (font_spec
);
3031 if (! NILP (prefer
))
3032 CHECK_FONT (prefer
);
3034 vec
= font_list_entities (frame
, font_spec
);
3039 return Fcons (AREF (vec
, 0), Qnil
);
3041 if (! NILP (prefer
))
3042 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
);
3044 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3045 if (n
== 0 || n
> len
)
3047 for (i
= 1; i
< n
; i
++)
3049 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3051 XSETCDR (tail
, val
);
3057 DEFUN ("list-families", Flist_families
, Slist_families
, 0, 1, 0,
3058 doc
: /* List available font families on the current frame.
3059 Optional 2nd argument FRAME specifies the target frame. */)
3064 struct font_driver_list
*driver_list
;
3068 frame
= selected_frame
;
3069 CHECK_LIVE_FRAME (frame
);
3072 for (driver_list
= f
->font_driver_list
; driver_list
;
3073 driver_list
= driver_list
->next
)
3074 if (driver_list
->driver
->list_family
)
3076 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3082 Lisp_Object tail
= list
;
3084 for (; CONSP (val
); val
= XCDR (val
))
3085 if (NILP (Fmemq (XCAR (val
), tail
)))
3086 list
= Fcons (XCAR (val
), list
);
3092 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3093 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3094 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3096 Lisp_Object font_spec
, frame
;
3098 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3105 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 1, 0,
3106 doc
: /* Return XLFD name of FONT.
3107 FONT is a font-spec, font-entity, or font-object.
3108 If the name is too long for XLFD (maximum 255 chars), return nil. */)
3115 if (FONT_SPEC_P (font
))
3116 CHECK_VALIDATE_FONT_SPEC (font
);
3117 else if (FONT_ENTITY_P (font
))
3123 CHECK_FONT_GET_OBJECT (font
, fontp
);
3124 font
= fontp
->entity
;
3125 pixel_size
= fontp
->pixel_size
;
3128 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3130 return build_string (name
);
3133 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3134 doc
: /* Clear font cache. */)
3137 Lisp_Object list
, frame
;
3139 FOR_EACH_FRAME (list
, frame
)
3141 FRAME_PTR f
= XFRAME (frame
);
3142 struct font_driver_list
*driver_list
= f
->font_driver_list
;
3144 for (; driver_list
; driver_list
= driver_list
->next
)
3145 if (driver_list
->on
)
3147 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
3148 Lisp_Object tail
, elt
;
3150 for (tail
= XCDR (cache
); CONSP (tail
); tail
= XCDR (tail
))
3153 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
3155 Lisp_Object vec
= XCDR (elt
);
3158 for (i
= 0; i
< ASIZE (vec
); i
++)
3160 Lisp_Object entity
= AREF (vec
, i
);
3162 if (EQ (driver_list
->driver
->type
,
3163 AREF (entity
, FONT_TYPE_INDEX
)))
3166 = AREF (entity
, FONT_OBJLIST_INDEX
);
3168 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
3170 Lisp_Object val
= XCAR (objlist
);
3171 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
3172 struct font
*font
= p
->pointer
;
3174 xassert (font
&& (driver_list
->driver
3176 driver_list
->driver
->close (f
, font
);
3180 if (driver_list
->driver
->free_entity
)
3181 driver_list
->driver
->free_entity (entity
);
3186 XSETCDR (cache
, Qnil
);
3193 DEFUN ("internal-set-font-style-table", Finternal_set_font_style_table
,
3194 Sinternal_set_font_style_table
, 2, 2, 0,
3195 doc
: /* Set font style table for PROP to TABLE.
3196 PROP must be `:weight', `:slant', or `:width'.
3197 TABLE must be an alist of symbols vs the corresponding numeric values
3198 sorted by numeric values. */)
3200 Lisp_Object prop
, table
;
3204 Lisp_Object tail
, val
;
3206 CHECK_SYMBOL (prop
);
3207 table_index
= (EQ (prop
, QCweight
) ? 0
3208 : EQ (prop
, QCslant
) ? 1
3209 : EQ (prop
, QCwidth
) ? 2
3211 if (table_index
>= ASIZE (font_style_table
))
3212 error ("Invalid font style property: %s", SDATA (SYMBOL_NAME (prop
)));
3213 table
= Fcopy_sequence (table
);
3215 for (tail
= table
; ! NILP (tail
); tail
= Fcdr (tail
))
3217 prop
= Fcar (Fcar (tail
));
3218 val
= Fcdr (Fcar (tail
));
3219 CHECK_SYMBOL (prop
);
3221 if (numeric
> XINT (val
))
3222 error ("Numeric values not sorted for %s", SDATA (SYMBOL_NAME (prop
)));
3223 numeric
= XINT (val
);
3224 XSETCAR (tail
, Fcons (prop
, val
));
3226 ASET (font_style_table
, table_index
, table
);
3230 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
3231 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
3232 FONT-OBJECT may be nil if it is not yet known.
3234 G-string is sequence of glyphs of a specific font,
3235 and is a vector of this form:
3236 [ HEADER GLYPH ... ]
3237 HEADER is a vector of this form:
3238 [FONT-OBJECT LBEARING RBEARING WIDTH ASCENT DESCENT]
3240 FONT-OBJECT is a font-object for all glyphs in the G-string,
3241 LBEARING thry DESCENT is the metrics (in pixels) of the whole G-string.
3242 GLYPH is a vector of this form:
3243 [ FROM-IDX TO-IDX C CODE WIDTH [ [X-OFF Y-OFF WADJUST] | nil] ]
3245 FROM-IDX and TO-IDX are used internally and should not be touched.
3246 C is the character of the glyph.
3247 CODE is the glyph-code of C in FONT-OBJECT.
3248 X-OFF and Y-OFF are offests to the base position for the glyph.
3249 WIDTH is the normal width of the glyph.
3250 WADJUST is the adjustment to the normal width of the glyph. */)
3252 Lisp_Object font_object
, num
;
3254 Lisp_Object gstring
, g
;
3258 if (! NILP (font_object
))
3259 CHECK_FONT_OBJECT (font_object
);
3262 len
= XINT (num
) + 1;
3263 gstring
= Fmake_vector (make_number (len
), Qnil
);
3264 g
= Fmake_vector (make_number (6), Qnil
);
3265 ASET (g
, 0, font_object
);
3266 ASET (gstring
, 0, g
);
3267 for (i
= 1; i
< len
; i
++)
3268 ASET (gstring
, i
, Fmake_vector (make_number (8), Qnil
));
3272 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
3273 doc
: /* Fillin glyph-string GSTRING by characters for FONT-OBJECT.
3274 START and END specifies the region to extract characters.
3275 If optional 3rd argument OBJECT is non-nil, it is a buffer or a string from
3276 where to extract characters.
3277 FONT-OBJECT may be nil if GSTRING already already contains one. */)
3278 (gstring
, font_object
, start
, end
, object
)
3279 Lisp_Object gstring
, font_object
, start
, end
, object
;
3285 CHECK_VECTOR (gstring
);
3286 if (NILP (font_object
))
3287 font_object
= LGSTRING_FONT (gstring
);
3288 CHECK_FONT_GET_OBJECT (font_object
, font
);
3290 if (STRINGP (object
))
3292 const unsigned char *p
;
3294 CHECK_NATNUM (start
);
3296 if (XINT (start
) > XINT (end
)
3297 || XINT (end
) > ASIZE (object
)
3298 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3299 args_out_of_range (start
, end
);
3301 len
= XINT (end
) - XINT (start
);
3302 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
3303 for (i
= 0; i
< len
; i
++)
3305 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3307 c
= STRING_CHAR_ADVANCE (p
);
3308 code
= font
->driver
->encode_char (font
, c
);
3309 if (code
> MOST_POSITIVE_FIXNUM
)
3310 error ("Glyph code 0x%X is too large", code
);
3311 LGLYPH_SET_FROM (g
, make_number (i
));
3312 LGLYPH_SET_TO (g
, make_number (i
+ 1));
3313 LGLYPH_SET_CHAR (g
, make_number (c
));
3314 LGLYPH_SET_CODE (g
, make_number (code
));
3321 if (! NILP (object
))
3322 Fset_buffer (object
);
3323 validate_region (&start
, &end
);
3324 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3325 args_out_of_range (start
, end
);
3326 len
= XINT (end
) - XINT (start
);
3328 pos_byte
= CHAR_TO_BYTE (pos
);
3329 for (i
= 0; i
< len
; i
++)
3331 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3333 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
3334 code
= font
->driver
->encode_char (font
, c
);
3335 if (code
> MOST_POSITIVE_FIXNUM
)
3336 error ("Glyph code 0x%X is too large", code
);
3337 LGLYPH_SET_FROM (g
, make_number (i
));
3338 LGLYPH_SET_TO (g
, make_number (i
+ 1));
3339 LGLYPH_SET_CHAR (g
, make_number (c
));
3340 LGLYPH_SET_CODE (g
, make_number (code
));
3343 for (i
= LGSTRING_LENGTH (gstring
) - 1; i
>= len
; i
--)
3345 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3347 LGLYPH_SET_FROM (g
, Qnil
);
3352 DEFUN ("font-otf-gsub", Ffont_otf_gsub
, Sfont_otf_gsub
, 6, 6, 0,
3353 doc
: /* Apply OpenType "GSUB" features on glyph-string GSTRING-IN.
3354 FEATURE-SPEC specifies which featuress to apply in this format:
3355 (SCRIPT LANGSYS FEATURE ...)
3357 SCRIPT is a symbol specifying a script tag of OpenType,
3358 LANGSYS is a symbol specifying a langsys tag of OpenType,
3359 FEATURE is a symbol specifying a feature tag of Opentype.
3361 If LANGYS is nil, the default langsys is selected.
3363 The features are applied in the order appeared in the list. FEATURE
3364 may be a symbol `*', in which case all available features not appeared
3365 in this list are applied, and the remaining FEATUREs are not ignored.
3366 For instance, (mlym nil vatu pstf * haln) means to apply vatu and pstf
3367 in this order, then to apply all available features other than vatu,
3370 The features are applied to the glyphs in the range FROM and TO of
3373 If some of a feature is actually applicable, the resulting glyphs are
3374 produced in the glyph-string GSTRING-OUT from the index INDEX. In
3375 this case, the value is the number of produced glyphs.
3377 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
3380 If GSTRING-OUT is too short to hold produced glyphs, no glyphs is
3381 produced in GSTRING-OUT, and the value is nil.
3383 See the documentation of `font-make-gstring' for the format of
3385 (feature_spec
, gstring_in
, from
, to
, gstring_out
, index
)
3386 Lisp_Object feature_spec
, gstring_in
, from
, to
, gstring_out
, index
;
3388 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
3389 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
3392 CHECK_FONT_GET_OBJECT (font_object
, font
);
3393 if (! font
->driver
->otf_gsub
)
3394 error ("Font backend %s can't drive OpenType GSUB table",
3395 SDATA (SYMBOL_NAME (font
->driver
->type
)));
3396 CHECK_CONS (feature_spec
);
3397 len
= check_gstring (gstring_in
);
3398 CHECK_VECTOR (gstring_out
);
3399 CHECK_NATNUM (from
);
3401 CHECK_NATNUM (index
);
3403 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
3404 args_out_of_range_3 (from
, to
, make_number (len
));
3405 if (XINT (index
) >= ASIZE (gstring_out
))
3406 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
3407 num
= font
->driver
->otf_gsub (font
, feature_spec
,
3408 gstring_in
, XINT (from
), XINT (to
),
3409 gstring_out
, XINT (index
), 0);
3412 return make_number (num
);
3416 DEFUN ("font-otf-gpos", Ffont_otf_gpos
, Sfont_otf_gpos
, 4, 4, 0,
3417 doc
: /* Apply OpenType "GPOS" features on glyph-string GSTRING.
3418 FEATURE-SPEC specifies which features to apply in this format:
3419 (SCRIPT LANGSYS FEATURE ...)
3420 See the documentation of `font-otf-gsub' for more detail.
3422 The features are applied to the glyphs in the range FROM and TO of
3424 (gpos_spec
, gstring
, from
, to
)
3425 Lisp_Object gpos_spec
, gstring
, from
, to
;
3427 Lisp_Object font_object
= LGSTRING_FONT (gstring
);
3431 CHECK_FONT_GET_OBJECT (font_object
, font
);
3432 if (! font
->driver
->otf_gpos
)
3433 error ("Font backend %s can't drive OpenType GPOS table",
3434 SDATA (SYMBOL_NAME (font
->driver
->type
)));
3435 CHECK_CONS (gpos_spec
);
3436 len
= check_gstring (gstring
);
3437 CHECK_NATNUM (from
);
3440 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
3441 args_out_of_range_3 (from
, to
, make_number (len
));
3442 num
= font
->driver
->otf_gpos (font
, gpos_spec
,
3443 gstring
, XINT (from
), XINT (to
));
3444 return (num
<= 0 ? Qnil
: Qt
);
3448 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
3450 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
3451 FEATURE-SPEC specifies which features of the font FONT-OBJECT to apply
3453 (SCRIPT LANGSYS FEATURE ...)
3454 See the documentation of `font-otf-gsub' for more detail.
3456 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
3457 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
3458 character code corresponding to the glyph or nil if there's no
3459 corresponding character. */)
3460 (font_object
, character
, feature_spec
)
3461 Lisp_Object font_object
, character
, feature_spec
;
3464 Lisp_Object gstring_in
, gstring_out
, g
;
3465 Lisp_Object alternates
;
3468 CHECK_FONT_GET_OBJECT (font_object
, font
);
3469 if (! font
->driver
->otf_gsub
)
3470 error ("Font backend %s can't drive OpenType GSUB table",
3471 SDATA (SYMBOL_NAME (font
->driver
->type
)));
3472 CHECK_CHARACTER (character
);
3473 CHECK_CONS (feature_spec
);
3475 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
3476 g
= LGSTRING_GLYPH (gstring_in
, 0);
3477 LGLYPH_SET_CHAR (g
, character
);
3478 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
3479 while ((num
= font
->driver
->otf_gsub (font
, feature_spec
, gstring_in
, 0, 1,
3480 gstring_out
, 0, 1)) < 0)
3481 gstring_out
= Ffont_make_gstring (font_object
,
3482 make_number (ASIZE (gstring_out
) * 2));
3484 for (i
= 0; i
< num
; i
++)
3486 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
3487 int c
= XINT (LGLYPH_CHAR (g
));
3488 unsigned code
= XUINT (LGLYPH_CODE (g
));
3490 alternates
= Fcons (Fcons (make_number (code
),
3491 c
> 0 ? make_number (c
) : Qnil
),
3494 return Fnreverse (alternates
);
3500 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
3501 doc
: /* Open FONT-ENTITY. */)
3502 (font_entity
, size
, frame
)
3503 Lisp_Object font_entity
;
3509 CHECK_FONT_ENTITY (font_entity
);
3511 size
= AREF (font_entity
, FONT_SIZE_INDEX
);
3512 CHECK_NUMBER (size
);
3514 frame
= selected_frame
;
3515 CHECK_LIVE_FRAME (frame
);
3517 isize
= XINT (size
);
3519 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
3521 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
3524 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
3525 doc
: /* Close FONT-OBJECT. */)
3526 (font_object
, frame
)
3527 Lisp_Object font_object
, frame
;
3529 CHECK_FONT_OBJECT (font_object
);
3531 frame
= selected_frame
;
3532 CHECK_LIVE_FRAME (frame
);
3533 font_close_object (XFRAME (frame
), font_object
);
3537 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
3538 doc
: /* Return information about FONT-OBJECT.
3539 The value is a vector:
3540 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
3543 NAME is a string of the font name (or nil if the font backend doesn't
3546 FILENAME is a string of the font file (or nil if the font backend
3547 doesn't provide a file name).
3549 PIXEL-SIZE is a pixel size by which the font is opened.
3551 SIZE is a maximum advance width of the font in pixel.
3553 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
3556 CAPABILITY is a list whose first element is a symbol representing the
3557 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
3558 remaining elements describes a detail of the font capability.
3560 If the font is OpenType font, the form of the list is
3561 \(opentype GSUB GPOS)
3562 where GSUB shows which "GSUB" features the font supports, and GPOS
3563 shows which "GPOS" features the font supports. Both GSUB and GPOS are
3564 lists of the format:
3565 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
3567 If the font is not OpenType font, currently the length of the form is
3570 SCRIPT is a symbol representing OpenType script tag.
3572 LANGSYS is a symbol representing OpenType langsys tag, or nil
3573 representing the default langsys.
3575 FEATURE is a symbol representing OpenType feature tag.
3577 If the font is not OpenType font, OTF-CAPABILITY is nil. */)
3579 Lisp_Object font_object
;
3584 CHECK_FONT_GET_OBJECT (font_object
, font
);
3586 val
= Fmake_vector (make_number (9), Qnil
);
3587 if (font
->font
.full_name
)
3588 ASET (val
, 0, make_unibyte_string (font
->font
.full_name
,
3589 strlen (font
->font
.full_name
)));
3590 if (font
->file_name
)
3591 ASET (val
, 1, make_unibyte_string (font
->file_name
,
3592 strlen (font
->file_name
)));
3593 ASET (val
, 2, make_number (font
->pixel_size
));
3594 ASET (val
, 3, make_number (font
->font
.size
));
3595 ASET (val
, 4, make_number (font
->ascent
));
3596 ASET (val
, 5, make_number (font
->descent
));
3597 ASET (val
, 6, make_number (font
->font
.space_width
));
3598 ASET (val
, 7, make_number (font
->font
.average_width
));
3599 if (font
->driver
->otf_capability
)
3600 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
3602 ASET (val
, 8, Fcons (font
->format
, Qnil
));
3606 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
3607 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
3608 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
3609 (font_object
, string
)
3610 Lisp_Object font_object
, string
;
3616 CHECK_FONT_GET_OBJECT (font_object
, font
);
3617 CHECK_STRING (string
);
3618 len
= SCHARS (string
);
3619 vec
= Fmake_vector (make_number (len
), Qnil
);
3620 for (i
= 0; i
< len
; i
++)
3622 Lisp_Object ch
= Faref (string
, make_number (i
));
3626 struct font_metrics metrics
;
3628 code
= font
->driver
->encode_char (font
, c
);
3629 if (code
== FONT_INVALID_CODE
)
3631 val
= Fmake_vector (make_number (6), Qnil
);
3632 if (code
<= MOST_POSITIVE_FIXNUM
)
3633 ASET (val
, 0, make_number (code
));
3635 ASET (val
, 0, Fcons (make_number (code
>> 16),
3636 make_number (code
& 0xFFFF)));
3637 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
3638 ASET (val
, 1, make_number (metrics
.lbearing
));
3639 ASET (val
, 2, make_number (metrics
.rbearing
));
3640 ASET (val
, 3, make_number (metrics
.width
));
3641 ASET (val
, 4, make_number (metrics
.ascent
));
3642 ASET (val
, 5, make_number (metrics
.descent
));
3648 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
3649 doc
: /* Return t iff font-spec SPEC matches with FONT.
3650 FONT is a font-spec, font-entity, or font-object. */)
3652 Lisp_Object spec
, font
;
3654 CHECK_FONT_SPEC (spec
);
3655 if (FONT_OBJECT_P (font
))
3656 font
= ((struct font
*) XSAVE_VALUE (font
)->pointer
)->entity
;
3657 else if (! FONT_ENTITY_P (font
))
3658 CHECK_FONT_SPEC (font
);
3660 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
3663 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 2, 0,
3664 doc
: /* Return a font-object for displaying a character at POSISTION.
3665 Optional second arg WINDOW, if non-nil, is a window displaying
3666 the current buffer. It defaults to the currently selected window. */)
3668 Lisp_Object position
, window
;
3671 EMACS_INT pos
, pos_byte
;
3674 CHECK_NUMBER_COERCE_MARKER (position
);
3675 pos
= XINT (position
);
3676 if (pos
< BEGV
|| pos
>= ZV
)
3677 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
3678 pos_byte
= CHAR_TO_BYTE (pos
);
3679 c
= FETCH_CHAR (pos_byte
);
3681 window
= selected_window
;
3682 CHECK_LIVE_WINDOW (window
);
3683 w
= XWINDOW (selected_window
);
3685 return font_at (c
, pos
, NULL
, w
, Qnil
);
3689 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
3690 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
3691 The value is a number of glyphs drawn.
3692 Type C-l to recover what previously shown. */)
3693 (font_object
, string
)
3694 Lisp_Object font_object
, string
;
3696 Lisp_Object frame
= selected_frame
;
3697 FRAME_PTR f
= XFRAME (frame
);
3703 CHECK_FONT_GET_OBJECT (font_object
, font
);
3704 CHECK_STRING (string
);
3705 len
= SCHARS (string
);
3706 code
= alloca (sizeof (unsigned) * len
);
3707 for (i
= 0; i
< len
; i
++)
3709 Lisp_Object ch
= Faref (string
, make_number (i
));
3713 code
[i
] = font
->driver
->encode_char (font
, c
);
3714 if (code
[i
] == FONT_INVALID_CODE
)
3717 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3719 if (font
->driver
->prepare_face
)
3720 font
->driver
->prepare_face (f
, face
);
3721 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
3722 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
3723 if (font
->driver
->done_face
)
3724 font
->driver
->done_face (f
, face
);
3726 return make_number (len
);
3730 #endif /* FONT_DEBUG */
3733 extern void syms_of_ftfont
P_ (());
3734 extern void syms_of_xfont
P_ (());
3735 extern void syms_of_xftfont
P_ (());
3736 extern void syms_of_ftxfont
P_ (());
3737 extern void syms_of_bdffont
P_ (());
3738 extern void syms_of_w32font
P_ (());
3739 extern void syms_of_atmfont
P_ (());
3744 sort_shift_bits
[FONT_SLANT_INDEX
] = 0;
3745 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 7;
3746 sort_shift_bits
[FONT_SIZE_INDEX
] = 14;
3747 sort_shift_bits
[FONT_WIDTH_INDEX
] = 21;
3748 sort_shift_bits
[FONT_ADSTYLE_INDEX
] = 28;
3749 sort_shift_bits
[FONT_FOUNDRY_INDEX
] = 29;
3750 sort_shift_bits
[FONT_FAMILY_INDEX
] = 30;
3751 sort_shift_bits
[FONT_REGISTRY_INDEX
] = 31;
3752 /* Note that sort_shift_bits[FONT_TYPE_INDEX] is never used. */
3754 staticpro (&font_style_table
);
3755 font_style_table
= Fmake_vector (make_number (3), Qnil
);
3757 staticpro (&font_family_alist
);
3758 font_family_alist
= Qnil
;
3760 DEFSYM (Qfontp
, "fontp");
3761 DEFSYM (Qopentype
, "opentype");
3763 DEFSYM (Qiso8859_1
, "iso8859-1");
3764 DEFSYM (Qiso10646_1
, "iso10646-1");
3765 DEFSYM (Qunicode_bmp
, "unicode-bmp");
3766 DEFSYM (Qunicode_sip
, "unicode-sip");
3768 DEFSYM (QCotf
, ":otf");
3769 DEFSYM (QClanguage
, ":language");
3770 DEFSYM (QCscript
, ":script");
3772 DEFSYM (QCfoundry
, ":foundry");
3773 DEFSYM (QCadstyle
, ":adstyle");
3774 DEFSYM (QCregistry
, ":registry");
3775 DEFSYM (QCspacing
, ":spacing");
3776 DEFSYM (QCdpi
, ":dpi");
3777 DEFSYM (QCscalable
, ":scalable");
3778 DEFSYM (QCextra
, ":extra");
3785 staticpro (&null_string
);
3786 null_string
= build_string ("");
3787 staticpro (&null_vector
);
3788 null_vector
= Fmake_vector (make_number (0), Qnil
);
3790 staticpro (&scratch_font_spec
);
3791 scratch_font_spec
= Ffont_spec (0, NULL
);
3792 staticpro (&scratch_font_prefer
);
3793 scratch_font_prefer
= Ffont_spec (0, NULL
);
3796 defsubr (&Sfont_spec
);
3797 defsubr (&Sfont_get
);
3798 defsubr (&Sfont_put
);
3799 defsubr (&Slist_fonts
);
3800 defsubr (&Slist_families
);
3801 defsubr (&Sfind_font
);
3802 defsubr (&Sfont_xlfd_name
);
3803 defsubr (&Sclear_font_cache
);
3804 defsubr (&Sinternal_set_font_style_table
);
3805 defsubr (&Sfont_make_gstring
);
3806 defsubr (&Sfont_fill_gstring
);
3807 defsubr (&Sfont_otf_gsub
);
3808 defsubr (&Sfont_otf_gpos
);
3809 defsubr (&Sfont_otf_alternates
);
3812 defsubr (&Sopen_font
);
3813 defsubr (&Sclose_font
);
3814 defsubr (&Squery_font
);
3815 defsubr (&Sget_font_glyphs
);
3816 defsubr (&Sfont_match_p
);
3817 defsubr (&Sfont_at
);
3819 defsubr (&Sdraw_string
);
3821 #endif /* FONT_DEBUG */
3823 #ifdef HAVE_FREETYPE
3825 #ifdef HAVE_X_WINDOWS
3830 #endif /* HAVE_XFT */
3831 #endif /* HAVE_X_WINDOWS */
3832 #else /* not HAVE_FREETYPE */
3833 #ifdef HAVE_X_WINDOWS
3835 #endif /* HAVE_X_WINDOWS */
3836 #endif /* not HAVE_FREETYPE */
3839 #endif /* HAVE_BDFFONT */
3842 #endif /* WINDOWSNT */
3848 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
3849 (do not change this comment) */