1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
3 Copyright (C) 2006, 2007, 2008
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 3 of the License, or
12 (at your option) any later version.
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. If not, see <http://www.gnu.org/licenses/>. */
35 #include "dispextern.h"
37 #include "character.h"
38 #include "composite.h"
44 #endif /* HAVE_X_WINDOWS */
48 #endif /* HAVE_NTGUI */
60 #define xassert(X) do {if (!(X)) abort ();} while (0)
62 #define xassert(X) (void) 0
65 Lisp_Object Qfont_spec
, Qfont_entity
, Qfont_object
;
67 Lisp_Object Qopentype
;
69 /* Important character set strings. */
70 Lisp_Object Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
72 /* Special vector of zero length. This is repeatedly used by (struct
73 font_driver *)->list when a specified font is not found. */
74 static Lisp_Object null_vector
;
76 /* Vector of 3 elements. Each element is a vector for one of font
77 style properties (weight, slant, width). The vector contains a
78 mapping between symbolic property values (e.g. `medium' for weight)
79 and numeric property values (e.g. 100). So, it looks like this:
80 [[(ultra-light . 20) ... (black . 210)]
81 [(reverse-oblique . 0) ... (oblique . 210)]
82 [(ultra-contains . 50) ... (wide . 200)]] */
83 static Lisp_Object font_style_table
;
85 extern Lisp_Object Qnormal
;
87 /* Symbols representing keys of normal font properties. */
88 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
, QCsize
, QCname
;
89 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
;
90 /* Symbols representing keys of font extra info. */
91 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
92 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
93 /* Symbols representing values of font spacing property. */
94 Lisp_Object Qc
, Qm
, Qp
, Qd
;
96 /* Alist of font registry symbol and the corresponding charsets
97 information. The information is retrieved from
98 Vfont_encoding_alist on demand.
100 Eash element has the form:
101 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
105 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
106 encodes a character code to a glyph code of a font, and
107 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
108 character is supported by a font.
110 The latter form means that the information for REGISTRY couldn't be
112 static Lisp_Object font_charset_alist
;
114 /* List of all font drivers. Each font-backend (XXXfont.c) calls
115 register_font_driver in syms_of_XXXfont to register its font-driver
117 static struct font_driver_list
*font_driver_list
;
121 /* Creaters of font-related Lisp object. */
126 Lisp_Object font_spec
;
127 struct font_spec
*spec
128 = ((struct font_spec
*)
129 allocate_pseudovector (VECSIZE (struct font_spec
),
130 FONT_SPEC_MAX
, PVEC_FONT
));
131 XSETFONT (font_spec
, spec
);
138 Lisp_Object font_entity
;
139 struct font_entity
*entity
140 = ((struct font_entity
*)
141 allocate_pseudovector (VECSIZE (struct font_entity
),
142 FONT_ENTITY_MAX
, PVEC_FONT
));
143 XSETFONT (font_entity
, entity
);
148 font_make_object (size
)
151 Lisp_Object font_object
;
153 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
154 XSETFONT (font_object
, font
);
161 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
162 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
163 static Lisp_Object font_matching_entity
P_ ((FRAME_PTR
, Lisp_Object
*,
166 /* Number of registered font drivers. */
167 static int num_font_drivers
;
170 /* Return a Lispy value of a font property value at STR and LEN bytes.
171 If STR is "*", it returns nil.
172 If all characters in STR are digits, it returns an integer.
173 Otherwise, it returns a symbol interned from STR. */
176 font_intern_prop (str
, len
)
181 Lisp_Object tem
, string
;
184 if (len
== 1 && *str
== '*')
186 if (len
>=1 && isdigit (*str
))
188 for (i
= 1; i
< len
; i
++)
189 if (! isdigit (str
[i
]))
192 return make_number (atoi (str
));
195 /* The following code is copied from the function intern (in lread.c). */
197 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
198 obarray
= check_obarray (obarray
);
199 tem
= oblookup (obarray
, str
, len
, len
);
202 return Fintern (make_unibyte_string (str
, len
), obarray
);
205 /* Return a pixel size of font-spec SPEC on frame F. */
208 font_pixel_size (f
, spec
)
212 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
215 Lisp_Object extra
, val
;
220 return 0; xassert (FLOATP (size
));
221 point_size
= XFLOAT_DATA (size
);
222 val
= AREF (spec
, FONT_DPI_INDEX
);
224 dpi
= XINT (XCDR (val
));
227 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
232 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
233 font vector. If VAL is not valid (i.e. not registered in
234 font_style_table), return -1 if NOERROR is zero, and return a
235 proper index if NOERROR is nonzero. In that case, register VAL in
236 font_style_table if VAL is a symbol, and return a closest index if
237 VAL is an integer. */
240 font_style_to_value (prop
, val
, noerror
)
241 enum font_property_index prop
;
245 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
246 int len
= ASIZE (table
);
252 Lisp_Object args
[2], elt
;
254 /* At first try exact match. */
255 for (i
= 0; i
< len
; i
++)
256 if (EQ (val
, XCAR (AREF (table
, i
))))
257 return (XINT (XCDR (AREF (table
, i
))) << 8) | i
;
258 /* Try also with case-folding match. */
259 s
= SDATA (SYMBOL_NAME (val
));
260 for (i
= 0; i
< len
; i
++)
262 elt
= XCAR (AREF (table
, i
));
263 if (strcasecmp (s
, (char *) SDATA (SYMBOL_NAME (elt
))) == 0)
271 args
[1] = Fmake_vector (make_number (1), Fcons (val
, make_number (255)));
272 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
273 return (255 << 8) | i
;
277 int last_i
, i
, last_n
;
278 int numeric
= XINT (val
);
280 for (i
= 1, last_i
= last_n
= -1; i
< len
;)
282 int n
= XINT (XCDR (AREF (table
, i
)));
290 return ((last_i
< 0 || n
- numeric
< numeric
- last_n
)
291 ? (n
<< 8) | i
: (last_n
<< 8 | last_i
));
295 for (i
++; i
< len
&& n
== XINT (XCDR (AREF (table
, i
+ 1))); i
++);
299 return (last_n
<< 8) | last_i
;
304 font_style_symbolic (font
, prop
, for_face
)
306 enum font_property_index prop
;
309 Lisp_Object val
= AREF (font
, prop
);
315 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
317 return XCAR (AREF (table
, XINT (val
) & 0xFF));
318 numeric
= XINT (val
) >> 8;
319 for (i
= 0; i
< ASIZE (table
); i
++)
320 if (XINT (XCDR (AREF (table
, i
))) == numeric
)
321 return XCAR (AREF (table
, i
));
326 extern Lisp_Object Vface_alternative_font_family_alist
;
328 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
331 /* Return encoding charset and repertory charset for REGISTRY in
332 ENCODING and REPERTORY correspondingly. If correct information for
333 REGISTRY is available, return 0. Otherwise return -1. */
336 font_registry_charsets (registry
, encoding
, repertory
)
337 Lisp_Object registry
;
338 struct charset
**encoding
, **repertory
;
341 int encoding_id
, repertory_id
;
343 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
349 encoding_id
= XINT (XCAR (val
));
350 repertory_id
= XINT (XCDR (val
));
354 val
= find_font_encoding (SYMBOL_NAME (registry
));
355 if (SYMBOLP (val
) && CHARSETP (val
))
357 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
359 else if (CONSP (val
))
361 if (! CHARSETP (XCAR (val
)))
363 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
364 if (NILP (XCDR (val
)))
368 if (! CHARSETP (XCDR (val
)))
370 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
375 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
377 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
381 *encoding
= CHARSET_FROM_ID (encoding_id
);
383 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
388 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
393 /* Font property value validaters. See the comment of
394 font_property_table for the meaning of the arguments. */
396 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
397 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
398 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
399 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
400 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
401 static int get_font_prop_index
P_ ((Lisp_Object
));
404 font_prop_validate_symbol (prop
, val
)
405 Lisp_Object prop
, val
;
408 val
= Fintern (val
, Qnil
);
411 else if (EQ (prop
, QCregistry
))
412 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
418 font_prop_validate_style (style
, val
)
419 Lisp_Object style
, val
;
421 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
422 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
429 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
433 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), n
& 0xFF);
434 if (XINT (XCDR (elt
)) != (n
>> 8))
438 else if (SYMBOLP (val
))
440 int n
= font_style_to_value (prop
, val
, 0);
442 val
= n
>= 0 ? make_number (n
) : Qerror
;
450 font_prop_validate_non_neg (prop
, val
)
451 Lisp_Object prop
, val
;
453 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
458 font_prop_validate_spacing (prop
, val
)
459 Lisp_Object prop
, val
;
461 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
464 return make_number (FONT_SPACING_CHARCELL
);
466 return make_number (FONT_SPACING_MONO
);
468 return make_number (FONT_SPACING_PROPORTIONAL
);
470 return make_number (FONT_SPACING_DUAL
);
475 font_prop_validate_otf (prop
, val
)
476 Lisp_Object prop
, val
;
478 Lisp_Object tail
, tmp
;
481 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
482 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
483 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
486 if (! SYMBOLP (XCAR (val
)))
491 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
493 for (i
= 0; i
< 2; i
++)
500 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
501 if (! SYMBOLP (XCAR (tmp
)))
509 /* Structure of known font property keys and validater of the
513 /* Pointer to the key symbol. */
515 /* Function to validate PROP's value VAL, or NULL if any value is
516 ok. The value is VAL or its regularized value if VAL is valid,
517 and Qerror if not. */
518 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
519 } font_property_table
[] =
520 { { &QCtype
, font_prop_validate_symbol
},
521 { &QCfoundry
, font_prop_validate_symbol
},
522 { &QCfamily
, font_prop_validate_symbol
},
523 { &QCadstyle
, font_prop_validate_symbol
},
524 { &QCregistry
, font_prop_validate_symbol
},
525 { &QCweight
, font_prop_validate_style
},
526 { &QCslant
, font_prop_validate_style
},
527 { &QCwidth
, font_prop_validate_style
},
528 { &QCsize
, font_prop_validate_non_neg
},
529 { &QCdpi
, font_prop_validate_non_neg
},
530 { &QCspacing
, font_prop_validate_spacing
},
531 { &QCavgwidth
, font_prop_validate_non_neg
},
532 /* The order of the above entries must match with enum
533 font_property_index. */
534 { &QClang
, font_prop_validate_symbol
},
535 { &QCscript
, font_prop_validate_symbol
},
536 { &QCotf
, font_prop_validate_otf
}
539 /* Size (number of elements) of the above table. */
540 #define FONT_PROPERTY_TABLE_SIZE \
541 ((sizeof font_property_table) / (sizeof *font_property_table))
543 /* Return an index number of font property KEY or -1 if KEY is not an
544 already known property. */
547 get_font_prop_index (key
)
552 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
553 if (EQ (key
, *font_property_table
[i
].key
))
558 /* Validate the font property. The property key is specified by the
559 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
560 signal an error. The value is VAL or the regularized one. */
563 font_prop_validate (idx
, prop
, val
)
565 Lisp_Object prop
, val
;
567 Lisp_Object validated
;
572 prop
= *font_property_table
[idx
].key
;
575 idx
= get_font_prop_index (prop
);
579 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
580 if (EQ (validated
, Qerror
))
581 signal_error ("invalid font property", Fcons (prop
, val
));
586 /* Store VAL as a value of extra font property PROP in FONT while
587 keeping the sorting order. Don't check the validity of VAL. */
590 font_put_extra (font
, prop
, val
)
591 Lisp_Object font
, prop
, val
;
593 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
594 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
598 Lisp_Object prev
= Qnil
;
601 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
602 prev
= extra
, extra
= XCDR (extra
);
604 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
606 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
614 /* Font name parser and unparser */
616 static int parse_matrix
P_ ((char *));
617 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
618 static int font_parse_name
P_ ((char *, Lisp_Object
));
620 /* An enumerator for each field of an XLFD font name. */
621 enum xlfd_field_index
640 /* An enumerator for mask bit corresponding to each XLFD field. */
643 XLFD_FOUNDRY_MASK
= 0x0001,
644 XLFD_FAMILY_MASK
= 0x0002,
645 XLFD_WEIGHT_MASK
= 0x0004,
646 XLFD_SLANT_MASK
= 0x0008,
647 XLFD_SWIDTH_MASK
= 0x0010,
648 XLFD_ADSTYLE_MASK
= 0x0020,
649 XLFD_PIXEL_MASK
= 0x0040,
650 XLFD_POINT_MASK
= 0x0080,
651 XLFD_RESX_MASK
= 0x0100,
652 XLFD_RESY_MASK
= 0x0200,
653 XLFD_SPACING_MASK
= 0x0400,
654 XLFD_AVGWIDTH_MASK
= 0x0800,
655 XLFD_REGISTRY_MASK
= 0x1000,
656 XLFD_ENCODING_MASK
= 0x2000
660 /* Parse P pointing the pixel/point size field of the form
661 `[A B C D]' which specifies a transformation matrix:
667 by which all glyphs of the font are transformed. The spec says
668 that scalar value N for the pixel/point size is equivalent to:
669 A = N * resx/resy, B = C = 0, D = N.
671 Return the scalar value N if the form is valid. Otherwise return
682 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
685 matrix
[i
] = - strtod (p
+ 1, &end
);
687 matrix
[i
] = strtod (p
, &end
);
690 return (i
== 4 ? (int) matrix
[3] : -1);
693 /* Expand a wildcard field in FIELD (the first N fields are filled) to
694 multiple fields to fill in all 14 XLFD fields while restring a
695 field position by its contents. */
698 font_expand_wildcards (field
, n
)
699 Lisp_Object field
[XLFD_LAST_INDEX
];
703 Lisp_Object tmp
[XLFD_LAST_INDEX
];
704 /* Array of information about where this element can go. Nth
705 element is for Nth element of FIELD. */
707 /* Minimum possible field. */
709 /* Maxinum possible field. */
711 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
713 } range
[XLFD_LAST_INDEX
];
715 int range_from
, range_to
;
718 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
719 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
720 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
721 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
722 | XLFD_AVGWIDTH_MASK)
723 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
725 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
726 field. The value is shifted to left one bit by one in the
728 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
729 range_mask
= (range_mask
<< 1) | 1;
731 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
732 position-based retriction for FIELD[I]. */
733 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
734 i
++, range_from
++, range_to
++, range_mask
<<= 1)
736 Lisp_Object val
= field
[i
];
742 range
[i
].from
= range_from
;
743 range
[i
].to
= range_to
;
744 range
[i
].mask
= range_mask
;
748 /* The triplet FROM, TO, and MASK is a value-based
749 retriction for FIELD[I]. */
755 int numeric
= XINT (val
);
758 from
= to
= XLFD_ENCODING_INDEX
,
759 mask
= XLFD_ENCODING_MASK
;
760 else if (numeric
== 0)
761 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
762 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
763 else if (numeric
<= 48)
764 from
= to
= XLFD_PIXEL_INDEX
,
765 mask
= XLFD_PIXEL_MASK
;
767 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
768 mask
= XLFD_LARGENUM_MASK
;
770 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
771 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
772 mask
= XLFD_NULL_MASK
;
774 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
777 Lisp_Object name
= SYMBOL_NAME (val
);
779 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
780 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
781 mask
= XLFD_REGENC_MASK
;
783 from
= to
= XLFD_ENCODING_INDEX
,
784 mask
= XLFD_ENCODING_MASK
;
786 else if (range_from
<= XLFD_WEIGHT_INDEX
787 && range_to
>= XLFD_WEIGHT_INDEX
788 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
789 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
790 else if (range_from
<= XLFD_SLANT_INDEX
791 && range_to
>= XLFD_SLANT_INDEX
792 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
793 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
794 else if (range_from
<= XLFD_SWIDTH_INDEX
795 && range_to
>= XLFD_SWIDTH_INDEX
796 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
797 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
800 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
801 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
803 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
804 mask
= XLFD_SYMBOL_MASK
;
807 /* Merge position-based and value-based restrictions. */
809 while (from
< range_from
)
810 mask
&= ~(1 << from
++);
811 while (from
< 14 && ! (mask
& (1 << from
)))
813 while (to
> range_to
)
814 mask
&= ~(1 << to
--);
815 while (to
>= 0 && ! (mask
& (1 << to
)))
819 range
[i
].from
= from
;
821 range
[i
].mask
= mask
;
823 if (from
> range_from
|| to
< range_to
)
825 /* The range is narrowed by value-based restrictions.
826 Reflect it to the other fields. */
828 /* Following fields should be after FROM. */
830 /* Preceding fields should be before TO. */
831 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
833 /* Check FROM for non-wildcard field. */
834 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
836 while (range
[j
].from
< from
)
837 range
[j
].mask
&= ~(1 << range
[j
].from
++);
838 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
840 range
[j
].from
= from
;
843 from
= range
[j
].from
;
844 if (range
[j
].to
> to
)
846 while (range
[j
].to
> to
)
847 range
[j
].mask
&= ~(1 << range
[j
].to
--);
848 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
861 /* Decide all fileds from restrictions in RANGE. */
862 for (i
= j
= 0; i
< n
; i
++)
864 if (j
< range
[i
].from
)
866 if (i
== 0 || ! NILP (tmp
[i
- 1]))
867 /* None of TMP[X] corresponds to Jth field. */
869 for (; j
< range
[i
].from
; j
++)
874 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
876 for (; j
< XLFD_LAST_INDEX
; j
++)
878 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
879 field
[XLFD_ENCODING_INDEX
]
880 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
885 #ifdef ENABLE_CHECKING
886 /* Match a 14-field XLFD pattern against a full XLFD font name. */
888 font_match_xlfd (char *pattern
, char *name
)
890 while (*pattern
&& *name
)
892 if (*pattern
== *name
)
894 else if (*pattern
== '*')
895 if (*name
== pattern
[1])
906 /* Make sure the font object matches the XLFD font name. */
908 font_check_xlfd_parse (Lisp_Object font
, char *name
)
910 char name_check
[256];
911 font_unparse_xlfd (font
, 0, name_check
, 255);
912 return font_match_xlfd (name_check
, name
);
918 /* Parse NAME (null terminated) as XLFD and store information in FONT
919 (font-spec or font-entity). Size property of FONT is set as
921 specified XLFD fields FONT property
922 --------------------- -------------
923 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
924 POINT_SIZE and RESY calculated pixel size (Lisp integer)
925 POINT_SIZE POINT_SIZE/10 (Lisp float)
927 If NAME is successfully parsed, return 0. Otherwise return -1.
929 FONT is usually a font-spec, but when this function is called from
930 X font backend driver, it is a font-entity. In that case, NAME is
931 a fully specified XLFD. */
934 font_parse_xlfd (name
, font
)
938 int len
= strlen (name
);
940 char *f
[XLFD_LAST_INDEX
+ 1];
945 /* Maximum XLFD name length is 255. */
947 /* Accept "*-.." as a fully specified XLFD. */
948 if (name
[0] == '*' && name
[1] == '-')
949 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
952 for (p
= name
+ i
; *p
; p
++)
956 if (i
== XLFD_LAST_INDEX
)
961 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N])
963 if (i
== XLFD_LAST_INDEX
)
965 /* Fully specified XLFD. */
969 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD (XLFD_FOUNDRY_INDEX
));
970 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD (XLFD_FAMILY_INDEX
));
971 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
972 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
974 val
= INTERN_FIELD (i
);
977 if ((n
= font_style_to_value (j
, INTERN_FIELD (i
), 0)) < 0)
979 ASET (font
, j
, make_number (n
));
982 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD (XLFD_ADSTYLE_INDEX
));
983 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
984 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
986 ASET (font
, FONT_REGISTRY_INDEX
,
987 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
988 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
]));
989 p
= f
[XLFD_PIXEL_INDEX
];
990 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
991 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
994 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
996 ASET (font
, FONT_SIZE_INDEX
, val
);
999 double point_size
= -1;
1001 xassert (FONT_SPEC_P (font
));
1002 p
= f
[XLFD_POINT_INDEX
];
1004 point_size
= parse_matrix (p
);
1005 else if (isdigit (*p
))
1006 point_size
= atoi (p
), point_size
/= 10;
1007 if (point_size
>= 0)
1008 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1012 ASET (font
, FONT_DPI_INDEX
, INTERN_FIELD (XLFD_RESY_INDEX
));
1013 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1016 val
= font_prop_validate_spacing (QCspacing
, val
);
1017 if (! INTEGERP (val
))
1019 ASET (font
, FONT_SPACING_INDEX
, val
);
1021 p
= f
[XLFD_AVGWIDTH_INDEX
];
1024 ASET (font
, FONT_AVGWIDTH_INDEX
,
1025 font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
));
1029 int wild_card_found
= 0;
1030 Lisp_Object prop
[XLFD_LAST_INDEX
];
1032 if (FONT_ENTITY_P (font
))
1034 for (j
= 0; j
< i
; j
++)
1038 if (f
[j
][1] && f
[j
][1] != '-')
1041 wild_card_found
= 1;
1044 prop
[j
] = INTERN_FIELD (j
);
1046 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
]);
1048 if (! wild_card_found
)
1050 if (font_expand_wildcards (prop
, i
) < 0)
1053 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1054 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1055 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1056 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1057 if (! NILP (prop
[i
]))
1059 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1061 ASET (font
, j
, make_number (n
));
1063 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1064 val
= prop
[XLFD_REGISTRY_INDEX
];
1067 val
= prop
[XLFD_ENCODING_INDEX
];
1069 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1071 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1072 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1074 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1075 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1077 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1079 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1080 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1081 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1083 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1085 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1088 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1089 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1090 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1092 val
= font_prop_validate_spacing (QCspacing
,
1093 prop
[XLFD_SPACING_INDEX
]);
1094 if (! INTEGERP (val
))
1096 ASET (font
, FONT_SPACING_INDEX
, val
);
1098 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1099 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1105 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1106 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1107 0, use PIXEL_SIZE instead. */
1110 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1116 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1120 xassert (FONTP (font
));
1122 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1125 if (i
== FONT_ADSTYLE_INDEX
)
1126 j
= XLFD_ADSTYLE_INDEX
;
1127 else if (i
== FONT_REGISTRY_INDEX
)
1128 j
= XLFD_REGISTRY_INDEX
;
1129 val
= AREF (font
, i
);
1132 if (j
== XLFD_REGISTRY_INDEX
)
1133 f
[j
] = "*-*", len
+= 4;
1135 f
[j
] = "*", len
+= 2;
1140 val
= SYMBOL_NAME (val
);
1141 if (j
== XLFD_REGISTRY_INDEX
1142 && ! strchr ((char *) SDATA (val
), '-'))
1144 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1145 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1147 f
[j
] = alloca (SBYTES (val
) + 3);
1148 sprintf (f
[j
], "%s-*", SDATA (val
));
1149 len
+= SBYTES (val
) + 3;
1153 f
[j
] = alloca (SBYTES (val
) + 4);
1154 sprintf (f
[j
], "%s*-*", SDATA (val
));
1155 len
+= SBYTES (val
) + 4;
1159 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1163 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1166 val
= font_style_symbolic (font
, i
, 0);
1168 f
[j
] = "*", len
+= 2;
1171 val
= SYMBOL_NAME (val
);
1172 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1176 val
= AREF (font
, FONT_SIZE_INDEX
);
1177 xassert (NUMBERP (val
) || NILP (val
));
1185 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1186 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1189 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1191 else if (FLOATP (val
))
1193 i
= XFLOAT_DATA (val
) * 10;
1194 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1195 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1198 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1200 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1202 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1203 f
[XLFD_RESX_INDEX
] = alloca (22);
1204 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1208 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1209 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1211 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1213 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1214 : spacing
<= FONT_SPACING_DUAL
? "d"
1215 : spacing
<= FONT_SPACING_MONO
? "m"
1220 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1221 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1223 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1224 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
],
1225 "%d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1228 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1229 len
++; /* for terminating '\0'. */
1232 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1233 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1234 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1235 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1236 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1237 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1238 f
[XLFD_REGISTRY_INDEX
]);
1241 /* Parse NAME (null terminated) as Fonconfig's name format and store
1242 information in FONT (font-spec or font-entity). If NAME is
1243 successfully parsed, return 0. Otherwise return -1. */
1246 font_parse_fcname (name
, font
)
1251 int len
= strlen (name
);
1256 /* It is assured that (name[0] && name[0] != '-'). */
1264 for (p0
= name
+ 1; *p0
&& (*p0
!= '-' && *p0
!= ':'); p0
++)
1265 if (*p0
== '\\' && p0
[1])
1267 family
= font_intern_prop (name
, p0
- name
);
1270 if (! isdigit (p0
[1]))
1272 point_size
= strtod (p0
+ 1, &p1
);
1273 if (*p1
&& *p1
!= ':')
1275 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1278 ASET (font
, FONT_FAMILY_INDEX
, family
);
1282 copy
= alloca (len
+ 1);
1287 /* Now parse ":KEY=VAL" patterns. Store known keys and values in
1288 extra, copy unknown ones to COPY. It is stored in extra slot by
1289 the key QCfc_unknown_spec. */
1292 Lisp_Object key
, val
;
1295 for (p1
= p0
+ 1; *p1
&& *p1
!= '=' && *p1
!= ':'; p1
++);
1298 /* Must be an enumerated value. */
1299 val
= font_intern_prop (p0
+ 1, p1
- p0
- 1);
1300 if (memcmp (p0
+ 1, "light", 5) == 0
1301 || memcmp (p0
+ 1, "medium", 6) == 0
1302 || memcmp (p0
+ 1, "demibold", 8) == 0
1303 || memcmp (p0
+ 1, "bold", 4) == 0
1304 || memcmp (p0
+ 1, "black", 5) == 0)
1305 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1306 else if (memcmp (p0
+ 1, "roman", 5) == 0
1307 || memcmp (p0
+ 1, "italic", 6) == 0
1308 || memcmp (p0
+ 1, "oblique", 7) == 0)
1309 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1310 else if (memcmp (p0
+ 1, "charcell", 8) == 0
1311 || memcmp (p0
+ 1, "mono", 4) == 0
1312 || memcmp (p0
+ 1, "proportional", 12) == 0)
1314 int spacing
= (p0
[1] == 'c' ? FONT_SPACING_CHARCELL
1315 : p0
[1] == 'm' ? FONT_SPACING_MONO
1316 : FONT_SPACING_PROPORTIONAL
);
1317 ASET (font
, FONT_SPACING_INDEX
, make_number (spacing
));
1322 bcopy (p0
, copy
, p1
- p0
);
1328 if (memcmp (p0
+ 1, "pixelsize=", 10) == 0)
1329 prop
= FONT_SIZE_INDEX
;
1332 key
= font_intern_prop (p0
, p1
- p0
);
1333 prop
= get_font_prop_index (key
);
1336 for (p1
= p0
; *p1
&& *p1
!= ':'; p1
++);
1337 val
= font_intern_prop (p0
, p1
- p0
);
1340 if (prop
>= FONT_FOUNDRY_INDEX
&& prop
< FONT_EXTRA_INDEX
)
1341 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1343 Ffont_put (font
, key
, val
);
1345 bcopy (p0
- 1, copy
, p1
- p0
+ 1);
1346 copy
+= p1
- p0
+ 1;
1352 font_put_extra (font
, QCfc_unknown_spec
,
1353 make_unibyte_string (name
, copy
- name
));
1358 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1359 NAME (NBYTES length), and return the name length. If
1360 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1363 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1369 Lisp_Object tail
, val
;
1371 int dpi
, spacing
, avgwidth
;
1374 Lisp_Object styles
[3];
1375 char *style_names
[3] = { "weight", "slant", "width" };
1378 val
= AREF (font
, FONT_FAMILY_INDEX
);
1380 len
+= SBYTES (val
);
1382 val
= AREF (font
, FONT_SIZE_INDEX
);
1385 if (XINT (val
) != 0)
1386 pixel_size
= XINT (val
);
1388 len
+= 21; /* for ":pixelsize=NUM" */
1390 else if (FLOATP (val
))
1393 point_size
= (int) XFLOAT_DATA (val
);
1394 len
+= 11; /* for "-NUM" */
1397 val
= AREF (font
, FONT_FOUNDRY_INDEX
);
1399 /* ":foundry=NAME" */
1400 len
+= 9 + SBYTES (val
);
1402 for (i
= 0; i
< 3; i
++)
1406 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1407 if (! NILP (styles
[i
]))
1408 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1409 SDATA (SYMBOL_NAME (styles
[i
])));
1412 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1413 len
+= sprintf (work
, ":dpi=%d", dpi
);
1414 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1415 len
+= strlen (":spacing=100");
1416 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1417 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1418 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1420 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1422 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1424 len
+= SBYTES (val
);
1425 else if (INTEGERP (val
))
1426 len
+= sprintf (work
, "%d", XINT (val
));
1427 else if (SYMBOLP (val
))
1428 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1434 if (! NILP (AREF (font
, FONT_FAMILY_INDEX
)))
1435 p
+= sprintf(p
, "%s", SDATA (SYMBOL_NAME (AREF (font
, FONT_FAMILY_INDEX
))));
1439 p
+= sprintf (p
, "%d", point_size
);
1441 p
+= sprintf (p
, "-%d", point_size
);
1443 else if (pixel_size
> 0)
1444 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1445 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1446 p
+= sprintf (p
, ":foundry=%s",
1447 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1448 for (i
= 0; i
< 3; i
++)
1449 if (! NILP (styles
[i
]))
1450 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1451 SDATA (SYMBOL_NAME (styles
[i
])));
1452 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1453 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1454 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1455 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1456 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1458 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1459 p
+= sprintf (p
, ":scalable=true");
1461 p
+= sprintf (p
, ":scalable=false");
1466 /* Parse NAME (null terminated) and store information in FONT
1467 (font-spec or font-entity). If NAME is successfully parsed, return
1468 0. Otherwise return -1. */
1471 font_parse_name (name
, font
)
1475 if (name
[0] == '-' || index (name
, '*'))
1476 return font_parse_xlfd (name
, font
);
1477 return font_parse_fcname (name
, font
);
1481 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1482 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1486 font_parse_family_registry (family
, registry
, font_spec
)
1487 Lisp_Object family
, registry
, font_spec
;
1492 if (! NILP (family
))
1494 CHECK_STRING (family
);
1495 len
= SBYTES (family
);
1496 p0
= (char *) SDATA (family
);
1497 p1
= index (p0
, '-');
1500 if (*p0
!= '*' || p1
- p0
> 1)
1501 ASET (font_spec
, FONT_FOUNDRY_INDEX
,
1502 font_intern_prop (p0
, p1
- p0
));
1505 ASET (font_spec
, FONT_FAMILY_INDEX
, font_intern_prop (p1
, len
));
1508 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1510 if (! NILP (registry
))
1512 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1513 CHECK_STRING (registry
);
1514 len
= SBYTES (registry
);
1515 p0
= (char *) SDATA (registry
);
1516 p1
= index (p0
, '-');
1519 if (SDATA (registry
)[len
- 1] == '*')
1520 registry
= concat2 (registry
, build_string ("-*"));
1522 registry
= concat2 (registry
, build_string ("*-*"));
1524 registry
= Fdowncase (registry
);
1525 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1530 /* This part (through the next ^L) is still experimental and not
1531 tested much. We may drastically change codes. */
1535 #define LGSTRING_HEADER_SIZE 6
1536 #define LGSTRING_GLYPH_SIZE 8
1539 check_gstring (gstring
)
1540 Lisp_Object gstring
;
1545 CHECK_VECTOR (gstring
);
1546 val
= AREF (gstring
, 0);
1548 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1550 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1551 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1552 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1553 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1554 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1555 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1556 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1557 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1558 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1559 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1560 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1562 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1564 val
= LGSTRING_GLYPH (gstring
, i
);
1566 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1568 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1570 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1571 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1572 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1573 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1574 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1575 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1576 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1577 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1579 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1581 if (ASIZE (val
) < 3)
1583 for (j
= 0; j
< 3; j
++)
1584 CHECK_NUMBER (AREF (val
, j
));
1589 error ("Invalid glyph-string format");
1594 check_otf_features (otf_features
)
1595 Lisp_Object otf_features
;
1599 CHECK_CONS (otf_features
);
1600 CHECK_SYMBOL (XCAR (otf_features
));
1601 otf_features
= XCDR (otf_features
);
1602 CHECK_CONS (otf_features
);
1603 CHECK_SYMBOL (XCAR (otf_features
));
1604 otf_features
= XCDR (otf_features
);
1605 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1607 CHECK_SYMBOL (Fcar (val
));
1608 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1609 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1611 otf_features
= XCDR (otf_features
);
1612 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1614 CHECK_SYMBOL (Fcar (val
));
1615 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1616 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1623 Lisp_Object otf_list
;
1626 otf_tag_symbol (tag
)
1631 OTF_tag_name (tag
, name
);
1632 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1639 Lisp_Object val
= Fassoc (file
, otf_list
);
1643 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1646 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1647 val
= make_save_value (otf
, 0);
1648 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1654 /* Return a list describing which scripts/languages FONT supports by
1655 which GSUB/GPOS features of OpenType tables. See the comment of
1656 (struct font_driver).otf_capability. */
1659 font_otf_capability (font
)
1663 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1666 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1669 for (i
= 0; i
< 2; i
++)
1671 OTF_GSUB_GPOS
*gsub_gpos
;
1672 Lisp_Object script_list
= Qnil
;
1675 if (OTF_get_features (otf
, i
== 0) < 0)
1677 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1678 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1680 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1681 Lisp_Object langsys_list
= Qnil
;
1682 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1685 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1687 OTF_LangSys
*langsys
;
1688 Lisp_Object feature_list
= Qnil
;
1689 Lisp_Object langsys_tag
;
1692 if (k
== script
->LangSysCount
)
1694 langsys
= &script
->DefaultLangSys
;
1699 langsys
= script
->LangSys
+ k
;
1701 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1703 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1705 OTF_Feature
*feature
1706 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1707 Lisp_Object feature_tag
1708 = otf_tag_symbol (feature
->FeatureTag
);
1710 feature_list
= Fcons (feature_tag
, feature_list
);
1712 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1715 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1720 XSETCAR (capability
, script_list
);
1722 XSETCDR (capability
, script_list
);
1728 /* Parse OTF features in SPEC and write a proper features spec string
1729 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1730 assured that the sufficient memory has already allocated for
1734 generate_otf_features (spec
, features
)
1744 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1750 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1755 else if (! asterisk
)
1757 val
= SYMBOL_NAME (val
);
1758 p
+= sprintf (p
, "%s", SDATA (val
));
1762 val
= SYMBOL_NAME (val
);
1763 p
+= sprintf (p
, "~%s", SDATA (val
));
1767 error ("OTF spec too long");
1772 font_otf_DeviceTable (device_table
)
1773 OTF_DeviceTable
*device_table
;
1775 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1777 return Fcons (make_number (len
),
1778 make_unibyte_string (device_table
->DeltaValue
, len
));
1782 font_otf_ValueRecord (value_format
, value_record
)
1784 OTF_ValueRecord
*value_record
;
1786 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1788 if (value_format
& OTF_XPlacement
)
1789 ASET (val
, 0, make_number (value_record
->XPlacement
));
1790 if (value_format
& OTF_YPlacement
)
1791 ASET (val
, 1, make_number (value_record
->YPlacement
));
1792 if (value_format
& OTF_XAdvance
)
1793 ASET (val
, 2, make_number (value_record
->XAdvance
));
1794 if (value_format
& OTF_YAdvance
)
1795 ASET (val
, 3, make_number (value_record
->YAdvance
));
1796 if (value_format
& OTF_XPlaDevice
)
1797 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1798 if (value_format
& OTF_YPlaDevice
)
1799 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1800 if (value_format
& OTF_XAdvDevice
)
1801 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
1802 if (value_format
& OTF_YAdvDevice
)
1803 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
1808 font_otf_Anchor (anchor
)
1813 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
1814 ASET (val
, 0, make_number (anchor
->XCoordinate
));
1815 ASET (val
, 1, make_number (anchor
->YCoordinate
));
1816 if (anchor
->AnchorFormat
== 2)
1817 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
1820 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
1821 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
1826 #endif /* HAVE_LIBOTF */
1828 /* G-string (glyph string) handler */
1830 /* G-string is a vector of the form [HEADER GLYPH ...].
1831 See the docstring of `font-make-gstring' for more detail. */
1834 font_prepare_composition (cmp
, f
)
1835 struct composition
*cmp
;
1839 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
1840 cmp
->hash_index
* 2);
1842 cmp
->font
= XFONT_OBJECT (LGSTRING_FONT (gstring
));
1843 cmp
->glyph_len
= LGSTRING_LENGTH (gstring
);
1844 cmp
->pixel_width
= LGSTRING_WIDTH (gstring
);
1845 cmp
->lbearing
= LGSTRING_LBEARING (gstring
);
1846 cmp
->rbearing
= LGSTRING_RBEARING (gstring
);
1847 cmp
->ascent
= LGSTRING_ASCENT (gstring
);
1848 cmp
->descent
= LGSTRING_DESCENT (gstring
);
1849 cmp
->width
= cmp
->pixel_width
/ FRAME_COLUMN_WIDTH (f
);
1850 if (cmp
->width
== 0)
1859 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*, Lisp_Object
));
1860 static int font_compare
P_ ((const void *, const void *));
1861 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
1862 Lisp_Object
, Lisp_Object
,
1865 /* We sort fonts by scoring each of them against a specified
1866 font-spec. The score value is 32 bit (`unsigned'), and the smaller
1867 the value is, the closer the font is to the font-spec.
1869 The highest 2 bits of the score is used for FAMILY. The exact
1870 match is 0, match with one of face-font-family-alternatives is
1873 The next 2 bits of the score is used for the atomic properties
1874 FOUNDRY and ADSTYLE respectively.
1876 Each 7-bit in the lower 28 bits are used for numeric properties
1877 WEIGHT, SLANT, WIDTH, and SIZE. */
1879 /* How many bits to shift to store the difference value of each font
1880 property in a score. Note that flots for FONT_TYPE_INDEX and
1881 FONT_REGISTRY_INDEX are not used. */
1882 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
1884 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
1885 The return value indicates how different ENTITY is compared with
1888 ALTERNATE_FAMILIES, if non-nil, is a pre-calculated list of
1889 alternate family names for AREF (SPEC_PROP, FONT_FAMILY_INDEX). */
1892 font_score (entity
, spec_prop
, alternate_families
)
1893 Lisp_Object entity
, *spec_prop
;
1894 Lisp_Object alternate_families
;
1899 /* Score three atomic fields. Maximum difference is 1 (family is 3). */
1900 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_ADSTYLE_INDEX
; i
++)
1901 if (i
!= FONT_REGISTRY_INDEX
1902 && ! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
1904 Lisp_Object entity_str
= SYMBOL_NAME (AREF (entity
, i
));
1905 Lisp_Object spec_str
= SYMBOL_NAME (spec_prop
[i
]);
1907 if (strcasecmp (SDATA (spec_str
), SDATA (entity_str
)))
1909 if (i
== FONT_FAMILY_INDEX
&& CONSP (alternate_families
))
1913 for (j
= 1; CONSP (alternate_families
);
1914 j
++, alternate_families
= XCDR (alternate_families
))
1916 spec_str
= XCAR (alternate_families
);
1917 if (strcasecmp (SDATA (spec_str
), SDATA (entity_str
)) == 0)
1923 score
|= j
<< sort_shift_bits
[i
];
1926 score
|= 1 << sort_shift_bits
[i
];
1930 /* Score three style numeric fields. Maximum difference is 127. */
1931 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
1932 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
1934 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
1938 /* This is to prefer the exact symbol style. */
1940 score
|= min (diff
, 127) << sort_shift_bits
[i
];
1943 /* Score the size. Maximum difference is 127. */
1944 i
= FONT_SIZE_INDEX
;
1945 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
])
1946 && XINT (AREF (entity
, i
)) > 0)
1948 /* We use the higher 6-bit for the actual size difference. The
1949 lowest bit is set if the DPI is different. */
1950 int diff
= XINT (spec_prop
[i
]) - XINT (AREF (entity
, i
));
1955 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
1956 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
1958 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
1965 /* The comparison function for qsort. */
1968 font_compare (d1
, d2
)
1969 const void *d1
, *d2
;
1971 return (*(unsigned *) d1
- *(unsigned *) d2
);
1975 /* The structure for elements being sorted by qsort. */
1976 struct font_sort_data
1983 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
1984 If PREFER specifies a point-size, calculate the corresponding
1985 pixel-size from QCdpi property of PREFER or from the Y-resolution
1986 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
1987 get the font-entities in VEC.
1989 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
1990 return the sorted VEC. */
1993 font_sort_entites (vec
, prefer
, frame
, spec
, best_only
)
1994 Lisp_Object vec
, prefer
, frame
, spec
;
1997 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
1999 struct font_sort_data
*data
;
2000 Lisp_Object alternate_families
= Qnil
;
2001 unsigned best_score
;
2002 Lisp_Object best_entity
;
2007 return best_only
? AREF (vec
, 0) : vec
;
2009 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_DPI_INDEX
; i
++)
2010 prefer_prop
[i
] = AREF (prefer
, i
);
2014 /* A font driver may return a font that has a property value
2015 different from the value specified in SPEC if the driver
2016 thinks they are the same. That happens, for instance, such a
2017 generic family name as "serif" is specified. So, to ignore
2018 such a difference, for all properties specified in SPEC, set
2019 the corresponding properties in PREFER_PROP to nil. */
2020 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2021 if (! NILP (AREF (spec
, i
)))
2022 prefer_prop
[i
] = Qnil
;
2025 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2026 prefer_prop
[FONT_SIZE_INDEX
]
2027 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2028 if (! NILP (prefer_prop
[FONT_FAMILY_INDEX
]))
2031 = Fassoc_string (prefer_prop
[FONT_FAMILY_INDEX
],
2032 Vface_alternative_font_family_alist
, Qt
);
2033 if (CONSP (alternate_families
))
2034 alternate_families
= XCDR (alternate_families
);
2037 /* Scoring and sorting. */
2038 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2039 best_score
= 0xFFFFFFFF;
2041 for (i
= 0; i
< len
; i
++)
2043 data
[i
].entity
= AREF (vec
, i
);
2044 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
,
2045 alternate_families
);
2046 if (best_only
&& best_score
> data
[i
].score
)
2048 best_score
= data
[i
].score
;
2049 best_entity
= data
[i
].entity
;
2050 if (best_score
== 0)
2054 if (NILP (best_entity
))
2056 qsort (data
, len
, sizeof *data
, font_compare
);
2057 for (i
= 0; i
< len
; i
++)
2058 ASET (vec
, i
, data
[i
].entity
);
2068 /* API of Font Service Layer. */
2070 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2071 sort_shift_bits. Finternal_set_font_selection_order calls this
2072 function with font_sort_order after setting up it. */
2075 font_update_sort_order (order
)
2080 for (i
= 0, shift_bits
= 21; i
< 4; i
++, shift_bits
-= 7)
2082 int xlfd_idx
= order
[i
];
2084 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2085 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2086 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2087 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2088 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2089 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2091 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2096 /* Check if ENTITY matches with the font specification SPEC. */
2099 font_match_p (spec
, entity
)
2100 Lisp_Object spec
, entity
;
2102 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2103 Lisp_Object alternate_families
= Qnil
;
2104 int prefer_style
[3];
2107 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2108 prefer_prop
[i
] = AREF (spec
, i
);
2109 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2110 prefer_prop
[FONT_SIZE_INDEX
]
2111 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2112 if (! NILP (prefer_prop
[FONT_FAMILY_INDEX
]))
2115 = Fassoc_string (prefer_prop
[FONT_FAMILY_INDEX
],
2116 Vface_alternative_font_family_alist
, Qt
);
2117 if (CONSP (alternate_families
))
2118 alternate_families
= XCDR (alternate_families
);
2121 return (font_score (entity
, prefer_prop
, alternate_families
) == 0);
2125 /* CHeck a lispy font object corresponding to FONT. */
2128 font_check_object (font
)
2131 Lisp_Object tail
, elt
;
2133 for (tail
= font
->props
[FONT_OBJLIST_INDEX
]; CONSP (tail
);
2137 if (font
== XFONT_OBJECT (elt
))
2146 Each font backend has the callback function get_cache, and it
2147 returns a cons cell of which cdr part can be freely used for
2148 caching fonts. The cons cell may be shared by multiple frames
2149 and/or multiple font drivers. So, we arrange the cdr part as this:
2151 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2153 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2154 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2155 cons (FONT-SPEC FONT-ENTITY ...). */
2157 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2158 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2159 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2160 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2161 struct font_driver
*));
2164 font_prepare_cache (f
, driver
)
2166 struct font_driver
*driver
;
2168 Lisp_Object cache
, val
;
2170 cache
= driver
->get_cache (f
);
2172 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2176 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2177 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2181 val
= XCDR (XCAR (val
));
2182 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2188 font_finish_cache (f
, driver
)
2190 struct font_driver
*driver
;
2192 Lisp_Object cache
, val
, tmp
;
2195 cache
= driver
->get_cache (f
);
2197 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2198 cache
= val
, val
= XCDR (val
);
2199 xassert (! NILP (val
));
2200 tmp
= XCDR (XCAR (val
));
2201 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2202 if (XINT (XCAR (tmp
)) == 0)
2204 font_clear_cache (f
, XCAR (val
), driver
);
2205 XSETCDR (cache
, XCDR (val
));
2211 font_get_cache (f
, driver
)
2213 struct font_driver
*driver
;
2215 Lisp_Object val
= driver
->get_cache (f
);
2216 Lisp_Object type
= driver
->type
;
2218 xassert (CONSP (val
));
2219 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2220 xassert (CONSP (val
));
2221 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2222 val
= XCDR (XCAR (val
));
2226 static int num_fonts
;
2229 font_clear_cache (f
, cache
, driver
)
2232 struct font_driver
*driver
;
2234 Lisp_Object tail
, elt
;
2236 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2237 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2240 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)) && VECTORP (XCDR (elt
)))
2242 Lisp_Object vec
= XCDR (elt
);
2245 for (i
= 0; i
< ASIZE (vec
); i
++)
2247 Lisp_Object entity
= AREF (vec
, i
);
2249 if (EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2251 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2253 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2255 Lisp_Object val
= XCAR (objlist
);
2256 struct font
*font
= XFONT_OBJECT (val
);
2258 xassert (font
&& driver
== font
->driver
);
2259 driver
->close (f
, font
);
2262 if (driver
->free_entity
)
2263 driver
->free_entity (entity
);
2268 XSETCDR (cache
, Qnil
);
2272 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2275 font_delete_unmatched (list
, spec
, size
)
2276 Lisp_Object list
, spec
;
2279 Lisp_Object entity
, prev
, tail
;
2280 enum font_property_index prop
;
2282 for (tail
= list
, prev
= Qnil
; CONSP (tail
); )
2284 entity
= XCAR (tail
);
2285 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2286 if (INTEGERP (AREF (spec
, prop
))
2287 && ((XINT (AREF (spec
, prop
)) >> 8)
2288 != (XINT (AREF (entity
, prop
)) >> 8)))
2289 prop
= FONT_SPEC_MAX
;
2290 if (prop
++ <= FONT_SIZE_INDEX
2292 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2294 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2297 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2298 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2299 prop
= FONT_SPEC_MAX
;
2301 if (prop
< FONT_SPEC_MAX
2302 && INTEGERP (AREF (spec
, FONT_SPACING_INDEX
))
2303 && ! EQ (AREF (spec
, FONT_SPACING_INDEX
),
2304 AREF (entity
, FONT_SPACING_INDEX
)))
2305 prop
= FONT_SPEC_MAX
;
2306 if (prop
< FONT_SPEC_MAX
)
2307 prev
= tail
, tail
= XCDR (tail
);
2308 else if (NILP (prev
))
2309 list
= tail
= XCDR (tail
);
2311 tail
= XCDR (tail
), XSETCDR (prev
, tail
);
2317 /* Return a vector of font-entities matching with SPEC on FRAME. */
2320 font_list_entities (frame
, spec
)
2321 Lisp_Object frame
, spec
;
2323 FRAME_PTR f
= XFRAME (frame
);
2324 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2325 Lisp_Object ftype
, family
, alternate_familes
;
2328 int need_filtering
= 0;
2332 xassert (FONT_SPEC_P (spec
));
2334 family
= AREF (spec
, FONT_FAMILY_INDEX
);
2336 alternate_familes
= Qnil
;
2339 alternate_familes
= Fassoc_string (family
,
2340 Vface_alternative_font_family_alist
,
2342 if (! NILP (alternate_familes
))
2343 alternate_familes
= XCDR (alternate_familes
);
2344 n_family
+= XINT (Flength (alternate_familes
));
2347 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2348 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2349 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2350 size
= font_pixel_size (f
, spec
);
2354 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2355 for (i
= 0; i
<= FONT_REGISTRY_INDEX
; i
++)
2356 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2357 for (; i
< FONT_EXTRA_INDEX
; i
++)
2359 ASET (scratch_font_spec
, i
, Qnil
);
2360 if (! NILP (AREF (spec
, i
)))
2363 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2365 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
* n_family
);
2369 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2371 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2373 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2374 Lisp_Object tail
= alternate_familes
;
2378 Lisp_Object val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2380 if (CONSP (val
) && VECTORP (XCDR (val
)))
2386 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2387 if (! NILP (val
) && need_filtering
)
2388 val
= font_delete_unmatched (val
, spec
, size
);
2389 copy
= Fcopy_font_spec (scratch_font_spec
);
2390 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2399 ASET (scratch_font_spec
, FONT_FAMILY_INDEX
,
2400 Fintern (XCAR (tail
), Qnil
));
2405 return (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2409 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2410 nil, is an array of face's attributes, which specifies preferred
2411 font-related attributes. */
2414 font_matching_entity (f
, attrs
, spec
)
2416 Lisp_Object
*attrs
, spec
;
2418 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2419 Lisp_Object ftype
, size
, entity
;
2422 XSETFRAME (frame
, f
);
2423 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2424 size
= AREF (spec
, FONT_SIZE_INDEX
);
2426 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2428 for (; driver_list
; driver_list
= driver_list
->next
)
2430 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2432 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2434 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2435 entity
= assoc_no_quit (spec
, XCDR (cache
));
2436 if (CONSP (entity
) && ! VECTORP (XCDR (entity
)))
2437 entity
= XCDR (entity
);
2440 entity
= driver_list
->driver
->match (frame
, spec
);
2441 XSETCDR (cache
, Fcons (Fcons (Fcopy_font_spec (spec
), entity
),
2444 if (! NILP (entity
))
2447 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2448 ASET (spec
, FONT_SIZE_INDEX
, size
);
2453 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2454 opened font object. */
2457 font_open_entity (f
, entity
, pixel_size
)
2462 struct font_driver_list
*driver_list
;
2463 Lisp_Object objlist
, size
, val
, font_object
;
2467 xassert (FONT_ENTITY_P (entity
));
2468 size
= AREF (entity
, FONT_SIZE_INDEX
);
2469 if (XINT (size
) != 0)
2470 pixel_size
= XINT (size
);
2472 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2473 objlist
= XCDR (objlist
))
2474 if (XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2475 return XCAR (objlist
);
2477 val
= AREF (entity
, FONT_TYPE_INDEX
);
2478 for (driver_list
= f
->font_driver_list
;
2479 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2480 driver_list
= driver_list
->next
);
2484 font_object
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2485 if (NILP (font_object
))
2487 ASET (entity
, FONT_OBJLIST_INDEX
,
2488 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2489 ASET (font_object
, FONT_OBJLIST_INDEX
, AREF (entity
, FONT_OBJLIST_INDEX
));
2492 font
= XFONT_OBJECT (font_object
);
2493 min_width
= (font
->min_width
? font
->min_width
2494 : font
->average_width
? font
->average_width
2495 : font
->space_width
? font
->space_width
2497 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2498 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2500 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2501 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
;
2502 fonts_changed_p
= 1;
2506 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2507 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2508 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > font
->height
)
2509 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
, fonts_changed_p
= 1;
2516 /* Close FONT_OBJECT that is opened on frame F. */
2519 font_close_object (f
, font_object
)
2521 Lisp_Object font_object
;
2523 struct font
*font
= XFONT_OBJECT (font_object
);
2524 Lisp_Object objlist
;
2525 Lisp_Object tail
, prev
= Qnil
;
2527 objlist
= AREF (font_object
, FONT_OBJLIST_INDEX
);
2528 for (prev
= Qnil
, tail
= objlist
; CONSP (tail
);
2529 prev
= tail
, tail
= XCDR (tail
))
2530 if (EQ (font_object
, XCAR (tail
)))
2532 xassert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2533 font
->driver
->close (f
, font
);
2534 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2536 ASET (font_object
, FONT_OBJLIST_INDEX
, XCDR (objlist
));
2538 XSETCDR (prev
, XCDR (objlist
));
2546 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2547 FONT is a font-entity and it must be opened to check. */
2550 font_has_char (f
, font
, c
)
2557 if (FONT_ENTITY_P (font
))
2559 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2560 struct font_driver_list
*driver_list
;
2562 for (driver_list
= f
->font_driver_list
;
2563 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2564 driver_list
= driver_list
->next
);
2567 if (! driver_list
->driver
->has_char
)
2569 return driver_list
->driver
->has_char (font
, c
);
2572 xassert (FONT_OBJECT_P (font
));
2573 fontp
= XFONT_OBJECT (font
);
2574 if (fontp
->driver
->has_char
)
2576 int result
= fontp
->driver
->has_char (font
, c
);
2581 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2585 /* Return the glyph ID of FONT_OBJECT for character C. */
2588 font_encode_char (font_object
, c
)
2589 Lisp_Object font_object
;
2594 xassert (FONT_OBJECT_P (font_object
));
2595 font
= XFONT_OBJECT (font_object
);
2596 return font
->driver
->encode_char (font
, c
);
2600 /* Return the name of FONT_OBJECT. */
2603 font_get_name (font_object
)
2604 Lisp_Object font_object
;
2608 xassert (FONT_OBJECT_P (font_object
));
2609 return AREF (font_object
, FONT_NAME_INDEX
);
2613 /* Return the specification of FONT_OBJECT. */
2616 font_get_spec (font_object
)
2617 Lisp_Object font_object
;
2619 Lisp_Object spec
= font_make_spec ();
2622 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2623 ASET (spec
, i
, AREF (font_object
, i
));
2624 ASET (spec
, FONT_SIZE_INDEX
,
2625 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2630 font_spec_from_name (font_name
)
2631 Lisp_Object font_name
;
2633 Lisp_Object args
[2];
2636 args
[1] = font_name
;
2637 return Ffont_spec (2, args
);
2642 font_clear_prop (attrs
, prop
)
2644 enum font_property_index prop
;
2646 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2647 Lisp_Object extra
, prev
;
2651 if (NILP (AREF (font
, prop
))
2652 && prop
!= FONT_FAMILY_INDEX
&& prop
!= FONT_FAMILY_INDEX
)
2654 font
= Fcopy_font_spec (font
);
2655 ASET (font
, prop
, Qnil
);
2656 if (prop
== FONT_FAMILY_INDEX
)
2658 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
2659 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
2660 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
2661 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2662 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2663 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2665 else if (prop
== FONT_SIZE_INDEX
)
2667 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2668 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2669 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2671 attrs
[LFACE_FONT_INDEX
] = font
;
2675 font_update_lface (f
, attrs
)
2679 Lisp_Object spec
, val
;
2682 spec
= attrs
[LFACE_FONT_INDEX
];
2683 if (! FONT_SPEC_P (spec
))
2686 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
))
2687 || ! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2691 if (NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
2692 family
= AREF (spec
, FONT_FAMILY_INDEX
);
2693 else if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2694 family
= concat2 (SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
)),
2695 build_string ("-*"));
2697 family
= concat3 (SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
)),
2699 SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
)));
2700 attrs
[LFACE_FAMILY_INDEX
] = family
;
2702 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
2703 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
2704 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
2705 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);;
2706 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
2707 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
2708 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
2712 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2717 val
= Ffont_get (spec
, QCdpi
);
2720 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
2723 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2724 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
2725 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
2730 /* Return a font-entity satisfying SPEC and best matching with face's
2731 font related attributes in ATTRS. C, if not negative, is a
2732 character that the entity must support. */
2735 font_find_for_lface (f
, attrs
, spec
, c
)
2741 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
2747 Lisp_Object registry
= AREF (spec
, FONT_REGISTRY_INDEX
);
2748 struct charset
*encoding
, *repertory
;
2750 if (font_registry_charsets (registry
, &encoding
, &repertory
) < 0)
2754 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
2756 /* Any font of this registry support C. So, let's
2757 suppress the further checking. */
2760 else if (c
> encoding
->max_char
)
2764 XSETFRAME (frame
, f
);
2765 size
= AREF (spec
, FONT_SIZE_INDEX
);
2766 ASET (spec
, FONT_SIZE_INDEX
, Qnil
);
2767 entities
= font_list_entities (frame
, spec
);
2768 ASET (spec
, FONT_SIZE_INDEX
, size
);
2769 if (ASIZE (entities
) == 0)
2771 if (ASIZE (entities
) == 1)
2774 return AREF (entities
, 0);
2778 /* Sort fonts by properties specified in LFACE. */
2779 Lisp_Object prefer
= scratch_font_prefer
;
2781 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
2782 ASET (prefer
, i
, AREF (spec
, i
));
2783 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
2785 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
2787 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
2788 if (NILP (AREF (prefer
, i
)))
2789 ASET (prefer
, i
, AREF (face_font
, i
));
2791 if (NILP (AREF (prefer
, FONT_FAMILY_INDEX
)))
2792 font_parse_family_registry (attrs
[LFACE_FAMILY_INDEX
], Qnil
, prefer
);
2793 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
2794 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2795 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
2796 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2797 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
2798 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2799 if (INTEGERP (size
))
2800 ASET (prefer
, FONT_SIZE_INDEX
, size
);
2801 else if (FLOATP (size
))
2802 ASET (prefer
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2805 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
2806 int pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
2807 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2809 ASET (spec
, FONT_SIZE_INDEX
, Qnil
);
2810 entities
= font_sort_entites (entities
, prefer
, frame
, spec
, c
< 0);
2811 ASET (spec
, FONT_SIZE_INDEX
, size
);
2816 for (i
= 0; i
< ASIZE (entities
); i
++)
2820 val
= AREF (entities
, i
);
2823 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
2824 if (! EQ (AREF (val
, j
), props
[j
]))
2826 if (j
> FONT_REGISTRY_INDEX
)
2829 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
2830 props
[j
] = AREF (val
, j
);
2831 result
= font_has_char (f
, val
, c
);
2836 val
= font_open_for_lface (f
, val
, attrs
, spec
);
2839 result
= font_has_char (f
, val
, c
);
2840 font_close_object (f
, val
);
2842 return AREF (entities
, i
);
2849 font_open_for_lface (f
, entity
, attrs
, spec
)
2857 if (FONT_SPEC_P (spec
) && INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2858 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2861 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
2864 size
= POINT_TO_PIXEL (pt
, f
->resy
);
2866 return font_open_entity (f
, entity
, size
);
2870 /* Find a font satisfying SPEC and best matching with face's
2871 attributes in ATTRS on FRAME, and return the opened
2875 font_load_for_lface (f
, attrs
, spec
)
2877 Lisp_Object
*attrs
, spec
;
2881 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
2884 /* No font is listed for SPEC, but each font-backend may have
2885 the different criteria about "font matching". So, try
2887 entity
= font_matching_entity (f
, attrs
, spec
);
2891 return font_open_for_lface (f
, entity
, attrs
, spec
);
2895 /* Make FACE on frame F ready to use the font opened for FACE. */
2898 font_prepare_for_face (f
, face
)
2902 if (face
->font
->driver
->prepare_face
)
2903 face
->font
->driver
->prepare_face (f
, face
);
2907 /* Make FACE on frame F stop using the font opened for FACE. */
2910 font_done_for_face (f
, face
)
2914 if (face
->font
->driver
->done_face
)
2915 face
->font
->driver
->done_face (f
, face
);
2920 /* Open a font best matching with NAME on frame F. If no proper font
2921 is found, return Qnil. */
2924 font_open_by_name (f
, name
)
2928 Lisp_Object args
[2];
2929 Lisp_Object spec
, prefer
, size
, entity
, entity_list
;
2934 XSETFRAME (frame
, f
);
2937 args
[1] = make_unibyte_string (name
, strlen (name
));
2938 spec
= Ffont_spec (2, args
);
2939 prefer
= scratch_font_prefer
;
2940 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2942 ASET (prefer
, i
, AREF (spec
, i
));
2943 if (NILP (AREF (prefer
, i
))
2944 && i
>= FONT_WEIGHT_INDEX
&& i
<= FONT_WIDTH_INDEX
)
2945 FONT_SET_STYLE (prefer
, i
, make_number (100));
2947 size
= AREF (spec
, FONT_SIZE_INDEX
);
2952 if (INTEGERP (size
))
2953 pixel_size
= XINT (size
);
2954 else /* FLOATP (size) */
2956 double pt
= XFLOAT_DATA (size
);
2958 pixel_size
= POINT_TO_PIXEL (pt
, f
->resy
);
2960 if (pixel_size
== 0)
2961 ASET (spec
, FONT_SIZE_INDEX
, Qnil
);
2963 if (pixel_size
== 0)
2965 pixel_size
= POINT_TO_PIXEL (12.0, f
->resy
);
2966 size
= make_number (pixel_size
);
2967 ASET (prefer
, FONT_SIZE_INDEX
, size
);
2969 if (NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
2970 ASET (spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2972 entity_list
= Flist_fonts (spec
, frame
, make_number (1), prefer
);
2973 if (NILP (entity_list
))
2974 entity
= font_matching_entity (f
, NULL
, spec
);
2976 entity
= XCAR (entity_list
);
2977 return (NILP (entity
)
2979 : font_open_entity (f
, entity
, pixel_size
));
2983 /* Register font-driver DRIVER. This function is used in two ways.
2985 The first is with frame F non-NULL. In this case, make DRIVER
2986 available (but not yet activated) on F. All frame creaters
2987 (e.g. Fx_create_frame) must call this function at least once with
2988 an available font-driver.
2990 The second is with frame F NULL. In this case, DRIVER is globally
2991 registered in the variable `font_driver_list'. All font-driver
2992 implementations must call this function in its syms_of_XXXX
2993 (e.g. syms_of_xfont). */
2996 register_font_driver (driver
, f
)
2997 struct font_driver
*driver
;
3000 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3001 struct font_driver_list
*prev
, *list
;
3003 if (f
&& ! driver
->draw
)
3004 error ("Unusable font driver for a frame: %s",
3005 SDATA (SYMBOL_NAME (driver
->type
)));
3007 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3008 if (EQ (list
->driver
->type
, driver
->type
))
3009 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3011 list
= malloc (sizeof (struct font_driver_list
));
3013 list
->driver
= driver
;
3018 f
->font_driver_list
= list
;
3020 font_driver_list
= list
;
3025 /* Free font-driver list on frame F. It doesn't free font-drivers
3029 free_font_driver_list (f
)
3032 while (f
->font_driver_list
)
3034 struct font_driver_list
*next
= f
->font_driver_list
->next
;
3036 free (f
->font_driver_list
);
3037 f
->font_driver_list
= next
;
3042 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3043 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3044 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3046 A caller must free all realized faces if any in advance. The
3047 return value is a list of font backends actually made used on
3051 font_update_drivers (f
, new_drivers
)
3053 Lisp_Object new_drivers
;
3055 Lisp_Object active_drivers
= Qnil
;
3056 struct font_driver_list
*list
;
3058 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3061 if (! EQ (new_drivers
, Qt
)
3062 && NILP (Fmemq (list
->driver
->type
, new_drivers
)))
3064 if (list
->driver
->end_for_frame
)
3065 list
->driver
->end_for_frame (f
);
3066 font_finish_cache (f
, list
->driver
);
3072 if (EQ (new_drivers
, Qt
)
3073 || ! NILP (Fmemq (list
->driver
->type
, new_drivers
)))
3075 if (! list
->driver
->start_for_frame
3076 || list
->driver
->start_for_frame (f
) == 0)
3078 font_prepare_cache (f
, list
->driver
);
3080 active_drivers
= nconc2 (active_drivers
,
3081 Fcons (list
->driver
->type
, Qnil
));
3086 return active_drivers
;
3090 font_put_frame_data (f
, driver
, data
)
3092 struct font_driver
*driver
;
3095 struct font_data_list
*list
, *prev
;
3097 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3098 prev
= list
, list
= list
->next
)
3099 if (list
->driver
== driver
)
3106 prev
->next
= list
->next
;
3108 f
->font_data_list
= list
->next
;
3116 list
= malloc (sizeof (struct font_data_list
));
3119 list
->driver
= driver
;
3120 list
->next
= f
->font_data_list
;
3121 f
->font_data_list
= list
;
3129 font_get_frame_data (f
, driver
)
3131 struct font_driver
*driver
;
3133 struct font_data_list
*list
;
3135 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3136 if (list
->driver
== driver
)
3144 /* Return the font used to draw character C by FACE at buffer position
3145 POS in window W. If STRING is non-nil, it is a string containing C
3146 at index POS. If C is negative, get C from the current buffer or
3150 font_at (c
, pos
, face
, w
, string
)
3159 Lisp_Object font_object
;
3165 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3168 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3170 c
= FETCH_CHAR (pos_byte
);
3173 c
= FETCH_BYTE (pos
);
3179 multibyte
= STRING_MULTIBYTE (string
);
3182 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3184 str
= SDATA (string
) + pos_byte
;
3185 c
= STRING_CHAR (str
, 0);
3188 c
= SDATA (string
)[pos
];
3192 f
= XFRAME (w
->frame
);
3193 if (! FRAME_WINDOW_P (f
))
3200 if (STRINGP (string
))
3201 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3202 DEFAULT_FACE_ID
, 0);
3204 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3206 face
= FACE_FROM_ID (f
, face_id
);
3210 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3211 face
= FACE_FROM_ID (f
, face_id
);
3216 xassert (font_check_object ((struct font
*) face
->font
));
3217 XSETFONT (font_object
, face
->font
);
3222 /* Check how many characters after POS (at most to LIMIT) can be
3223 displayed by the same font. FACE is the face selected for the
3224 character as POS on frame F. STRING, if not nil, is the string to
3225 check instead of the current buffer.
3227 The return value is the position of the character that is displayed
3228 by the differnt font than that of the character as POS. */
3231 font_range (pos
, limit
, face
, f
, string
)
3232 EMACS_INT pos
, limit
;
3245 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3246 pos_byte
= CHAR_TO_BYTE (pos
);
3250 multibyte
= STRING_MULTIBYTE (string
);
3251 pos_byte
= string_char_to_byte (string
, pos
);
3255 /* All unibyte character are displayed by the same font. */
3263 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3265 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3266 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3267 face
= FACE_FROM_ID (f
, face_id
);
3274 else if (font
!= face
->font
)
3286 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3287 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3288 Return nil otherwise.
3289 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3290 which kind of font it is. It must be one of `font-spec', `font-entity'
3292 (object
, extra_type
)
3293 Lisp_Object object
, extra_type
;
3295 if (NILP (extra_type
))
3296 return (FONTP (object
) ? Qt
: Qnil
);
3297 if (EQ (extra_type
, Qfont_spec
))
3298 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3299 if (EQ (extra_type
, Qfont_entity
))
3300 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3301 if (EQ (extra_type
, Qfont_object
))
3302 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3303 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3306 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3307 doc
: /* Return a newly created font-spec with arguments as properties.
3309 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3310 valid font property name listed below:
3312 `:family', `:weight', `:slant', `:width'
3314 They are the same as face attributes of the same name. See
3315 `set-face-attribute'.
3319 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3323 VALUE must be a string or a symbol specifying the additional
3324 typographic style information of a font, e.g. ``sans''.
3328 VALUE must be a string or a symbol specifying the charset registry and
3329 encoding of a font, e.g. ``iso8859-1''.
3333 VALUE must be a non-negative integer or a floating point number
3334 specifying the font size. It specifies the font size in pixels
3335 (if VALUE is an integer), or in points (if VALUE is a float).
3336 usage: (font-spec ARGS ...) */)
3341 Lisp_Object spec
= font_make_spec ();
3344 for (i
= 0; i
< nargs
; i
+= 2)
3346 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3348 if (EQ (key
, QCname
))
3351 font_parse_name ((char *) SDATA (val
), spec
);
3352 font_put_extra (spec
, key
, val
);
3354 else if (EQ (key
, QCfamily
))
3357 font_parse_family_registry (val
, Qnil
, spec
);
3361 int idx
= get_font_prop_index (key
);
3365 val
= font_prop_validate (idx
, Qnil
, val
);
3366 if (idx
< FONT_EXTRA_INDEX
)
3367 ASET (spec
, idx
, val
);
3369 font_put_extra (spec
, key
, val
);
3372 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3378 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3379 doc
: /* Return a copy of FONT as a font-spec. */)
3383 Lisp_Object new_spec
, tail
, extra
;
3387 new_spec
= font_make_spec ();
3388 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3389 ASET (new_spec
, i
, AREF (font
, i
));
3391 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3393 if (! EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3394 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3396 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3400 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3401 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3402 Every specified properties in FROM override the corresponding
3403 properties in TO. */)
3405 Lisp_Object from
, to
;
3407 Lisp_Object extra
, tail
;
3412 to
= Fcopy_font_spec (to
);
3413 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3414 ASET (to
, i
, AREF (from
, i
));
3415 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3416 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3417 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3419 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3422 XSETCDR (slot
, XCDR (XCAR (tail
)));
3424 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3426 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3430 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3431 doc
: /* Return the value of FONT's property KEY.
3432 FONT is a font-spec, a font-entity, or a font-object. */)
3434 Lisp_Object font
, key
;
3441 idx
= get_font_prop_index (key
);
3442 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3443 return AREF (font
, idx
);
3444 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3448 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3449 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
3450 (font_spec
, prop
, val
)
3451 Lisp_Object font_spec
, prop
, val
;
3454 Lisp_Object extra
, slot
;
3456 CHECK_FONT_SPEC (font_spec
);
3457 idx
= get_font_prop_index (prop
);
3458 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3460 if (idx
== FONT_FAMILY_INDEX
3462 font_parse_family_registry (val
, Qnil
, font_spec
);
3464 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
3467 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
3471 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3472 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3473 Optional 2nd argument FRAME specifies the target frame.
3474 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3475 Optional 4th argument PREFER, if non-nil, is a font-spec to
3476 control the order of the returned list. Fonts are sorted by
3477 how they are close to PREFER. */)
3478 (font_spec
, frame
, num
, prefer
)
3479 Lisp_Object font_spec
, frame
, num
, prefer
;
3481 Lisp_Object vec
, list
, tail
;
3485 frame
= selected_frame
;
3486 CHECK_LIVE_FRAME (frame
);
3487 CHECK_FONT_SPEC (font_spec
);
3495 if (! NILP (prefer
))
3496 CHECK_FONT_SPEC (prefer
);
3498 vec
= font_list_entities (frame
, font_spec
);
3503 return Fcons (AREF (vec
, 0), Qnil
);
3505 if (! NILP (prefer
))
3506 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
, 0);
3508 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3509 if (n
== 0 || n
> len
)
3511 for (i
= 1; i
< n
; i
++)
3513 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3515 XSETCDR (tail
, val
);
3521 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
3522 doc
: /* List available font families on the current frame.
3523 Optional argument FRAME specifies the target frame. */)
3528 struct font_driver_list
*driver_list
;
3532 frame
= selected_frame
;
3533 CHECK_LIVE_FRAME (frame
);
3536 for (driver_list
= f
->font_driver_list
; driver_list
;
3537 driver_list
= driver_list
->next
)
3538 if (driver_list
->driver
->list_family
)
3540 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3546 Lisp_Object tail
= list
;
3548 for (; CONSP (val
); val
= XCDR (val
))
3549 if (NILP (Fmemq (XCAR (val
), tail
)))
3550 list
= Fcons (XCAR (val
), list
);
3556 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3557 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3558 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3560 Lisp_Object font_spec
, frame
;
3562 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3569 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 1, 0,
3570 doc
: /* Return XLFD name of FONT.
3571 FONT is a font-spec, font-entity, or font-object.
3572 If the name is too long for XLFD (maximum 255 chars), return nil. */)
3581 if (FONT_OBJECT_P (font
))
3583 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
3585 if (STRINGP (font_name
)
3586 && SDATA (font_name
)[0] == '-')
3588 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
3590 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3592 return build_string (name
);
3595 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3596 doc
: /* Clear font cache. */)
3599 Lisp_Object list
, frame
;
3601 FOR_EACH_FRAME (list
, frame
)
3603 FRAME_PTR f
= XFRAME (frame
);
3604 struct font_driver_list
*driver_list
= f
->font_driver_list
;
3606 for (; driver_list
; driver_list
= driver_list
->next
)
3607 if (driver_list
->on
)
3609 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
3614 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
3616 xassert (! NILP (val
));
3617 val
= XCDR (XCAR (val
));
3618 if (XINT (XCAR (val
)) == 0)
3620 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
3621 XSETCDR (cache
, XCDR (val
));
3629 DEFUN ("internal-set-font-style-table", Finternal_set_font_style_table
,
3630 Sinternal_set_font_style_table
, 3, 3, 0,
3631 doc
: /* Setup font style table from WEIGHT, SLANT, and WIDTH tables.
3632 WEIGHT, SLANT, WIDTH must be `font-weight-table', `font-slant-table',
3633 `font-width-table' respectivly.
3634 This function is called after those tables are initialized. */)
3635 (weight
, slant
, width
)
3636 Lisp_Object weight
, slant
, width
;
3638 Lisp_Object tables
[3];
3641 tables
[0] = weight
, tables
[1] = slant
, tables
[2] = width
;
3643 font_style_table
= Fmake_vector (make_number (3), Qnil
);
3644 /* In the following loop, we don't use XCAR and XCDR until assuring
3645 the argument is a cons cell so that the error in the tables can
3647 for (i
= 0; i
< 3; i
++)
3649 Lisp_Object tail
, elt
, list
, val
;
3651 for (tail
= tables
[i
], list
= Qnil
; CONSP (tail
); tail
= XCDR (tail
))
3656 CHECK_SYMBOL (Fcar (elt
));
3657 val
= Fcons (XCAR (elt
), Qnil
);
3659 CHECK_NATNUM (Fcar (elt
));
3660 if (numeric
>= XINT (XCAR (elt
)))
3661 error ("Numeric values not unique nor sorted in %s",
3662 (i
== 0 ? "font-weight-table"
3663 : i
== 1 ? "font-slant-table"
3664 : "font-width-table"));
3665 numeric
= XINT (XCAR (elt
));
3666 XSETCDR (val
, XCAR (elt
));
3667 list
= Fcons (val
, list
);
3668 for (elt
= XCDR (elt
); CONSP (elt
); elt
= XCDR (elt
))
3672 list
= Fcons (Fcons (XCAR (elt
), make_number (numeric
)), list
);
3675 list
= Fnreverse (list
);
3676 ASET (font_style_table
, i
, Fvconcat (1, &list
));
3682 /* The following three functions are still expremental. */
3684 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
3685 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
3686 FONT-OBJECT may be nil if it is not yet known.
3688 G-string is sequence of glyphs of a specific font,
3689 and is a vector of this form:
3690 [ HEADER GLYPH ... ]
3691 HEADER is a vector of this form:
3692 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
3694 FONT-OBJECT is a font-object for all glyphs in the g-string,
3695 WIDTH thry DESCENT are the metrics (in pixels) of the whole G-string.
3696 GLYPH is a vector of this form:
3697 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
3698 [ [X-OFF Y-OFF WADJUST] | nil] ]
3700 FROM-IDX and TO-IDX are used internally and should not be touched.
3701 C is the character of the glyph.
3702 CODE is the glyph-code of C in FONT-OBJECT.
3703 WIDTH thry DESCENT are the metrics (in pixels) of the glyph.
3704 X-OFF and Y-OFF are offests to the base position for the glyph.
3705 WADJUST is the adjustment to the normal width of the glyph. */)
3707 Lisp_Object font_object
, num
;
3709 Lisp_Object gstring
, g
;
3713 if (! NILP (font_object
))
3714 CHECK_FONT_OBJECT (font_object
);
3717 len
= XINT (num
) + 1;
3718 gstring
= Fmake_vector (make_number (len
), Qnil
);
3719 g
= Fmake_vector (make_number (6), Qnil
);
3720 ASET (g
, 0, font_object
);
3721 ASET (gstring
, 0, g
);
3722 for (i
= 1; i
< len
; i
++)
3723 ASET (gstring
, i
, Fmake_vector (make_number (10), Qnil
));
3727 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
3728 doc
: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
3729 START and END specify the region to extract characters.
3730 If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
3731 where to extract characters.
3732 FONT-OBJECT may be nil if GSTRING already already contains one. */)
3733 (gstring
, font_object
, start
, end
, object
)
3734 Lisp_Object gstring
, font_object
, start
, end
, object
;
3740 CHECK_VECTOR (gstring
);
3741 if (NILP (font_object
))
3742 font_object
= LGSTRING_FONT (gstring
);
3743 font
= XFONT_OBJECT (font_object
);
3745 if (STRINGP (object
))
3747 const unsigned char *p
;
3749 CHECK_NATNUM (start
);
3751 if (XINT (start
) > XINT (end
)
3752 || XINT (end
) > ASIZE (object
)
3753 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3754 args_out_of_range_3 (object
, start
, end
);
3756 len
= XINT (end
) - XINT (start
);
3757 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
3758 for (i
= 0; i
< len
; i
++)
3760 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3761 /* Shut up GCC warning in comparison with
3762 MOST_POSITIVE_FIXNUM below. */
3765 c
= STRING_CHAR_ADVANCE (p
);
3766 cod
= code
= font
->driver
->encode_char (font
, c
);
3767 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
3769 LGLYPH_SET_FROM (g
, i
);
3770 LGLYPH_SET_TO (g
, i
);
3771 LGLYPH_SET_CHAR (g
, c
);
3772 LGLYPH_SET_CODE (g
, code
);
3779 if (! NILP (object
))
3780 Fset_buffer (object
);
3781 validate_region (&start
, &end
);
3782 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3783 args_out_of_range (start
, end
);
3784 len
= XINT (end
) - XINT (start
);
3786 pos_byte
= CHAR_TO_BYTE (pos
);
3787 for (i
= 0; i
< len
; i
++)
3789 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3790 /* Shut up GCC warning in comparison with
3791 MOST_POSITIVE_FIXNUM below. */
3794 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
3795 cod
= code
= font
->driver
->encode_char (font
, c
);
3796 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
3798 LGLYPH_SET_FROM (g
, i
);
3799 LGLYPH_SET_TO (g
, i
);
3800 LGLYPH_SET_CHAR (g
, c
);
3801 LGLYPH_SET_CODE (g
, code
);
3804 for (; i
< LGSTRING_LENGTH (gstring
); i
++)
3805 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
3809 DEFUN ("font-shape-text", Ffont_shape_text
, Sfont_shape_text
, 3, 4, 0,
3810 doc
: /* Shape text between FROM and TO by FONT-OBJECT.
3811 If optional 4th argument STRING is non-nil, it is a string to shape,
3812 and FROM and TO are indices to the string.
3813 The value is the end position of the text that can be shaped by
3815 (from
, to
, font_object
, string
)
3816 Lisp_Object from
, to
, font_object
, string
;
3819 struct font_metrics metrics
;
3820 EMACS_INT start
, end
;
3821 Lisp_Object gstring
, n
;
3824 if (! FONT_OBJECT_P (font_object
))
3826 font
= XFONT_OBJECT (font_object
);
3827 if (! font
->driver
->shape
)
3832 validate_region (&from
, &to
);
3833 start
= XFASTINT (from
);
3834 end
= XFASTINT (to
);
3835 modify_region (current_buffer
, start
, end
, 0);
3839 CHECK_STRING (string
);
3840 start
= XINT (from
);
3842 if (start
< 0 || start
> end
|| end
> SCHARS (string
))
3843 args_out_of_range_3 (string
, from
, to
);
3847 gstring
= Ffont_make_gstring (font_object
, make_number (len
));
3848 Ffont_fill_gstring (gstring
, font_object
, from
, to
, string
);
3850 /* Try at most three times with larger gstring each time. */
3851 for (i
= 0; i
< 3; i
++)
3853 Lisp_Object args
[2];
3855 n
= font
->driver
->shape (gstring
);
3859 args
[1] = Fmake_vector (make_number (len
), Qnil
);
3860 gstring
= Fvconcat (2, args
);
3862 if (! INTEGERP (n
) || XINT (n
) == 0)
3866 for (i
= 0; i
< len
;)
3869 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3870 EMACS_INT this_from
= LGLYPH_FROM (g
);
3871 EMACS_INT this_to
= LGLYPH_TO (g
) + 1;
3873 int need_composition
= 0;
3875 metrics
.lbearing
= LGLYPH_LBEARING (g
);
3876 metrics
.rbearing
= LGLYPH_RBEARING (g
);
3877 metrics
.ascent
= LGLYPH_ASCENT (g
);
3878 metrics
.descent
= LGLYPH_DESCENT (g
);
3879 if (NILP (LGLYPH_ADJUSTMENT (g
)))
3881 metrics
.width
= LGLYPH_WIDTH (g
);
3882 if (LGLYPH_CHAR (g
) == 0 || metrics
.width
== 0)
3883 need_composition
= 1;
3887 metrics
.width
= LGLYPH_WADJUST (g
);
3888 metrics
.lbearing
+= LGLYPH_XOFF (g
);
3889 metrics
.rbearing
+= LGLYPH_XOFF (g
);
3890 metrics
.ascent
-= LGLYPH_YOFF (g
);
3891 metrics
.descent
+= LGLYPH_YOFF (g
);
3892 need_composition
= 1;
3894 for (j
= i
+ 1; j
< len
; j
++)
3898 g
= LGSTRING_GLYPH (gstring
, j
);
3899 if (this_from
!= LGLYPH_FROM (g
))
3901 need_composition
= 1;
3902 x
= metrics
.width
+ LGLYPH_LBEARING (g
) + LGLYPH_XOFF (g
);
3903 if (metrics
.lbearing
> x
)
3904 metrics
.lbearing
= x
;
3905 x
= metrics
.width
+ LGLYPH_RBEARING (g
) + LGLYPH_XOFF (g
);
3906 if (metrics
.rbearing
< x
)
3907 metrics
.rbearing
= x
;
3908 x
= LGLYPH_ASCENT (g
) - LGLYPH_YOFF (g
);
3909 if (metrics
.ascent
< x
)
3911 x
= LGLYPH_DESCENT (g
) - LGLYPH_YOFF (g
);
3912 if (metrics
.descent
< x
)
3913 metrics
.descent
= x
;
3914 if (NILP (LGLYPH_ADJUSTMENT (g
)))
3915 metrics
.width
+= LGLYPH_WIDTH (g
);
3917 metrics
.width
+= LGLYPH_WADJUST (g
);
3920 if (need_composition
)
3922 gstr
= Ffont_make_gstring (font_object
, make_number (j
- i
));
3923 LGSTRING_SET_WIDTH (gstr
, metrics
.width
);
3924 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
3925 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
);
3926 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
3927 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
3928 for (k
= i
; i
< j
; i
++)
3930 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3932 LGLYPH_SET_FROM (g
, LGLYPH_FROM (g
) - this_from
);
3933 LGLYPH_SET_TO (g
, LGLYPH_TO (g
) - this_from
);
3934 LGSTRING_SET_GLYPH (gstr
, i
- k
, LGSTRING_GLYPH (gstring
, i
));
3936 from
= make_number (start
+ this_from
);
3937 to
= make_number (start
+ this_to
);
3939 Fcompose_region_internal (from
, to
, gstr
, Qnil
);
3941 Fcompose_string_internal (string
, from
, to
, gstr
, Qnil
);
3950 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
3951 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
3952 OTF-FEATURES specifies which features to apply in this format:
3953 (SCRIPT LANGSYS GSUB GPOS)
3955 SCRIPT is a symbol specifying a script tag of OpenType,
3956 LANGSYS is a symbol specifying a langsys tag of OpenType,
3957 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
3959 If LANGYS is nil, the default langsys is selected.
3961 The features are applied in the order they appear in the list. The
3962 symbol `*' means to apply all available features not present in this
3963 list, and the remaining features are ignored. For instance, (vatu
3964 pstf * haln) is to apply vatu and pstf in this order, then to apply
3965 all available features other than vatu, pstf, and haln.
3967 The features are applied to the glyphs in the range FROM and TO of
3968 the glyph-string GSTRING-IN.
3970 If some feature is actually applicable, the resulting glyphs are
3971 produced in the glyph-string GSTRING-OUT from the index INDEX. In
3972 this case, the value is the number of produced glyphs.
3974 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
3977 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
3978 produced in GSTRING-OUT, and the value is nil.
3980 See the documentation of `font-make-gstring' for the format of
3982 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
3983 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
3985 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
3990 check_otf_features (otf_features
);
3991 CHECK_FONT_OBJECT (font_object
);
3992 font
= XFONT_OBJECT (font_object
);
3993 if (! font
->driver
->otf_drive
)
3994 error ("Font backend %s can't drive OpenType GSUB table",
3995 SDATA (SYMBOL_NAME (font
->driver
->type
)));
3996 CHECK_CONS (otf_features
);
3997 CHECK_SYMBOL (XCAR (otf_features
));
3998 val
= XCDR (otf_features
);
3999 CHECK_SYMBOL (XCAR (val
));
4000 val
= XCDR (otf_features
);
4003 len
= check_gstring (gstring_in
);
4004 CHECK_VECTOR (gstring_out
);
4005 CHECK_NATNUM (from
);
4007 CHECK_NATNUM (index
);
4009 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4010 args_out_of_range_3 (from
, to
, make_number (len
));
4011 if (XINT (index
) >= ASIZE (gstring_out
))
4012 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4013 num
= font
->driver
->otf_drive (font
, otf_features
,
4014 gstring_in
, XINT (from
), XINT (to
),
4015 gstring_out
, XINT (index
), 0);
4018 return make_number (num
);
4021 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4023 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4024 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4026 (SCRIPT LANGSYS FEATURE ...)
4027 See the documentation of `font-otf-gsub' for more detail.
4029 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4030 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4031 character code corresponding to the glyph or nil if there's no
4032 corresponding character. */)
4033 (font_object
, character
, otf_features
)
4034 Lisp_Object font_object
, character
, otf_features
;
4037 Lisp_Object gstring_in
, gstring_out
, g
;
4038 Lisp_Object alternates
;
4041 CHECK_FONT_GET_OBJECT (font_object
, font
);
4042 if (! font
->driver
->otf_drive
)
4043 error ("Font backend %s can't drive OpenType GSUB table",
4044 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4045 CHECK_CHARACTER (character
);
4046 CHECK_CONS (otf_features
);
4048 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4049 g
= LGSTRING_GLYPH (gstring_in
, 0);
4050 LGLYPH_SET_CHAR (g
, XINT (character
));
4051 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4052 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4053 gstring_out
, 0, 1)) < 0)
4054 gstring_out
= Ffont_make_gstring (font_object
,
4055 make_number (ASIZE (gstring_out
) * 2));
4057 for (i
= 0; i
< num
; i
++)
4059 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4060 int c
= LGLYPH_CHAR (g
);
4061 unsigned code
= LGLYPH_CODE (g
);
4063 alternates
= Fcons (Fcons (make_number (code
),
4064 c
> 0 ? make_number (c
) : Qnil
),
4067 return Fnreverse (alternates
);
4073 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4074 doc
: /* Open FONT-ENTITY. */)
4075 (font_entity
, size
, frame
)
4076 Lisp_Object font_entity
;
4082 CHECK_FONT_ENTITY (font_entity
);
4084 frame
= selected_frame
;
4085 CHECK_LIVE_FRAME (frame
);
4088 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4091 CHECK_NUMBER_OR_FLOAT (size
);
4093 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
4095 isize
= XINT (size
);
4099 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4102 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4103 doc
: /* Close FONT-OBJECT. */)
4104 (font_object
, frame
)
4105 Lisp_Object font_object
, frame
;
4107 CHECK_FONT_OBJECT (font_object
);
4109 frame
= selected_frame
;
4110 CHECK_LIVE_FRAME (frame
);
4111 font_close_object (XFRAME (frame
), font_object
);
4115 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4116 doc
: /* Return information about FONT-OBJECT.
4117 The value is a vector:
4118 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4121 NAME is a string of the font name (or nil if the font backend doesn't
4124 FILENAME is a string of the font file (or nil if the font backend
4125 doesn't provide a file name).
4127 PIXEL-SIZE is a pixel size by which the font is opened.
4129 SIZE is a maximum advance width of the font in pixel.
4131 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4134 CAPABILITY is a list whose first element is a symbol representing the
4135 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4136 remaining elements describes a detail of the font capability.
4138 If the font is OpenType font, the form of the list is
4139 \(opentype GSUB GPOS)
4140 where GSUB shows which "GSUB" features the font supports, and GPOS
4141 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4142 lists of the format:
4143 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4145 If the font is not OpenType font, currently the length of the form is
4148 SCRIPT is a symbol representing OpenType script tag.
4150 LANGSYS is a symbol representing OpenType langsys tag, or nil
4151 representing the default langsys.
4153 FEATURE is a symbol representing OpenType feature tag.
4155 If the font is not OpenType font, CAPABILITY is nil. */)
4157 Lisp_Object font_object
;
4162 CHECK_FONT_GET_OBJECT (font_object
, font
);
4164 val
= Fmake_vector (make_number (9), Qnil
);
4165 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4166 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4167 ASET (val
, 2, make_number (font
->pixel_size
));
4168 ASET (val
, 3, make_number (font
->max_width
));
4169 ASET (val
, 4, make_number (font
->ascent
));
4170 ASET (val
, 5, make_number (font
->descent
));
4171 ASET (val
, 6, make_number (font
->space_width
));
4172 ASET (val
, 7, make_number (font
->average_width
));
4173 if (font
->driver
->otf_capability
)
4174 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4178 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4179 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4180 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4181 (font_object
, string
)
4182 Lisp_Object font_object
, string
;
4188 CHECK_FONT_GET_OBJECT (font_object
, font
);
4189 CHECK_STRING (string
);
4190 len
= SCHARS (string
);
4191 vec
= Fmake_vector (make_number (len
), Qnil
);
4192 for (i
= 0; i
< len
; i
++)
4194 Lisp_Object ch
= Faref (string
, make_number (i
));
4199 struct font_metrics metrics
;
4201 cod
= code
= font
->driver
->encode_char (font
, c
);
4202 if (code
== FONT_INVALID_CODE
)
4204 val
= Fmake_vector (make_number (6), Qnil
);
4205 if (cod
<= MOST_POSITIVE_FIXNUM
)
4206 ASET (val
, 0, make_number (code
));
4208 ASET (val
, 0, Fcons (make_number (code
>> 16),
4209 make_number (code
& 0xFFFF)));
4210 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4211 ASET (val
, 1, make_number (metrics
.lbearing
));
4212 ASET (val
, 2, make_number (metrics
.rbearing
));
4213 ASET (val
, 3, make_number (metrics
.width
));
4214 ASET (val
, 4, make_number (metrics
.ascent
));
4215 ASET (val
, 5, make_number (metrics
.descent
));
4221 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4222 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4223 FONT is a font-spec, font-entity, or font-object. */)
4225 Lisp_Object spec
, font
;
4227 CHECK_FONT_SPEC (spec
);
4230 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4233 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4234 doc
: /* Return a font-object for displaying a character at POSITION.
4235 Optional second arg WINDOW, if non-nil, is a window displaying
4236 the current buffer. It defaults to the currently selected window. */)
4237 (position
, window
, string
)
4238 Lisp_Object position
, window
, string
;
4245 CHECK_NUMBER_COERCE_MARKER (position
);
4246 pos
= XINT (position
);
4247 if (pos
< BEGV
|| pos
>= ZV
)
4248 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4252 CHECK_NUMBER (position
);
4253 CHECK_STRING (string
);
4254 pos
= XINT (position
);
4255 if (pos
< 0 || pos
>= SCHARS (string
))
4256 args_out_of_range (string
, position
);
4259 window
= selected_window
;
4260 CHECK_LIVE_WINDOW (window
);
4261 w
= XWINDOW (window
);
4263 return font_at (-1, pos
, NULL
, w
, string
);
4267 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4268 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4269 The value is a number of glyphs drawn.
4270 Type C-l to recover what previously shown. */)
4271 (font_object
, string
)
4272 Lisp_Object font_object
, string
;
4274 Lisp_Object frame
= selected_frame
;
4275 FRAME_PTR f
= XFRAME (frame
);
4281 CHECK_FONT_GET_OBJECT (font_object
, font
);
4282 CHECK_STRING (string
);
4283 len
= SCHARS (string
);
4284 code
= alloca (sizeof (unsigned) * len
);
4285 for (i
= 0; i
< len
; i
++)
4287 Lisp_Object ch
= Faref (string
, make_number (i
));
4291 code
[i
] = font
->driver
->encode_char (font
, c
);
4292 if (code
[i
] == FONT_INVALID_CODE
)
4295 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4297 if (font
->driver
->prepare_face
)
4298 font
->driver
->prepare_face (f
, face
);
4299 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4300 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4301 if (font
->driver
->done_face
)
4302 font
->driver
->done_face (f
, face
);
4304 return make_number (len
);
4308 #endif /* FONT_DEBUG */
4311 extern void syms_of_ftfont
P_ (());
4312 extern void syms_of_xfont
P_ (());
4313 extern void syms_of_xftfont
P_ (());
4314 extern void syms_of_ftxfont
P_ (());
4315 extern void syms_of_bdffont
P_ (());
4316 extern void syms_of_w32font
P_ (());
4317 extern void syms_of_atmfont
P_ (());
4322 sort_shift_bits
[FONT_SLANT_INDEX
] = 0;
4323 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 7;
4324 sort_shift_bits
[FONT_SIZE_INDEX
] = 14;
4325 sort_shift_bits
[FONT_WIDTH_INDEX
] = 21;
4326 sort_shift_bits
[FONT_ADSTYLE_INDEX
] = 28;
4327 sort_shift_bits
[FONT_FOUNDRY_INDEX
] = 29;
4328 sort_shift_bits
[FONT_FAMILY_INDEX
] = 30;
4329 /* Note that sort_shift_bits[FONT_SORT_TYPE] and
4330 sort_shift_bits[FONT_SORT_REGISTRY] are never used. */
4332 staticpro (&font_style_table
);
4333 font_style_table
= Fmake_vector (make_number (3), Qnil
);
4335 staticpro (&font_charset_alist
);
4336 font_charset_alist
= Qnil
;
4338 DEFSYM (Qfont_spec
, "font-spec");
4339 DEFSYM (Qfont_entity
, "font-entity");
4340 DEFSYM (Qfont_object
, "font-object");
4342 DEFSYM (Qopentype
, "opentype");
4344 DEFSYM (Qiso8859_1
, "iso8859-1");
4345 DEFSYM (Qiso10646_1
, "iso10646-1");
4346 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4347 DEFSYM (Qunicode_sip
, "unicode-sip");
4349 DEFSYM (QCotf
, ":otf");
4350 DEFSYM (QClang
, ":lang");
4351 DEFSYM (QCscript
, ":script");
4352 DEFSYM (QCantialias
, ":antialias");
4354 DEFSYM (QCfoundry
, ":foundry");
4355 DEFSYM (QCadstyle
, ":adstyle");
4356 DEFSYM (QCregistry
, ":registry");
4357 DEFSYM (QCspacing
, ":spacing");
4358 DEFSYM (QCdpi
, ":dpi");
4359 DEFSYM (QCscalable
, ":scalable");
4360 DEFSYM (QCavgwidth
, ":avgwidth");
4361 DEFSYM (QCfont_entity
, ":font-entity");
4362 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
4369 staticpro (&null_vector
);
4370 null_vector
= Fmake_vector (make_number (0), Qnil
);
4372 staticpro (&scratch_font_spec
);
4373 scratch_font_spec
= Ffont_spec (0, NULL
);
4374 staticpro (&scratch_font_prefer
);
4375 scratch_font_prefer
= Ffont_spec (0, NULL
);
4378 staticpro (&otf_list
);
4383 defsubr (&Sfont_spec
);
4384 defsubr (&Sfont_get
);
4385 defsubr (&Sfont_put
);
4386 defsubr (&Slist_fonts
);
4387 defsubr (&Sfont_family_list
);
4388 defsubr (&Sfind_font
);
4389 defsubr (&Sfont_xlfd_name
);
4390 defsubr (&Sclear_font_cache
);
4391 defsubr (&Sinternal_set_font_style_table
);
4392 defsubr (&Sfont_make_gstring
);
4393 defsubr (&Sfont_fill_gstring
);
4394 defsubr (&Sfont_shape_text
);
4395 defsubr (&Sfont_drive_otf
);
4396 defsubr (&Sfont_otf_alternates
);
4399 defsubr (&Sopen_font
);
4400 defsubr (&Sclose_font
);
4401 defsubr (&Squery_font
);
4402 defsubr (&Sget_font_glyphs
);
4403 defsubr (&Sfont_match_p
);
4404 defsubr (&Sfont_at
);
4406 defsubr (&Sdraw_string
);
4408 #endif /* FONT_DEBUG */
4410 #ifdef HAVE_FREETYPE
4412 #ifdef HAVE_X_WINDOWS
4417 #endif /* HAVE_XFT */
4418 #endif /* HAVE_X_WINDOWS */
4419 #else /* not HAVE_FREETYPE */
4420 #ifdef HAVE_X_WINDOWS
4422 #endif /* HAVE_X_WINDOWS */
4423 #endif /* not HAVE_FREETYPE */
4426 #endif /* HAVE_BDFFONT */
4429 #endif /* WINDOWSNT */
4435 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
4436 (do not change this comment) */