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 Lisp_Object Vfont_encoding_alist
;
98 /* Alist of font registry symbol and the corresponding charsets
99 information. The information is retrieved from
100 Vfont_encoding_alist on demand.
102 Eash element has the form:
103 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
107 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
108 encodes a character code to a glyph code of a font, and
109 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
110 character is supported by a font.
112 The latter form means that the information for REGISTRY couldn't be
114 static Lisp_Object font_charset_alist
;
116 /* List of all font drivers. Each font-backend (XXXfont.c) calls
117 register_font_driver in syms_of_XXXfont to register its font-driver
119 static struct font_driver_list
*font_driver_list
;
123 /* Creaters of font-related Lisp object. */
128 Lisp_Object font_spec
;
129 struct font_spec
*spec
130 = ((struct font_spec
*)
131 allocate_pseudovector (VECSIZE (struct font_spec
),
132 FONT_SPEC_MAX
, PVEC_FONT
));
133 XSETFONT (font_spec
, spec
);
140 Lisp_Object font_entity
;
141 struct font_entity
*entity
142 = ((struct font_entity
*)
143 allocate_pseudovector (VECSIZE (struct font_entity
),
144 FONT_ENTITY_MAX
, PVEC_FONT
));
145 XSETFONT (font_entity
, entity
);
150 font_make_object (size
)
153 Lisp_Object font_object
;
155 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
156 XSETFONT (font_object
, font
);
163 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
164 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
165 static Lisp_Object font_matching_entity
P_ ((FRAME_PTR
, Lisp_Object
*,
168 /* Number of registered font drivers. */
169 static int num_font_drivers
;
172 /* Return a Lispy value of a font property value at STR and LEN bytes.
173 If STR is "*", it returns nil.
174 If all characters in STR are digits, it returns an integer.
175 Otherwise, it returns a symbol interned from STR. */
178 font_intern_prop (str
, len
)
183 Lisp_Object tem
, string
;
186 if (len
== 1 && *str
== '*')
188 if (len
>=1 && isdigit (*str
))
190 for (i
= 1; i
< len
; i
++)
191 if (! isdigit (str
[i
]))
194 return make_number (atoi (str
));
197 /* The following code is copied from the function intern (in lread.c). */
199 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
200 obarray
= check_obarray (obarray
);
201 tem
= oblookup (obarray
, str
, len
, len
);
204 return Fintern (make_unibyte_string (str
, len
), obarray
);
207 /* Return a pixel size of font-spec SPEC on frame F. */
210 font_pixel_size (f
, spec
)
214 #ifdef HAVE_WINDOW_SYSTEM
215 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
218 Lisp_Object extra
, val
;
224 xassert (FLOATP (size
));
225 point_size
= XFLOAT_DATA (size
);
226 val
= AREF (spec
, FONT_DPI_INDEX
);
228 dpi
= XINT (XCDR (val
));
231 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
239 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
240 font vector. If VAL is not valid (i.e. not registered in
241 font_style_table), return -1 if NOERROR is zero, and return a
242 proper index if NOERROR is nonzero. In that case, register VAL in
243 font_style_table if VAL is a symbol, and return a closest index if
244 VAL is an integer. */
247 font_style_to_value (prop
, val
, noerror
)
248 enum font_property_index prop
;
252 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
253 int len
= ASIZE (table
);
259 Lisp_Object args
[2], elt
;
261 /* At first try exact match. */
262 for (i
= 0; i
< len
; i
++)
263 if (EQ (val
, XCAR (AREF (table
, i
))))
264 return (XINT (XCDR (AREF (table
, i
))) << 8) | i
;
265 /* Try also with case-folding match. */
266 s
= SDATA (SYMBOL_NAME (val
));
267 for (i
= 0; i
< len
; i
++)
269 elt
= XCAR (AREF (table
, i
));
270 if (strcasecmp (s
, (char *) SDATA (SYMBOL_NAME (elt
))) == 0)
278 args
[1] = Fmake_vector (make_number (1), Fcons (val
, make_number (255)));
279 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
280 return (255 << 8) | i
;
284 int last_i
, i
, last_n
;
285 int numeric
= XINT (val
);
287 for (i
= 1, last_i
= last_n
= -1; i
< len
;)
289 int n
= XINT (XCDR (AREF (table
, i
)));
297 return ((last_i
< 0 || n
- numeric
< numeric
- last_n
)
298 ? (n
<< 8) | i
: (last_n
<< 8 | last_i
));
302 for (i
++; i
< len
&& n
== XINT (XCDR (AREF (table
, i
+ 1))); i
++);
306 return (last_n
<< 8) | last_i
;
311 font_style_symbolic (font
, prop
, for_face
)
313 enum font_property_index prop
;
316 Lisp_Object val
= AREF (font
, prop
);
322 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
324 return XCAR (AREF (table
, XINT (val
) & 0xFF));
325 numeric
= XINT (val
) >> 8;
326 for (i
= 0; i
< ASIZE (table
); i
++)
327 if (XINT (XCDR (AREF (table
, i
))) == numeric
)
328 return XCAR (AREF (table
, i
));
333 extern Lisp_Object Vface_alternative_font_family_alist
;
335 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
338 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
339 FONTNAME. ENCODING is a charset symbol that specifies the encoding
340 of the font. REPERTORY is a charset symbol or nil. */
343 find_font_encoding (fontname
)
344 Lisp_Object fontname
;
346 Lisp_Object tail
, elt
;
348 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
352 && STRINGP (XCAR (elt
))
353 && fast_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
354 && (SYMBOLP (XCDR (elt
))
355 ? CHARSETP (XCDR (elt
))
356 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
359 /* We don't know the encoding of this font. Let's assume `ascii'. */
363 /* Return encoding charset and repertory charset for REGISTRY in
364 ENCODING and REPERTORY correspondingly. If correct information for
365 REGISTRY is available, return 0. Otherwise return -1. */
368 font_registry_charsets (registry
, encoding
, repertory
)
369 Lisp_Object registry
;
370 struct charset
**encoding
, **repertory
;
373 int encoding_id
, repertory_id
;
375 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
381 encoding_id
= XINT (XCAR (val
));
382 repertory_id
= XINT (XCDR (val
));
386 val
= find_font_encoding (SYMBOL_NAME (registry
));
387 if (SYMBOLP (val
) && CHARSETP (val
))
389 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
391 else if (CONSP (val
))
393 if (! CHARSETP (XCAR (val
)))
395 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
396 if (NILP (XCDR (val
)))
400 if (! CHARSETP (XCDR (val
)))
402 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
407 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
409 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
413 *encoding
= CHARSET_FROM_ID (encoding_id
);
415 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
420 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
425 /* Font property value validaters. See the comment of
426 font_property_table for the meaning of the arguments. */
428 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
429 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
430 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
431 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
432 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
433 static int get_font_prop_index
P_ ((Lisp_Object
));
436 font_prop_validate_symbol (prop
, val
)
437 Lisp_Object prop
, val
;
440 val
= Fintern (val
, Qnil
);
443 else if (EQ (prop
, QCregistry
))
444 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
450 font_prop_validate_style (style
, val
)
451 Lisp_Object style
, val
;
453 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
454 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
461 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
465 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), n
& 0xFF);
466 if (XINT (XCDR (elt
)) != (n
>> 8))
470 else if (SYMBOLP (val
))
472 int n
= font_style_to_value (prop
, val
, 0);
474 val
= n
>= 0 ? make_number (n
) : Qerror
;
482 font_prop_validate_non_neg (prop
, val
)
483 Lisp_Object prop
, val
;
485 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
490 font_prop_validate_spacing (prop
, val
)
491 Lisp_Object prop
, val
;
493 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
496 return make_number (FONT_SPACING_CHARCELL
);
498 return make_number (FONT_SPACING_MONO
);
500 return make_number (FONT_SPACING_PROPORTIONAL
);
502 return make_number (FONT_SPACING_DUAL
);
507 font_prop_validate_otf (prop
, val
)
508 Lisp_Object prop
, val
;
510 Lisp_Object tail
, tmp
;
513 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
514 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
515 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
518 if (! SYMBOLP (XCAR (val
)))
523 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
525 for (i
= 0; i
< 2; i
++)
532 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
533 if (! SYMBOLP (XCAR (tmp
)))
541 /* Structure of known font property keys and validater of the
545 /* Pointer to the key symbol. */
547 /* Function to validate PROP's value VAL, or NULL if any value is
548 ok. The value is VAL or its regularized value if VAL is valid,
549 and Qerror if not. */
550 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
551 } font_property_table
[] =
552 { { &QCtype
, font_prop_validate_symbol
},
553 { &QCfoundry
, font_prop_validate_symbol
},
554 { &QCfamily
, font_prop_validate_symbol
},
555 { &QCadstyle
, font_prop_validate_symbol
},
556 { &QCregistry
, font_prop_validate_symbol
},
557 { &QCweight
, font_prop_validate_style
},
558 { &QCslant
, font_prop_validate_style
},
559 { &QCwidth
, font_prop_validate_style
},
560 { &QCsize
, font_prop_validate_non_neg
},
561 { &QCdpi
, font_prop_validate_non_neg
},
562 { &QCspacing
, font_prop_validate_spacing
},
563 { &QCavgwidth
, font_prop_validate_non_neg
},
564 /* The order of the above entries must match with enum
565 font_property_index. */
566 { &QClang
, font_prop_validate_symbol
},
567 { &QCscript
, font_prop_validate_symbol
},
568 { &QCotf
, font_prop_validate_otf
}
571 /* Size (number of elements) of the above table. */
572 #define FONT_PROPERTY_TABLE_SIZE \
573 ((sizeof font_property_table) / (sizeof *font_property_table))
575 /* Return an index number of font property KEY or -1 if KEY is not an
576 already known property. */
579 get_font_prop_index (key
)
584 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
585 if (EQ (key
, *font_property_table
[i
].key
))
590 /* Validate the font property. The property key is specified by the
591 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
592 signal an error. The value is VAL or the regularized one. */
595 font_prop_validate (idx
, prop
, val
)
597 Lisp_Object prop
, val
;
599 Lisp_Object validated
;
604 prop
= *font_property_table
[idx
].key
;
607 idx
= get_font_prop_index (prop
);
611 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
612 if (EQ (validated
, Qerror
))
613 signal_error ("invalid font property", Fcons (prop
, val
));
618 /* Store VAL as a value of extra font property PROP in FONT while
619 keeping the sorting order. Don't check the validity of VAL. */
622 font_put_extra (font
, prop
, val
)
623 Lisp_Object font
, prop
, val
;
625 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
626 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
630 Lisp_Object prev
= Qnil
;
633 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
634 prev
= extra
, extra
= XCDR (extra
);
636 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
638 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
646 /* Font name parser and unparser */
648 static int parse_matrix
P_ ((char *));
649 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
650 static int font_parse_name
P_ ((char *, Lisp_Object
));
652 /* An enumerator for each field of an XLFD font name. */
653 enum xlfd_field_index
672 /* An enumerator for mask bit corresponding to each XLFD field. */
675 XLFD_FOUNDRY_MASK
= 0x0001,
676 XLFD_FAMILY_MASK
= 0x0002,
677 XLFD_WEIGHT_MASK
= 0x0004,
678 XLFD_SLANT_MASK
= 0x0008,
679 XLFD_SWIDTH_MASK
= 0x0010,
680 XLFD_ADSTYLE_MASK
= 0x0020,
681 XLFD_PIXEL_MASK
= 0x0040,
682 XLFD_POINT_MASK
= 0x0080,
683 XLFD_RESX_MASK
= 0x0100,
684 XLFD_RESY_MASK
= 0x0200,
685 XLFD_SPACING_MASK
= 0x0400,
686 XLFD_AVGWIDTH_MASK
= 0x0800,
687 XLFD_REGISTRY_MASK
= 0x1000,
688 XLFD_ENCODING_MASK
= 0x2000
692 /* Parse P pointing the pixel/point size field of the form
693 `[A B C D]' which specifies a transformation matrix:
699 by which all glyphs of the font are transformed. The spec says
700 that scalar value N for the pixel/point size is equivalent to:
701 A = N * resx/resy, B = C = 0, D = N.
703 Return the scalar value N if the form is valid. Otherwise return
714 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
717 matrix
[i
] = - strtod (p
+ 1, &end
);
719 matrix
[i
] = strtod (p
, &end
);
722 return (i
== 4 ? (int) matrix
[3] : -1);
725 /* Expand a wildcard field in FIELD (the first N fields are filled) to
726 multiple fields to fill in all 14 XLFD fields while restring a
727 field position by its contents. */
730 font_expand_wildcards (field
, n
)
731 Lisp_Object field
[XLFD_LAST_INDEX
];
735 Lisp_Object tmp
[XLFD_LAST_INDEX
];
736 /* Array of information about where this element can go. Nth
737 element is for Nth element of FIELD. */
739 /* Minimum possible field. */
741 /* Maxinum possible field. */
743 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
745 } range
[XLFD_LAST_INDEX
];
747 int range_from
, range_to
;
750 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
751 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
752 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
753 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
754 | XLFD_AVGWIDTH_MASK)
755 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
757 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
758 field. The value is shifted to left one bit by one in the
760 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
761 range_mask
= (range_mask
<< 1) | 1;
763 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
764 position-based retriction for FIELD[I]. */
765 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
766 i
++, range_from
++, range_to
++, range_mask
<<= 1)
768 Lisp_Object val
= field
[i
];
774 range
[i
].from
= range_from
;
775 range
[i
].to
= range_to
;
776 range
[i
].mask
= range_mask
;
780 /* The triplet FROM, TO, and MASK is a value-based
781 retriction for FIELD[I]. */
787 int numeric
= XINT (val
);
790 from
= to
= XLFD_ENCODING_INDEX
,
791 mask
= XLFD_ENCODING_MASK
;
792 else if (numeric
== 0)
793 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
794 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
795 else if (numeric
<= 48)
796 from
= to
= XLFD_PIXEL_INDEX
,
797 mask
= XLFD_PIXEL_MASK
;
799 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
800 mask
= XLFD_LARGENUM_MASK
;
802 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
803 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
804 mask
= XLFD_NULL_MASK
;
806 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
809 Lisp_Object name
= SYMBOL_NAME (val
);
811 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
812 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
813 mask
= XLFD_REGENC_MASK
;
815 from
= to
= XLFD_ENCODING_INDEX
,
816 mask
= XLFD_ENCODING_MASK
;
818 else if (range_from
<= XLFD_WEIGHT_INDEX
819 && range_to
>= XLFD_WEIGHT_INDEX
820 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
821 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
822 else if (range_from
<= XLFD_SLANT_INDEX
823 && range_to
>= XLFD_SLANT_INDEX
824 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
825 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
826 else if (range_from
<= XLFD_SWIDTH_INDEX
827 && range_to
>= XLFD_SWIDTH_INDEX
828 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
829 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
832 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
833 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
835 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
836 mask
= XLFD_SYMBOL_MASK
;
839 /* Merge position-based and value-based restrictions. */
841 while (from
< range_from
)
842 mask
&= ~(1 << from
++);
843 while (from
< 14 && ! (mask
& (1 << from
)))
845 while (to
> range_to
)
846 mask
&= ~(1 << to
--);
847 while (to
>= 0 && ! (mask
& (1 << to
)))
851 range
[i
].from
= from
;
853 range
[i
].mask
= mask
;
855 if (from
> range_from
|| to
< range_to
)
857 /* The range is narrowed by value-based restrictions.
858 Reflect it to the other fields. */
860 /* Following fields should be after FROM. */
862 /* Preceding fields should be before TO. */
863 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
865 /* Check FROM for non-wildcard field. */
866 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
868 while (range
[j
].from
< from
)
869 range
[j
].mask
&= ~(1 << range
[j
].from
++);
870 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
872 range
[j
].from
= from
;
875 from
= range
[j
].from
;
876 if (range
[j
].to
> to
)
878 while (range
[j
].to
> to
)
879 range
[j
].mask
&= ~(1 << range
[j
].to
--);
880 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
893 /* Decide all fileds from restrictions in RANGE. */
894 for (i
= j
= 0; i
< n
; i
++)
896 if (j
< range
[i
].from
)
898 if (i
== 0 || ! NILP (tmp
[i
- 1]))
899 /* None of TMP[X] corresponds to Jth field. */
901 for (; j
< range
[i
].from
; j
++)
906 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
908 for (; j
< XLFD_LAST_INDEX
; j
++)
910 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
911 field
[XLFD_ENCODING_INDEX
]
912 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
917 #ifdef ENABLE_CHECKING
918 /* Match a 14-field XLFD pattern against a full XLFD font name. */
920 font_match_xlfd (char *pattern
, char *name
)
922 while (*pattern
&& *name
)
924 if (*pattern
== *name
)
926 else if (*pattern
== '*')
927 if (*name
== pattern
[1])
938 /* Make sure the font object matches the XLFD font name. */
940 font_check_xlfd_parse (Lisp_Object font
, char *name
)
942 char name_check
[256];
943 font_unparse_xlfd (font
, 0, name_check
, 255);
944 return font_match_xlfd (name_check
, name
);
950 /* Parse NAME (null terminated) as XLFD and store information in FONT
951 (font-spec or font-entity). Size property of FONT is set as
953 specified XLFD fields FONT property
954 --------------------- -------------
955 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
956 POINT_SIZE and RESY calculated pixel size (Lisp integer)
957 POINT_SIZE POINT_SIZE/10 (Lisp float)
959 If NAME is successfully parsed, return 0. Otherwise return -1.
961 FONT is usually a font-spec, but when this function is called from
962 X font backend driver, it is a font-entity. In that case, NAME is
963 a fully specified XLFD. */
966 font_parse_xlfd (name
, font
)
970 int len
= strlen (name
);
972 char *f
[XLFD_LAST_INDEX
+ 1];
977 /* Maximum XLFD name length is 255. */
979 /* Accept "*-.." as a fully specified XLFD. */
980 if (name
[0] == '*' && name
[1] == '-')
981 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
984 for (p
= name
+ i
; *p
; p
++)
988 if (i
== XLFD_LAST_INDEX
)
993 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N])
995 if (i
== XLFD_LAST_INDEX
)
997 /* Fully specified XLFD. */
1001 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD (XLFD_FOUNDRY_INDEX
));
1002 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD (XLFD_FAMILY_INDEX
));
1003 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1004 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1006 val
= INTERN_FIELD (i
);
1009 if ((n
= font_style_to_value (j
, INTERN_FIELD (i
), 0)) < 0)
1011 ASET (font
, j
, make_number (n
));
1014 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD (XLFD_ADSTYLE_INDEX
));
1015 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
1016 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
1018 ASET (font
, FONT_REGISTRY_INDEX
,
1019 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
1020 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
]));
1021 p
= f
[XLFD_PIXEL_INDEX
];
1022 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
1023 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
1026 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
1028 ASET (font
, FONT_SIZE_INDEX
, val
);
1031 double point_size
= -1;
1033 xassert (FONT_SPEC_P (font
));
1034 p
= f
[XLFD_POINT_INDEX
];
1036 point_size
= parse_matrix (p
);
1037 else if (isdigit (*p
))
1038 point_size
= atoi (p
), point_size
/= 10;
1039 if (point_size
>= 0)
1040 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1044 ASET (font
, FONT_DPI_INDEX
, INTERN_FIELD (XLFD_RESY_INDEX
));
1045 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1048 val
= font_prop_validate_spacing (QCspacing
, val
);
1049 if (! INTEGERP (val
))
1051 ASET (font
, FONT_SPACING_INDEX
, val
);
1053 p
= f
[XLFD_AVGWIDTH_INDEX
];
1056 ASET (font
, FONT_AVGWIDTH_INDEX
,
1057 font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
));
1061 int wild_card_found
= 0;
1062 Lisp_Object prop
[XLFD_LAST_INDEX
];
1064 if (FONT_ENTITY_P (font
))
1066 for (j
= 0; j
< i
; j
++)
1070 if (f
[j
][1] && f
[j
][1] != '-')
1073 wild_card_found
= 1;
1076 prop
[j
] = INTERN_FIELD (j
);
1078 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
]);
1080 if (! wild_card_found
)
1082 if (font_expand_wildcards (prop
, i
) < 0)
1085 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1086 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1087 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1088 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1089 if (! NILP (prop
[i
]))
1091 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1093 ASET (font
, j
, make_number (n
));
1095 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1096 val
= prop
[XLFD_REGISTRY_INDEX
];
1099 val
= prop
[XLFD_ENCODING_INDEX
];
1101 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1103 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1104 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1106 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1107 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1109 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1111 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1112 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1113 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1115 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1117 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1120 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1121 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1122 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1124 val
= font_prop_validate_spacing (QCspacing
,
1125 prop
[XLFD_SPACING_INDEX
]);
1126 if (! INTEGERP (val
))
1128 ASET (font
, FONT_SPACING_INDEX
, val
);
1130 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1131 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1137 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1138 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1139 0, use PIXEL_SIZE instead. */
1142 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1148 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1152 xassert (FONTP (font
));
1154 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1157 if (i
== FONT_ADSTYLE_INDEX
)
1158 j
= XLFD_ADSTYLE_INDEX
;
1159 else if (i
== FONT_REGISTRY_INDEX
)
1160 j
= XLFD_REGISTRY_INDEX
;
1161 val
= AREF (font
, i
);
1164 if (j
== XLFD_REGISTRY_INDEX
)
1165 f
[j
] = "*-*", len
+= 4;
1167 f
[j
] = "*", len
+= 2;
1172 val
= SYMBOL_NAME (val
);
1173 if (j
== XLFD_REGISTRY_INDEX
1174 && ! strchr ((char *) SDATA (val
), '-'))
1176 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1177 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1179 f
[j
] = alloca (SBYTES (val
) + 3);
1180 sprintf (f
[j
], "%s-*", SDATA (val
));
1181 len
+= SBYTES (val
) + 3;
1185 f
[j
] = alloca (SBYTES (val
) + 4);
1186 sprintf (f
[j
], "%s*-*", SDATA (val
));
1187 len
+= SBYTES (val
) + 4;
1191 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1195 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1198 val
= font_style_symbolic (font
, i
, 0);
1200 f
[j
] = "*", len
+= 2;
1203 val
= SYMBOL_NAME (val
);
1204 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1208 val
= AREF (font
, FONT_SIZE_INDEX
);
1209 xassert (NUMBERP (val
) || NILP (val
));
1217 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1218 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1221 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1223 else if (FLOATP (val
))
1225 i
= XFLOAT_DATA (val
) * 10;
1226 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1227 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1230 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1232 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1234 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1235 f
[XLFD_RESX_INDEX
] = alloca (22);
1236 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1240 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1241 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1243 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1245 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1246 : spacing
<= FONT_SPACING_DUAL
? "d"
1247 : spacing
<= FONT_SPACING_MONO
? "m"
1252 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1253 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1255 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1256 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
],
1257 "%d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1260 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1261 len
++; /* for terminating '\0'. */
1264 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1265 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1266 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1267 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1268 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1269 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1270 f
[XLFD_REGISTRY_INDEX
]);
1273 /* Parse NAME (null terminated) as Fonconfig's name format and store
1274 information in FONT (font-spec or font-entity). If NAME is
1275 successfully parsed, return 0. Otherwise return -1. */
1278 font_parse_fcname (name
, font
)
1283 int len
= strlen (name
);
1288 /* It is assured that (name[0] && name[0] != '-'). */
1296 for (p0
= name
+ 1; *p0
&& (*p0
!= '-' && *p0
!= ':'); p0
++)
1297 if (*p0
== '\\' && p0
[1])
1299 family
= font_intern_prop (name
, p0
- name
);
1302 if (! isdigit (p0
[1]))
1304 point_size
= strtod (p0
+ 1, &p1
);
1305 if (*p1
&& *p1
!= ':')
1307 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1310 ASET (font
, FONT_FAMILY_INDEX
, family
);
1314 copy
= alloca (len
+ 1);
1319 /* Now parse ":KEY=VAL" patterns. Store known keys and values in
1320 extra, copy unknown ones to COPY. It is stored in extra slot by
1321 the key QCfc_unknown_spec. */
1324 Lisp_Object key
, val
;
1327 for (p1
= p0
+ 1; *p1
&& *p1
!= '=' && *p1
!= ':'; p1
++);
1330 /* Must be an enumerated value. */
1331 val
= font_intern_prop (p0
+ 1, p1
- p0
- 1);
1332 if (memcmp (p0
+ 1, "light", 5) == 0
1333 || memcmp (p0
+ 1, "medium", 6) == 0
1334 || memcmp (p0
+ 1, "demibold", 8) == 0
1335 || memcmp (p0
+ 1, "bold", 4) == 0
1336 || memcmp (p0
+ 1, "black", 5) == 0)
1337 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1338 else if (memcmp (p0
+ 1, "roman", 5) == 0
1339 || memcmp (p0
+ 1, "italic", 6) == 0
1340 || memcmp (p0
+ 1, "oblique", 7) == 0)
1341 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1342 else if (memcmp (p0
+ 1, "charcell", 8) == 0
1343 || memcmp (p0
+ 1, "mono", 4) == 0
1344 || memcmp (p0
+ 1, "proportional", 12) == 0)
1346 int spacing
= (p0
[1] == 'c' ? FONT_SPACING_CHARCELL
1347 : p0
[1] == 'm' ? FONT_SPACING_MONO
1348 : FONT_SPACING_PROPORTIONAL
);
1349 ASET (font
, FONT_SPACING_INDEX
, make_number (spacing
));
1354 bcopy (p0
, copy
, p1
- p0
);
1360 if (memcmp (p0
+ 1, "pixelsize=", 10) == 0)
1361 prop
= FONT_SIZE_INDEX
;
1364 key
= font_intern_prop (p0
, p1
- p0
);
1365 prop
= get_font_prop_index (key
);
1368 for (p1
= p0
; *p1
&& *p1
!= ':'; p1
++);
1369 val
= font_intern_prop (p0
, p1
- p0
);
1372 if (prop
>= FONT_FOUNDRY_INDEX
&& prop
< FONT_EXTRA_INDEX
)
1373 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1375 Ffont_put (font
, key
, val
);
1377 bcopy (p0
- 1, copy
, p1
- p0
+ 1);
1378 copy
+= p1
- p0
+ 1;
1384 font_put_extra (font
, QCfc_unknown_spec
,
1385 make_unibyte_string (name
, copy
- name
));
1390 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1391 NAME (NBYTES length), and return the name length. If
1392 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1395 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1401 Lisp_Object tail
, val
;
1403 int dpi
, spacing
, avgwidth
;
1406 Lisp_Object styles
[3];
1407 char *style_names
[3] = { "weight", "slant", "width" };
1410 val
= AREF (font
, FONT_FAMILY_INDEX
);
1412 len
+= SBYTES (val
);
1414 val
= AREF (font
, FONT_SIZE_INDEX
);
1417 if (XINT (val
) != 0)
1418 pixel_size
= XINT (val
);
1420 len
+= 21; /* for ":pixelsize=NUM" */
1422 else if (FLOATP (val
))
1425 point_size
= (int) XFLOAT_DATA (val
);
1426 len
+= 11; /* for "-NUM" */
1429 val
= AREF (font
, FONT_FOUNDRY_INDEX
);
1431 /* ":foundry=NAME" */
1432 len
+= 9 + SBYTES (val
);
1434 for (i
= 0; i
< 3; i
++)
1438 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1439 if (! NILP (styles
[i
]))
1440 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1441 SDATA (SYMBOL_NAME (styles
[i
])));
1444 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1445 len
+= sprintf (work
, ":dpi=%d", dpi
);
1446 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1447 len
+= strlen (":spacing=100");
1448 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1449 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1450 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1452 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1454 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1456 len
+= SBYTES (val
);
1457 else if (INTEGERP (val
))
1458 len
+= sprintf (work
, "%d", XINT (val
));
1459 else if (SYMBOLP (val
))
1460 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1466 if (! NILP (AREF (font
, FONT_FAMILY_INDEX
)))
1467 p
+= sprintf(p
, "%s", SDATA (SYMBOL_NAME (AREF (font
, FONT_FAMILY_INDEX
))));
1471 p
+= sprintf (p
, "%d", point_size
);
1473 p
+= sprintf (p
, "-%d", point_size
);
1475 else if (pixel_size
> 0)
1476 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1477 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1478 p
+= sprintf (p
, ":foundry=%s",
1479 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1480 for (i
= 0; i
< 3; i
++)
1481 if (! NILP (styles
[i
]))
1482 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1483 SDATA (SYMBOL_NAME (styles
[i
])));
1484 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1485 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1486 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1487 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1488 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1490 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1491 p
+= sprintf (p
, ":scalable=true");
1493 p
+= sprintf (p
, ":scalable=false");
1498 /* Parse NAME (null terminated) and store information in FONT
1499 (font-spec or font-entity). If NAME is successfully parsed, return
1500 0. Otherwise return -1. */
1503 font_parse_name (name
, font
)
1507 if (name
[0] == '-' || index (name
, '*'))
1508 return font_parse_xlfd (name
, font
);
1509 return font_parse_fcname (name
, font
);
1513 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1514 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1518 font_parse_family_registry (family
, registry
, font_spec
)
1519 Lisp_Object family
, registry
, font_spec
;
1524 if (! NILP (family
))
1526 CHECK_STRING (family
);
1527 len
= SBYTES (family
);
1528 p0
= (char *) SDATA (family
);
1529 p1
= index (p0
, '-');
1532 if (*p0
!= '*' || p1
- p0
> 1)
1533 ASET (font_spec
, FONT_FOUNDRY_INDEX
,
1534 font_intern_prop (p0
, p1
- p0
));
1537 ASET (font_spec
, FONT_FAMILY_INDEX
, font_intern_prop (p1
, len
));
1540 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1542 if (! NILP (registry
))
1544 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1545 CHECK_STRING (registry
);
1546 len
= SBYTES (registry
);
1547 p0
= (char *) SDATA (registry
);
1548 p1
= index (p0
, '-');
1551 if (SDATA (registry
)[len
- 1] == '*')
1552 registry
= concat2 (registry
, build_string ("-*"));
1554 registry
= concat2 (registry
, build_string ("*-*"));
1556 registry
= Fdowncase (registry
);
1557 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1562 /* This part (through the next ^L) is still experimental and not
1563 tested much. We may drastically change codes. */
1567 #define LGSTRING_HEADER_SIZE 6
1568 #define LGSTRING_GLYPH_SIZE 8
1571 check_gstring (gstring
)
1572 Lisp_Object gstring
;
1577 CHECK_VECTOR (gstring
);
1578 val
= AREF (gstring
, 0);
1580 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1582 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1583 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1584 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1585 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1586 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1587 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1588 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1589 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1590 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1591 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1592 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1594 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1596 val
= LGSTRING_GLYPH (gstring
, i
);
1598 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1600 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1602 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1603 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1604 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1605 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1606 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1607 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1608 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1609 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1611 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1613 if (ASIZE (val
) < 3)
1615 for (j
= 0; j
< 3; j
++)
1616 CHECK_NUMBER (AREF (val
, j
));
1621 error ("Invalid glyph-string format");
1626 check_otf_features (otf_features
)
1627 Lisp_Object otf_features
;
1631 CHECK_CONS (otf_features
);
1632 CHECK_SYMBOL (XCAR (otf_features
));
1633 otf_features
= XCDR (otf_features
);
1634 CHECK_CONS (otf_features
);
1635 CHECK_SYMBOL (XCAR (otf_features
));
1636 otf_features
= XCDR (otf_features
);
1637 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1639 CHECK_SYMBOL (Fcar (val
));
1640 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1641 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1643 otf_features
= XCDR (otf_features
);
1644 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1646 CHECK_SYMBOL (Fcar (val
));
1647 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1648 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1655 Lisp_Object otf_list
;
1658 otf_tag_symbol (tag
)
1663 OTF_tag_name (tag
, name
);
1664 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1671 Lisp_Object val
= Fassoc (file
, otf_list
);
1675 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1678 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1679 val
= make_save_value (otf
, 0);
1680 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1686 /* Return a list describing which scripts/languages FONT supports by
1687 which GSUB/GPOS features of OpenType tables. See the comment of
1688 (struct font_driver).otf_capability. */
1691 font_otf_capability (font
)
1695 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1698 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1701 for (i
= 0; i
< 2; i
++)
1703 OTF_GSUB_GPOS
*gsub_gpos
;
1704 Lisp_Object script_list
= Qnil
;
1707 if (OTF_get_features (otf
, i
== 0) < 0)
1709 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1710 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1712 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1713 Lisp_Object langsys_list
= Qnil
;
1714 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1717 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1719 OTF_LangSys
*langsys
;
1720 Lisp_Object feature_list
= Qnil
;
1721 Lisp_Object langsys_tag
;
1724 if (k
== script
->LangSysCount
)
1726 langsys
= &script
->DefaultLangSys
;
1731 langsys
= script
->LangSys
+ k
;
1733 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1735 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1737 OTF_Feature
*feature
1738 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1739 Lisp_Object feature_tag
1740 = otf_tag_symbol (feature
->FeatureTag
);
1742 feature_list
= Fcons (feature_tag
, feature_list
);
1744 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1747 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1752 XSETCAR (capability
, script_list
);
1754 XSETCDR (capability
, script_list
);
1760 /* Parse OTF features in SPEC and write a proper features spec string
1761 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1762 assured that the sufficient memory has already allocated for
1766 generate_otf_features (spec
, features
)
1776 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1782 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1787 else if (! asterisk
)
1789 val
= SYMBOL_NAME (val
);
1790 p
+= sprintf (p
, "%s", SDATA (val
));
1794 val
= SYMBOL_NAME (val
);
1795 p
+= sprintf (p
, "~%s", SDATA (val
));
1799 error ("OTF spec too long");
1804 font_otf_DeviceTable (device_table
)
1805 OTF_DeviceTable
*device_table
;
1807 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1809 return Fcons (make_number (len
),
1810 make_unibyte_string (device_table
->DeltaValue
, len
));
1814 font_otf_ValueRecord (value_format
, value_record
)
1816 OTF_ValueRecord
*value_record
;
1818 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1820 if (value_format
& OTF_XPlacement
)
1821 ASET (val
, 0, make_number (value_record
->XPlacement
));
1822 if (value_format
& OTF_YPlacement
)
1823 ASET (val
, 1, make_number (value_record
->YPlacement
));
1824 if (value_format
& OTF_XAdvance
)
1825 ASET (val
, 2, make_number (value_record
->XAdvance
));
1826 if (value_format
& OTF_YAdvance
)
1827 ASET (val
, 3, make_number (value_record
->YAdvance
));
1828 if (value_format
& OTF_XPlaDevice
)
1829 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1830 if (value_format
& OTF_YPlaDevice
)
1831 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1832 if (value_format
& OTF_XAdvDevice
)
1833 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
1834 if (value_format
& OTF_YAdvDevice
)
1835 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
1840 font_otf_Anchor (anchor
)
1845 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
1846 ASET (val
, 0, make_number (anchor
->XCoordinate
));
1847 ASET (val
, 1, make_number (anchor
->YCoordinate
));
1848 if (anchor
->AnchorFormat
== 2)
1849 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
1852 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
1853 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
1858 #endif /* HAVE_LIBOTF */
1860 /* G-string (glyph string) handler */
1862 /* G-string is a vector of the form [HEADER GLYPH ...].
1863 See the docstring of `font-make-gstring' for more detail. */
1866 font_prepare_composition (cmp
, f
)
1867 struct composition
*cmp
;
1871 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
1872 cmp
->hash_index
* 2);
1874 cmp
->font
= XFONT_OBJECT (LGSTRING_FONT (gstring
));
1875 cmp
->glyph_len
= LGSTRING_LENGTH (gstring
);
1876 cmp
->pixel_width
= LGSTRING_WIDTH (gstring
);
1877 cmp
->lbearing
= LGSTRING_LBEARING (gstring
);
1878 cmp
->rbearing
= LGSTRING_RBEARING (gstring
);
1879 cmp
->ascent
= LGSTRING_ASCENT (gstring
);
1880 cmp
->descent
= LGSTRING_DESCENT (gstring
);
1881 cmp
->width
= cmp
->pixel_width
/ FRAME_COLUMN_WIDTH (f
);
1882 if (cmp
->width
== 0)
1891 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*, Lisp_Object
));
1892 static int font_compare
P_ ((const void *, const void *));
1893 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
1894 Lisp_Object
, Lisp_Object
,
1897 /* We sort fonts by scoring each of them against a specified
1898 font-spec. The score value is 32 bit (`unsigned'), and the smaller
1899 the value is, the closer the font is to the font-spec.
1901 The highest 2 bits of the score is used for FAMILY. The exact
1902 match is 0, match with one of face-font-family-alternatives is
1905 The next 2 bits of the score is used for the atomic properties
1906 FOUNDRY and ADSTYLE respectively.
1908 Each 7-bit in the lower 28 bits are used for numeric properties
1909 WEIGHT, SLANT, WIDTH, and SIZE. */
1911 /* How many bits to shift to store the difference value of each font
1912 property in a score. Note that flots for FONT_TYPE_INDEX and
1913 FONT_REGISTRY_INDEX are not used. */
1914 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
1916 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
1917 The return value indicates how different ENTITY is compared with
1920 ALTERNATE_FAMILIES, if non-nil, is a pre-calculated list of
1921 alternate family names for AREF (SPEC_PROP, FONT_FAMILY_INDEX). */
1924 font_score (entity
, spec_prop
, alternate_families
)
1925 Lisp_Object entity
, *spec_prop
;
1926 Lisp_Object alternate_families
;
1931 /* Score three atomic fields. Maximum difference is 1 (family is 3). */
1932 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_ADSTYLE_INDEX
; i
++)
1933 if (i
!= FONT_REGISTRY_INDEX
1934 && ! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
1936 Lisp_Object entity_str
= SYMBOL_NAME (AREF (entity
, i
));
1937 Lisp_Object spec_str
= SYMBOL_NAME (spec_prop
[i
]);
1939 if (strcasecmp (SDATA (spec_str
), SDATA (entity_str
)))
1941 if (i
== FONT_FAMILY_INDEX
&& CONSP (alternate_families
))
1945 for (j
= 1; CONSP (alternate_families
);
1946 j
++, alternate_families
= XCDR (alternate_families
))
1948 spec_str
= XCAR (alternate_families
);
1949 if (strcasecmp (SDATA (spec_str
), SDATA (entity_str
)) == 0)
1955 score
|= j
<< sort_shift_bits
[i
];
1958 score
|= 1 << sort_shift_bits
[i
];
1962 /* Score three style numeric fields. Maximum difference is 127. */
1963 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
1964 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
1966 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
1970 /* This is to prefer the exact symbol style. */
1972 score
|= min (diff
, 127) << sort_shift_bits
[i
];
1975 /* Score the size. Maximum difference is 127. */
1976 i
= FONT_SIZE_INDEX
;
1977 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
])
1978 && XINT (AREF (entity
, i
)) > 0)
1980 /* We use the higher 6-bit for the actual size difference. The
1981 lowest bit is set if the DPI is different. */
1982 int diff
= XINT (spec_prop
[i
]) - XINT (AREF (entity
, i
));
1987 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
1988 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
1990 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
1997 /* The comparison function for qsort. */
2000 font_compare (d1
, d2
)
2001 const void *d1
, *d2
;
2003 return (*(unsigned *) d1
- *(unsigned *) d2
);
2007 /* The structure for elements being sorted by qsort. */
2008 struct font_sort_data
2015 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
2016 If PREFER specifies a point-size, calculate the corresponding
2017 pixel-size from QCdpi property of PREFER or from the Y-resolution
2018 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
2019 get the font-entities in VEC.
2021 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
2022 return the sorted VEC. */
2025 font_sort_entites (vec
, prefer
, frame
, spec
, best_only
)
2026 Lisp_Object vec
, prefer
, frame
, spec
;
2029 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2031 struct font_sort_data
*data
;
2032 Lisp_Object alternate_families
= Qnil
;
2033 unsigned best_score
;
2034 Lisp_Object best_entity
;
2039 return best_only
? AREF (vec
, 0) : vec
;
2041 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_DPI_INDEX
; i
++)
2042 prefer_prop
[i
] = AREF (prefer
, i
);
2046 /* A font driver may return a font that has a property value
2047 different from the value specified in SPEC if the driver
2048 thinks they are the same. That happens, for instance, such a
2049 generic family name as "serif" is specified. So, to ignore
2050 such a difference, for all properties specified in SPEC, set
2051 the corresponding properties in PREFER_PROP to nil. */
2052 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2053 if (! NILP (AREF (spec
, i
)))
2054 prefer_prop
[i
] = Qnil
;
2057 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2058 prefer_prop
[FONT_SIZE_INDEX
]
2059 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2060 if (! NILP (prefer_prop
[FONT_FAMILY_INDEX
]))
2063 = Fassoc_string (prefer_prop
[FONT_FAMILY_INDEX
],
2064 Vface_alternative_font_family_alist
, Qt
);
2065 if (CONSP (alternate_families
))
2066 alternate_families
= XCDR (alternate_families
);
2069 /* Scoring and sorting. */
2070 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2071 best_score
= 0xFFFFFFFF;
2073 for (i
= 0; i
< len
; i
++)
2075 data
[i
].entity
= AREF (vec
, i
);
2076 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
,
2077 alternate_families
);
2078 if (best_only
&& best_score
> data
[i
].score
)
2080 best_score
= data
[i
].score
;
2081 best_entity
= data
[i
].entity
;
2082 if (best_score
== 0)
2086 if (NILP (best_entity
))
2088 qsort (data
, len
, sizeof *data
, font_compare
);
2089 for (i
= 0; i
< len
; i
++)
2090 ASET (vec
, i
, data
[i
].entity
);
2100 /* API of Font Service Layer. */
2102 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2103 sort_shift_bits. Finternal_set_font_selection_order calls this
2104 function with font_sort_order after setting up it. */
2107 font_update_sort_order (order
)
2112 for (i
= 0, shift_bits
= 21; i
< 4; i
++, shift_bits
-= 7)
2114 int xlfd_idx
= order
[i
];
2116 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2117 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2118 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2119 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2120 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2121 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2123 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2128 /* Check if ENTITY matches with the font specification SPEC. */
2131 font_match_p (spec
, entity
)
2132 Lisp_Object spec
, entity
;
2134 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2135 Lisp_Object alternate_families
= Qnil
;
2136 int prefer_style
[3];
2139 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2140 prefer_prop
[i
] = AREF (spec
, i
);
2141 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2142 prefer_prop
[FONT_SIZE_INDEX
]
2143 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2144 if (! NILP (prefer_prop
[FONT_FAMILY_INDEX
]))
2147 = Fassoc_string (prefer_prop
[FONT_FAMILY_INDEX
],
2148 Vface_alternative_font_family_alist
, Qt
);
2149 if (CONSP (alternate_families
))
2150 alternate_families
= XCDR (alternate_families
);
2153 return (font_score (entity
, prefer_prop
, alternate_families
) == 0);
2157 /* CHeck a lispy font object corresponding to FONT. */
2160 font_check_object (font
)
2163 Lisp_Object tail
, elt
;
2165 for (tail
= font
->props
[FONT_OBJLIST_INDEX
]; CONSP (tail
);
2169 if (font
== XFONT_OBJECT (elt
))
2179 Each font backend has the callback function get_cache, and it
2180 returns a cons cell of which cdr part can be freely used for
2181 caching fonts. The cons cell may be shared by multiple frames
2182 and/or multiple font drivers. So, we arrange the cdr part as this:
2184 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2186 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2187 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2188 cons (FONT-SPEC FONT-ENTITY ...). */
2190 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2191 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2192 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2193 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2194 struct font_driver
*));
2197 font_prepare_cache (f
, driver
)
2199 struct font_driver
*driver
;
2201 Lisp_Object cache
, val
;
2203 cache
= driver
->get_cache (f
);
2205 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2209 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2210 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2214 val
= XCDR (XCAR (val
));
2215 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2221 font_finish_cache (f
, driver
)
2223 struct font_driver
*driver
;
2225 Lisp_Object cache
, val
, tmp
;
2228 cache
= driver
->get_cache (f
);
2230 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2231 cache
= val
, val
= XCDR (val
);
2232 xassert (! NILP (val
));
2233 tmp
= XCDR (XCAR (val
));
2234 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2235 if (XINT (XCAR (tmp
)) == 0)
2237 font_clear_cache (f
, XCAR (val
), driver
);
2238 XSETCDR (cache
, XCDR (val
));
2244 font_get_cache (f
, driver
)
2246 struct font_driver
*driver
;
2248 Lisp_Object val
= driver
->get_cache (f
);
2249 Lisp_Object type
= driver
->type
;
2251 xassert (CONSP (val
));
2252 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2253 xassert (CONSP (val
));
2254 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2255 val
= XCDR (XCAR (val
));
2259 static int num_fonts
;
2262 font_clear_cache (f
, cache
, driver
)
2265 struct font_driver
*driver
;
2267 Lisp_Object tail
, elt
;
2269 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2270 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2273 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)) && VECTORP (XCDR (elt
)))
2275 Lisp_Object vec
= XCDR (elt
);
2278 for (i
= 0; i
< ASIZE (vec
); i
++)
2280 Lisp_Object entity
= AREF (vec
, i
);
2282 if (EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2284 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2286 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2288 Lisp_Object val
= XCAR (objlist
);
2289 struct font
*font
= XFONT_OBJECT (val
);
2291 xassert (font
&& driver
== font
->driver
);
2292 driver
->close (f
, font
);
2295 if (driver
->free_entity
)
2296 driver
->free_entity (entity
);
2301 XSETCDR (cache
, Qnil
);
2305 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2308 font_delete_unmatched (list
, spec
, size
)
2309 Lisp_Object list
, spec
;
2312 Lisp_Object entity
, prev
, tail
;
2313 enum font_property_index prop
;
2315 for (tail
= list
, prev
= Qnil
; CONSP (tail
); )
2317 entity
= XCAR (tail
);
2318 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2319 if (INTEGERP (AREF (spec
, prop
))
2320 && ((XINT (AREF (spec
, prop
)) >> 8)
2321 != (XINT (AREF (entity
, prop
)) >> 8)))
2322 prop
= FONT_SPEC_MAX
;
2323 if (prop
++ <= FONT_SIZE_INDEX
2325 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2327 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2330 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2331 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2332 prop
= FONT_SPEC_MAX
;
2334 if (prop
< FONT_SPEC_MAX
2335 && INTEGERP (AREF (spec
, FONT_SPACING_INDEX
))
2336 && ! EQ (AREF (spec
, FONT_SPACING_INDEX
),
2337 AREF (entity
, FONT_SPACING_INDEX
)))
2338 prop
= FONT_SPEC_MAX
;
2339 if (prop
< FONT_SPEC_MAX
)
2340 prev
= tail
, tail
= XCDR (tail
);
2341 else if (NILP (prev
))
2342 list
= tail
= XCDR (tail
);
2344 tail
= XCDR (tail
), XSETCDR (prev
, tail
);
2350 /* Return a vector of font-entities matching with SPEC on FRAME. */
2353 font_list_entities (frame
, spec
)
2354 Lisp_Object frame
, spec
;
2356 FRAME_PTR f
= XFRAME (frame
);
2357 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2358 Lisp_Object ftype
, family
, alternate_familes
;
2361 int need_filtering
= 0;
2365 xassert (FONT_SPEC_P (spec
));
2367 family
= AREF (spec
, FONT_FAMILY_INDEX
);
2369 alternate_familes
= Qnil
;
2372 alternate_familes
= Fassoc_string (family
,
2373 Vface_alternative_font_family_alist
,
2375 if (! NILP (alternate_familes
))
2376 alternate_familes
= XCDR (alternate_familes
);
2377 n_family
+= XINT (Flength (alternate_familes
));
2380 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2381 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2382 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2383 size
= font_pixel_size (f
, spec
);
2387 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2388 for (i
= 1; i
<= FONT_REGISTRY_INDEX
; i
++)
2389 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2390 for (; i
< FONT_EXTRA_INDEX
; i
++)
2392 ASET (scratch_font_spec
, i
, Qnil
);
2393 if (! NILP (AREF (spec
, i
)))
2396 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2398 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
* n_family
);
2402 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2404 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2406 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2407 Lisp_Object tail
= alternate_familes
;
2411 Lisp_Object val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2419 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2420 if (! NILP (val
) && need_filtering
)
2421 val
= font_delete_unmatched (val
, spec
, size
);
2422 copy
= Fcopy_font_spec (scratch_font_spec
);
2423 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2432 ASET (scratch_font_spec
, FONT_FAMILY_INDEX
,
2433 Fintern (XCAR (tail
), Qnil
));
2438 return (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2442 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2443 nil, is an array of face's attributes, which specifies preferred
2444 font-related attributes. */
2447 font_matching_entity (f
, attrs
, spec
)
2449 Lisp_Object
*attrs
, spec
;
2451 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2452 Lisp_Object ftype
, size
, entity
;
2455 XSETFRAME (frame
, f
);
2456 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2457 size
= AREF (spec
, FONT_SIZE_INDEX
);
2459 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2461 for (; driver_list
; driver_list
= driver_list
->next
)
2463 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2465 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2468 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2469 entity
= assoc_no_quit (spec
, XCDR (cache
));
2471 entity
= XCDR (entity
);
2474 entity
= driver_list
->driver
->match (frame
, spec
);
2475 copy
= Fcopy_font_spec (spec
);
2476 ASET (copy
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2477 XSETCDR (cache
, Fcons (Fcons (copy
, entity
), XCDR (cache
)));
2479 if (! NILP (entity
))
2482 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2483 ASET (spec
, FONT_SIZE_INDEX
, size
);
2488 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2489 opened font object. */
2492 font_open_entity (f
, entity
, pixel_size
)
2497 struct font_driver_list
*driver_list
;
2498 Lisp_Object objlist
, size
, val
, font_object
;
2502 xassert (FONT_ENTITY_P (entity
));
2503 size
= AREF (entity
, FONT_SIZE_INDEX
);
2504 if (XINT (size
) != 0)
2505 pixel_size
= XINT (size
);
2507 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2508 objlist
= XCDR (objlist
))
2509 if (XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2510 return XCAR (objlist
);
2512 val
= AREF (entity
, FONT_TYPE_INDEX
);
2513 for (driver_list
= f
->font_driver_list
;
2514 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2515 driver_list
= driver_list
->next
);
2519 font_object
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2520 if (NILP (font_object
))
2522 ASET (entity
, FONT_OBJLIST_INDEX
,
2523 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2524 ASET (font_object
, FONT_OBJLIST_INDEX
, AREF (entity
, FONT_OBJLIST_INDEX
));
2527 font
= XFONT_OBJECT (font_object
);
2528 min_width
= (font
->min_width
? font
->min_width
2529 : font
->average_width
? font
->average_width
2530 : font
->space_width
? font
->space_width
2532 #ifdef HAVE_WINDOW_SYSTEM
2533 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2534 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2536 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2537 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
;
2538 fonts_changed_p
= 1;
2542 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2543 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2544 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > font
->height
)
2545 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
, fonts_changed_p
= 1;
2553 /* Close FONT_OBJECT that is opened on frame F. */
2556 font_close_object (f
, font_object
)
2558 Lisp_Object font_object
;
2560 struct font
*font
= XFONT_OBJECT (font_object
);
2561 Lisp_Object objlist
;
2562 Lisp_Object tail
, prev
= Qnil
;
2564 objlist
= AREF (font_object
, FONT_OBJLIST_INDEX
);
2565 for (prev
= Qnil
, tail
= objlist
; CONSP (tail
);
2566 prev
= tail
, tail
= XCDR (tail
))
2567 if (EQ (font_object
, XCAR (tail
)))
2569 font
->driver
->close (f
, font
);
2570 #ifdef HAVE_WINDOW_SYSTEM
2571 xassert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2572 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2575 ASET (font_object
, FONT_OBJLIST_INDEX
, XCDR (objlist
));
2577 XSETCDR (prev
, XCDR (objlist
));
2585 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2586 FONT is a font-entity and it must be opened to check. */
2589 font_has_char (f
, font
, c
)
2596 if (FONT_ENTITY_P (font
))
2598 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2599 struct font_driver_list
*driver_list
;
2601 for (driver_list
= f
->font_driver_list
;
2602 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2603 driver_list
= driver_list
->next
);
2606 if (! driver_list
->driver
->has_char
)
2608 return driver_list
->driver
->has_char (font
, c
);
2611 xassert (FONT_OBJECT_P (font
));
2612 fontp
= XFONT_OBJECT (font
);
2613 if (fontp
->driver
->has_char
)
2615 int result
= fontp
->driver
->has_char (font
, c
);
2620 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2624 /* Return the glyph ID of FONT_OBJECT for character C. */
2627 font_encode_char (font_object
, c
)
2628 Lisp_Object font_object
;
2633 xassert (FONT_OBJECT_P (font_object
));
2634 font
= XFONT_OBJECT (font_object
);
2635 return font
->driver
->encode_char (font
, c
);
2639 /* Return the name of FONT_OBJECT. */
2642 font_get_name (font_object
)
2643 Lisp_Object font_object
;
2647 xassert (FONT_OBJECT_P (font_object
));
2648 return AREF (font_object
, FONT_NAME_INDEX
);
2652 /* Return the specification of FONT_OBJECT. */
2655 font_get_spec (font_object
)
2656 Lisp_Object font_object
;
2658 Lisp_Object spec
= font_make_spec ();
2661 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2662 ASET (spec
, i
, AREF (font_object
, i
));
2663 ASET (spec
, FONT_SIZE_INDEX
,
2664 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2669 font_spec_from_name (font_name
)
2670 Lisp_Object font_name
;
2672 Lisp_Object args
[2];
2675 args
[1] = font_name
;
2676 return Ffont_spec (2, args
);
2681 font_clear_prop (attrs
, prop
)
2683 enum font_property_index prop
;
2685 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2686 Lisp_Object extra
, prev
;
2690 if (NILP (AREF (font
, prop
))
2691 && prop
!= FONT_FAMILY_INDEX
&& prop
!= FONT_FAMILY_INDEX
)
2693 font
= Fcopy_font_spec (font
);
2694 ASET (font
, prop
, Qnil
);
2695 if (prop
== FONT_FAMILY_INDEX
)
2697 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
2698 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
2699 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
2700 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2701 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2702 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2704 else if (prop
== FONT_SIZE_INDEX
)
2706 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2707 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2708 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2710 attrs
[LFACE_FONT_INDEX
] = font
;
2714 font_update_lface (f
, attrs
)
2718 Lisp_Object spec
, val
;
2721 spec
= attrs
[LFACE_FONT_INDEX
];
2722 if (! FONT_SPEC_P (spec
))
2725 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
))
2726 || ! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2730 if (NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
2731 family
= AREF (spec
, FONT_FAMILY_INDEX
);
2732 else if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2733 family
= concat2 (SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
)),
2734 build_string ("-*"));
2736 family
= concat3 (SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
)),
2738 SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
)));
2739 attrs
[LFACE_FAMILY_INDEX
] = family
;
2741 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
2742 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
2743 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
2744 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);;
2745 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
2746 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
2747 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
2751 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2756 val
= Ffont_get (spec
, QCdpi
);
2759 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
2762 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2763 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
2764 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
2769 /* Return a font-entity satisfying SPEC and best matching with face's
2770 font related attributes in ATTRS. C, if not negative, is a
2771 character that the entity must support. */
2774 font_find_for_lface (f
, attrs
, spec
, c
)
2780 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
2786 Lisp_Object registry
= AREF (spec
, FONT_REGISTRY_INDEX
);
2787 struct charset
*encoding
, *repertory
;
2789 if (font_registry_charsets (registry
, &encoding
, &repertory
) < 0)
2793 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
2795 /* Any font of this registry support C. So, let's
2796 suppress the further checking. */
2799 else if (c
> encoding
->max_char
)
2803 XSETFRAME (frame
, f
);
2804 size
= AREF (spec
, FONT_SIZE_INDEX
);
2805 ASET (spec
, FONT_SIZE_INDEX
, Qnil
);
2806 entities
= font_list_entities (frame
, spec
);
2807 ASET (spec
, FONT_SIZE_INDEX
, size
);
2808 if (ASIZE (entities
) == 0)
2810 if (ASIZE (entities
) == 1)
2813 return AREF (entities
, 0);
2817 /* Sort fonts by properties specified in LFACE. */
2818 Lisp_Object prefer
= scratch_font_prefer
;
2820 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
2821 ASET (prefer
, i
, AREF (spec
, i
));
2822 if (FONTP (attrs
[LFACE_FONT_INDEX
]))
2824 Lisp_Object face_font
= attrs
[LFACE_FONT_INDEX
];
2826 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
2827 if (NILP (AREF (prefer
, i
)))
2828 ASET (prefer
, i
, AREF (face_font
, i
));
2830 if (NILP (AREF (prefer
, FONT_FAMILY_INDEX
)))
2831 font_parse_family_registry (attrs
[LFACE_FAMILY_INDEX
], Qnil
, prefer
);
2832 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
2833 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2834 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
2835 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2836 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
2837 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2838 if (INTEGERP (size
))
2839 ASET (prefer
, FONT_SIZE_INDEX
, size
);
2840 else if (FLOATP (size
))
2841 ASET (prefer
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2844 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
2845 int pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
2846 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2848 ASET (spec
, FONT_SIZE_INDEX
, Qnil
);
2849 entities
= font_sort_entites (entities
, prefer
, frame
, spec
, c
< 0);
2850 ASET (spec
, FONT_SIZE_INDEX
, size
);
2855 for (i
= 0; i
< ASIZE (entities
); i
++)
2859 val
= AREF (entities
, i
);
2862 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
2863 if (! EQ (AREF (val
, j
), props
[j
]))
2865 if (j
> FONT_REGISTRY_INDEX
)
2868 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
2869 props
[j
] = AREF (val
, j
);
2870 result
= font_has_char (f
, val
, c
);
2875 val
= font_open_for_lface (f
, val
, attrs
, spec
);
2878 result
= font_has_char (f
, val
, c
);
2879 font_close_object (f
, val
);
2881 return AREF (entities
, i
);
2888 font_open_for_lface (f
, entity
, attrs
, spec
)
2896 if (FONT_SPEC_P (spec
) && INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2897 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2900 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
2903 size
= POINT_TO_PIXEL (pt
, f
->resy
);
2905 return font_open_entity (f
, entity
, size
);
2909 /* Find a font satisfying SPEC and best matching with face's
2910 attributes in ATTRS on FRAME, and return the opened
2914 font_load_for_lface (f
, attrs
, spec
)
2916 Lisp_Object
*attrs
, spec
;
2920 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
2923 /* No font is listed for SPEC, but each font-backend may have
2924 the different criteria about "font matching". So, try
2926 entity
= font_matching_entity (f
, attrs
, spec
);
2930 return font_open_for_lface (f
, entity
, attrs
, spec
);
2934 /* Make FACE on frame F ready to use the font opened for FACE. */
2937 font_prepare_for_face (f
, face
)
2941 if (face
->font
->driver
->prepare_face
)
2942 face
->font
->driver
->prepare_face (f
, face
);
2946 /* Make FACE on frame F stop using the font opened for FACE. */
2949 font_done_for_face (f
, face
)
2953 if (face
->font
->driver
->done_face
)
2954 face
->font
->driver
->done_face (f
, face
);
2959 /* Open a font best matching with NAME on frame F. If no proper font
2960 is found, return Qnil. */
2963 font_open_by_name (f
, name
)
2967 Lisp_Object args
[2];
2968 Lisp_Object spec
, prefer
, size
, entity
, entity_list
;
2973 XSETFRAME (frame
, f
);
2976 args
[1] = make_unibyte_string (name
, strlen (name
));
2977 spec
= Ffont_spec (2, args
);
2978 prefer
= scratch_font_prefer
;
2979 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2981 ASET (prefer
, i
, AREF (spec
, i
));
2982 if (NILP (AREF (prefer
, i
))
2983 && i
>= FONT_WEIGHT_INDEX
&& i
<= FONT_WIDTH_INDEX
)
2984 FONT_SET_STYLE (prefer
, i
, make_number (100));
2986 size
= AREF (spec
, FONT_SIZE_INDEX
);
2991 if (INTEGERP (size
))
2992 pixel_size
= XINT (size
);
2993 else /* FLOATP (size) */
2995 double pt
= XFLOAT_DATA (size
);
2997 pixel_size
= POINT_TO_PIXEL (pt
, f
->resy
);
2999 if (pixel_size
== 0)
3000 ASET (spec
, FONT_SIZE_INDEX
, Qnil
);
3002 if (pixel_size
== 0)
3004 pixel_size
= POINT_TO_PIXEL (12.0, f
->resy
);
3005 size
= make_number (pixel_size
);
3006 ASET (prefer
, FONT_SIZE_INDEX
, size
);
3008 if (NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
3009 ASET (spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
3011 entity_list
= Flist_fonts (spec
, frame
, make_number (1), prefer
);
3012 if (NILP (entity_list
))
3013 entity
= font_matching_entity (f
, NULL
, spec
);
3015 entity
= XCAR (entity_list
);
3016 return (NILP (entity
)
3018 : font_open_entity (f
, entity
, pixel_size
));
3022 /* Register font-driver DRIVER. This function is used in two ways.
3024 The first is with frame F non-NULL. In this case, make DRIVER
3025 available (but not yet activated) on F. All frame creaters
3026 (e.g. Fx_create_frame) must call this function at least once with
3027 an available font-driver.
3029 The second is with frame F NULL. In this case, DRIVER is globally
3030 registered in the variable `font_driver_list'. All font-driver
3031 implementations must call this function in its syms_of_XXXX
3032 (e.g. syms_of_xfont). */
3035 register_font_driver (driver
, f
)
3036 struct font_driver
*driver
;
3039 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
3040 struct font_driver_list
*prev
, *list
;
3042 if (f
&& ! driver
->draw
)
3043 error ("Unusable font driver for a frame: %s",
3044 SDATA (SYMBOL_NAME (driver
->type
)));
3046 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
3047 if (EQ (list
->driver
->type
, driver
->type
))
3048 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3050 list
= malloc (sizeof (struct font_driver_list
));
3052 list
->driver
= driver
;
3057 f
->font_driver_list
= list
;
3059 font_driver_list
= list
;
3064 /* Free font-driver list on frame F. It doesn't free font-drivers
3068 free_font_driver_list (f
)
3071 while (f
->font_driver_list
)
3073 struct font_driver_list
*next
= f
->font_driver_list
->next
;
3075 free (f
->font_driver_list
);
3076 f
->font_driver_list
= next
;
3081 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3082 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3083 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3085 A caller must free all realized faces if any in advance. The
3086 return value is a list of font backends actually made used on
3090 font_update_drivers (f
, new_drivers
)
3092 Lisp_Object new_drivers
;
3094 Lisp_Object active_drivers
= Qnil
;
3095 struct font_driver_list
*list
;
3097 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3100 if (! EQ (new_drivers
, Qt
)
3101 && NILP (Fmemq (list
->driver
->type
, new_drivers
)))
3103 if (list
->driver
->end_for_frame
)
3104 list
->driver
->end_for_frame (f
);
3105 font_finish_cache (f
, list
->driver
);
3111 if (EQ (new_drivers
, Qt
)
3112 || ! NILP (Fmemq (list
->driver
->type
, new_drivers
)))
3114 if (! list
->driver
->start_for_frame
3115 || list
->driver
->start_for_frame (f
) == 0)
3117 font_prepare_cache (f
, list
->driver
);
3119 active_drivers
= nconc2 (active_drivers
,
3120 Fcons (list
->driver
->type
, Qnil
));
3125 return active_drivers
;
3129 font_put_frame_data (f
, driver
, data
)
3131 struct font_driver
*driver
;
3134 struct font_data_list
*list
, *prev
;
3136 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3137 prev
= list
, list
= list
->next
)
3138 if (list
->driver
== driver
)
3145 prev
->next
= list
->next
;
3147 f
->font_data_list
= list
->next
;
3155 list
= malloc (sizeof (struct font_data_list
));
3158 list
->driver
= driver
;
3159 list
->next
= f
->font_data_list
;
3160 f
->font_data_list
= list
;
3168 font_get_frame_data (f
, driver
)
3170 struct font_driver
*driver
;
3172 struct font_data_list
*list
;
3174 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3175 if (list
->driver
== driver
)
3183 /* Return the font used to draw character C by FACE at buffer position
3184 POS in window W. If STRING is non-nil, it is a string containing C
3185 at index POS. If C is negative, get C from the current buffer or
3189 font_at (c
, pos
, face
, w
, string
)
3198 Lisp_Object font_object
;
3204 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3207 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3209 c
= FETCH_CHAR (pos_byte
);
3212 c
= FETCH_BYTE (pos
);
3218 multibyte
= STRING_MULTIBYTE (string
);
3221 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3223 str
= SDATA (string
) + pos_byte
;
3224 c
= STRING_CHAR (str
, 0);
3227 c
= SDATA (string
)[pos
];
3231 f
= XFRAME (w
->frame
);
3232 if (! FRAME_WINDOW_P (f
))
3239 if (STRINGP (string
))
3240 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3241 DEFAULT_FACE_ID
, 0);
3243 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3245 face
= FACE_FROM_ID (f
, face_id
);
3249 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3250 face
= FACE_FROM_ID (f
, face_id
);
3255 xassert (font_check_object ((struct font
*) face
->font
));
3256 XSETFONT (font_object
, face
->font
);
3261 /* Check how many characters after POS (at most to LIMIT) can be
3262 displayed by the same font. FACE is the face selected for the
3263 character as POS on frame F. STRING, if not nil, is the string to
3264 check instead of the current buffer.
3266 The return value is the position of the character that is displayed
3267 by the differnt font than that of the character as POS. */
3270 font_range (pos
, limit
, face
, f
, string
)
3271 EMACS_INT pos
, limit
;
3284 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3285 pos_byte
= CHAR_TO_BYTE (pos
);
3289 multibyte
= STRING_MULTIBYTE (string
);
3290 pos_byte
= string_char_to_byte (string
, pos
);
3294 /* All unibyte character are displayed by the same font. */
3302 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3304 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3305 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3306 face
= FACE_FROM_ID (f
, face_id
);
3313 else if (font
!= face
->font
)
3325 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3326 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3327 Return nil otherwise.
3328 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3329 which kind of font it is. It must be one of `font-spec', `font-entity'
3331 (object
, extra_type
)
3332 Lisp_Object object
, extra_type
;
3334 if (NILP (extra_type
))
3335 return (FONTP (object
) ? Qt
: Qnil
);
3336 if (EQ (extra_type
, Qfont_spec
))
3337 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3338 if (EQ (extra_type
, Qfont_entity
))
3339 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3340 if (EQ (extra_type
, Qfont_object
))
3341 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3342 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3345 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3346 doc
: /* Return a newly created font-spec with arguments as properties.
3348 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3349 valid font property name listed below:
3351 `:family', `:weight', `:slant', `:width'
3353 They are the same as face attributes of the same name. See
3354 `set-face-attribute'.
3358 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3362 VALUE must be a string or a symbol specifying the additional
3363 typographic style information of a font, e.g. ``sans''.
3367 VALUE must be a string or a symbol specifying the charset registry and
3368 encoding of a font, e.g. ``iso8859-1''.
3372 VALUE must be a non-negative integer or a floating point number
3373 specifying the font size. It specifies the font size in pixels
3374 (if VALUE is an integer), or in points (if VALUE is a float).
3375 usage: (font-spec ARGS ...) */)
3380 Lisp_Object spec
= font_make_spec ();
3383 for (i
= 0; i
< nargs
; i
+= 2)
3385 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3387 if (EQ (key
, QCname
))
3390 font_parse_name ((char *) SDATA (val
), spec
);
3391 font_put_extra (spec
, key
, val
);
3393 else if (EQ (key
, QCfamily
))
3396 font_parse_family_registry (val
, Qnil
, spec
);
3400 int idx
= get_font_prop_index (key
);
3404 val
= font_prop_validate (idx
, Qnil
, val
);
3405 if (idx
< FONT_EXTRA_INDEX
)
3406 ASET (spec
, idx
, val
);
3408 font_put_extra (spec
, key
, val
);
3411 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3417 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3418 doc
: /* Return a copy of FONT as a font-spec. */)
3422 Lisp_Object new_spec
, tail
, extra
;
3426 new_spec
= font_make_spec ();
3427 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3428 ASET (new_spec
, i
, AREF (font
, i
));
3430 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3432 if (! EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3433 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3435 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3439 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3440 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3441 Every specified properties in FROM override the corresponding
3442 properties in TO. */)
3444 Lisp_Object from
, to
;
3446 Lisp_Object extra
, tail
;
3451 to
= Fcopy_font_spec (to
);
3452 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3453 ASET (to
, i
, AREF (from
, i
));
3454 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3455 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3456 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3458 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3461 XSETCDR (slot
, XCDR (XCAR (tail
)));
3463 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3465 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3469 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3470 doc
: /* Return the value of FONT's property KEY.
3471 FONT is a font-spec, a font-entity, or a font-object. */)
3473 Lisp_Object font
, key
;
3480 idx
= get_font_prop_index (key
);
3481 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3482 return AREF (font
, idx
);
3483 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3487 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3488 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
3489 (font_spec
, prop
, val
)
3490 Lisp_Object font_spec
, prop
, val
;
3493 Lisp_Object extra
, slot
;
3495 CHECK_FONT_SPEC (font_spec
);
3496 idx
= get_font_prop_index (prop
);
3497 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3499 if (idx
== FONT_FAMILY_INDEX
3501 font_parse_family_registry (val
, Qnil
, font_spec
);
3503 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
3506 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
3510 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3511 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3512 Optional 2nd argument FRAME specifies the target frame.
3513 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3514 Optional 4th argument PREFER, if non-nil, is a font-spec to
3515 control the order of the returned list. Fonts are sorted by
3516 how they are close to PREFER. */)
3517 (font_spec
, frame
, num
, prefer
)
3518 Lisp_Object font_spec
, frame
, num
, prefer
;
3520 Lisp_Object vec
, list
, tail
;
3524 frame
= selected_frame
;
3525 CHECK_LIVE_FRAME (frame
);
3526 CHECK_FONT_SPEC (font_spec
);
3534 if (! NILP (prefer
))
3535 CHECK_FONT_SPEC (prefer
);
3537 vec
= font_list_entities (frame
, font_spec
);
3542 return Fcons (AREF (vec
, 0), Qnil
);
3544 if (! NILP (prefer
))
3545 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
, 0);
3547 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3548 if (n
== 0 || n
> len
)
3550 for (i
= 1; i
< n
; i
++)
3552 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3554 XSETCDR (tail
, val
);
3560 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
3561 doc
: /* List available font families on the current frame.
3562 Optional argument FRAME specifies the target frame. */)
3567 struct font_driver_list
*driver_list
;
3571 frame
= selected_frame
;
3572 CHECK_LIVE_FRAME (frame
);
3575 for (driver_list
= f
->font_driver_list
; driver_list
;
3576 driver_list
= driver_list
->next
)
3577 if (driver_list
->driver
->list_family
)
3579 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3585 Lisp_Object tail
= list
;
3587 for (; CONSP (val
); val
= XCDR (val
))
3588 if (NILP (Fmemq (XCAR (val
), tail
)))
3589 list
= Fcons (XCAR (val
), list
);
3595 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3596 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3597 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3599 Lisp_Object font_spec
, frame
;
3601 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3608 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 1, 0,
3609 doc
: /* Return XLFD name of FONT.
3610 FONT is a font-spec, font-entity, or font-object.
3611 If the name is too long for XLFD (maximum 255 chars), return nil. */)
3620 if (FONT_OBJECT_P (font
))
3622 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
3624 if (STRINGP (font_name
)
3625 && SDATA (font_name
)[0] == '-')
3627 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
3629 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3631 return build_string (name
);
3634 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3635 doc
: /* Clear font cache. */)
3638 Lisp_Object list
, frame
;
3640 FOR_EACH_FRAME (list
, frame
)
3642 FRAME_PTR f
= XFRAME (frame
);
3643 struct font_driver_list
*driver_list
= f
->font_driver_list
;
3645 for (; driver_list
; driver_list
= driver_list
->next
)
3646 if (driver_list
->on
)
3648 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
3653 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
3655 xassert (! NILP (val
));
3656 val
= XCDR (XCAR (val
));
3657 if (XINT (XCAR (val
)) == 0)
3659 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
3660 XSETCDR (cache
, XCDR (val
));
3668 DEFUN ("internal-set-font-style-table", Finternal_set_font_style_table
,
3669 Sinternal_set_font_style_table
, 3, 3, 0,
3670 doc
: /* Setup font style table from WEIGHT, SLANT, and WIDTH tables.
3671 WEIGHT, SLANT, WIDTH must be `font-weight-table', `font-slant-table',
3672 `font-width-table' respectivly.
3673 This function is called after those tables are initialized. */)
3674 (weight
, slant
, width
)
3675 Lisp_Object weight
, slant
, width
;
3677 Lisp_Object tables
[3];
3680 tables
[0] = weight
, tables
[1] = slant
, tables
[2] = width
;
3682 font_style_table
= Fmake_vector (make_number (3), Qnil
);
3683 /* In the following loop, we don't use XCAR and XCDR until assuring
3684 the argument is a cons cell so that the error in the tables can
3686 for (i
= 0; i
< 3; i
++)
3688 Lisp_Object tail
, elt
, list
, val
;
3690 for (tail
= tables
[i
], list
= Qnil
; CONSP (tail
); tail
= XCDR (tail
))
3695 CHECK_SYMBOL (Fcar (elt
));
3696 val
= Fcons (XCAR (elt
), Qnil
);
3698 CHECK_NATNUM (Fcar (elt
));
3699 if (numeric
>= XINT (XCAR (elt
)))
3700 error ("Numeric values not unique nor sorted in %s",
3701 (i
== 0 ? "font-weight-table"
3702 : i
== 1 ? "font-slant-table"
3703 : "font-width-table"));
3704 numeric
= XINT (XCAR (elt
));
3705 XSETCDR (val
, XCAR (elt
));
3706 list
= Fcons (val
, list
);
3707 for (elt
= XCDR (elt
); CONSP (elt
); elt
= XCDR (elt
))
3711 list
= Fcons (Fcons (XCAR (elt
), make_number (numeric
)), list
);
3714 list
= Fnreverse (list
);
3715 ASET (font_style_table
, i
, Fvconcat (1, &list
));
3721 /* The following three functions are still expremental. */
3723 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
3724 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
3725 FONT-OBJECT may be nil if it is not yet known.
3727 G-string is sequence of glyphs of a specific font,
3728 and is a vector of this form:
3729 [ HEADER GLYPH ... ]
3730 HEADER is a vector of this form:
3731 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
3733 FONT-OBJECT is a font-object for all glyphs in the g-string,
3734 WIDTH thry DESCENT are the metrics (in pixels) of the whole G-string.
3735 GLYPH is a vector of this form:
3736 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
3737 [ [X-OFF Y-OFF WADJUST] | nil] ]
3739 FROM-IDX and TO-IDX are used internally and should not be touched.
3740 C is the character of the glyph.
3741 CODE is the glyph-code of C in FONT-OBJECT.
3742 WIDTH thry DESCENT are the metrics (in pixels) of the glyph.
3743 X-OFF and Y-OFF are offests to the base position for the glyph.
3744 WADJUST is the adjustment to the normal width of the glyph. */)
3746 Lisp_Object font_object
, num
;
3748 Lisp_Object gstring
, g
;
3752 if (! NILP (font_object
))
3753 CHECK_FONT_OBJECT (font_object
);
3756 len
= XINT (num
) + 1;
3757 gstring
= Fmake_vector (make_number (len
), Qnil
);
3758 g
= Fmake_vector (make_number (6), Qnil
);
3759 ASET (g
, 0, font_object
);
3760 ASET (gstring
, 0, g
);
3761 for (i
= 1; i
< len
; i
++)
3762 ASET (gstring
, i
, Fmake_vector (make_number (10), Qnil
));
3766 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
3767 doc
: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
3768 START and END specify the region to extract characters.
3769 If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
3770 where to extract characters.
3771 FONT-OBJECT may be nil if GSTRING already already contains one. */)
3772 (gstring
, font_object
, start
, end
, object
)
3773 Lisp_Object gstring
, font_object
, start
, end
, object
;
3779 CHECK_VECTOR (gstring
);
3780 if (NILP (font_object
))
3781 font_object
= LGSTRING_FONT (gstring
);
3782 font
= XFONT_OBJECT (font_object
);
3784 if (STRINGP (object
))
3786 const unsigned char *p
;
3788 CHECK_NATNUM (start
);
3790 if (XINT (start
) > XINT (end
)
3791 || XINT (end
) > ASIZE (object
)
3792 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3793 args_out_of_range_3 (object
, start
, end
);
3795 len
= XINT (end
) - XINT (start
);
3796 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
3797 for (i
= 0; i
< len
; i
++)
3799 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3800 /* Shut up GCC warning in comparison with
3801 MOST_POSITIVE_FIXNUM below. */
3804 c
= STRING_CHAR_ADVANCE (p
);
3805 cod
= code
= font
->driver
->encode_char (font
, c
);
3806 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
3808 LGLYPH_SET_FROM (g
, i
);
3809 LGLYPH_SET_TO (g
, i
);
3810 LGLYPH_SET_CHAR (g
, c
);
3811 LGLYPH_SET_CODE (g
, code
);
3818 if (! NILP (object
))
3819 Fset_buffer (object
);
3820 validate_region (&start
, &end
);
3821 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3822 args_out_of_range (start
, end
);
3823 len
= XINT (end
) - XINT (start
);
3825 pos_byte
= CHAR_TO_BYTE (pos
);
3826 for (i
= 0; i
< len
; i
++)
3828 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3829 /* Shut up GCC warning in comparison with
3830 MOST_POSITIVE_FIXNUM below. */
3833 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
3834 cod
= code
= font
->driver
->encode_char (font
, c
);
3835 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
3837 LGLYPH_SET_FROM (g
, i
);
3838 LGLYPH_SET_TO (g
, i
);
3839 LGLYPH_SET_CHAR (g
, c
);
3840 LGLYPH_SET_CODE (g
, code
);
3843 for (; i
< LGSTRING_LENGTH (gstring
); i
++)
3844 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
3848 DEFUN ("font-shape-text", Ffont_shape_text
, Sfont_shape_text
, 3, 4, 0,
3849 doc
: /* Shape text between FROM and TO by FONT-OBJECT.
3850 If optional 4th argument STRING is non-nil, it is a string to shape,
3851 and FROM and TO are indices to the string.
3852 The value is the end position of the text that can be shaped by
3854 (from
, to
, font_object
, string
)
3855 Lisp_Object from
, to
, font_object
, string
;
3858 struct font_metrics metrics
;
3859 EMACS_INT start
, end
;
3860 Lisp_Object gstring
, n
;
3863 if (! FONT_OBJECT_P (font_object
))
3865 font
= XFONT_OBJECT (font_object
);
3866 if (! font
->driver
->shape
)
3871 validate_region (&from
, &to
);
3872 start
= XFASTINT (from
);
3873 end
= XFASTINT (to
);
3874 modify_region (current_buffer
, start
, end
, 0);
3878 CHECK_STRING (string
);
3879 start
= XINT (from
);
3881 if (start
< 0 || start
> end
|| end
> SCHARS (string
))
3882 args_out_of_range_3 (string
, from
, to
);
3886 gstring
= Ffont_make_gstring (font_object
, make_number (len
));
3887 Ffont_fill_gstring (gstring
, font_object
, from
, to
, string
);
3889 /* Try at most three times with larger gstring each time. */
3890 for (i
= 0; i
< 3; i
++)
3892 Lisp_Object args
[2];
3894 n
= font
->driver
->shape (gstring
);
3898 args
[1] = Fmake_vector (make_number (len
), Qnil
);
3899 gstring
= Fvconcat (2, args
);
3901 if (! INTEGERP (n
) || XINT (n
) == 0)
3905 for (i
= 0; i
< len
;)
3908 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3909 EMACS_INT this_from
= LGLYPH_FROM (g
);
3910 EMACS_INT this_to
= LGLYPH_TO (g
) + 1;
3912 int need_composition
= 0;
3914 metrics
.lbearing
= LGLYPH_LBEARING (g
);
3915 metrics
.rbearing
= LGLYPH_RBEARING (g
);
3916 metrics
.ascent
= LGLYPH_ASCENT (g
);
3917 metrics
.descent
= LGLYPH_DESCENT (g
);
3918 if (NILP (LGLYPH_ADJUSTMENT (g
)))
3920 metrics
.width
= LGLYPH_WIDTH (g
);
3921 if (LGLYPH_CHAR (g
) == 0 || metrics
.width
== 0)
3922 need_composition
= 1;
3926 metrics
.width
= LGLYPH_WADJUST (g
);
3927 metrics
.lbearing
+= LGLYPH_XOFF (g
);
3928 metrics
.rbearing
+= LGLYPH_XOFF (g
);
3929 metrics
.ascent
-= LGLYPH_YOFF (g
);
3930 metrics
.descent
+= LGLYPH_YOFF (g
);
3931 need_composition
= 1;
3933 for (j
= i
+ 1; j
< len
; j
++)
3937 g
= LGSTRING_GLYPH (gstring
, j
);
3938 if (this_from
!= LGLYPH_FROM (g
))
3940 need_composition
= 1;
3941 x
= metrics
.width
+ LGLYPH_LBEARING (g
) + LGLYPH_XOFF (g
);
3942 if (metrics
.lbearing
> x
)
3943 metrics
.lbearing
= x
;
3944 x
= metrics
.width
+ LGLYPH_RBEARING (g
) + LGLYPH_XOFF (g
);
3945 if (metrics
.rbearing
< x
)
3946 metrics
.rbearing
= x
;
3947 x
= LGLYPH_ASCENT (g
) - LGLYPH_YOFF (g
);
3948 if (metrics
.ascent
< x
)
3950 x
= LGLYPH_DESCENT (g
) - LGLYPH_YOFF (g
);
3951 if (metrics
.descent
< x
)
3952 metrics
.descent
= x
;
3953 if (NILP (LGLYPH_ADJUSTMENT (g
)))
3954 metrics
.width
+= LGLYPH_WIDTH (g
);
3956 metrics
.width
+= LGLYPH_WADJUST (g
);
3959 if (need_composition
)
3961 gstr
= Ffont_make_gstring (font_object
, make_number (j
- i
));
3962 LGSTRING_SET_WIDTH (gstr
, metrics
.width
);
3963 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
3964 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
);
3965 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
3966 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
3967 for (k
= i
; i
< j
; i
++)
3969 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3971 LGLYPH_SET_FROM (g
, LGLYPH_FROM (g
) - this_from
);
3972 LGLYPH_SET_TO (g
, LGLYPH_TO (g
) - this_from
);
3973 LGSTRING_SET_GLYPH (gstr
, i
- k
, LGSTRING_GLYPH (gstring
, i
));
3975 from
= make_number (start
+ this_from
);
3976 to
= make_number (start
+ this_to
);
3978 Fcompose_region_internal (from
, to
, gstr
, Qnil
);
3980 Fcompose_string_internal (string
, from
, to
, gstr
, Qnil
);
3989 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
3990 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
3991 OTF-FEATURES specifies which features to apply in this format:
3992 (SCRIPT LANGSYS GSUB GPOS)
3994 SCRIPT is a symbol specifying a script tag of OpenType,
3995 LANGSYS is a symbol specifying a langsys tag of OpenType,
3996 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
3998 If LANGYS is nil, the default langsys is selected.
4000 The features are applied in the order they appear in the list. The
4001 symbol `*' means to apply all available features not present in this
4002 list, and the remaining features are ignored. For instance, (vatu
4003 pstf * haln) is to apply vatu and pstf in this order, then to apply
4004 all available features other than vatu, pstf, and haln.
4006 The features are applied to the glyphs in the range FROM and TO of
4007 the glyph-string GSTRING-IN.
4009 If some feature is actually applicable, the resulting glyphs are
4010 produced in the glyph-string GSTRING-OUT from the index INDEX. In
4011 this case, the value is the number of produced glyphs.
4013 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
4016 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
4017 produced in GSTRING-OUT, and the value is nil.
4019 See the documentation of `font-make-gstring' for the format of
4021 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
4022 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
4024 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
4029 check_otf_features (otf_features
);
4030 CHECK_FONT_OBJECT (font_object
);
4031 font
= XFONT_OBJECT (font_object
);
4032 if (! font
->driver
->otf_drive
)
4033 error ("Font backend %s can't drive OpenType GSUB table",
4034 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4035 CHECK_CONS (otf_features
);
4036 CHECK_SYMBOL (XCAR (otf_features
));
4037 val
= XCDR (otf_features
);
4038 CHECK_SYMBOL (XCAR (val
));
4039 val
= XCDR (otf_features
);
4042 len
= check_gstring (gstring_in
);
4043 CHECK_VECTOR (gstring_out
);
4044 CHECK_NATNUM (from
);
4046 CHECK_NATNUM (index
);
4048 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4049 args_out_of_range_3 (from
, to
, make_number (len
));
4050 if (XINT (index
) >= ASIZE (gstring_out
))
4051 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4052 num
= font
->driver
->otf_drive (font
, otf_features
,
4053 gstring_in
, XINT (from
), XINT (to
),
4054 gstring_out
, XINT (index
), 0);
4057 return make_number (num
);
4060 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4062 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4063 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4065 (SCRIPT LANGSYS FEATURE ...)
4066 See the documentation of `font-otf-gsub' for more detail.
4068 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4069 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4070 character code corresponding to the glyph or nil if there's no
4071 corresponding character. */)
4072 (font_object
, character
, otf_features
)
4073 Lisp_Object font_object
, character
, otf_features
;
4076 Lisp_Object gstring_in
, gstring_out
, g
;
4077 Lisp_Object alternates
;
4080 CHECK_FONT_GET_OBJECT (font_object
, font
);
4081 if (! font
->driver
->otf_drive
)
4082 error ("Font backend %s can't drive OpenType GSUB table",
4083 SDATA (SYMBOL_NAME (font
->driver
->type
)));
4084 CHECK_CHARACTER (character
);
4085 CHECK_CONS (otf_features
);
4087 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4088 g
= LGSTRING_GLYPH (gstring_in
, 0);
4089 LGLYPH_SET_CHAR (g
, XINT (character
));
4090 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4091 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4092 gstring_out
, 0, 1)) < 0)
4093 gstring_out
= Ffont_make_gstring (font_object
,
4094 make_number (ASIZE (gstring_out
) * 2));
4096 for (i
= 0; i
< num
; i
++)
4098 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4099 int c
= LGLYPH_CHAR (g
);
4100 unsigned code
= LGLYPH_CODE (g
);
4102 alternates
= Fcons (Fcons (make_number (code
),
4103 c
> 0 ? make_number (c
) : Qnil
),
4106 return Fnreverse (alternates
);
4112 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4113 doc
: /* Open FONT-ENTITY. */)
4114 (font_entity
, size
, frame
)
4115 Lisp_Object font_entity
;
4121 CHECK_FONT_ENTITY (font_entity
);
4123 frame
= selected_frame
;
4124 CHECK_LIVE_FRAME (frame
);
4127 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4130 CHECK_NUMBER_OR_FLOAT (size
);
4132 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
4134 isize
= XINT (size
);
4138 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4141 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4142 doc
: /* Close FONT-OBJECT. */)
4143 (font_object
, frame
)
4144 Lisp_Object font_object
, frame
;
4146 CHECK_FONT_OBJECT (font_object
);
4148 frame
= selected_frame
;
4149 CHECK_LIVE_FRAME (frame
);
4150 font_close_object (XFRAME (frame
), font_object
);
4154 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4155 doc
: /* Return information about FONT-OBJECT.
4156 The value is a vector:
4157 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4160 NAME is a string of the font name (or nil if the font backend doesn't
4163 FILENAME is a string of the font file (or nil if the font backend
4164 doesn't provide a file name).
4166 PIXEL-SIZE is a pixel size by which the font is opened.
4168 SIZE is a maximum advance width of the font in pixel.
4170 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4173 CAPABILITY is a list whose first element is a symbol representing the
4174 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4175 remaining elements describes a detail of the font capability.
4177 If the font is OpenType font, the form of the list is
4178 \(opentype GSUB GPOS)
4179 where GSUB shows which "GSUB" features the font supports, and GPOS
4180 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4181 lists of the format:
4182 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4184 If the font is not OpenType font, currently the length of the form is
4187 SCRIPT is a symbol representing OpenType script tag.
4189 LANGSYS is a symbol representing OpenType langsys tag, or nil
4190 representing the default langsys.
4192 FEATURE is a symbol representing OpenType feature tag.
4194 If the font is not OpenType font, CAPABILITY is nil. */)
4196 Lisp_Object font_object
;
4201 CHECK_FONT_GET_OBJECT (font_object
, font
);
4203 val
= Fmake_vector (make_number (9), Qnil
);
4204 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4205 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4206 ASET (val
, 2, make_number (font
->pixel_size
));
4207 ASET (val
, 3, make_number (font
->max_width
));
4208 ASET (val
, 4, make_number (font
->ascent
));
4209 ASET (val
, 5, make_number (font
->descent
));
4210 ASET (val
, 6, make_number (font
->space_width
));
4211 ASET (val
, 7, make_number (font
->average_width
));
4212 if (font
->driver
->otf_capability
)
4213 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4217 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4218 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4219 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4220 (font_object
, string
)
4221 Lisp_Object font_object
, string
;
4227 CHECK_FONT_GET_OBJECT (font_object
, font
);
4228 CHECK_STRING (string
);
4229 len
= SCHARS (string
);
4230 vec
= Fmake_vector (make_number (len
), Qnil
);
4231 for (i
= 0; i
< len
; i
++)
4233 Lisp_Object ch
= Faref (string
, make_number (i
));
4238 struct font_metrics metrics
;
4240 cod
= code
= font
->driver
->encode_char (font
, c
);
4241 if (code
== FONT_INVALID_CODE
)
4243 val
= Fmake_vector (make_number (6), Qnil
);
4244 if (cod
<= MOST_POSITIVE_FIXNUM
)
4245 ASET (val
, 0, make_number (code
));
4247 ASET (val
, 0, Fcons (make_number (code
>> 16),
4248 make_number (code
& 0xFFFF)));
4249 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4250 ASET (val
, 1, make_number (metrics
.lbearing
));
4251 ASET (val
, 2, make_number (metrics
.rbearing
));
4252 ASET (val
, 3, make_number (metrics
.width
));
4253 ASET (val
, 4, make_number (metrics
.ascent
));
4254 ASET (val
, 5, make_number (metrics
.descent
));
4260 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4261 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4262 FONT is a font-spec, font-entity, or font-object. */)
4264 Lisp_Object spec
, font
;
4266 CHECK_FONT_SPEC (spec
);
4269 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4272 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4273 doc
: /* Return a font-object for displaying a character at POSITION.
4274 Optional second arg WINDOW, if non-nil, is a window displaying
4275 the current buffer. It defaults to the currently selected window. */)
4276 (position
, window
, string
)
4277 Lisp_Object position
, window
, string
;
4284 CHECK_NUMBER_COERCE_MARKER (position
);
4285 pos
= XINT (position
);
4286 if (pos
< BEGV
|| pos
>= ZV
)
4287 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4291 CHECK_NUMBER (position
);
4292 CHECK_STRING (string
);
4293 pos
= XINT (position
);
4294 if (pos
< 0 || pos
>= SCHARS (string
))
4295 args_out_of_range (string
, position
);
4298 window
= selected_window
;
4299 CHECK_LIVE_WINDOW (window
);
4300 w
= XWINDOW (window
);
4302 return font_at (-1, pos
, NULL
, w
, string
);
4306 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4307 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4308 The value is a number of glyphs drawn.
4309 Type C-l to recover what previously shown. */)
4310 (font_object
, string
)
4311 Lisp_Object font_object
, string
;
4313 Lisp_Object frame
= selected_frame
;
4314 FRAME_PTR f
= XFRAME (frame
);
4320 CHECK_FONT_GET_OBJECT (font_object
, font
);
4321 CHECK_STRING (string
);
4322 len
= SCHARS (string
);
4323 code
= alloca (sizeof (unsigned) * len
);
4324 for (i
= 0; i
< len
; i
++)
4326 Lisp_Object ch
= Faref (string
, make_number (i
));
4330 code
[i
] = font
->driver
->encode_char (font
, c
);
4331 if (code
[i
] == FONT_INVALID_CODE
)
4334 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4336 if (font
->driver
->prepare_face
)
4337 font
->driver
->prepare_face (f
, face
);
4338 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4339 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4340 if (font
->driver
->done_face
)
4341 font
->driver
->done_face (f
, face
);
4343 return make_number (len
);
4347 #endif /* FONT_DEBUG */
4350 extern void syms_of_ftfont
P_ (());
4351 extern void syms_of_xfont
P_ (());
4352 extern void syms_of_xftfont
P_ (());
4353 extern void syms_of_ftxfont
P_ (());
4354 extern void syms_of_bdffont
P_ (());
4355 extern void syms_of_w32font
P_ (());
4356 extern void syms_of_atmfont
P_ (());
4361 sort_shift_bits
[FONT_SLANT_INDEX
] = 0;
4362 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 7;
4363 sort_shift_bits
[FONT_SIZE_INDEX
] = 14;
4364 sort_shift_bits
[FONT_WIDTH_INDEX
] = 21;
4365 sort_shift_bits
[FONT_ADSTYLE_INDEX
] = 28;
4366 sort_shift_bits
[FONT_FOUNDRY_INDEX
] = 29;
4367 sort_shift_bits
[FONT_FAMILY_INDEX
] = 30;
4368 /* Note that sort_shift_bits[FONT_SORT_TYPE] and
4369 sort_shift_bits[FONT_SORT_REGISTRY] are never used. */
4371 staticpro (&font_style_table
);
4372 font_style_table
= Fmake_vector (make_number (3), Qnil
);
4374 staticpro (&font_charset_alist
);
4375 font_charset_alist
= Qnil
;
4377 DEFSYM (Qfont_spec
, "font-spec");
4378 DEFSYM (Qfont_entity
, "font-entity");
4379 DEFSYM (Qfont_object
, "font-object");
4381 DEFSYM (Qopentype
, "opentype");
4383 DEFSYM (Qiso8859_1
, "iso8859-1");
4384 DEFSYM (Qiso10646_1
, "iso10646-1");
4385 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4386 DEFSYM (Qunicode_sip
, "unicode-sip");
4388 DEFSYM (QCotf
, ":otf");
4389 DEFSYM (QClang
, ":lang");
4390 DEFSYM (QCscript
, ":script");
4391 DEFSYM (QCantialias
, ":antialias");
4393 DEFSYM (QCfoundry
, ":foundry");
4394 DEFSYM (QCadstyle
, ":adstyle");
4395 DEFSYM (QCregistry
, ":registry");
4396 DEFSYM (QCspacing
, ":spacing");
4397 DEFSYM (QCdpi
, ":dpi");
4398 DEFSYM (QCscalable
, ":scalable");
4399 DEFSYM (QCavgwidth
, ":avgwidth");
4400 DEFSYM (QCfont_entity
, ":font-entity");
4401 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
4408 staticpro (&null_vector
);
4409 null_vector
= Fmake_vector (make_number (0), Qnil
);
4411 staticpro (&scratch_font_spec
);
4412 scratch_font_spec
= Ffont_spec (0, NULL
);
4413 staticpro (&scratch_font_prefer
);
4414 scratch_font_prefer
= Ffont_spec (0, NULL
);
4417 staticpro (&otf_list
);
4422 defsubr (&Sfont_spec
);
4423 defsubr (&Sfont_get
);
4424 defsubr (&Sfont_put
);
4425 defsubr (&Slist_fonts
);
4426 defsubr (&Sfont_family_list
);
4427 defsubr (&Sfind_font
);
4428 defsubr (&Sfont_xlfd_name
);
4429 defsubr (&Sclear_font_cache
);
4430 defsubr (&Sinternal_set_font_style_table
);
4431 defsubr (&Sfont_make_gstring
);
4432 defsubr (&Sfont_fill_gstring
);
4433 defsubr (&Sfont_shape_text
);
4434 defsubr (&Sfont_drive_otf
);
4435 defsubr (&Sfont_otf_alternates
);
4438 defsubr (&Sopen_font
);
4439 defsubr (&Sclose_font
);
4440 defsubr (&Squery_font
);
4441 defsubr (&Sget_font_glyphs
);
4442 defsubr (&Sfont_match_p
);
4443 defsubr (&Sfont_at
);
4445 defsubr (&Sdraw_string
);
4447 #endif /* FONT_DEBUG */
4449 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
4451 Alist of fontname patterns vs the corresponding encoding and repertory info.
4452 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
4453 where ENCODING is a charset or a char-table,
4454 and REPERTORY is a charset, a char-table, or nil.
4456 If ENCDING and REPERTORY are the same, the element can have the form
4457 \(REGEXP . ENCODING).
4459 ENCODING is for converting a character to a glyph code of the font.
4460 If ENCODING is a charset, encoding a character by the charset gives
4461 the corresponding glyph code. If ENCODING is a char-table, looking up
4462 the table by a character gives the corresponding glyph code.
4464 REPERTORY specifies a repertory of characters supported by the font.
4465 If REPERTORY is a charset, all characters beloging to the charset are
4466 supported. If REPERTORY is a char-table, all characters who have a
4467 non-nil value in the table are supported. It REPERTORY is nil, Emacs
4468 gets the repertory information by an opened font and ENCODING. */);
4469 Vfont_encoding_alist
= Qnil
;
4471 #ifdef HAVE_WINDOW_SYSTEM
4472 #ifdef HAVE_FREETYPE
4474 #ifdef HAVE_X_WINDOWS
4479 #endif /* HAVE_XFT */
4480 #endif /* HAVE_X_WINDOWS */
4481 #else /* not HAVE_FREETYPE */
4482 #ifdef HAVE_X_WINDOWS
4484 #endif /* HAVE_X_WINDOWS */
4485 #endif /* not HAVE_FREETYPE */
4488 #endif /* HAVE_BDFFONT */
4491 #endif /* WINDOWSNT */
4495 #endif /* HAVE_WINDOW_SYSTEM */
4498 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
4499 (do not change this comment) */