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. */
32 #include "dispextern.h"
34 #include "character.h"
35 #include "composite.h"
43 #define xassert(X) do {if (!(X)) abort ();} while (0)
45 #define xassert(X) (void) 0
48 int enable_font_backend
;
52 /* Important character set symbols. */
53 Lisp_Object Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
;
55 /* Like CHECK_FONT_SPEC but also validate properties of the font-spec,
56 and set X to the validated result. */
58 #define CHECK_VALIDATE_FONT_SPEC(x) \
60 if (! FONT_SPEC_P (x)) x = wrong_type_argument (Qfont, x); \
61 x = font_prop_validate (x); \
64 /* Number of pt per inch (from the TeXbook). */
65 #define PT_PER_INCH 72.27
67 /* Return a pixel size (integer) corresponding to POINT size (double)
68 on resolution RESY. */
69 #define POINT_TO_PIXEL(POINT, RESY) ((POINT) * (RESY) / PT_PER_INCH + 0.5)
71 /* Return a point size (double) corresponding to POINT size (integer)
72 on resolution RESY. */
73 #define PIXEL_TO_POINT(PIXEL, RESY) ((PIXEL) * PT_PER_INCH * 10 / (RESY) + 0.5)
75 /* Special string of zero length. It is used to specify a NULL name
76 in a font properties (e.g. adstyle). We don't use the symbol of
77 NULL name because it's confusing (Lisp printer prints nothing for
79 Lisp_Object null_string
;
81 /* Special vector of zero length. This is repeatedly used by (struct
82 font_driver *)->list when a specified font is not found. */
83 Lisp_Object null_vector
;
85 /* Vector of 3 elements. Each element is an alist for one of font
86 style properties (weight, slant, width). The alist contains a
87 mapping between symbolic property values (e.g. `medium' for weight)
88 and numeric property values (e.g. 100). So, it looks like this:
89 [((thin . 0) ... (heavy . 210))
90 ((ro . 0) ... (ot . 210))
91 ((ultracondensed . 50) ... (wide . 200))] */
92 static Lisp_Object font_style_table
;
94 /* Alist of font family vs the corresponding aliases.
95 Each element has this form:
96 (FAMILY ALIAS1 ALIAS2 ...) */
98 static Lisp_Object font_family_alist
;
100 /* Symbols representing keys of normal font properties. */
101 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
, QCsize
, QCname
;
102 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
, QCextra
;
103 /* Symbols representing keys of font extra info. */
104 Lisp_Object QCspacing
, QCdpi
, QCotf
, QClanguage
, QCscript
;
106 /* List of all font drivers. All font-backends (XXXfont.c) call
107 add_font_driver in syms_of_XXXfont to register the font-driver
109 static struct font_driver_list
*font_driver_list
;
111 static Lisp_Object prop_name_to_numeric
P_ ((enum font_property_index
,
113 static Lisp_Object prop_numeric_to_name
P_ ((enum font_property_index
, int));
114 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
116 /* Number of registered font drivers. */
117 static int num_font_drivers
;
119 /* Return a pixel size of font-spec SPEC on frame F. */
121 font_pixel_size (f
, spec
)
125 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
128 Lisp_Object extra
, val
;
134 point_size
= XFLOAT_DATA (size
);
135 extra
= AREF (spec
, FONT_EXTRA_INDEX
);
136 val
= assq_no_quit (extra
, QCdpi
);
138 if (CONSP (val
) && INTEGERP (XCDR (val
)))
139 dpi
= XINT (XCDR (val
));
142 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
146 /* Return a numeric value corresponding to PROP's NAME (symbol). If
147 NAME is not registered in font_style_table, return Qnil. PROP must
148 be one of FONT_{WEIGHT|SLANT|SWIDTH}_INDEX. */
151 prop_name_to_numeric (prop
, name
)
152 enum font_property_index prop
;
155 int table_index
= prop
- FONT_WEIGHT_INDEX
;
158 val
= assq_no_quit (name
, AREF (font_style_table
, table_index
));
159 return (NILP (val
) ? Qnil
: XCDR (val
));
163 /* Return a name (symbol) corresponding to PROP's NUMERIC value. If
164 no name is registered for NUMERIC in font_style_table, return a
165 symbol of integer name (e.g. `123'). PROP must be one of
166 FONT_{WEIGHT|SLANT|SWIDTH}_INDEX. */
169 prop_numeric_to_name (prop
, numeric
)
170 enum font_property_index prop
;
173 int table_index
= prop
- FONT_WEIGHT_INDEX
;
174 Lisp_Object table
= AREF (font_style_table
, table_index
);
177 while (! NILP (table
))
179 if (XINT (XCDR (XCAR (table
))) >= numeric
)
181 if (XINT (XCDR (XCAR (table
))) == numeric
)
182 return XCAR (XCAR (table
));
186 table
= XCDR (table
);
188 sprintf (buf
, "%d", numeric
);
193 /* Return a symbol whose name is STR (length LEN). If STR contains
194 uppercase letters, downcase them in advance. */
197 intern_downcase (str
, len
)
204 for (i
= 0; i
< len
; i
++)
205 if (isupper (str
[i
]))
208 return Fintern (make_unibyte_string (str
, len
), Qnil
);
211 return Fintern (null_string
, Qnil
);
212 bcopy (str
, buf
, len
);
214 if (isascii (buf
[i
]))
215 buf
[i
] = tolower (buf
[i
]);
216 return Fintern (make_unibyte_string (buf
, len
), Qnil
);
219 extern Lisp_Object Vface_alternative_font_family_alist
;
222 build_font_family_alist ()
224 Lisp_Object alist
= Vface_alternative_font_family_alist
;
226 for (; CONSP (alist
); alist
= XCDR (alist
))
228 Lisp_Object tail
, elt
;
230 for (tail
= XCAR (alist
), elt
= Qnil
; CONSP (tail
); tail
= XCDR (tail
))
231 elt
= nconc2 (elt
, Fcons (Fintern (XCAR (tail
), Qnil
), Qnil
));
232 font_family_alist
= Fcons (elt
, font_family_alist
);
237 /* Font property validater. */
240 font_prop_validate_type (prop
, val
)
241 enum font_property_index prop
;
244 return (SYMBOLP (val
) ? val
: Qerror
);
248 font_prop_validate_symbol (prop
, val
)
249 enum font_property_index prop
;
253 val
= (SCHARS (val
) == 0 ? null_string
254 : intern_downcase ((char *) SDATA (val
), SBYTES (val
)));
255 else if (SYMBOLP (val
))
257 if (SCHARS (SYMBOL_NAME (val
)) == 0)
266 font_prop_validate_style (prop
, val
)
267 enum font_property_index prop
;
270 if (! INTEGERP (val
))
273 val
= intern_downcase ((char *) SDATA (val
), SBYTES (val
));
278 val
= prop_name_to_numeric (prop
, val
);
287 font_prop_validate_size (prop
, val
)
288 enum font_property_index prop
;
291 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
296 font_prop_validate_extra (prop
, val
)
297 enum font_property_index prop
;
302 for (tail
= val
; CONSP (tail
); tail
= XCDR (tail
))
304 Lisp_Object key
= Fcar (XCAR (tail
)), this_val
= Fcdr (XCAR (tail
));
308 if (EQ (key
, QClanguage
))
309 if (! SYMBOLP (this_val
))
311 for (; CONSP (this_val
); this_val
= XCDR (this_val
))
312 if (! SYMBOLP (XCAR (this_val
)))
314 if (! NILP (this_val
))
318 if (! STRINGP (this_val
))
321 return (NILP (tail
) ? val
: Qerror
);
328 Lisp_Object (*validater
) P_ ((enum font_property_index prop
,
330 } font_property_table
[FONT_SPEC_MAX
] =
331 { { &QCtype
, font_prop_validate_type
},
332 { &QCfoundry
, font_prop_validate_symbol
},
333 { &QCfamily
, font_prop_validate_symbol
},
334 { &QCadstyle
, font_prop_validate_symbol
},
335 { &QCregistry
, font_prop_validate_symbol
},
336 { &QCweight
, font_prop_validate_style
},
337 { &QCslant
, font_prop_validate_style
},
338 { &QCwidth
, font_prop_validate_style
},
339 { &QCsize
, font_prop_validate_size
},
340 { &QCextra
, font_prop_validate_extra
}
343 static enum font_property_index
344 check_font_prop_name (key
)
347 enum font_property_index i
;
349 for (i
= FONT_TYPE_INDEX
; i
< FONT_SPEC_MAX
; i
++)
350 if (EQ (key
, *font_property_table
[i
].key
))
356 font_prop_validate (spec
)
359 enum font_property_index i
;
362 for (i
= FONT_TYPE_INDEX
; i
<= FONT_EXTRA_INDEX
; i
++)
364 if (! NILP (AREF (spec
, i
)))
366 val
= (font_property_table
[i
].validater
) (i
, AREF (spec
, i
));
367 if (EQ (val
, Qerror
))
368 Fsignal (Qerror
, list3 (build_string ("invalid font property"),
369 *font_property_table
[i
].key
,
378 font_put_extra (font
, prop
, val
, force
)
379 Lisp_Object font
, prop
, val
;
382 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
383 Lisp_Object slot
= (NILP (extra
) ? Qnil
: Fassq (prop
, extra
));
387 extra
= Fcons (Fcons (prop
, val
), extra
);
388 ASET (font
, FONT_EXTRA_INDEX
, extra
);
391 if (! NILP (XCDR (slot
)) && ! force
)
398 /* Font name parser and unparser */
400 /* An enumerator for each field of an XLFD font name. */
402 enum xlfd_field_index
423 XLFD_FOUNDRY_MASK
= 0x0001,
424 XLFD_FAMILY_MASK
= 0x0002,
425 XLFD_WEIGHT_MASK
= 0x0004,
426 XLFD_SLANT_MASK
= 0x0008,
427 XLFD_SWIDTH_MASK
= 0x0010,
428 XLFD_ADSTYLE_MASK
= 0x0020,
429 XLFD_PIXEL_MASK
= 0x0040,
430 XLFD_POINT_MASK
= 0x0080,
431 XLFD_RESX_MASK
= 0x0100,
432 XLFD_RESY_MASK
= 0x0200,
433 XLFD_SPACING_MASK
= 0x0400,
434 XLFD_AVGWIDTH_MASK
= 0x0800,
435 XLFD_REGISTRY_MASK
= 0x1000,
436 XLFD_ENCODING_MASK
= 0x2000
440 /* Return a Lispy value for string at STR and bytes LEN.
441 If LEN == 0, return a null string.
442 If the string is "*", return Qnil.
443 It is assured that LEN < 256. */
446 intern_font_field (str
, len
)
454 if (*str
== '*' && len
== 1)
458 for (i
= 1; i
< len
; i
++)
459 if (! isdigit (str
[i
]))
462 return make_number (atoi (str
));
464 return intern_downcase (str
, len
);
467 /* Parse P pointing the pixel/point size field of the form
468 `[A B C D]' which specifies a transformation matrix:
474 by which all glyphs of the font are transformed. The spec says
475 that scalar value N for the pixel/point size is equivalent to:
476 A = N * resx/resy, B = C = 0, D = N.
478 Return the scalar value N if the form is valid. Otherwise return
489 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
492 matrix
[i
] = - strtod (p
+ 1, &end
);
494 matrix
[i
] = strtod (p
, &end
);
497 return (i
== 4 ? (int) matrix
[3] : -1);
500 /* Expand a wildcard field in FIELD (the first N fields are filled) to
501 multiple fields to fill in all 14 XLFD fields while restring a
502 field position by its contents. */
505 font_expand_wildcards (field
, n
)
506 Lisp_Object field
[XLFD_LAST_INDEX
];
510 Lisp_Object tmp
[XLFD_LAST_INDEX
];
511 /* Array of information about where this element can go. Nth
512 element is for Nth element of FIELD. */
514 /* Minimum possible field. */
516 /* Maxinum possible field. */
518 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
520 } range
[XLFD_LAST_INDEX
];
524 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
525 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
526 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
527 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
528 | XLFD_AVGWIDTH_MASK)
529 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
531 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
532 field. The value is shifted to left one bit by one in the
534 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
535 range_mask
= (range_mask
<< 1) | 1;
537 for (i
= 0; i
< n
; i
++, range_mask
<<= 1)
539 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
540 position-based retriction for FIELD[I]. */
541 int range_from
= i
, range_to
= 14 - n
+ i
;
542 Lisp_Object val
= field
[i
];
548 range
[i
].from
= range_from
;
549 range
[i
].to
= range_to
;
550 range
[i
].mask
= range_mask
;
554 /* The triplet FROM, TO, and MASK is a value-based
555 retriction for FIELD[I]. */
561 int numeric
= XINT (val
);
564 from
= to
= XLFD_ENCODING_INDEX
,
565 mask
= XLFD_ENCODING_MASK
;
566 else if (numeric
<= 48)
567 from
= to
= XLFD_PIXEL_INDEX
,
568 mask
= XLFD_PIXEL_MASK
;
570 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_MASK
,
571 mask
= XLFD_LARGENUM_MASK
;
573 else if (EQ (val
, null_string
))
574 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
575 mask
= XLFD_NULL_MASK
;
577 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
580 Lisp_Object name
= SYMBOL_NAME (val
);
582 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
583 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
584 mask
= XLFD_REGENC_MASK
;
586 from
= to
= XLFD_ENCODING_INDEX
,
587 mask
= XLFD_ENCODING_MASK
;
589 else if (range_from
<= XLFD_WEIGHT_INDEX
590 && range_to
>= XLFD_WEIGHT_INDEX
591 && !NILP (prop_name_to_numeric (FONT_WEIGHT_INDEX
, val
)))
592 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
593 else if (range_from
<= XLFD_SLANT_INDEX
594 && range_to
>= XLFD_SLANT_INDEX
595 && !NILP (prop_name_to_numeric (FONT_SLANT_INDEX
, val
)))
596 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
597 else if (range_from
<= XLFD_SWIDTH_INDEX
598 && range_to
>= XLFD_SWIDTH_INDEX
599 && !NILP (prop_name_to_numeric (FONT_WIDTH_INDEX
, val
)))
600 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
603 Lisp_Object name
= SYMBOL_NAME (val
);
605 if (SBYTES (name
) == 1
606 && (SDATA (name
)[0] == 'c'
607 || SDATA (name
)[0] == 'm'
608 || SDATA (name
)[0] == 'p'))
609 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
611 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
612 mask
= XLFD_SYMBOL_MASK
;
615 /* Merge position-based and value-based restrictions. */
617 while (from
< range_from
)
618 mask
&= ~(1 << from
++);
619 while (from
< 14 && ! (mask
& (1 << from
)))
621 while (to
> range_to
)
622 mask
&= ~(1 << to
--);
623 while (to
>= 0 && ! (mask
& (1 << to
)))
627 range
[i
].from
= from
;
629 range
[i
].mask
= mask
;
631 if (from
> range_from
|| to
< range_to
)
632 /* The range is narrowed by value-based restrictions.
633 Reflect it to the previous fields. */
634 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
636 /* Check FROM for non-wildcard field. */
637 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
639 while (range
[j
].from
< from
)
640 range
[j
].mask
&= ~(1 << range
[j
].from
++);
641 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
643 range
[j
].from
= from
;
646 from
= range
[j
].from
;
647 if (range
[j
].to
> to
)
649 while (range
[j
].to
> to
)
650 range
[j
].mask
&= ~(1 << range
[j
].to
--);
651 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
663 /* Decide all fileds from restrictions in RANGE. */
664 for (i
= j
= 0; i
< n
; i
++)
666 if (j
< range
[i
].from
)
668 if (i
== 0 || ! NILP (tmp
[i
- 1]))
669 /* None of TMP[X] corresponds to Jth field. */
671 for (; j
< range
[i
].from
; j
++)
676 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
678 for (; j
< XLFD_LAST_INDEX
; j
++)
680 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
681 field
[XLFD_ENCODING_INDEX
]
682 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
686 /* Parse NAME (null terminated) as XLFD and store information in FONT
687 (font-spec or font-entity). Size property of FONT is set as
689 specified XLFD fields FONT property
690 --------------------- -------------
691 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
692 POINT_SIZE and RESY calculated pixel size (Lisp integer)
693 POINT_SIZE POINT_SIZE/10 (Lisp float)
695 If NAME is successfully parsed, return 2 (size is specified), 1
696 (size is not specified), or 0 (size is not specified but resolution
697 is specified). Otherwise return -1.
699 See font_parse_name for more detail. */
702 font_parse_xlfd (name
, font
, merge
)
707 int len
= strlen (name
);
709 int pixel_size
, resy
, avgwidth
;
711 Lisp_Object f
[XLFD_LAST_INDEX
];
716 /* Maximum XLFD name length is 255. */
718 i
= (name
[0] == '*' && name
[1] == '-');
719 for (p
= name
+ 1; *p
; p
++)
724 if (i
== XLFD_ENCODING_INDEX
)
729 pixel_size
= resy
= avgwidth
= -1;
732 if (i
== XLFD_ENCODING_INDEX
)
734 /* Fully specified XLFD. */
737 for (i
= 0, p
= name
; ; p
++)
741 if (i
< XLFD_PIXEL_INDEX
)
742 f
[i
++] = intern_font_field (name
, p
- name
);
743 else if (i
== XLFD_PIXEL_INDEX
)
746 pixel_size
= atoi (name
);
747 else if (*name
== '[')
748 pixel_size
= parse_matrix (name
);
751 else if (i
== XLFD_POINT_INDEX
)
753 /* If PIXEL_SIZE is specified, we don't have to
754 calculate POINT_SIZE. */
758 point_size
= atoi (name
);
759 else if (*name
== '[')
760 point_size
= parse_matrix (name
);
764 else if (i
== XLFD_RESX_INDEX
)
766 /* Skip this field. */
769 else if (i
== XLFD_RESY_INDEX
)
771 /* Stuff RESY, SPACING, and AVGWIDTH. */
772 /* If PIXEL_SIZE is specified, we don't have to
774 if (pixel_size
< 0 && isdigit (*name
))
776 for (p
++; *p
!= '-'; p
++);
778 avgwidth
= atoi (p
+ 1);
779 else if (p
[1] == '~' && isdigit (p
[2]))
780 avgwidth
= atoi (p
+ 2);
781 for (p
++; *p
!= '-'; p
++);
782 if (FONT_ENTITY_P (font
))
783 f
[i
] = intern_font_field (name
, p
- name
);
786 i
= XLFD_REGISTRY_INDEX
;
790 /* Stuff REGISTRY and ENCODING. */
792 f
[i
++] = intern_font_field (name
, p
- name
);
798 xassert (i
== XLFD_ENCODING_INDEX
);
802 int wild_card_found
= 0;
806 for (i
= 0, p
= name
; ; p
++)
808 if (*p
== '-' || ! *p
)
817 else if (isdigit (*name
))
819 f
[i
++] = make_number (atoi (name
));
820 /* Check if all chars in this field is number. */
822 while (isdigit (*name
)) name
++;
827 f
[i
++] = null_string
;
830 f
[i
++] = intern_downcase (name
, p
- name
);
837 if (! wild_card_found
)
839 if (font_expand_wildcards (f
, i
) < 0)
841 if (! NILP (f
[XLFD_PIXEL_INDEX
]))
842 pixel_size
= XINT (f
[XLFD_PIXEL_INDEX
]);
843 /* If PIXEL_SIZE is specified, we don't have to
844 calculate POINT_SIZE and RESY. */
847 if (! NILP (f
[XLFD_POINT_INDEX
]))
848 point_size
= XINT (f
[XLFD_POINT_INDEX
]);
849 if (! NILP (f
[XLFD_RESY_INDEX
]))
850 resy
= XINT (f
[XLFD_RESY_INDEX
]);
852 if (! NILP (f
[XLFD_AVGWIDTH_INDEX
]))
853 avgwidth
= XINT (f
[XLFD_AVGWIDTH_INDEX
]);
854 if (NILP (f
[XLFD_REGISTRY_INDEX
]))
856 if (! NILP (f
[XLFD_ENCODING_INDEX
]))
857 f
[XLFD_REGISTRY_INDEX
]
858 = Fintern (concat2 (build_string ("*-"),
859 SYMBOL_NAME (f
[XLFD_ENCODING_INDEX
])), Qnil
);
863 if (! NILP (f
[XLFD_ENCODING_INDEX
]))
864 f
[XLFD_REGISTRY_INDEX
]
865 = Fintern (concat3 (SYMBOL_NAME (f
[XLFD_REGISTRY_INDEX
]),
867 SYMBOL_NAME (f
[XLFD_ENCODING_INDEX
])), Qnil
);
871 if (! merge
|| NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
872 ASET (font
, FONT_FOUNDRY_INDEX
, f
[XLFD_FOUNDRY_INDEX
]);
873 if (! merge
|| NILP (AREF (font
, FONT_FAMILY_INDEX
)))
874 ASET (font
, FONT_FAMILY_INDEX
, f
[XLFD_FAMILY_INDEX
]);
875 if (! merge
|| NILP (AREF (font
, FONT_ADSTYLE_INDEX
)))
876 ASET (font
, FONT_ADSTYLE_INDEX
, f
[XLFD_ADSTYLE_INDEX
]);
877 if (! merge
|| NILP (AREF (font
, FONT_REGISTRY_INDEX
)))
878 ASET (font
, FONT_REGISTRY_INDEX
, f
[XLFD_REGISTRY_INDEX
]);
880 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
;
881 j
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
882 if (! merge
|| NILP (AREF (font
, i
)))
884 if (! INTEGERP (f
[j
]))
886 val
= prop_name_to_numeric (i
, f
[j
]);
890 ASET (font
, i
, f
[j
]);
893 if (pixel_size
< 0 && FONT_ENTITY_P (font
))
896 if (! merge
|| NILP (AREF (font
, FONT_SIZE_INDEX
)))
899 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
900 else if (point_size
>= 0)
901 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
904 if (FONT_ENTITY_P (font
))
906 if (EQ (AREF (font
, FONT_TYPE_INDEX
), Qx
))
907 ASET (font
, FONT_EXTRA_INDEX
, f
[XLFD_RESY_INDEX
]);
910 font_put_extra (font
, QCdpi
, make_number (resy
), merge
);
912 return (avgwidth
> 0 ? 2 : resy
== 0);
915 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
916 length), and return the name length. If FONT_SIZE_INDEX of FONT is
917 0, use PIXEL_SIZE instead. */
920 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
926 char *f
[XLFD_REGISTRY_INDEX
+ 1], *pixel_point
;
931 xassert (FONTP (font
));
933 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
936 if (i
== FONT_ADSTYLE_INDEX
)
937 j
= XLFD_ADSTYLE_INDEX
;
938 else if (i
== FONT_REGISTRY_INDEX
)
939 j
= XLFD_REGISTRY_INDEX
;
940 val
= AREF (font
, i
);
943 if (j
== XLFD_REGISTRY_INDEX
)
944 f
[j
] = "*-*", len
+= 4;
946 f
[j
] = "*", len
+= 2;
951 val
= SYMBOL_NAME (val
);
952 if (j
== XLFD_REGISTRY_INDEX
953 && ! strchr ((char *) SDATA (val
), '-'))
955 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
956 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
958 f
[j
] = alloca (SBYTES (val
) + 3);
959 sprintf (f
[j
], "%s-*", SDATA (val
));
960 len
+= SBYTES (val
) + 3;
964 f
[j
] = alloca (SBYTES (val
) + 4);
965 sprintf (f
[j
], "%s*-*", SDATA (val
));
966 len
+= SBYTES (val
) + 4;
970 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
974 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
977 val
= AREF (font
, i
);
979 f
[j
] = "*", len
+= 2;
983 val
= prop_numeric_to_name (i
, XINT (val
));
985 val
= SYMBOL_NAME (val
);
986 xassert (STRINGP (val
));
987 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
991 val
= AREF (font
, FONT_SIZE_INDEX
);
992 xassert (NUMBERP (val
) || NILP (val
));
997 len
+= sprintf (work
, "%d-*", i
) + 1;
999 len
+= sprintf (work
, "%d-*", pixel_size
) + 1;
1002 else if (FLOATP (val
))
1004 i
= XFLOAT_DATA (val
) * 10;
1005 len
+= sprintf (work
, "*-%d", i
) + 1;
1009 pixel_point
= "*-*", len
+= 4;
1011 if (FONT_ENTITY_P (font
)
1012 && EQ (AREF (font
, FONT_TYPE_INDEX
), Qx
))
1014 /* Setup names for RESY-SPACING-AVWIDTH. */
1015 val
= AREF (font
, FONT_EXTRA_INDEX
);
1016 if (SYMBOLP (val
) && ! NILP (val
))
1018 val
= SYMBOL_NAME (val
);
1019 f
[XLFD_RESY_INDEX
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1022 f
[XLFD_RESY_INDEX
] = "*-*-*", len
+= 6;
1025 f
[XLFD_RESY_INDEX
] = "*-*-*", len
+= 6;
1027 len
+= 3; /* for "-*" of resx, and terminating '\0'. */
1030 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-*-%s-%s",
1031 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1032 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1033 f
[XLFD_SWIDTH_INDEX
],
1034 f
[XLFD_ADSTYLE_INDEX
], pixel_point
,
1035 f
[XLFD_RESY_INDEX
], f
[XLFD_REGISTRY_INDEX
]);
1038 /* Parse NAME (null terminated) as Fonconfig's name format and store
1039 information in FONT (font-spec or font-entity). If NAME is
1040 successfully parsed, return 0. Otherwise return -1. */
1043 font_parse_fcname (name
, font
, merge
)
1049 Lisp_Object family
= Qnil
;
1050 double point_size
= 0;
1052 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
1053 int len
= strlen (name
);
1056 /* It is assured that (name[0] && name[0] != '-'). */
1061 for (p0
= name
+ 1; *p0
&& (*p0
!= '-' && *p0
!= ':'); p0
++);
1062 if (isdigit (name
[0]) && *p0
!= '-')
1063 point_size
= strtod (name
, NULL
);
1066 family
= intern_font_field (name
, p0
- name
);
1069 point_size
= strtod (p0
+ 1, &p1
);
1070 if (*p1
&& *p1
!= ':')
1075 if (! merge
|| NILP (AREF (font
, FONT_FAMILY_INDEX
)))
1076 ASET (font
, FONT_FAMILY_INDEX
, family
);
1080 copy
= alloca (len
+ 1);
1085 /* Now parse ":KEY=VAL" patterns. Store known keys and values in
1086 extra, copy unknown ones to COPY. */
1089 Lisp_Object key
, val
;
1090 enum font_property_index prop
;
1092 for (p1
= p0
+ 1; islower (*p1
); p1
++);
1095 /* Must be an enumerated value. */
1096 val
= intern_font_field (p0
+ 1, p1
- p0
- 1);
1098 if (memcmp (p0
+ 1, "light", 5) == 0
1099 || memcmp (p0
+ 1, "medium", 6) == 0
1100 || memcmp (p0
+ 1, "demibold", 8) == 0
1101 || memcmp (p0
+ 1, "bold", 4) == 0
1102 || memcmp (p0
+ 1, "black", 5) == 0)
1104 if (! merge
|| NILP (AREF (font
, FONT_WEIGHT_INDEX
)))
1105 ASET (font
, FONT_WEIGHT_INDEX
,
1106 prop_name_to_numeric (FONT_WEIGHT_INDEX
, val
));
1108 else if (memcmp (p0
+ 1, "roman", 5) == 0
1109 || memcmp (p0
+ 1, "italic", 6) == 0
1110 || memcmp (p0
+ 1, "oblique", 7) == 0)
1112 if (! merge
|| NILP (AREF (font
, FONT_SLANT_INDEX
)))
1113 ASET (font
, FONT_SLANT_INDEX
,
1114 prop_name_to_numeric (FONT_SLANT_INDEX
, val
));
1116 else if (memcmp (p0
+ 1, "charcell", 8) == 0
1117 || memcmp (p0
+ 1, "mono", 4) == 0
1118 || memcmp (p0
+ 1, "proportional", 12) == 0)
1120 font_put_extra (font
, QCspacing
,
1121 p0
[1] == 'c' ? make_number (FONT_SPACING_CHARCELL
)
1122 : p0
[1] == 'm' ? make_number (FONT_SPACING_MONO
)
1123 : make_number (FONT_SPACING_PROPORTIONAL
),
1129 bcopy (p0
, copy
, p1
- p0
);
1137 if (memcmp (p0
+ 1, "pixelsize=", 10) == 0)
1138 prop
= FONT_SIZE_INDEX
;
1141 key
= intern_font_field (p0
, p1
- p0
);
1142 prop
= check_font_prop_name (key
);
1145 for (p1
= p0
; *p1
&& *p1
!= ':'; p1
++);
1146 if (prop
== FONT_SIZE_INDEX
)
1148 pixel_size
= atoi (p0
);
1150 else if (prop
< FONT_EXTRA_INDEX
)
1152 if (! merge
|| NILP (AREF (font
, prop
)))
1154 val
= intern_font_field (p0
, p1
- p0
);
1155 if (prop
>= FONT_WEIGHT_INDEX
&& prop
<= FONT_WIDTH_INDEX
)
1156 val
= font_property_table
[prop
].validater (prop
, val
);
1157 if (! EQ (val
, Qerror
))
1158 ASET (font
, prop
, val
);
1161 else if (EQ (key
, QCdpi
))
1164 font_put_extra (font
, key
, val
, merge
);
1169 bcopy (pbeg
, copy
, p1
- pbeg
);
1176 if (! merge
|| NILP (AREF (font
, FONT_SIZE_INDEX
)))
1179 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1180 else if (point_size
> 0)
1181 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1184 font_put_extra (font
, QCname
, make_unibyte_string (name
, copy
- name
),
1190 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1191 NAME (NBYTES length), and return the name length. If
1192 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1195 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1201 Lisp_Object val
, size
;
1205 Lisp_Object styles
[3];
1206 char *style_names
[3] = { "weight", "slant", "swidth" };
1208 if (SYMBOLP (AREF (font
, FONT_FAMILY_INDEX
))
1209 && ! NILP (AREF (font
, FONT_FAMILY_INDEX
)))
1210 len
+= SBYTES (SYMBOL_NAME (AREF (font
, FONT_FAMILY_INDEX
)));
1211 size
= AREF (font
, FONT_SIZE_INDEX
);
1212 if (INTEGERP (size
))
1214 if (XINT (size
) > 0)
1215 pixel_size
= XINT (size
);
1217 len
+= 21; /* for ":pixelsize=NUM" */
1219 else if (FLOATP (size
))
1221 pt
= (int) XFLOAT_DATA (size
);
1223 len
+= 11; /* for "-NUM" */
1225 if (SYMBOLP (AREF (font
, FONT_FOUNDRY_INDEX
))
1226 && ! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1227 /* ":foundry=NAME" */
1228 len
+= 9 + SBYTES (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
)));
1229 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
1231 val
= AREF (font
, i
);
1234 val
= prop_numeric_to_name (i
, XINT (val
));
1235 len
+= (strlen (style_names
[i
- FONT_WEIGHT_INDEX
])
1236 + 2 + SBYTES (SYMBOL_NAME (val
))); /* :xxx=NAME */
1238 styles
[i
- FONT_WEIGHT_INDEX
] = val
;
1243 if (! NILP (AREF (font
, FONT_FAMILY_INDEX
)))
1244 p
+= sprintf(p
, "%s",
1245 SDATA (SYMBOL_NAME (AREF (font
, FONT_FAMILY_INDEX
))));
1247 p
+= sprintf (p
, "-%d", pt
);
1248 else if (pixel_size
> 0)
1249 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1250 if (SYMBOLP (AREF (font
, FONT_FOUNDRY_INDEX
))
1251 && ! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1252 p
+= sprintf (p
, ":foundry=%s",
1253 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1254 for (i
= 0; i
< 3; i
++)
1255 if (! NILP (styles
[i
]))
1256 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1257 SDATA (SYMBOL_NAME (styles
[i
])));
1261 /* Parse NAME (null terminated) and store information in FONT
1262 (font-spec or font-entity). If NAME is successfully parsed, return
1263 a non-negative value. Otherwise return -1.
1265 If NAME is XLFD and FONT is a font-entity, store
1266 RESY-SPACING-AVWIDTH information as a symbol in FONT_EXTRA_INDEX.
1268 If MERGE is nonzero, set a property of FONT only when it's nil. */
1271 font_parse_name (name
, font
, merge
)
1276 if (name
[0] == '-' || index (name
, '*'))
1277 return font_parse_xlfd (name
, font
, merge
);
1279 return font_parse_fcname (name
, font
, merge
);
1284 font_merge_old_spec (name
, family
, registry
, spec
)
1285 Lisp_Object name
, family
, registry
, spec
;
1289 if (font_parse_xlfd ((char *) SDATA (name
), spec
, 1) < 0)
1291 Lisp_Object extra
= Fcons (Fcons (QCname
, name
), Qnil
);
1293 ASET (spec
, FONT_EXTRA_INDEX
, extra
);
1298 if (! NILP (family
))
1303 xassert (STRINGP (family
));
1304 len
= SBYTES (family
);
1305 p0
= (char *) SDATA (family
);
1306 p1
= index (p0
, '-');
1309 if (NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
1310 ASET (spec
, FONT_FOUNDRY_INDEX
,
1311 intern_downcase (p0
, p1
- p0
));
1312 if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
1313 ASET (spec
, FONT_FAMILY_INDEX
,
1314 intern_downcase (p1
+ 1, len
- (p1
+ 1 - p0
)));
1316 else if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
1317 ASET (spec
, FONT_FAMILY_INDEX
, intern_downcase (p0
, len
));
1319 if (! NILP (registry
)
1320 && NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
1321 ASET (spec
, FONT_REGISTRY_INDEX
,
1322 intern_downcase ((char *) SDATA (registry
), SBYTES (registry
)));
1336 struct otf_list
*next
;
1339 static struct otf_list
*otf_list
;
1342 otf_tag_symbol (tag
)
1347 OTF_tag_name (tag
, name
);
1348 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1352 otf_open (entity
, file
)
1356 struct otf_list
*list
= otf_list
;
1358 while (list
&& ! EQ (list
->entity
, entity
))
1362 list
= malloc (sizeof (struct otf_list
));
1363 list
->entity
= entity
;
1364 list
->otf
= file
? OTF_open (file
) : NULL
;
1365 list
->next
= otf_list
;
1372 /* Return a list describing which scripts/languages FONT supports by
1373 which GSUB/GPOS features of OpenType tables. See the comment of
1374 (sturct font_driver).otf_capability. */
1377 font_otf_capability (font
)
1381 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1384 otf
= otf_open (font
->entity
, font
->file_name
);
1387 for (i
= 0; i
< 2; i
++)
1389 OTF_GSUB_GPOS
*gsub_gpos
;
1390 Lisp_Object script_list
= Qnil
;
1393 if (OTF_get_features (otf
, i
== 0) < 0)
1395 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1396 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1398 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1399 Lisp_Object langsys_list
= Qnil
;
1400 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1403 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1405 OTF_LangSys
*langsys
;
1406 Lisp_Object feature_list
= Qnil
;
1407 Lisp_Object langsys_tag
;
1410 if (j
== script
->LangSysCount
)
1412 langsys
= &script
->DefaultLangSys
;
1417 langsys
= script
->LangSys
+ k
;
1419 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1421 for (l
= langsys
->FeatureCount
-1; l
>= 0; l
--)
1423 OTF_Feature
*feature
1424 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1425 Lisp_Object feature_tag
1426 = otf_tag_symbol (feature
->FeatureTag
);
1428 feature_list
= Fcons (feature_tag
, feature_list
);
1430 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1433 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1438 XSETCAR (capability
, script_list
);
1440 XSETCDR (capability
, script_list
);
1447 parse_gsub_gpos_spec (spec
, script
, langsys
, features
)
1449 char **script
, **langsys
, **features
;
1457 *script
= (char *) SDATA (SYMBOL_NAME (val
));
1460 *langsys
= NILP (val
) ? NULL
: (char *) SDATA (SYMBOL_NAME (val
));
1462 len
= XINT (Flength (spec
));
1463 *features
= p
= malloc (6 * len
);
1467 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1470 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1473 p
+= sprintf (p
, ",*");
1475 else if (! asterisk
)
1476 p
+= sprintf (p
, ",%s", SDATA (SYMBOL_NAME (val
)));
1478 p
+= sprintf (p
, ",~%s", SDATA (SYMBOL_NAME (val
)));
1483 #define DEVICE_DELTA(table, size) \
1484 (((size) >= (table).StartSize && (size) <= (table).EndSize) \
1485 ? (table).DeltaValue[(size) >= (table).StartSize] \
1489 adjust_anchor (struct font
*font
, OTF_Anchor
*anchor
,
1490 unsigned code
, int size
, int *x
, int *y
)
1492 if (anchor
->AnchorFormat
== 2)
1496 if (font
->driver
->anchor_point (font
, code
, anchor
->f
.f1
.AnchorPoint
,
1500 else if (anchor
->AnchorFormat
== 3)
1502 if (anchor
->f
.f2
.XDeviceTable
.offset
)
1503 *x
+= DEVICE_DELTA (anchor
->f
.f2
.XDeviceTable
, size
);
1504 if (anchor
->f
.f2
.YDeviceTable
.offset
)
1505 *y
+= DEVICE_DELTA (anchor
->f
.f2
.YDeviceTable
, size
);
1510 /* Drive FONT's OTF GSUB features according to GSUB_SPEC. See the
1511 comment of (sturct font_driver).otf_gsub. */
1514 font_otf_gsub (font
, gsub_spec
, gstring_in
, from
, to
, gstring_out
, idx
)
1516 Lisp_Object gsub_spec
;
1517 Lisp_Object gstring_in
;
1519 Lisp_Object gstring_out
;
1525 OTF_GlyphString otf_gstring
;
1527 char *script
, *langsys
, *features
;
1529 otf
= otf_open (font
->entity
, font
->file_name
);
1532 if (OTF_get_table (otf
, "head") < 0)
1534 if (OTF_check_table (otf
, "GSUB") < 0)
1536 if (parse_gsub_gpos_spec (gsub_spec
, &script
, &langsys
, &features
) < 0)
1539 otf_gstring
.size
= otf_gstring
.used
= len
;
1540 otf_gstring
.glyphs
= (OTF_Glyph
*) malloc (sizeof (OTF_Glyph
) * len
);
1541 memset (otf_gstring
.glyphs
, 0, sizeof (OTF_Glyph
) * len
);
1542 for (i
= 0; i
< len
; i
++)
1544 Lisp_Object g
= LGSTRING_GLYPH (gstring_in
, from
+ i
);
1546 otf_gstring
.glyphs
[i
].c
= XINT (LGLYPH_CHAR (g
));
1547 otf_gstring
.glyphs
[i
].glyph_id
= XINT (LGLYPH_CODE (g
));
1550 OTF_drive_gdef (otf
, &otf_gstring
);
1551 if (OTF_drive_gsub (otf
, &otf_gstring
, script
, langsys
, features
) < 0)
1553 free (otf_gstring
.glyphs
);
1556 if (ASIZE (gstring_out
) < idx
+ otf_gstring
.used
)
1558 free (otf_gstring
.glyphs
);
1562 for (i
= 0, g
= otf_gstring
.glyphs
; i
< otf_gstring
.used
;)
1564 int i0
= g
->f
.index
.from
, i1
= g
->f
.index
.to
;
1565 Lisp_Object glyph
= LGSTRING_GLYPH (gstring_in
, from
+ i0
);
1566 Lisp_Object min_idx
= AREF (glyph
, 0);
1567 Lisp_Object max_idx
= AREF (glyph
, 1);
1571 int min_idx_i
= XINT (min_idx
), max_idx_i
= XINT (max_idx
);
1573 for (i0
++; i0
<= i1
; i0
++)
1575 glyph
= LGSTRING_GLYPH (gstring_in
, from
+ i0
);
1576 if (min_idx_i
> XINT (AREF (glyph
, 0)))
1577 min_idx_i
= XINT (AREF (glyph
, 0));
1578 if (max_idx_i
< XINT (AREF (glyph
, 1)))
1579 max_idx_i
= XINT (AREF (glyph
, 1));
1581 min_idx
= make_number (min_idx_i
);
1582 max_idx
= make_number (max_idx_i
);
1583 i0
= g
->f
.index
.from
;
1585 for (; i
< otf_gstring
.used
&& g
->f
.index
.from
== i0
; i
++, g
++)
1587 glyph
= LGSTRING_GLYPH (gstring_out
, idx
+ i
);
1588 ASET (glyph
, 0, min_idx
);
1589 ASET (glyph
, 1, max_idx
);
1590 LGLYPH_SET_CHAR (glyph
, make_number (g
->c
));
1591 LGLYPH_SET_CODE (glyph
, make_number (g
->glyph_id
));
1595 free (otf_gstring
.glyphs
);
1599 /* Drive FONT's OTF GPOS features according to GPOS_SPEC. See the
1600 comment of (sturct font_driver).otf_gpos. */
1603 font_otf_gpos (font
, gpos_spec
, gstring
, from
, to
)
1605 Lisp_Object gpos_spec
;
1606 Lisp_Object gstring
;
1612 OTF_GlyphString otf_gstring
;
1614 char *script
, *langsys
, *features
;
1617 Lisp_Object base
, mark
;
1619 otf
= otf_open (font
->entity
, font
->file_name
);
1622 if (OTF_get_table (otf
, "head") < 0)
1624 if (OTF_check_table (otf
, "GPOS") < 0)
1626 if (parse_gsub_gpos_spec (gpos_spec
, &script
, &langsys
, &features
) < 0)
1629 otf_gstring
.size
= otf_gstring
.used
= len
;
1630 otf_gstring
.glyphs
= (OTF_Glyph
*) malloc (sizeof (OTF_Glyph
) * len
);
1631 memset (otf_gstring
.glyphs
, 0, sizeof (OTF_Glyph
) * len
);
1632 for (i
= 0; i
< len
; i
++)
1634 glyph
= LGSTRING_GLYPH (gstring
, from
+ i
);
1635 otf_gstring
.glyphs
[i
].glyph_id
= XINT (LGLYPH_CODE (glyph
));
1638 OTF_drive_gdef (otf
, &otf_gstring
);
1640 if (OTF_drive_gpos (otf
, &otf_gstring
, script
, langsys
, features
) < 0)
1642 free (otf_gstring
.glyphs
);
1646 u
= otf
->head
->unitsPerEm
;
1647 size
= font
->pixel_size
;
1649 for (i
= 0, g
= otf_gstring
.glyphs
; i
< otf_gstring
.used
; i
++, g
++)
1652 int xoff
= 0, yoff
= 0, width_adjust
= 0;
1657 glyph
= LGSTRING_GLYPH (gstring
, from
+ i
);
1658 switch (g
->positioning_type
)
1664 int format
= g
->f
.f1
.format
;
1666 if (format
& OTF_XPlacement
)
1667 xoff
= g
->f
.f1
.value
->XPlacement
* size
/ u
;
1668 if (format
& OTF_XPlaDevice
)
1669 xoff
+= DEVICE_DELTA (g
->f
.f1
.value
->XPlaDevice
, size
);
1670 if (format
& OTF_YPlacement
)
1671 yoff
= - (g
->f
.f1
.value
->YPlacement
* size
/ u
);
1672 if (format
& OTF_YPlaDevice
)
1673 yoff
-= DEVICE_DELTA (g
->f
.f1
.value
->YPlaDevice
, size
);
1674 if (format
& OTF_XAdvance
)
1675 width_adjust
+= g
->f
.f1
.value
->XAdvance
* size
/ u
;
1676 if (format
& OTF_XAdvDevice
)
1677 width_adjust
+= DEVICE_DELTA (g
->f
.f1
.value
->XAdvDevice
, size
);
1681 /* Not yet supported. */
1687 goto label_adjust_anchor
;
1688 default: /* i.e. case 6 */
1693 label_adjust_anchor
:
1695 int base_x
, base_y
, mark_x
, mark_y
, width
;
1698 base_x
= g
->f
.f4
.base_anchor
->XCoordinate
* size
/ u
;
1699 base_y
= g
->f
.f4
.base_anchor
->YCoordinate
* size
/ u
;
1700 mark_x
= g
->f
.f4
.mark_anchor
->XCoordinate
* size
/ u
;
1701 mark_y
= g
->f
.f4
.mark_anchor
->YCoordinate
* size
/ u
;
1703 code
= XINT (LGLYPH_CODE (prev
));
1704 if (g
->f
.f4
.base_anchor
->AnchorFormat
!= 1)
1705 adjust_anchor (font
, g
->f
.f4
.base_anchor
,
1706 code
, size
, &base_x
, &base_y
);
1707 if (g
->f
.f4
.mark_anchor
->AnchorFormat
!= 1)
1708 adjust_anchor (font
, g
->f
.f4
.mark_anchor
,
1709 code
, size
, &mark_x
, &mark_y
);
1711 if (NILP (LGLYPH_WIDTH (prev
)))
1713 width
= font
->driver
->text_extents (font
, &code
, 1, NULL
);
1714 LGLYPH_SET_WIDTH (prev
, make_number (width
));
1716 xoff
= XINT (LGLYPH_XOFF (prev
)) + (base_x
- width
) - mark_x
;
1717 yoff
= XINT (LGLYPH_YOFF (prev
)) + mark_y
- base_y
;
1720 if (g
->GlyphClass
== OTF_GlyphClass0
)
1721 base
= mark
= glyph
;
1722 else if (g
->GlyphClass
== OTF_GlyphClassMark
)
1727 LGLYPH_SET_XOFF (glyph
, make_number (xoff
));
1728 LGLYPH_SET_YOFF (glyph
, make_number (yoff
));
1729 LGLYPH_SET_WADJUST (glyph
, make_number (width_adjust
));
1732 free (otf_gstring
.glyphs
);
1736 #endif /* HAVE_LIBOTF */
1739 /* glyph-string handler */
1741 /* GSTRING is a vector of this form:
1742 [ [FONT-OBJECT LBEARING RBEARING WITH ASCENT DESCENT] GLYPH ... ]
1743 and GLYPH is a vector of this form:
1744 [ FROM-IDX TO-IDX C CODE X-OFF Y-OFF WIDTH WADJUST ]
1746 FROM-IDX and TO-IDX are used internally and should not be touched.
1747 C is a character of the glyph.
1748 CODE is a glyph-code of C in FONT-OBJECT.
1749 X-OFF and Y-OFF are offests to the base position for the glyph.
1750 WIDTH is a normal width of the glyph.
1751 WADJUST is an adjustment to the normal width of the glyph. */
1754 font_prepare_composition (cmp
)
1755 struct composition
*cmp
;
1758 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
1759 cmp
->hash_index
* 2);
1760 struct font
*font
= XSAVE_VALUE (LGSTRING_FONT (gstring
))->pointer
;
1761 int len
= LGSTRING_LENGTH (gstring
);
1765 cmp
->lbearing
= cmp
->rbearing
= cmp
->pixel_width
= 0;
1766 cmp
->ascent
= font
->ascent
;
1767 cmp
->descent
= font
->descent
;
1769 for (i
= 0; i
< len
; i
++)
1771 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
1772 unsigned code
= XINT (LGLYPH_CODE (g
));
1773 struct font_metrics metrics
;
1775 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
1776 LGLYPH_SET_WIDTH (g
, make_number (metrics
.width
));
1777 metrics
.lbearing
+= XINT (LGLYPH_XOFF (g
));
1778 metrics
.rbearing
+= XINT (LGLYPH_XOFF (g
));
1779 metrics
.ascent
+= XINT (LGLYPH_YOFF (g
));
1780 metrics
.descent
+= XINT (LGLYPH_YOFF (g
));
1782 if (cmp
->lbearing
> cmp
->pixel_width
+ metrics
.lbearing
)
1783 cmp
->lbearing
= cmp
->pixel_width
+ metrics
.lbearing
;
1784 if (cmp
->rbearing
< cmp
->pixel_width
+ metrics
.rbearing
)
1785 cmp
->rbearing
= cmp
->pixel_width
+ metrics
.rbearing
;
1786 if (cmp
->ascent
< metrics
.ascent
)
1787 cmp
->ascent
= metrics
.ascent
;
1788 if (cmp
->descent
< metrics
.descent
)
1789 cmp
->descent
= metrics
.descent
;
1790 cmp
->pixel_width
+= metrics
.width
+ XINT (LGLYPH_WADJUST (g
));
1792 LGSTRING_SET_LBEARING (gstring
, make_number (cmp
->lbearing
));
1793 LGSTRING_SET_RBEARING (gstring
, make_number (cmp
->rbearing
));
1794 LGSTRING_SET_WIDTH (gstring
, make_number (cmp
->pixel_width
));
1795 LGSTRING_SET_ASCENT (gstring
, make_number (cmp
->ascent
));
1796 LGSTRING_SET_DESCENT (gstring
, make_number (cmp
->descent
));
1802 font_gstring_produce (old
, from
, to
, new, idx
, code
, n
)
1810 Lisp_Object min_idx
, max_idx
;
1813 if (idx
+ n
> ASIZE (new))
1819 min_idx
= make_number (0);
1820 max_idx
= make_number (1);
1824 min_idx
= AREF (AREF (old
, from
- 1), 0);
1825 max_idx
= AREF (AREF (old
, from
- 1), 1);
1828 else if (from
+ 1 == to
)
1830 min_idx
= AREF (AREF (old
, from
), 0);
1831 max_idx
= AREF (AREF (old
, from
), 1);
1835 int min_idx_i
= XINT (AREF (AREF (old
, from
), 0));
1836 int max_idx_i
= XINT (AREF (AREF (old
, from
), 1));
1838 for (i
= from
+ 1; i
< to
; i
++)
1840 if (min_idx_i
> XINT (AREF (AREF (old
, i
), 0)))
1841 min_idx_i
= XINT (AREF (AREF (old
, i
), 0));
1842 if (max_idx_i
< XINT (AREF (AREF (old
, i
), 1)))
1843 max_idx_i
= XINT (AREF (AREF (old
, i
), 1));
1845 min_idx
= make_number (min_idx_i
);
1846 max_idx
= make_number (max_idx_i
);
1849 for (i
= 0; i
< n
; i
++)
1851 ASET (AREF (new, idx
+ i
), 0, min_idx
);
1852 ASET (AREF (new, idx
+ i
), 1, max_idx
);
1853 ASET (AREF (new, idx
+ i
), 2, make_number (code
[i
]));
1861 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*));
1862 static int font_compare
P_ ((const void *, const void *));
1863 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
1864 Lisp_Object
, Lisp_Object
));
1866 /* We sort fonts by scoring each of them against a specified
1867 font-spec. The score value is 32 bit (`unsigned'), and the smaller
1868 the value is, the closer the font is to the font-spec.
1870 Each 1-bit in the highest 4 bits of the score is used for atomic
1871 properties FOUNDRY, FAMILY, ADSTYLE, and REGISTRY.
1873 Each 7-bit in the lowest 28 bits are used for numeric properties
1874 WEIGHT, SLANT, WIDTH, and SIZE. */
1876 /* How many bits to shift to store the difference value of each font
1877 property in a score. */
1878 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
1880 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
1881 The return value indicates how different ENTITY is compared with
1885 font_score (entity
, spec_prop
)
1886 Lisp_Object entity
, *spec_prop
;
1890 /* Score four atomic fields. Maximum difference is 1. */
1891 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
1892 if (! NILP (spec_prop
[i
])
1893 && ! EQ (spec_prop
[i
], AREF (entity
, i
)))
1894 score
|= 1 << sort_shift_bits
[i
];
1896 /* Score four numeric fields. Maximum difference is 127. */
1897 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
1899 Lisp_Object entity_val
= AREF (entity
, i
);
1901 if (! NILP (spec_prop
[i
]) && ! EQ (spec_prop
[i
], entity_val
))
1903 if (! INTEGERP (entity_val
))
1904 score
|= 127 << sort_shift_bits
[i
];
1907 int diff
= XINT (entity_val
) - XINT (spec_prop
[i
]);
1911 if (i
== FONT_SIZE_INDEX
)
1913 if (XINT (entity_val
) > 0
1914 && diff
> FONT_PIXEL_SIZE_QUANTUM
)
1915 score
|= min (diff
, 127) << sort_shift_bits
[i
];
1918 score
|= min (diff
, 127) << sort_shift_bits
[i
];
1927 /* The comparison function for qsort. */
1930 font_compare (d1
, d2
)
1931 const void *d1
, *d2
;
1933 return (*(unsigned *) d1
< *(unsigned *) d2
1934 ? -1 : *(unsigned *) d1
> *(unsigned *) d2
);
1938 /* The structure for elements being sorted by qsort. */
1939 struct font_sort_data
1946 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
1947 If PREFER specifies a point-size, calculate the corresponding
1948 pixel-size from QCdpi property of PREFER or from the Y-resolution
1949 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
1950 get the font-entities in VEC. */
1953 font_sort_entites (vec
, prefer
, frame
, spec
)
1954 Lisp_Object vec
, prefer
, frame
, spec
;
1956 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
1958 struct font_sort_data
*data
;
1965 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
1966 prefer_prop
[i
] = AREF (prefer
, i
);
1970 /* As it is assured that all fonts in VEC match with SPEC, we
1971 should ignore properties specified in SPEC. So, set the
1972 corresponding properties in PREFER_PROP to nil. */
1973 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
1974 if (! NILP (AREF (spec
, i
)))
1975 prefer_prop
[i
++] = Qnil
;
1978 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
1979 prefer_prop
[FONT_SIZE_INDEX
]
1980 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
1982 /* Scoring and sorting. */
1983 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
1984 for (i
= 0; i
< len
; i
++)
1986 data
[i
].entity
= AREF (vec
, i
);
1987 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
);
1989 qsort (data
, len
, sizeof *data
, font_compare
);
1990 for (i
= 0; i
< len
; i
++)
1991 ASET (vec
, i
, data
[i
].entity
);
1998 /* API of Font Service Layer. */
2001 font_update_sort_order (order
)
2004 int i
, shift_bits
= 21;
2006 for (i
= 0; i
< 4; i
++, shift_bits
-= 7)
2008 int xlfd_idx
= order
[i
];
2010 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2011 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2012 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2013 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2014 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2015 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2017 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2022 font_symbolic_weight (font
)
2025 Lisp_Object weight
= AREF (font
, FONT_WEIGHT_INDEX
);
2027 if (INTEGERP (weight
))
2028 weight
= prop_numeric_to_name (FONT_WEIGHT_INDEX
, XINT (weight
));
2033 font_symbolic_slant (font
)
2036 Lisp_Object slant
= AREF (font
, FONT_SLANT_INDEX
);
2038 if (INTEGERP (slant
))
2039 slant
= prop_numeric_to_name (FONT_SLANT_INDEX
, XINT (slant
));
2044 font_symbolic_width (font
)
2047 Lisp_Object width
= AREF (font
, FONT_WIDTH_INDEX
);
2049 if (INTEGERP (width
))
2050 width
= prop_numeric_to_name (FONT_WIDTH_INDEX
, XINT (width
));
2055 font_match_p (spec
, entity
)
2056 Lisp_Object spec
, entity
;
2060 for (i
= FONT_FOUNDRY_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2061 if (! NILP (AREF (spec
, i
))
2062 && ! EQ (AREF (spec
, i
), AREF (entity
, i
)))
2064 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
))
2065 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0
2066 && (XINT (AREF (spec
, FONT_SIZE_INDEX
))
2067 != XINT (AREF (entity
, FONT_SIZE_INDEX
))))
2073 font_find_object (font
)
2076 Lisp_Object tail
, elt
;
2078 for (tail
= AREF (font
->entity
, FONT_OBJLIST_INDEX
); CONSP (tail
);
2082 if (font
== XSAVE_VALUE (elt
)->pointer
2083 && XSAVE_VALUE (elt
)->integer
> 0)
2090 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2092 /* Return a vector of font-entities matching with SPEC on frame F. */
2095 font_list_entities (frame
, spec
)
2096 Lisp_Object frame
, spec
;
2098 FRAME_PTR f
= XFRAME (frame
);
2099 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2100 Lisp_Object ftype
, family
, size
, alternate_familes
;
2101 Lisp_Object
*vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
);
2107 family
= AREF (spec
, FONT_FAMILY_INDEX
);
2109 alternate_familes
= Qnil
;
2112 if (NILP (font_family_alist
)
2113 && !NILP (Vface_alternative_font_family_alist
))
2114 build_font_family_alist ();
2115 alternate_familes
= assq_no_quit (family
, font_family_alist
);
2116 if (! NILP (alternate_familes
))
2117 alternate_familes
= XCDR (alternate_familes
);
2119 size
= AREF (spec
, FONT_SIZE_INDEX
);
2121 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2123 xassert (ASIZE (spec
) == FONT_SPEC_MAX
);
2124 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2126 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2127 if (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
))
2129 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
2130 Lisp_Object tail
= alternate_familes
;
2133 xassert (CONSP (cache
));
2134 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2135 ASET (spec
, FONT_FAMILY_INDEX
, family
);
2139 val
= assoc_no_quit (spec
, XCDR (cache
));
2144 val
= driver_list
->driver
->list (frame
, spec
);
2146 XSETCDR (cache
, Fcons (Fcons (Fcopy_sequence (spec
), val
),
2149 if (VECTORP (val
) && ASIZE (val
) > 0)
2156 ASET (spec
, FONT_FAMILY_INDEX
, XCAR (tail
));
2160 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2161 ASET (spec
, FONT_FAMILY_INDEX
, family
);
2162 ASET (spec
, FONT_SIZE_INDEX
, size
);
2163 return (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2166 static int num_fonts
;
2169 font_open_entity (f
, entity
, pixel_size
)
2174 struct font_driver_list
*driver_list
;
2175 Lisp_Object objlist
, size
, val
;
2178 size
= AREF (entity
, FONT_SIZE_INDEX
);
2179 xassert (NATNUMP (size
));
2180 if (XINT (size
) != 0)
2181 pixel_size
= XINT (size
);
2183 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2184 objlist
= XCDR (objlist
))
2186 font
= XSAVE_VALUE (XCAR (objlist
))->pointer
;
2187 if (font
->pixel_size
== pixel_size
)
2189 XSAVE_VALUE (XCAR (objlist
))->integer
++;
2190 return XCAR (objlist
);
2194 xassert (FONT_ENTITY_P (entity
));
2195 val
= AREF (entity
, FONT_TYPE_INDEX
);
2196 for (driver_list
= f
->font_driver_list
;
2197 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2198 driver_list
= driver_list
->next
);
2202 font
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2205 val
= make_save_value (font
, 1);
2206 ASET (entity
, FONT_OBJLIST_INDEX
,
2207 Fcons (val
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2213 font_close_object (f
, font_object
)
2215 Lisp_Object font_object
;
2218 Lisp_Object objlist
= AREF (font
->entity
, FONT_OBJLIST_INDEX
);
2219 Lisp_Object tail
, prev
= Qnil
;
2221 for (prev
= Qnil
, tail
= objlist
; CONSP (tail
);
2222 prev
= tail
, tail
= XCDR (tail
))
2223 if (EQ (font_object
, XCAR (tail
)))
2225 struct Lisp_Save_Value
*p
= XSAVE_VALUE (font_object
);
2227 xassert (p
->integer
> 0);
2229 if (p
->integer
== 0)
2231 if (font
->driver
->close
)
2232 font
->driver
->close (f
, p
->pointer
);
2235 ASET (font
->entity
, FONT_OBJLIST_INDEX
, XCDR (objlist
));
2237 XSETCDR (prev
, XCDR (objlist
));
2244 font_has_char (f
, font
, c
)
2251 if (FONT_ENTITY_P (font
))
2253 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2254 struct font_driver_list
*driver_list
;
2256 for (driver_list
= f
->font_driver_list
;
2257 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2258 driver_list
= driver_list
->next
);
2261 if (! driver_list
->driver
->has_char
)
2263 return driver_list
->driver
->has_char (font
, c
);
2266 xassert (FONT_OBJECT_P (font
));
2267 fontp
= XSAVE_VALUE (font
)->pointer
;
2269 if (fontp
->driver
->has_char
)
2271 int result
= fontp
->driver
->has_char (fontp
->entity
, c
);
2276 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2280 font_encode_char (font_object
, c
)
2281 Lisp_Object font_object
;
2284 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2286 return font
->driver
->encode_char (font
, c
);
2290 font_get_name (font_object
)
2291 Lisp_Object font_object
;
2293 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2294 char *name
= (font
->font
.full_name
? font
->font
.full_name
2295 : font
->font
.name
? font
->font
.name
2298 return (name
? make_unibyte_string (name
, strlen (name
)) : null_string
);
2302 font_get_spec (font_object
)
2303 Lisp_Object font_object
;
2305 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2306 Lisp_Object spec
= Ffont_spec (0, NULL
);
2309 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2310 ASET (spec
, i
, AREF (font
->entity
, i
));
2311 ASET (spec
, FONT_SIZE_INDEX
, make_number (font
->pixel_size
));
2316 font_get_frame (font
)
2319 if (FONT_OBJECT_P (font
))
2320 font
= ((struct font
*) XSAVE_VALUE (font
)->pointer
)->entity
;
2321 xassert (FONT_ENTITY_P (font
));
2322 return AREF (font
, FONT_FRAME_INDEX
);
2325 /* Find a font entity best matching with LFACE. If SPEC is non-nil,
2326 the font must exactly match with it. */
2329 font_find_for_lface (f
, lface
, spec
)
2334 Lisp_Object frame
, entities
;
2338 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2339 ASET (scratch_font_spec
, i
, Qnil
);
2341 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2342 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2344 if (NILP (AREF (scratch_font_spec
, FONT_FAMILY_INDEX
))
2345 && ! NILP (lface
[LFACE_FAMILY_INDEX
]))
2346 font_merge_old_spec (Qnil
, lface
[LFACE_FAMILY_INDEX
], Qnil
,
2348 if (NILP (AREF (scratch_font_spec
, FONT_REGISTRY_INDEX
)))
2349 ASET (scratch_font_spec
, FONT_REGISTRY_INDEX
, intern ("iso8859-1"));
2351 if (NILP (AREF (scratch_font_spec
, FONT_SIZE_INDEX
))
2352 && ! NILP (lface
[LFACE_HEIGHT_INDEX
]))
2354 double pt
= XINT (lface
[LFACE_HEIGHT_INDEX
]);
2355 int pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
2357 ASET (scratch_font_spec
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2360 XSETFRAME (frame
, f
);
2361 entities
= font_list_entities (frame
, scratch_font_spec
);
2362 while (ASIZE (entities
) == 0)
2364 if (! NILP (AREF (scratch_font_spec
, FONT_SIZE_INDEX
))
2365 && (NILP (spec
) || NILP (AREF (spec
, FONT_SIZE_INDEX
))))
2367 ASET (scratch_font_spec
, FONT_SIZE_INDEX
, Qnil
);
2368 entities
= font_list_entities (frame
, scratch_font_spec
);
2370 else if (! NILP (AREF (scratch_font_spec
, FONT_FOUNDRY_INDEX
))
2371 && (NILP (spec
) || NILP (AREF (spec
, FONT_FOUNDRY_INDEX
))))
2373 ASET (scratch_font_spec
, FONT_FOUNDRY_INDEX
, Qnil
);
2374 entities
= font_list_entities (frame
, scratch_font_spec
);
2376 else if (! NILP (AREF (scratch_font_spec
, FONT_FAMILY_INDEX
))
2377 && (NILP (spec
) || NILP (AREF (spec
, FONT_FAMILY_INDEX
))))
2379 ASET (scratch_font_spec
, FONT_FAMILY_INDEX
, Qnil
);
2380 entities
= font_list_entities (frame
, scratch_font_spec
);
2386 if (ASIZE (entities
) > 1)
2388 Lisp_Object prefer
= scratch_font_prefer
, val
;
2391 ASET (prefer
, FONT_WEIGHT_INDEX
,
2392 font_prop_validate_style (FONT_WEIGHT_INDEX
,
2393 lface
[LFACE_WEIGHT_INDEX
]));
2394 ASET (prefer
, FONT_SLANT_INDEX
,
2395 font_prop_validate_style (FONT_SLANT_INDEX
,
2396 lface
[LFACE_SLANT_INDEX
]));
2397 ASET (prefer
, FONT_WIDTH_INDEX
,
2398 font_prop_validate_style (FONT_WIDTH_INDEX
,
2399 lface
[LFACE_SWIDTH_INDEX
]));
2400 pt
= XINT (lface
[LFACE_HEIGHT_INDEX
]);
2401 ASET (prefer
, FONT_SIZE_INDEX
, make_float (pt
/ 10));
2403 font_sort_entites (entities
, prefer
, frame
, spec
);
2406 return AREF (entities
, 0);
2410 font_open_for_lface (f
, lface
, entity
)
2415 double pt
= XINT (lface
[LFACE_HEIGHT_INDEX
]);
2419 size
= POINT_TO_PIXEL (pt
, f
->resy
);
2420 return font_open_entity (f
, entity
, size
);
2424 font_load_for_face (f
, face
)
2428 Lisp_Object font_object
= face
->lface
[LFACE_FONT_INDEX
];
2430 if (NILP (font_object
))
2432 Lisp_Object entity
= font_find_for_lface (f
, face
->lface
, Qnil
);
2434 if (! NILP (entity
))
2435 font_object
= font_open_for_lface (f
, face
->lface
, entity
);
2438 if (! NILP (font_object
))
2440 struct font
*font
= XSAVE_VALUE (font_object
)->pointer
;
2442 face
->font
= font
->font
.font
;
2443 face
->font_info
= (struct font_info
*) font
;
2444 face
->font_info_id
= 0;
2445 face
->font_name
= font
->font
.full_name
;
2450 face
->font_info
= NULL
;
2451 face
->font_info_id
= -1;
2452 face
->font_name
= NULL
;
2453 add_to_log ("Unable to load font for a face%s", null_string
, Qnil
);
2458 font_prepare_for_face (f
, face
)
2462 struct font
*font
= (struct font
*) face
->font_info
;
2464 if (font
->driver
->prepare_face
)
2465 font
->driver
->prepare_face (f
, face
);
2469 font_done_for_face (f
, face
)
2473 struct font
*font
= (struct font
*) face
->font_info
;
2475 if (font
->driver
->done_face
)
2476 font
->driver
->done_face (f
, face
);
2481 font_open_by_name (f
, name
)
2485 Lisp_Object args
[2];
2486 Lisp_Object spec
, prefer
, size
, entities
;
2488 struct font_driver_list
*dlist
;
2492 XSETFRAME (frame
, f
);
2495 args
[1] = make_unibyte_string (name
, strlen (name
));
2496 spec
= Ffont_spec (2, args
);
2497 prefer
= scratch_font_prefer
;
2498 for (i
= FONT_WEIGHT_INDEX
; i
< FONT_SIZE_INDEX
; i
++)
2499 if (NILP (AREF (spec
, i
)))
2500 ASET (prefer
, i
, make_number (100));
2501 size
= AREF (spec
, FONT_SIZE_INDEX
);
2504 else if (INTEGERP (size
))
2505 pixel_size
= XINT (size
);
2506 else /* FLOATP (size) */
2508 double pt
= XFLOAT_DATA (size
);
2510 pixel_size
= POINT_TO_PIXEL (pt
, f
->resy
);
2511 size
= make_number (pixel_size
);
2512 ASET (spec
, FONT_SIZE_INDEX
, size
);
2514 if (pixel_size
== 0)
2516 pixel_size
= POINT_TO_PIXEL (12.0, f
->resy
);
2517 size
= make_number (pixel_size
);
2519 ASET (prefer
, FONT_SIZE_INDEX
, size
);
2520 if (NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
2521 ASET (spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2523 entities
= Flist_fonts (spec
, frame
, make_number (1), prefer
);
2524 return (NILP (entities
)
2526 : font_open_entity (f
, XCAR (entities
), pixel_size
));
2530 /* Register font-driver DRIVER. This function is used in two ways.
2532 The first is with frame F non-NULL. In this case, DRIVER is
2533 registered to be used for drawing characters on F. All frame
2534 creaters (e.g. Fx_create_frame) must call this function at least
2535 once with an available font-driver.
2537 The second is with frame F NULL. In this case, DRIVER is globally
2538 registered in the variable `font_driver_list'. All font-driver
2539 implementations must call this function in its syms_of_XXXX
2540 (e.g. syms_of_xfont). */
2543 register_font_driver (driver
, f
)
2544 struct font_driver
*driver
;
2547 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
2548 struct font_driver_list
*prev
, *list
;
2550 if (f
&& ! driver
->draw
)
2551 error ("Unsable font driver for a frame: %s",
2552 SDATA (SYMBOL_NAME (driver
->type
)));
2554 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
2555 if (list
->driver
->type
== driver
->type
)
2556 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
2558 list
= malloc (sizeof (struct font_driver_list
));
2559 list
->driver
= driver
;
2564 f
->font_driver_list
= list
;
2566 font_driver_list
= list
;
2570 /* Free font-driver list on frame F. It doesn't free font-drivers
2574 free_font_driver_list (f
)
2577 while (f
->font_driver_list
)
2579 struct font_driver_list
*next
= f
->font_driver_list
->next
;
2581 free (f
->font_driver_list
);
2582 f
->font_driver_list
= next
;
2589 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 1, 0,
2590 doc
: /* Return t if object is a font-spec or font-entity. */)
2594 return (FONTP (object
) ? Qt
: Qnil
);
2597 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
2598 doc
: /* Return a newly created font-spec with specified arguments as properties.
2599 usage: (font-spec &rest properties) */)
2604 Lisp_Object spec
= Fmake_vector (make_number (FONT_SPEC_MAX
), Qnil
);
2605 Lisp_Object extra
= Qnil
, name
= Qnil
;
2608 for (i
= 0; i
< nargs
; i
+= 2)
2610 enum font_property_index prop
;
2611 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
2613 prop
= check_font_prop_name (key
);
2614 if (prop
< FONT_EXTRA_INDEX
)
2615 ASET (spec
, prop
, (font_property_table
[prop
].validater
) (prop
, val
));
2618 if (EQ (key
, QCname
))
2621 extra
= Fcons (Fcons (key
, val
), extra
);
2624 ASET (spec
, FONT_EXTRA_INDEX
, extra
);
2626 font_parse_name (SDATA (name
), spec
, 0);
2631 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
2632 doc
: /* Return the value of FONT's PROP property.
2633 FONT may be a font-spec or font-entity.
2634 If FONT is font-entity and PROP is :extra, always nil is returned. */)
2636 Lisp_Object font
, prop
;
2638 enum font_property_index idx
;
2641 idx
= check_font_prop_name (prop
);
2642 if (idx
< FONT_EXTRA_INDEX
)
2643 return AREF (font
, idx
);
2644 if (FONT_ENTITY_P (font
))
2646 return Fcdr (Fassoc (AREF (font
, FONT_EXTRA_INDEX
), prop
));
2650 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
2651 doc
: /* Set one property of FONT-SPEC: give property PROP value VALUE. */)
2652 (font_spec
, prop
, val
)
2653 Lisp_Object font_spec
, prop
, val
;
2655 enum font_property_index idx
;
2656 Lisp_Object extra
, slot
;
2658 CHECK_FONT_SPEC (font_spec
);
2659 idx
= check_font_prop_name (prop
);
2660 if (idx
< FONT_EXTRA_INDEX
)
2661 return ASET (font_spec
, idx
, val
);
2662 extra
= AREF (font_spec
, FONT_EXTRA_INDEX
);
2663 slot
= Fassoc (extra
, prop
);
2665 extra
= Fcons (Fcons (prop
, val
), extra
);
2667 Fsetcdr (slot
, val
);
2671 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
2672 doc
: /* List available fonts matching FONT-SPEC on the current frame.
2673 Optional 2nd argument FRAME specifies the target frame.
2674 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
2675 Optional 4th argument PREFER, if non-nil, is a font-spec to sort fonts
2676 by closeness to PREFER. */)
2677 (font_spec
, frame
, num
, prefer
)
2678 Lisp_Object font_spec
, frame
, num
, prefer
;
2680 Lisp_Object vec
, list
, tail
;
2684 frame
= selected_frame
;
2685 CHECK_LIVE_FRAME (frame
);
2686 CHECK_VALIDATE_FONT_SPEC (font_spec
);
2694 if (! NILP (prefer
))
2695 CHECK_FONT (prefer
);
2697 vec
= font_list_entities (frame
, font_spec
);
2702 return Fcons (AREF (vec
, 0), Qnil
);
2704 if (! NILP (prefer
))
2705 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
);
2707 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
2708 if (n
== 0 || n
> len
)
2710 for (i
= 1; i
< n
; i
++)
2712 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
2714 XSETCDR (tail
, val
);
2720 DEFUN ("list-families", Flist_families
, Slist_families
, 0, 1, 0,
2721 doc
: /* List available font families on the current frame.
2722 Optional 2nd argument FRAME specifies the target frame. */)
2727 struct font_driver_list
*driver_list
;
2731 frame
= selected_frame
;
2732 CHECK_LIVE_FRAME (frame
);
2735 for (driver_list
= f
->font_driver_list
; driver_list
;
2736 driver_list
= driver_list
->next
)
2737 if (driver_list
->driver
->list_family
)
2739 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
2745 Lisp_Object tail
= list
;
2747 for (; CONSP (val
); val
= XCDR (val
))
2748 if (NILP (Fmemq (XCAR (val
), tail
)))
2749 list
= Fcons (XCAR (val
), list
);
2755 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
2756 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
2757 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
2759 Lisp_Object font_spec
, frame
;
2761 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
2768 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 1, 0,
2769 doc
: /* Return XLFD name of FONT.
2770 FONT is a font-spec, font-entity, or font-object.
2771 If the name is too long for XLFD (maximum 255 chars), return nil. */)
2778 if (FONT_SPEC_P (font
))
2779 CHECK_VALIDATE_FONT_SPEC (font
);
2780 else if (FONT_ENTITY_P (font
))
2786 CHECK_FONT_GET_OBJECT (font
, fontp
);
2787 font
= fontp
->entity
;
2788 pixel_size
= fontp
->pixel_size
;
2791 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
2793 return build_string (name
);
2796 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
2797 doc
: /* Clear font cache. */)
2800 Lisp_Object list
, frame
;
2802 FOR_EACH_FRAME (list
, frame
)
2804 FRAME_PTR f
= XFRAME (frame
);
2805 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2807 for (; driver_list
; driver_list
= driver_list
->next
)
2809 Lisp_Object cache
= driver_list
->driver
->get_cache (frame
);
2810 Lisp_Object tail
, elt
;
2812 for (tail
= XCDR (cache
); CONSP (tail
); tail
= XCDR (tail
))
2815 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2817 Lisp_Object vec
= XCDR (elt
);
2820 for (i
= 0; i
< ASIZE (vec
); i
++)
2822 Lisp_Object entity
= AREF (vec
, i
);
2823 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2825 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2827 Lisp_Object val
= XCAR (objlist
);
2828 struct Lisp_Save_Value
*p
= XSAVE_VALUE (val
);
2829 struct font
*font
= p
->pointer
;
2832 && driver_list
->driver
== font
->driver
);
2833 driver_list
->driver
->close (f
, font
);
2837 if (driver_list
->driver
->free_entity
)
2838 driver_list
->driver
->free_entity (entity
);
2842 XSETCDR (cache
, Qnil
);
2849 DEFUN ("internal-set-font-style-table", Finternal_set_font_style_table
,
2850 Sinternal_set_font_style_table
, 2, 2, 0,
2851 doc
: /* Set font style table for PROP to TABLE.
2852 PROP must be `:weight', `:slant', or `:width'.
2853 TABLE must be an alist of symbols vs the corresponding numeric values
2854 sorted by numeric values. */)
2856 Lisp_Object prop
, table
;
2860 Lisp_Object tail
, val
;
2862 CHECK_SYMBOL (prop
);
2863 table_index
= (EQ (prop
, QCweight
) ? 0
2864 : EQ (prop
, QCslant
) ? 1
2865 : EQ (prop
, QCwidth
) ? 2
2867 if (table_index
>= ASIZE (font_style_table
))
2868 error ("Invalid font style property: %s", SDATA (SYMBOL_NAME (prop
)));
2869 table
= Fcopy_sequence (table
);
2871 for (tail
= table
; ! NILP (tail
); tail
= Fcdr (tail
))
2873 prop
= Fcar (Fcar (tail
));
2874 val
= Fcdr (Fcar (tail
));
2875 CHECK_SYMBOL (prop
);
2877 if (numeric
> XINT (val
))
2878 error ("Numeric values not sorted for %s", SDATA (SYMBOL_NAME (prop
)));
2879 numeric
= XINT (val
);
2880 XSETCAR (tail
, Fcons (prop
, val
));
2882 ASET (font_style_table
, table_index
, table
);
2886 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
2887 doc
: /* Return a newly created glyph-string for FONT-OBJECT with NUM glyphs.
2888 FONT-OBJECT may be nil if it is not yet known. */)
2890 Lisp_Object font_object
, num
;
2892 Lisp_Object gstring
, g
;
2896 if (! NILP (font_object
))
2897 CHECK_FONT_OBJECT (font_object
);
2900 len
= XINT (num
) + 1;
2901 gstring
= Fmake_vector (make_number (len
), Qnil
);
2902 g
= Fmake_vector (make_number (6), Qnil
);
2903 ASET (g
, 0, font_object
);
2904 ASET (gstring
, 0, g
);
2905 for (i
= 1; i
< len
; i
++)
2906 ASET (gstring
, i
, Fmake_vector (make_number (8), make_number (0)));
2910 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
2911 doc
: /* Fillin glyph-string GSTRING by characters for FONT-OBJECT.
2912 START and END specifies the region to extract characters.
2913 If optional 3rd argument OBJECT is non-nil, it is a buffer or a string from
2914 where to extract characters.
2915 FONT-OBJECT may be nil if GSTRING already already contains one. */)
2916 (gstring
, font_object
, start
, end
, object
)
2917 Lisp_Object gstring
, font_object
, start
, end
, object
;
2923 CHECK_VECTOR (gstring
);
2924 if (NILP (font_object
))
2925 font_object
= Faref (Faref (gstring
, make_number (0)), make_number (0));
2926 CHECK_FONT_GET_OBJECT (font_object
, font
);
2928 if (STRINGP (object
))
2930 const unsigned char *p
;
2932 CHECK_NATNUM (start
);
2934 if (XINT (start
) > XINT (end
)
2935 || XINT (end
) > ASIZE (object
)
2936 || XINT (end
) - XINT (start
) >= XINT (Flength (gstring
)))
2937 args_out_of_range (start
, end
);
2939 len
= XINT (end
) - XINT (start
);
2940 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
2941 for (i
= 0; i
< len
; i
++)
2943 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
2945 c
= STRING_CHAR_ADVANCE (p
);
2946 code
= font
->driver
->encode_char (font
, c
);
2947 if (code
> MOST_POSITIVE_FIXNUM
)
2948 error ("Glyph code 0x%X is too large", code
);
2949 ASET (g
, 0, make_number (i
));
2950 ASET (g
, 1, make_number (i
+ 1));
2951 LGLYPH_SET_CHAR (g
, make_number (c
));
2952 LGLYPH_SET_CODE (g
, make_number (code
));
2959 if (! NILP (object
))
2960 Fset_buffer (object
);
2961 validate_region (&start
, &end
);
2962 if (XINT (end
) - XINT (start
) > len
)
2963 args_out_of_range (start
, end
);
2964 len
= XINT (end
) - XINT (start
);
2966 pos_byte
= CHAR_TO_BYTE (pos
);
2967 for (i
= 0; i
< len
; i
++)
2969 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
2971 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
2972 code
= font
->driver
->encode_char (font
, c
);
2973 if (code
> MOST_POSITIVE_FIXNUM
)
2974 error ("Glyph code 0x%X is too large", code
);
2975 ASET (g
, 0, make_number (i
));
2976 ASET (g
, 1, make_number (i
+ 1));
2977 LGLYPH_SET_CHAR (g
, make_number (c
));
2978 LGLYPH_SET_CODE (g
, make_number (code
));
2987 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
2988 doc
: /* Open FONT-ENTITY. */)
2989 (font_entity
, size
, frame
)
2990 Lisp_Object font_entity
;
2996 CHECK_FONT_ENTITY (font_entity
);
2998 size
= AREF (font_entity
, FONT_SIZE_INDEX
);
2999 CHECK_NUMBER (size
);
3001 frame
= selected_frame
;
3002 CHECK_LIVE_FRAME (frame
);
3004 isize
= XINT (size
);
3006 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
3008 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
3011 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
3012 doc
: /* Close FONT-OBJECT. */)
3013 (font_object
, frame
)
3014 Lisp_Object font_object
, frame
;
3016 CHECK_FONT_OBJECT (font_object
);
3018 frame
= selected_frame
;
3019 CHECK_LIVE_FRAME (frame
);
3020 font_close_object (XFRAME (frame
), font_object
);
3024 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
3025 doc
: /* Return information about FONT-OBJECT. */)
3027 Lisp_Object font_object
;
3032 CHECK_FONT_GET_OBJECT (font_object
, font
);
3034 val
= Fmake_vector (make_number (9), Qnil
);
3035 ASET (val
, 0, Ffont_xlfd_name (font_object
));
3036 if (font
->file_name
)
3037 ASET (val
, 1, make_unibyte_string (font
->file_name
,
3038 strlen (font
->file_name
)));
3039 ASET (val
, 2, make_number (font
->pixel_size
));
3040 ASET (val
, 3, make_number (font
->font
.size
));
3041 ASET (val
, 4, make_number (font
->ascent
));
3042 ASET (val
, 5, make_number (font
->descent
));
3043 ASET (val
, 6, make_number (font
->font
.space_width
));
3044 ASET (val
, 7, make_number (font
->font
.average_width
));
3045 if (font
->driver
->otf_capability
)
3046 ASET (val
, 8, font
->driver
->otf_capability (font
));
3050 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
3051 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
3052 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
3053 (font_object
, string
)
3054 Lisp_Object font_object
, string
;
3060 CHECK_FONT_GET_OBJECT (font_object
, font
);
3061 CHECK_STRING (string
);
3062 len
= SCHARS (string
);
3063 vec
= Fmake_vector (make_number (len
), Qnil
);
3064 for (i
= 0; i
< len
; i
++)
3066 Lisp_Object ch
= Faref (string
, make_number (i
));
3070 struct font_metrics metrics
;
3072 code
= font
->driver
->encode_char (font
, c
);
3073 if (code
== FONT_INVALID_CODE
)
3075 val
= Fmake_vector (make_number (6), Qnil
);
3076 if (code
<= MOST_POSITIVE_FIXNUM
)
3077 ASET (val
, 0, make_number (code
));
3079 ASET (val
, 0, Fcons (make_number (code
>> 16),
3080 make_number (code
& 0xFFFF)));
3081 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
3082 ASET (val
, 1, make_number (metrics
.lbearing
));
3083 ASET (val
, 2, make_number (metrics
.rbearing
));
3084 ASET (val
, 3, make_number (metrics
.width
));
3085 ASET (val
, 4, make_number (metrics
.ascent
));
3086 ASET (val
, 5, make_number (metrics
.descent
));
3093 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
3094 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
3095 The value is a number of glyphs drawn.
3096 Type C-l to recover what previously shown. */)
3097 (font_object
, string
)
3098 Lisp_Object font_object
, string
;
3100 Lisp_Object frame
= selected_frame
;
3101 FRAME_PTR f
= XFRAME (frame
);
3107 CHECK_FONT_GET_OBJECT (font_object
, font
);
3108 CHECK_STRING (string
);
3109 len
= SCHARS (string
);
3110 code
= alloca (sizeof (unsigned) * len
);
3111 for (i
= 0; i
< len
; i
++)
3113 Lisp_Object ch
= Faref (string
, make_number (i
));
3117 code
[i
] = font
->driver
->encode_char (font
, c
);
3118 if (code
[i
] == FONT_INVALID_CODE
)
3121 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3123 if (font
->driver
->prepare_face
)
3124 font
->driver
->prepare_face (f
, face
);
3125 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
3126 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
3127 if (font
->driver
->done_face
)
3128 font
->driver
->done_face (f
, face
);
3130 return make_number (len
);
3134 #endif /* FONT_DEBUG */
3137 extern void syms_of_ftfont
P_ (());
3138 extern void syms_of_xfont
P_ (());
3139 extern void syms_of_xftfont
P_ (());
3140 extern void syms_of_ftxfont
P_ (());
3141 extern void syms_of_bdffont
P_ (());
3142 extern void syms_of_w32font
P_ (());
3143 extern void syms_of_atmfont
P_ (());
3148 sort_shift_bits
[FONT_SLANT_INDEX
] = 0;
3149 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 7;
3150 sort_shift_bits
[FONT_SIZE_INDEX
] = 14;
3151 sort_shift_bits
[FONT_WIDTH_INDEX
] = 21;
3152 sort_shift_bits
[FONT_ADSTYLE_INDEX
] = 28;
3153 sort_shift_bits
[FONT_FOUNDRY_INDEX
] = 29;
3154 sort_shift_bits
[FONT_FAMILY_INDEX
] = 30;
3155 sort_shift_bits
[FONT_REGISTRY_INDEX
] = 31;
3156 /* Note that sort_shift_bits[FONT_SLANT_TYPE] is never used. */
3158 staticpro (&font_style_table
);
3159 font_style_table
= Fmake_vector (make_number (3), Qnil
);
3161 staticpro (&font_family_alist
);
3162 font_family_alist
= Qnil
;
3164 DEFSYM (Qfontp
, "fontp");
3166 DEFSYM (Qiso8859_1
, "iso8859-1");
3167 DEFSYM (Qiso10646_1
, "iso10646-1");
3168 DEFSYM (Qunicode_bmp
, "unicode-bmp");
3170 DEFSYM (QCotf
, ":otf");
3171 DEFSYM (QClanguage
, ":language");
3172 DEFSYM (QCscript
, ":script");
3174 DEFSYM (QCfoundry
, ":foundry");
3175 DEFSYM (QCadstyle
, ":adstyle");
3176 DEFSYM (QCregistry
, ":registry");
3177 DEFSYM (QCspacing
, ":spacing");
3178 DEFSYM (QCdpi
, ":dpi");
3179 DEFSYM (QCextra
, ":extra");
3181 staticpro (&null_string
);
3182 null_string
= build_string ("");
3183 staticpro (&null_vector
);
3184 null_vector
= Fmake_vector (make_number (0), Qnil
);
3186 staticpro (&scratch_font_spec
);
3187 scratch_font_spec
= Ffont_spec (0, NULL
);
3188 staticpro (&scratch_font_prefer
);
3189 scratch_font_prefer
= Ffont_spec (0, NULL
);
3192 defsubr (&Sfont_spec
);
3193 defsubr (&Sfont_get
);
3194 defsubr (&Sfont_put
);
3195 defsubr (&Slist_fonts
);
3196 defsubr (&Slist_families
);
3197 defsubr (&Sfind_font
);
3198 defsubr (&Sfont_xlfd_name
);
3199 defsubr (&Sclear_font_cache
);
3200 defsubr (&Sinternal_set_font_style_table
);
3201 defsubr (&Sfont_make_gstring
);
3202 defsubr (&Sfont_fill_gstring
);
3205 defsubr (&Sopen_font
);
3206 defsubr (&Sclose_font
);
3207 defsubr (&Squery_font
);
3208 defsubr (&Sget_font_glyphs
);
3210 defsubr (&Sdraw_string
);
3212 #endif /* FONT_DEBUG */
3214 #ifdef HAVE_FREETYPE
3216 #ifdef HAVE_X_WINDOWS
3221 #endif /* HAVE_XFT */
3222 #endif /* HAVE_X_WINDOWS */
3223 #else /* not HAVE_FREETYPE */
3224 #ifdef HAVE_X_WINDOWS
3226 #endif /* HAVE_X_WINDOWS */
3227 #endif /* not HAVE_FREETYPE */
3230 #endif /* HAVE_BDFFONT */
3233 #endif /* WINDOWSNT */
3239 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
3240 (do not change this comment) */