1 /* font.c -- "Font" primitives.
2 Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
3 Copyright (C) 2006, 2007, 2008
4 National Institute of Advanced Industrial Science and Technology (AIST)
5 Registration Number H13PRO009
7 This file is part of GNU Emacs.
9 GNU Emacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 GNU Emacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
35 #include "dispextern.h"
37 #include "character.h"
38 #include "composite.h"
44 #endif /* HAVE_X_WINDOWS */
48 #endif /* HAVE_NTGUI */
60 #define xassert(X) do {if (!(X)) abort ();} while (0)
62 #define xassert(X) (void) 0
65 Lisp_Object Qfont_spec
, Qfont_entity
, Qfont_object
;
67 Lisp_Object Qopentype
;
69 /* Important character set strings. */
70 Lisp_Object Qiso8859_1
, Qiso10646_1
, Qunicode_bmp
, Qunicode_sip
;
72 /* Special vector of zero length. This is repeatedly used by (struct
73 font_driver *)->list when a specified font is not found. */
74 static Lisp_Object null_vector
;
76 /* Vector of 3 elements. Each element is a vector for one of font
77 style properties (weight, slant, width). The vector contains a
78 mapping between symbolic property values (e.g. `medium' for weight)
79 and numeric property values (e.g. 100). So, it looks like this:
80 [[(ultra-light . 20) ... (black . 210)]
81 [(reverse-oblique . 0) ... (oblique . 210)]
82 [(ultra-contains . 50) ... (wide . 200)]] */
83 static Lisp_Object font_style_table
;
85 extern Lisp_Object Qnormal
;
87 /* Symbols representing keys of normal font properties. */
88 extern Lisp_Object QCtype
, QCfamily
, QCweight
, QCslant
, QCwidth
, QCsize
, QCname
;
89 Lisp_Object QCfoundry
, QCadstyle
, QCregistry
;
90 /* Symbols representing keys of font extra info. */
91 Lisp_Object QCspacing
, QCdpi
, QCscalable
, QCotf
, QClang
, QCscript
, QCavgwidth
;
92 Lisp_Object QCantialias
, QCfont_entity
, QCfc_unknown_spec
;
93 /* Symbols representing values of font spacing property. */
94 Lisp_Object Qc
, Qm
, Qp
, Qd
;
96 /* Alist of font registry symbol and the corresponding charsets
97 information. The information is retrieved from
98 Vfont_encoding_alist on demand.
100 Eash element has the form:
101 (REGISTRY . (ENCODING-CHARSET-ID . REPERTORY-CHARSET-ID))
105 In the former form, ENCODING-CHARSET-ID is an ID of a charset that
106 encodes a character code to a glyph code of a font, and
107 REPERTORY-CHARSET-ID is an ID of a charset that tells if a
108 character is supported by a font.
110 The latter form means that the information for REGISTRY couldn't be
112 static Lisp_Object font_charset_alist
;
114 /* List of all font drivers. Each font-backend (XXXfont.c) calls
115 register_font_driver in syms_of_XXXfont to register its font-driver
117 static struct font_driver_list
*font_driver_list
;
121 /* Creaters of font-related Lisp object. */
126 Lisp_Object font_spec
;
127 struct font_spec
*spec
128 = ((struct font_spec
*)
129 allocate_pseudovector (VECSIZE (struct font_spec
),
130 FONT_SPEC_MAX
, PVEC_FONT
));
131 XSETFONT (font_spec
, spec
);
138 Lisp_Object font_entity
;
139 struct font_entity
*entity
140 = ((struct font_entity
*)
141 allocate_pseudovector (VECSIZE (struct font_entity
),
142 FONT_ENTITY_MAX
, PVEC_FONT
));
143 XSETFONT (font_entity
, entity
);
148 font_make_object (size
)
151 Lisp_Object font_object
;
153 = (struct font
*) allocate_pseudovector (size
, FONT_OBJECT_MAX
, PVEC_FONT
);
154 XSETFONT (font_object
, font
);
161 static int font_pixel_size
P_ ((FRAME_PTR f
, Lisp_Object
));
162 static Lisp_Object font_open_entity
P_ ((FRAME_PTR
, Lisp_Object
, int));
163 static Lisp_Object font_matching_entity
P_ ((FRAME_PTR
, Lisp_Object
*,
166 /* Number of registered font drivers. */
167 static int num_font_drivers
;
170 /* Return a Lispy value of a font property value at STR and LEN bytes.
171 If STR is "*", it returns nil.
172 If all characters in STR are digits, it returns an integer.
173 Otherwise, it returns a symbol interned from STR. */
176 font_intern_prop (str
, len
)
181 Lisp_Object tem
, string
;
184 if (len
== 1 && *str
== '*')
186 if (len
>=1 && isdigit (*str
))
188 for (i
= 1; i
< len
; i
++)
189 if (! isdigit (str
[i
]))
192 return make_number (atoi (str
));
195 /* The following code is copied from the function intern (in lread.c). */
197 if (!VECTORP (obarray
) || XVECTOR (obarray
)->size
== 0)
198 obarray
= check_obarray (obarray
);
199 tem
= oblookup (obarray
, str
, len
, len
);
202 return Fintern (make_unibyte_string (str
, len
), obarray
);
205 /* Return a pixel size of font-spec SPEC on frame F. */
208 font_pixel_size (f
, spec
)
212 Lisp_Object size
= AREF (spec
, FONT_SIZE_INDEX
);
215 Lisp_Object extra
, val
;
220 return 0; xassert (FLOATP (size
));
221 point_size
= XFLOAT_DATA (size
);
222 val
= AREF (spec
, FONT_DPI_INDEX
);
224 dpi
= XINT (XCDR (val
));
227 pixel_size
= POINT_TO_PIXEL (point_size
, dpi
);
232 /* Return a value of PROP's VAL (symbol or integer) to be stored in a
233 font vector. If VAL is not valid (i.e. not registered in
234 font_style_table), return -1 if NOERROR is zero, and return a
235 proper index if NOERROR is nonzero. In that case, register VAL in
236 font_style_table if VAL is a symbol, and return a closest index if
237 VAL is an integer. */
240 font_style_to_value (prop
, val
, noerror
)
241 enum font_property_index prop
;
245 Lisp_Object table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
246 int len
= ASIZE (table
);
252 Lisp_Object args
[2], elt
;
254 /* At first try exact match. */
255 for (i
= 0; i
< len
; i
++)
256 if (EQ (val
, XCAR (AREF (table
, i
))))
257 return (XINT (XCDR (AREF (table
, i
))) << 8) | i
;
258 /* Try also with case-folding match. */
259 s
= SDATA (SYMBOL_NAME (val
));
260 for (i
= 0; i
< len
; i
++)
262 elt
= XCAR (AREF (table
, i
));
263 if (strcasecmp (s
, (char *) SDATA (SYMBOL_NAME (elt
))) == 0)
271 args
[1] = Fmake_vector (make_number (1), Fcons (val
, make_number (255)));
272 ASET (font_style_table
, prop
- FONT_WEIGHT_INDEX
, Fvconcat (2, args
));
273 return (255 << 8) | i
;
277 int last_i
, i
, last_n
;
278 int numeric
= XINT (val
);
280 for (i
= 1, last_i
= last_n
= -1; i
< len
;)
282 int n
= XINT (XCDR (AREF (table
, i
)));
290 return ((last_i
< 0 || n
- numeric
< numeric
- last_n
)
291 ? (n
<< 8) | i
: (last_n
<< 8 | last_i
));
295 for (i
++; i
< len
&& n
== XINT (XCDR (AREF (table
, i
+ 1))); i
++);
299 return (last_n
<< 8) | last_i
;
304 font_style_symbolic (font
, prop
, for_face
)
306 enum font_property_index prop
;
309 Lisp_Object val
= AREF (font
, prop
);
315 table
= AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
);
317 return XCAR (AREF (table
, XINT (val
) & 0xFF));
318 numeric
= XINT (val
) >> 8;
319 for (i
= 0; i
< ASIZE (table
); i
++)
320 if (XINT (XCDR (AREF (table
, i
))) == numeric
)
321 return XCAR (AREF (table
, i
));
326 extern Lisp_Object Vface_alternative_font_family_alist
;
328 extern Lisp_Object find_font_encoding
P_ ((Lisp_Object
));
331 /* Return encoding charset and repertory charset for REGISTRY in
332 ENCODING and REPERTORY correspondingly. If correct information for
333 REGISTRY is available, return 0. Otherwise return -1. */
336 font_registry_charsets (registry
, encoding
, repertory
)
337 Lisp_Object registry
;
338 struct charset
**encoding
, **repertory
;
341 int encoding_id
, repertory_id
;
343 val
= Fassoc_string (registry
, font_charset_alist
, Qt
);
349 encoding_id
= XINT (XCAR (val
));
350 repertory_id
= XINT (XCDR (val
));
354 val
= find_font_encoding (SYMBOL_NAME (registry
));
355 if (SYMBOLP (val
) && CHARSETP (val
))
357 encoding_id
= repertory_id
= XINT (CHARSET_SYMBOL_ID (val
));
359 else if (CONSP (val
))
361 if (! CHARSETP (XCAR (val
)))
363 encoding_id
= XINT (CHARSET_SYMBOL_ID (XCAR (val
)));
364 if (NILP (XCDR (val
)))
368 if (! CHARSETP (XCDR (val
)))
370 repertory_id
= XINT (CHARSET_SYMBOL_ID (XCDR (val
)));
375 val
= Fcons (make_number (encoding_id
), make_number (repertory_id
));
377 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, val
), Qnil
));
381 *encoding
= CHARSET_FROM_ID (encoding_id
);
383 *repertory
= repertory_id
>= 0 ? CHARSET_FROM_ID (repertory_id
) : NULL
;
388 = nconc2 (font_charset_alist
, Fcons (Fcons (registry
, Qnil
), Qnil
));
393 /* Font property value validaters. See the comment of
394 font_property_table for the meaning of the arguments. */
396 static Lisp_Object font_prop_validate
P_ ((int, Lisp_Object
, Lisp_Object
));
397 static Lisp_Object font_prop_validate_symbol
P_ ((Lisp_Object
, Lisp_Object
));
398 static Lisp_Object font_prop_validate_style
P_ ((Lisp_Object
, Lisp_Object
));
399 static Lisp_Object font_prop_validate_non_neg
P_ ((Lisp_Object
, Lisp_Object
));
400 static Lisp_Object font_prop_validate_spacing
P_ ((Lisp_Object
, Lisp_Object
));
401 static int get_font_prop_index
P_ ((Lisp_Object
));
404 font_prop_validate_symbol (prop
, val
)
405 Lisp_Object prop
, val
;
408 val
= Fintern (val
, Qnil
);
411 else if (EQ (prop
, QCregistry
))
412 val
= Fintern (Fdowncase (SYMBOL_NAME (val
)), Qnil
);
418 font_prop_validate_style (style
, val
)
419 Lisp_Object style
, val
;
421 enum font_property_index prop
= (EQ (style
, QCweight
) ? FONT_WEIGHT_INDEX
422 : EQ (style
, QCslant
) ? FONT_SLANT_INDEX
429 >= ASIZE (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
)))
433 Lisp_Object elt
= AREF (AREF (font_style_table
, prop
- FONT_WEIGHT_INDEX
), n
& 0xFF);
434 if (XINT (XCDR (elt
)) != (n
>> 8))
438 else if (SYMBOLP (val
))
440 int n
= font_style_to_value (prop
, val
, 0);
442 val
= n
>= 0 ? make_number (n
) : Qerror
;
450 font_prop_validate_non_neg (prop
, val
)
451 Lisp_Object prop
, val
;
453 return (NATNUMP (val
) || (FLOATP (val
) && XFLOAT_DATA (val
) >= 0)
458 font_prop_validate_spacing (prop
, val
)
459 Lisp_Object prop
, val
;
461 if (NILP (val
) || (NATNUMP (val
) && XINT (val
) <= FONT_SPACING_CHARCELL
))
464 return make_number (FONT_SPACING_CHARCELL
);
466 return make_number (FONT_SPACING_MONO
);
468 return make_number (FONT_SPACING_PROPORTIONAL
);
470 return make_number (FONT_SPACING_DUAL
);
475 font_prop_validate_otf (prop
, val
)
476 Lisp_Object prop
, val
;
478 Lisp_Object tail
, tmp
;
481 /* VAL = (SCRIPT [ LANGSYS [ GSUB-FEATURES [ GPOS-FEATURES ]]])
482 GSUB-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil
483 GPOS-FEATURES = (FEATURE ... [ nil FEATURE ... ]) | nil */
486 if (! SYMBOLP (XCAR (val
)))
491 if (! CONSP (tail
) || ! SYMBOLP (XCAR (val
)))
493 for (i
= 0; i
< 2; i
++)
500 for (tmp
= XCAR (tail
); CONSP (tmp
); tmp
= XCDR (tmp
))
501 if (! SYMBOLP (XCAR (tmp
)))
509 /* Structure of known font property keys and validater of the
513 /* Pointer to the key symbol. */
515 /* Function to validate PROP's value VAL, or NULL if any value is
516 ok. The value is VAL or its regularized value if VAL is valid,
517 and Qerror if not. */
518 Lisp_Object (*validater
) P_ ((Lisp_Object prop
, Lisp_Object val
));
519 } font_property_table
[] =
520 { { &QCtype
, font_prop_validate_symbol
},
521 { &QCfoundry
, font_prop_validate_symbol
},
522 { &QCfamily
, font_prop_validate_symbol
},
523 { &QCadstyle
, font_prop_validate_symbol
},
524 { &QCregistry
, font_prop_validate_symbol
},
525 { &QCweight
, font_prop_validate_style
},
526 { &QCslant
, font_prop_validate_style
},
527 { &QCwidth
, font_prop_validate_style
},
528 { &QCsize
, font_prop_validate_non_neg
},
529 { &QCdpi
, font_prop_validate_non_neg
},
530 { &QCspacing
, font_prop_validate_spacing
},
531 { &QCavgwidth
, font_prop_validate_non_neg
},
532 /* The order of the above entries must match with enum
533 font_property_index. */
534 { &QClang
, font_prop_validate_symbol
},
535 { &QCscript
, font_prop_validate_symbol
},
536 { &QCotf
, font_prop_validate_otf
}
539 /* Size (number of elements) of the above table. */
540 #define FONT_PROPERTY_TABLE_SIZE \
541 ((sizeof font_property_table) / (sizeof *font_property_table))
543 /* Return an index number of font property KEY or -1 if KEY is not an
544 already known property. */
547 get_font_prop_index (key
)
552 for (i
= 0; i
< FONT_PROPERTY_TABLE_SIZE
; i
++)
553 if (EQ (key
, *font_property_table
[i
].key
))
558 /* Validate the font property. The property key is specified by the
559 symbol PROP, or the index IDX (if PROP is nil). If VAL is invalid,
560 signal an error. The value is VAL or the regularized one. */
563 font_prop_validate (idx
, prop
, val
)
565 Lisp_Object prop
, val
;
567 Lisp_Object validated
;
570 prop
= *font_property_table
[idx
].key
;
573 idx
= get_font_prop_index (prop
);
577 validated
= (font_property_table
[idx
].validater
) (prop
, val
);
578 if (EQ (validated
, Qerror
))
579 signal_error ("invalid font property", Fcons (prop
, val
));
584 /* Store VAL as a value of extra font property PROP in FONT while
585 keeping the sorting order. Don't check the validity of VAL. */
588 font_put_extra (font
, prop
, val
)
589 Lisp_Object font
, prop
, val
;
591 Lisp_Object extra
= AREF (font
, FONT_EXTRA_INDEX
);
592 Lisp_Object slot
= (NILP (extra
) ? Qnil
: assq_no_quit (prop
, extra
));
596 Lisp_Object prev
= Qnil
;
599 && NILP (Fstring_lessp (prop
, XCAR (XCAR (extra
)))))
600 prev
= extra
, extra
= XCDR (extra
);
602 ASET (font
, FONT_EXTRA_INDEX
, Fcons (Fcons (prop
, val
), extra
));
604 XSETCDR (prev
, Fcons (Fcons (prop
, val
), extra
));
612 /* Font name parser and unparser */
614 static int parse_matrix
P_ ((char *));
615 static int font_expand_wildcards
P_ ((Lisp_Object
*, int));
616 static int font_parse_name
P_ ((char *, Lisp_Object
));
618 /* An enumerator for each field of an XLFD font name. */
619 enum xlfd_field_index
638 /* An enumerator for mask bit corresponding to each XLFD field. */
641 XLFD_FOUNDRY_MASK
= 0x0001,
642 XLFD_FAMILY_MASK
= 0x0002,
643 XLFD_WEIGHT_MASK
= 0x0004,
644 XLFD_SLANT_MASK
= 0x0008,
645 XLFD_SWIDTH_MASK
= 0x0010,
646 XLFD_ADSTYLE_MASK
= 0x0020,
647 XLFD_PIXEL_MASK
= 0x0040,
648 XLFD_POINT_MASK
= 0x0080,
649 XLFD_RESX_MASK
= 0x0100,
650 XLFD_RESY_MASK
= 0x0200,
651 XLFD_SPACING_MASK
= 0x0400,
652 XLFD_AVGWIDTH_MASK
= 0x0800,
653 XLFD_REGISTRY_MASK
= 0x1000,
654 XLFD_ENCODING_MASK
= 0x2000
658 /* Parse P pointing the pixel/point size field of the form
659 `[A B C D]' which specifies a transformation matrix:
665 by which all glyphs of the font are transformed. The spec says
666 that scalar value N for the pixel/point size is equivalent to:
667 A = N * resx/resy, B = C = 0, D = N.
669 Return the scalar value N if the form is valid. Otherwise return
680 for (i
= 0, p
++; i
< 4 && *p
&& *p
!= ']'; i
++)
683 matrix
[i
] = - strtod (p
+ 1, &end
);
685 matrix
[i
] = strtod (p
, &end
);
688 return (i
== 4 ? (int) matrix
[3] : -1);
691 /* Expand a wildcard field in FIELD (the first N fields are filled) to
692 multiple fields to fill in all 14 XLFD fields while restring a
693 field position by its contents. */
696 font_expand_wildcards (field
, n
)
697 Lisp_Object field
[XLFD_LAST_INDEX
];
701 Lisp_Object tmp
[XLFD_LAST_INDEX
];
702 /* Array of information about where this element can go. Nth
703 element is for Nth element of FIELD. */
705 /* Minimum possible field. */
707 /* Maxinum possible field. */
709 /* Bit mask of possible field. Nth bit corresponds to Nth field. */
711 } range
[XLFD_LAST_INDEX
];
713 int range_from
, range_to
;
716 #define XLFD_SYMBOL_MASK (XLFD_FOUNDRY_MASK | XLFD_FAMILY_MASK \
717 | XLFD_ADSTYLE_MASK | XLFD_REGISTRY_MASK)
718 #define XLFD_NULL_MASK (XLFD_FOUNDRY_MASK | XLFD_ADSTYLE_MASK)
719 #define XLFD_LARGENUM_MASK (XLFD_POINT_MASK | XLFD_RESX_MASK | XLFD_RESY_MASK \
720 | XLFD_AVGWIDTH_MASK)
721 #define XLFD_REGENC_MASK (XLFD_REGISTRY_MASK | XLFD_ENCODING_MASK)
723 /* Initialize RANGE_MASK for FIELD[0] which can be 0th to (14 - N)th
724 field. The value is shifted to left one bit by one in the
726 for (i
= 0, range_mask
= 0; i
<= 14 - n
; i
++)
727 range_mask
= (range_mask
<< 1) | 1;
729 /* The triplet RANGE_FROM, RANGE_TO, and RANGE_MASK is a
730 position-based retriction for FIELD[I]. */
731 for (i
= 0, range_from
= 0, range_to
= 14 - n
; i
< n
;
732 i
++, range_from
++, range_to
++, range_mask
<<= 1)
734 Lisp_Object val
= field
[i
];
740 range
[i
].from
= range_from
;
741 range
[i
].to
= range_to
;
742 range
[i
].mask
= range_mask
;
746 /* The triplet FROM, TO, and MASK is a value-based
747 retriction for FIELD[I]. */
753 int numeric
= XINT (val
);
756 from
= to
= XLFD_ENCODING_INDEX
,
757 mask
= XLFD_ENCODING_MASK
;
758 else if (numeric
== 0)
759 from
= XLFD_PIXEL_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
760 mask
= XLFD_PIXEL_MASK
| XLFD_LARGENUM_MASK
;
761 else if (numeric
<= 48)
762 from
= to
= XLFD_PIXEL_INDEX
,
763 mask
= XLFD_PIXEL_MASK
;
765 from
= XLFD_POINT_INDEX
, to
= XLFD_AVGWIDTH_INDEX
,
766 mask
= XLFD_LARGENUM_MASK
;
768 else if (SBYTES (SYMBOL_NAME (val
)) == 0)
769 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ADSTYLE_INDEX
,
770 mask
= XLFD_NULL_MASK
;
772 from
= to
= XLFD_FOUNDRY_INDEX
, mask
= XLFD_FOUNDRY_MASK
;
775 Lisp_Object name
= SYMBOL_NAME (val
);
777 if (SDATA (name
)[SBYTES (name
) - 1] == '*')
778 from
= XLFD_REGISTRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
779 mask
= XLFD_REGENC_MASK
;
781 from
= to
= XLFD_ENCODING_INDEX
,
782 mask
= XLFD_ENCODING_MASK
;
784 else if (range_from
<= XLFD_WEIGHT_INDEX
785 && range_to
>= XLFD_WEIGHT_INDEX
786 && FONT_WEIGHT_NAME_NUMERIC (val
) >= 0)
787 from
= to
= XLFD_WEIGHT_INDEX
, mask
= XLFD_WEIGHT_MASK
;
788 else if (range_from
<= XLFD_SLANT_INDEX
789 && range_to
>= XLFD_SLANT_INDEX
790 && FONT_SLANT_NAME_NUMERIC (val
) >= 0)
791 from
= to
= XLFD_SLANT_INDEX
, mask
= XLFD_SLANT_MASK
;
792 else if (range_from
<= XLFD_SWIDTH_INDEX
793 && range_to
>= XLFD_SWIDTH_INDEX
794 && FONT_WIDTH_NAME_NUMERIC (val
) >= 0)
795 from
= to
= XLFD_SWIDTH_INDEX
, mask
= XLFD_SWIDTH_MASK
;
798 if (EQ (val
, Qc
) || EQ (val
, Qm
) || EQ (val
, Qp
) || EQ (val
, Qd
))
799 from
= to
= XLFD_SPACING_INDEX
, mask
= XLFD_SPACING_MASK
;
801 from
= XLFD_FOUNDRY_INDEX
, to
= XLFD_ENCODING_INDEX
,
802 mask
= XLFD_SYMBOL_MASK
;
805 /* Merge position-based and value-based restrictions. */
807 while (from
< range_from
)
808 mask
&= ~(1 << from
++);
809 while (from
< 14 && ! (mask
& (1 << from
)))
811 while (to
> range_to
)
812 mask
&= ~(1 << to
--);
813 while (to
>= 0 && ! (mask
& (1 << to
)))
817 range
[i
].from
= from
;
819 range
[i
].mask
= mask
;
821 if (from
> range_from
|| to
< range_to
)
823 /* The range is narrowed by value-based restrictions.
824 Reflect it to the other fields. */
826 /* Following fields should be after FROM. */
828 /* Preceding fields should be before TO. */
829 for (j
= i
- 1, from
--, to
--; j
>= 0; j
--, from
--, to
--)
831 /* Check FROM for non-wildcard field. */
832 if (! NILP (tmp
[j
]) && range
[j
].from
< from
)
834 while (range
[j
].from
< from
)
835 range
[j
].mask
&= ~(1 << range
[j
].from
++);
836 while (from
< 14 && ! (range
[j
].mask
& (1 << from
)))
838 range
[j
].from
= from
;
841 from
= range
[j
].from
;
842 if (range
[j
].to
> to
)
844 while (range
[j
].to
> to
)
845 range
[j
].mask
&= ~(1 << range
[j
].to
--);
846 while (to
>= 0 && ! (range
[j
].mask
& (1 << to
)))
859 /* Decide all fileds from restrictions in RANGE. */
860 for (i
= j
= 0; i
< n
; i
++)
862 if (j
< range
[i
].from
)
864 if (i
== 0 || ! NILP (tmp
[i
- 1]))
865 /* None of TMP[X] corresponds to Jth field. */
867 for (; j
< range
[i
].from
; j
++)
872 if (! NILP (tmp
[n
- 1]) && j
< XLFD_REGISTRY_INDEX
)
874 for (; j
< XLFD_LAST_INDEX
; j
++)
876 if (INTEGERP (field
[XLFD_ENCODING_INDEX
]))
877 field
[XLFD_ENCODING_INDEX
]
878 = Fintern (Fnumber_to_string (field
[XLFD_ENCODING_INDEX
]), Qnil
);
883 #ifdef ENABLE_CHECKING
884 /* Match a 14-field XLFD pattern against a full XLFD font name. */
886 font_match_xlfd (char *pattern
, char *name
)
888 while (*pattern
&& *name
)
890 if (*pattern
== *name
)
892 else if (*pattern
== '*')
893 if (*name
== pattern
[1])
904 /* Make sure the font object matches the XLFD font name. */
906 font_check_xlfd_parse (Lisp_Object font
, char *name
)
908 char name_check
[256];
909 font_unparse_xlfd (font
, 0, name_check
, 255);
910 return font_match_xlfd (name_check
, name
);
916 /* Parse NAME (null terminated) as XLFD and store information in FONT
917 (font-spec or font-entity). Size property of FONT is set as
919 specified XLFD fields FONT property
920 --------------------- -------------
921 PIXEL_SIZE PIXEL_SIZE (Lisp integer)
922 POINT_SIZE and RESY calculated pixel size (Lisp integer)
923 POINT_SIZE POINT_SIZE/10 (Lisp float)
925 If NAME is successfully parsed, return 0. Otherwise return -1.
927 FONT is usually a font-spec, but when this function is called from
928 X font backend driver, it is a font-entity. In that case, NAME is
929 a fully specified XLFD. */
932 font_parse_xlfd (name
, font
)
936 int len
= strlen (name
);
938 char *f
[XLFD_LAST_INDEX
+ 1];
943 /* Maximum XLFD name length is 255. */
945 /* Accept "*-.." as a fully specified XLFD. */
946 if (name
[0] == '*' && name
[1] == '-')
947 i
= 1, f
[XLFD_FOUNDRY_INDEX
] = name
;
950 for (p
= name
+ i
; *p
; p
++)
954 if (i
== XLFD_LAST_INDEX
)
959 #define INTERN_FIELD(N) font_intern_prop (f[N], f[(N) + 1] - 1 - f[N])
961 if (i
== XLFD_LAST_INDEX
)
963 /* Fully specified XLFD. */
967 ASET (font
, FONT_FOUNDRY_INDEX
, INTERN_FIELD (XLFD_FOUNDRY_INDEX
));
968 ASET (font
, FONT_FAMILY_INDEX
, INTERN_FIELD (XLFD_FAMILY_INDEX
));
969 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
970 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
972 val
= INTERN_FIELD (i
);
975 if ((n
= font_style_to_value (j
, INTERN_FIELD (i
), 0)) < 0)
977 ASET (font
, j
, make_number (n
));
980 ASET (font
, FONT_ADSTYLE_INDEX
, INTERN_FIELD (XLFD_ADSTYLE_INDEX
));
981 if (strcmp (f
[XLFD_REGISTRY_INDEX
], "*-*") == 0)
982 ASET (font
, FONT_REGISTRY_INDEX
, Qnil
);
984 ASET (font
, FONT_REGISTRY_INDEX
,
985 font_intern_prop (f
[XLFD_REGISTRY_INDEX
],
986 f
[XLFD_LAST_INDEX
] - f
[XLFD_REGISTRY_INDEX
]));
987 p
= f
[XLFD_PIXEL_INDEX
];
988 if (*p
== '[' && (pixel_size
= parse_matrix (p
)) >= 0)
989 ASET (font
, FONT_SIZE_INDEX
, make_number (pixel_size
));
992 val
= INTERN_FIELD (XLFD_PIXEL_INDEX
);
994 ASET (font
, FONT_SIZE_INDEX
, val
);
997 double point_size
= -1;
999 xassert (FONT_SPEC_P (font
));
1000 p
= f
[XLFD_POINT_INDEX
];
1002 point_size
= parse_matrix (p
);
1003 else if (isdigit (*p
))
1004 point_size
= atoi (p
), point_size
/= 10;
1005 if (point_size
>= 0)
1006 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1010 ASET (font
, FONT_DPI_INDEX
, INTERN_FIELD (XLFD_RESY_INDEX
));
1011 val
= INTERN_FIELD (XLFD_SPACING_INDEX
);
1014 val
= font_prop_validate_spacing (QCspacing
, val
);
1015 if (! INTEGERP (val
))
1017 ASET (font
, FONT_SPACING_INDEX
, val
);
1019 p
= f
[XLFD_AVGWIDTH_INDEX
];
1022 ASET (font
, FONT_AVGWIDTH_INDEX
,
1023 font_intern_prop (p
, f
[XLFD_REGISTRY_INDEX
] - 1 - p
));
1027 int wild_card_found
= 0;
1028 Lisp_Object prop
[XLFD_LAST_INDEX
];
1030 if (FONT_ENTITY_P (font
))
1032 for (j
= 0; j
< i
; j
++)
1036 if (f
[j
][1] && f
[j
][1] != '-')
1039 wild_card_found
= 1;
1042 prop
[j
] = INTERN_FIELD (j
);
1044 prop
[j
] = font_intern_prop (f
[j
], f
[i
] - f
[j
]);
1046 if (! wild_card_found
)
1048 if (font_expand_wildcards (prop
, i
) < 0)
1051 ASET (font
, FONT_FOUNDRY_INDEX
, prop
[XLFD_FOUNDRY_INDEX
]);
1052 ASET (font
, FONT_FAMILY_INDEX
, prop
[XLFD_FAMILY_INDEX
]);
1053 for (i
= XLFD_WEIGHT_INDEX
, j
= FONT_WEIGHT_INDEX
;
1054 i
<= XLFD_SWIDTH_INDEX
; i
++, j
++)
1055 if (! NILP (prop
[i
]))
1057 if ((n
= font_style_to_value (j
, prop
[i
], 1)) < 0)
1059 ASET (font
, j
, make_number (n
));
1061 ASET (font
, FONT_ADSTYLE_INDEX
, prop
[XLFD_ADSTYLE_INDEX
]);
1062 val
= prop
[XLFD_REGISTRY_INDEX
];
1065 val
= prop
[XLFD_ENCODING_INDEX
];
1067 val
= concat2 (build_string ("*-"), SYMBOL_NAME (val
));
1069 else if (NILP (prop
[XLFD_ENCODING_INDEX
]))
1070 val
= concat2 (SYMBOL_NAME (val
), build_string ("-*"));
1072 val
= concat3 (SYMBOL_NAME (val
), build_string ("-"),
1073 SYMBOL_NAME (prop
[XLFD_ENCODING_INDEX
]));
1075 ASET (font
, FONT_REGISTRY_INDEX
, Fintern (val
, Qnil
));
1077 if (INTEGERP (prop
[XLFD_PIXEL_INDEX
]))
1078 ASET (font
, FONT_SIZE_INDEX
, prop
[XLFD_PIXEL_INDEX
]);
1079 else if (INTEGERP (prop
[XLFD_POINT_INDEX
]))
1081 double point_size
= XINT (prop
[XLFD_POINT_INDEX
]);
1083 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
/ 10));
1086 if (INTEGERP (prop
[XLFD_RESX_INDEX
]))
1087 ASET (font
, FONT_DPI_INDEX
, prop
[XLFD_RESY_INDEX
]);
1088 if (! NILP (prop
[XLFD_SPACING_INDEX
]))
1090 val
= font_prop_validate_spacing (QCspacing
,
1091 prop
[XLFD_SPACING_INDEX
]);
1092 if (! INTEGERP (val
))
1094 ASET (font
, FONT_SPACING_INDEX
, val
);
1096 if (INTEGERP (prop
[XLFD_AVGWIDTH_INDEX
]))
1097 ASET (font
, FONT_AVGWIDTH_INDEX
, prop
[XLFD_AVGWIDTH_INDEX
]);
1103 /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES
1104 length), and return the name length. If FONT_SIZE_INDEX of FONT is
1105 0, use PIXEL_SIZE instead. */
1108 font_unparse_xlfd (font
, pixel_size
, name
, nbytes
)
1114 char *f
[XLFD_REGISTRY_INDEX
+ 1];
1118 xassert (FONTP (font
));
1120 for (i
= FONT_FOUNDRY_INDEX
, j
= XLFD_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
;
1123 if (i
== FONT_ADSTYLE_INDEX
)
1124 j
= XLFD_ADSTYLE_INDEX
;
1125 else if (i
== FONT_REGISTRY_INDEX
)
1126 j
= XLFD_REGISTRY_INDEX
;
1127 val
= AREF (font
, i
);
1130 if (j
== XLFD_REGISTRY_INDEX
)
1131 f
[j
] = "*-*", len
+= 4;
1133 f
[j
] = "*", len
+= 2;
1138 val
= SYMBOL_NAME (val
);
1139 if (j
== XLFD_REGISTRY_INDEX
1140 && ! strchr ((char *) SDATA (val
), '-'))
1142 /* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
1143 if (SDATA (val
)[SBYTES (val
) - 1] == '*')
1145 f
[j
] = alloca (SBYTES (val
) + 3);
1146 sprintf (f
[j
], "%s-*", SDATA (val
));
1147 len
+= SBYTES (val
) + 3;
1151 f
[j
] = alloca (SBYTES (val
) + 4);
1152 sprintf (f
[j
], "%s*-*", SDATA (val
));
1153 len
+= SBYTES (val
) + 4;
1157 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1161 for (i
= FONT_WEIGHT_INDEX
, j
= XLFD_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
;
1164 val
= font_style_symbolic (font
, i
, 0);
1166 f
[j
] = "*", len
+= 2;
1169 val
= SYMBOL_NAME (val
);
1170 f
[j
] = (char *) SDATA (val
), len
+= SBYTES (val
) + 1;
1174 val
= AREF (font
, FONT_SIZE_INDEX
);
1175 xassert (NUMBERP (val
) || NILP (val
));
1183 f
[XLFD_PIXEL_INDEX
] = alloca (22);
1184 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "%d-*", i
) + 1;
1187 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1189 else if (FLOATP (val
))
1191 i
= XFLOAT_DATA (val
) * 10;
1192 f
[XLFD_PIXEL_INDEX
] = alloca (12);
1193 len
+= sprintf (f
[XLFD_PIXEL_INDEX
], "*-%d", i
) + 1;
1196 f
[XLFD_PIXEL_INDEX
] = "*-*", len
+= 4;
1198 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1200 i
= XINT (AREF (font
, FONT_DPI_INDEX
));
1201 f
[XLFD_RESX_INDEX
] = alloca (22);
1202 len
+= sprintf (f
[XLFD_RESX_INDEX
],
1206 f
[XLFD_RESX_INDEX
] = "*-*", len
+= 4;
1207 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1209 int spacing
= XINT (AREF (font
, FONT_SPACING_INDEX
));
1211 f
[XLFD_SPACING_INDEX
] = (spacing
<= FONT_SPACING_PROPORTIONAL
? "p"
1212 : spacing
<= FONT_SPACING_DUAL
? "d"
1213 : spacing
<= FONT_SPACING_MONO
? "m"
1218 f
[XLFD_SPACING_INDEX
] = "*", len
+= 2;
1219 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1221 f
[XLFD_AVGWIDTH_INDEX
] = alloca (11);
1222 len
+= sprintf (f
[XLFD_AVGWIDTH_INDEX
],
1223 "%d", XINT (AREF (font
, FONT_AVGWIDTH_INDEX
))) + 1;
1226 f
[XLFD_AVGWIDTH_INDEX
] = "*", len
+= 2;
1227 len
++; /* for terminating '\0'. */
1230 return sprintf (name
, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
1231 f
[XLFD_FOUNDRY_INDEX
], f
[XLFD_FAMILY_INDEX
],
1232 f
[XLFD_WEIGHT_INDEX
], f
[XLFD_SLANT_INDEX
],
1233 f
[XLFD_SWIDTH_INDEX
], f
[XLFD_ADSTYLE_INDEX
],
1234 f
[XLFD_PIXEL_INDEX
], f
[XLFD_RESX_INDEX
],
1235 f
[XLFD_SPACING_INDEX
], f
[XLFD_AVGWIDTH_INDEX
],
1236 f
[XLFD_REGISTRY_INDEX
]);
1239 /* Parse NAME (null terminated) as Fonconfig's name format and store
1240 information in FONT (font-spec or font-entity). If NAME is
1241 successfully parsed, return 0. Otherwise return -1. */
1244 font_parse_fcname (name
, font
)
1249 int len
= strlen (name
);
1254 /* It is assured that (name[0] && name[0] != '-'). */
1262 for (p0
= name
+ 1; *p0
&& (*p0
!= '-' && *p0
!= ':'); p0
++)
1263 if (*p0
== '\\' && p0
[1])
1265 family
= font_intern_prop (name
, p0
- name
);
1268 if (! isdigit (p0
[1]))
1270 point_size
= strtod (p0
+ 1, &p1
);
1271 if (*p1
&& *p1
!= ':')
1273 ASET (font
, FONT_SIZE_INDEX
, make_float (point_size
));
1276 ASET (font
, FONT_FAMILY_INDEX
, family
);
1280 copy
= alloca (len
+ 1);
1285 /* Now parse ":KEY=VAL" patterns. Store known keys and values in
1286 extra, copy unknown ones to COPY. It is stored in extra slot by
1287 the key QCfc_unknown_spec. */
1290 Lisp_Object key
, val
;
1293 for (p1
= p0
+ 1; *p1
&& *p1
!= '=' && *p1
!= ':'; p1
++);
1296 /* Must be an enumerated value. */
1297 val
= font_intern_prop (p0
+ 1, p1
- p0
- 1);
1298 if (memcmp (p0
+ 1, "light", 5) == 0
1299 || memcmp (p0
+ 1, "medium", 6) == 0
1300 || memcmp (p0
+ 1, "demibold", 8) == 0
1301 || memcmp (p0
+ 1, "bold", 4) == 0
1302 || memcmp (p0
+ 1, "black", 5) == 0)
1303 FONT_SET_STYLE (font
, FONT_WEIGHT_INDEX
, val
);
1304 else if (memcmp (p0
+ 1, "roman", 5) == 0
1305 || memcmp (p0
+ 1, "italic", 6) == 0
1306 || memcmp (p0
+ 1, "oblique", 7) == 0)
1307 FONT_SET_STYLE (font
, FONT_SLANT_INDEX
, val
);
1308 else if (memcmp (p0
+ 1, "charcell", 8) == 0
1309 || memcmp (p0
+ 1, "mono", 4) == 0
1310 || memcmp (p0
+ 1, "proportional", 12) == 0)
1312 int spacing
= (p0
[1] == 'c' ? FONT_SPACING_CHARCELL
1313 : p0
[1] == 'm' ? FONT_SPACING_MONO
1314 : FONT_SPACING_PROPORTIONAL
);
1315 ASET (font
, FONT_SPACING_INDEX
, make_number (spacing
));
1320 bcopy (p0
, copy
, p1
- p0
);
1326 if (memcmp (p0
+ 1, "pixelsize=", 10) == 0)
1327 prop
= FONT_SIZE_INDEX
;
1330 key
= font_intern_prop (p0
, p1
- p0
);
1331 prop
= get_font_prop_index (key
);
1334 for (p1
= p0
; *p1
&& *p1
!= ':'; p1
++);
1335 val
= font_intern_prop (p0
, p1
- p0
);
1338 if (prop
>= FONT_FOUNDRY_INDEX
&& prop
< FONT_EXTRA_INDEX
)
1339 ASET (font
, prop
, font_prop_validate (prop
, Qnil
, val
));
1341 Ffont_put (font
, key
, val
);
1343 bcopy (p0
- 1, copy
, p1
- p0
+ 1);
1344 copy
+= p1
- p0
+ 1;
1350 font_put_extra (font
, QCfc_unknown_spec
,
1351 make_unibyte_string (name
, copy
- name
));
1356 /* Store fontconfig's font name of FONT (font-spec or font-entity) in
1357 NAME (NBYTES length), and return the name length. If
1358 FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */
1361 font_unparse_fcname (font
, pixel_size
, name
, nbytes
)
1367 Lisp_Object tail
, val
;
1369 int dpi
, spacing
, avgwidth
;
1372 Lisp_Object styles
[3];
1373 char *style_names
[3] = { "weight", "slant", "width" };
1376 val
= AREF (font
, FONT_FAMILY_INDEX
);
1378 len
+= SBYTES (val
);
1380 val
= AREF (font
, FONT_SIZE_INDEX
);
1383 if (XINT (val
) != 0)
1384 pixel_size
= XINT (val
);
1386 len
+= 21; /* for ":pixelsize=NUM" */
1388 else if (FLOATP (val
))
1391 point_size
= (int) XFLOAT_DATA (val
);
1392 len
+= 11; /* for "-NUM" */
1395 val
= AREF (font
, FONT_FOUNDRY_INDEX
);
1397 /* ":foundry=NAME" */
1398 len
+= 9 + SBYTES (val
);
1400 for (i
= 0; i
< 3; i
++)
1404 styles
[i
] = font_style_symbolic (font
, FONT_WEIGHT_INDEX
+ i
, 0);
1405 if (! NILP (styles
[i
]))
1406 len
+= sprintf (work
, ":%s=%s", style_names
[i
],
1407 SDATA (SYMBOL_NAME (styles
[i
])));
1410 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1411 len
+= sprintf (work
, ":dpi=%d", dpi
);
1412 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1413 len
+= strlen (":spacing=100");
1414 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1415 len
+= strlen (":scalable=false"); /* or ":scalable=true" */
1416 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
1418 Lisp_Object key
= XCAR (XCAR (tail
)), val
= XCDR (XCAR (tail
));
1420 len
+= SBYTES (SYMBOL_NAME (key
)) + 1; /* for :KEY= */
1422 len
+= SBYTES (val
);
1423 else if (INTEGERP (val
))
1424 len
+= sprintf (work
, "%d", XINT (val
));
1425 else if (SYMBOLP (val
))
1426 len
+= (NILP (val
) ? 5 : 4); /* for "false" or "true" */
1432 if (! NILP (AREF (font
, FONT_FAMILY_INDEX
)))
1433 p
+= sprintf(p
, "%s", SDATA (SYMBOL_NAME (AREF (font
, FONT_FAMILY_INDEX
))));
1437 p
+= sprintf (p
, "%d", point_size
);
1439 p
+= sprintf (p
, "-%d", point_size
);
1441 else if (pixel_size
> 0)
1442 p
+= sprintf (p
, ":pixelsize=%d", pixel_size
);
1443 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
1444 p
+= sprintf (p
, ":foundry=%s",
1445 SDATA (SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
))));
1446 for (i
= 0; i
< 3; i
++)
1447 if (! NILP (styles
[i
]))
1448 p
+= sprintf (p
, ":%s=%s", style_names
[i
],
1449 SDATA (SYMBOL_NAME (styles
[i
])));
1450 if (INTEGERP (AREF (font
, FONT_DPI_INDEX
)))
1451 p
+= sprintf (p
, ":dpi=%d", XINT (AREF (font
, FONT_DPI_INDEX
)));
1452 if (INTEGERP (AREF (font
, FONT_SPACING_INDEX
)))
1453 p
+= sprintf (p
, ":spacing=%d", XINT (AREF (font
, FONT_SPACING_INDEX
)));
1454 if (INTEGERP (AREF (font
, FONT_AVGWIDTH_INDEX
)))
1456 if (XINT (AREF (font
, FONT_AVGWIDTH_INDEX
)) == 0)
1457 p
+= sprintf (p
, ":scalable=true");
1459 p
+= sprintf (p
, ":scalable=false");
1464 /* Parse NAME (null terminated) and store information in FONT
1465 (font-spec or font-entity). If NAME is successfully parsed, return
1466 0. Otherwise return -1. */
1469 font_parse_name (name
, font
)
1473 if (name
[0] == '-' || index (name
, '*'))
1474 return font_parse_xlfd (name
, font
);
1475 return font_parse_fcname (name
, font
);
1479 /* Merge FAMILY and REGISTRY into FONT_SPEC. FAMILY may have the form
1480 "FAMILY-FOUNDRY". REGISTRY may not contain charset-encoding
1484 font_parse_family_registry (family
, registry
, font_spec
)
1485 Lisp_Object family
, registry
, font_spec
;
1490 if (! NILP (family
))
1492 CHECK_STRING (family
);
1493 len
= SBYTES (family
);
1494 p0
= (char *) SDATA (family
);
1495 p1
= index (p0
, '-');
1498 if (*p0
!= '*' || p1
- p0
> 1)
1499 ASET (font_spec
, FONT_FOUNDRY_INDEX
,
1500 font_intern_prop (p0
, p1
- p0
));
1503 ASET (font_spec
, FONT_FAMILY_INDEX
, font_intern_prop (p1
, len
));
1506 ASET (font_spec
, FONT_FAMILY_INDEX
, Fintern (family
, Qnil
));
1508 if (! NILP (registry
))
1510 /* Convert "XXX" and "XXX*" to "XXX*-*". */
1511 CHECK_STRING (registry
);
1512 len
= SBYTES (registry
);
1513 p0
= (char *) SDATA (registry
);
1514 p1
= index (p0
, '-');
1517 if (SDATA (registry
)[len
- 1] == '*')
1518 registry
= concat2 (registry
, build_string ("-*"));
1520 registry
= concat2 (registry
, build_string ("*-*"));
1522 registry
= Fdowncase (registry
);
1523 ASET (font_spec
, FONT_REGISTRY_INDEX
, Fintern (registry
, Qnil
));
1528 /* This part (through the next ^L) is still experimental and not
1529 tested much. We may drastically change codes. */
1533 #define LGSTRING_HEADER_SIZE 6
1534 #define LGSTRING_GLYPH_SIZE 8
1537 check_gstring (gstring
)
1538 Lisp_Object gstring
;
1543 CHECK_VECTOR (gstring
);
1544 val
= AREF (gstring
, 0);
1546 if (ASIZE (val
) < LGSTRING_HEADER_SIZE
)
1548 CHECK_FONT_OBJECT (LGSTRING_FONT (gstring
));
1549 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
)))
1550 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_LBEARING
));
1551 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
)))
1552 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_RBEARING
));
1553 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
)))
1554 CHECK_NATNUM (LGSTRING_SLOT (gstring
, LGSTRING_IX_WIDTH
));
1555 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1556 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1557 if (!NILP (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
)))
1558 CHECK_NUMBER (LGSTRING_SLOT (gstring
, LGSTRING_IX_ASCENT
));
1560 for (i
= 0; i
< LGSTRING_LENGTH (gstring
); i
++)
1562 val
= LGSTRING_GLYPH (gstring
, i
);
1564 if (ASIZE (val
) < LGSTRING_GLYPH_SIZE
)
1566 if (NILP (AREF (val
, LGLYPH_IX_CHAR
)))
1568 CHECK_NATNUM (AREF (val
, LGLYPH_IX_FROM
));
1569 CHECK_NATNUM (AREF (val
, LGLYPH_IX_TO
));
1570 CHECK_CHARACTER (AREF (val
, LGLYPH_IX_CHAR
));
1571 if (!NILP (AREF (val
, LGLYPH_IX_CODE
)))
1572 CHECK_NATNUM (AREF (val
, LGLYPH_IX_CODE
));
1573 if (!NILP (AREF (val
, LGLYPH_IX_WIDTH
)))
1574 CHECK_NATNUM (AREF (val
, LGLYPH_IX_WIDTH
));
1575 if (!NILP (AREF (val
, LGLYPH_IX_ADJUSTMENT
)))
1577 val
= AREF (val
, LGLYPH_IX_ADJUSTMENT
);
1579 if (ASIZE (val
) < 3)
1581 for (j
= 0; j
< 3; j
++)
1582 CHECK_NUMBER (AREF (val
, j
));
1587 error ("Invalid glyph-string format");
1592 check_otf_features (otf_features
)
1593 Lisp_Object otf_features
;
1597 CHECK_CONS (otf_features
);
1598 CHECK_SYMBOL (XCAR (otf_features
));
1599 otf_features
= XCDR (otf_features
);
1600 CHECK_CONS (otf_features
);
1601 CHECK_SYMBOL (XCAR (otf_features
));
1602 otf_features
= XCDR (otf_features
);
1603 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1605 CHECK_SYMBOL (Fcar (val
));
1606 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1607 error ("Invalid OTF GSUB feature: %s", SYMBOL_NAME (XCAR (val
)));
1609 otf_features
= XCDR (otf_features
);
1610 for (val
= Fcar (otf_features
); ! NILP (val
); val
= Fcdr (val
))
1612 CHECK_SYMBOL (Fcar (val
));
1613 if (SBYTES (SYMBOL_NAME (XCAR (val
))) > 4)
1614 error ("Invalid OTF GPOS feature: %s", SYMBOL_NAME (XCAR (val
)));
1621 Lisp_Object otf_list
;
1624 otf_tag_symbol (tag
)
1629 OTF_tag_name (tag
, name
);
1630 return Fintern (make_unibyte_string (name
, 4), Qnil
);
1637 Lisp_Object val
= Fassoc (file
, otf_list
);
1641 otf
= XSAVE_VALUE (XCDR (val
))->pointer
;
1644 otf
= STRINGP (file
) ? OTF_open ((char *) SDATA (file
)) : NULL
;
1645 val
= make_save_value (otf
, 0);
1646 otf_list
= Fcons (Fcons (file
, val
), otf_list
);
1652 /* Return a list describing which scripts/languages FONT supports by
1653 which GSUB/GPOS features of OpenType tables. See the comment of
1654 (struct font_driver).otf_capability. */
1657 font_otf_capability (font
)
1661 Lisp_Object capability
= Fcons (Qnil
, Qnil
);
1664 otf
= otf_open (font
->props
[FONT_FILE_INDEX
]);
1667 for (i
= 0; i
< 2; i
++)
1669 OTF_GSUB_GPOS
*gsub_gpos
;
1670 Lisp_Object script_list
= Qnil
;
1673 if (OTF_get_features (otf
, i
== 0) < 0)
1675 gsub_gpos
= i
== 0 ? otf
->gsub
: otf
->gpos
;
1676 for (j
= gsub_gpos
->ScriptList
.ScriptCount
- 1; j
>= 0; j
--)
1678 OTF_Script
*script
= gsub_gpos
->ScriptList
.Script
+ j
;
1679 Lisp_Object langsys_list
= Qnil
;
1680 Lisp_Object script_tag
= otf_tag_symbol (script
->ScriptTag
);
1683 for (k
= script
->LangSysCount
; k
>= 0; k
--)
1685 OTF_LangSys
*langsys
;
1686 Lisp_Object feature_list
= Qnil
;
1687 Lisp_Object langsys_tag
;
1690 if (k
== script
->LangSysCount
)
1692 langsys
= &script
->DefaultLangSys
;
1697 langsys
= script
->LangSys
+ k
;
1699 = otf_tag_symbol (script
->LangSysRecord
[k
].LangSysTag
);
1701 for (l
= langsys
->FeatureCount
- 1; l
>= 0; l
--)
1703 OTF_Feature
*feature
1704 = gsub_gpos
->FeatureList
.Feature
+ langsys
->FeatureIndex
[l
];
1705 Lisp_Object feature_tag
1706 = otf_tag_symbol (feature
->FeatureTag
);
1708 feature_list
= Fcons (feature_tag
, feature_list
);
1710 langsys_list
= Fcons (Fcons (langsys_tag
, feature_list
),
1713 script_list
= Fcons (Fcons (script_tag
, langsys_list
),
1718 XSETCAR (capability
, script_list
);
1720 XSETCDR (capability
, script_list
);
1726 /* Parse OTF features in SPEC and write a proper features spec string
1727 in FEATURES for the call of OTF_drive_gsub/gpos (of libotf). It is
1728 assured that the sufficient memory has already allocated for
1732 generate_otf_features (spec
, features
)
1742 for (asterisk
= 0; CONSP (spec
); spec
= XCDR (spec
))
1748 if (SREF (SYMBOL_NAME (val
), 0) == '*')
1753 else if (! asterisk
)
1755 val
= SYMBOL_NAME (val
);
1756 p
+= sprintf (p
, "%s", SDATA (val
));
1760 val
= SYMBOL_NAME (val
);
1761 p
+= sprintf (p
, "~%s", SDATA (val
));
1765 error ("OTF spec too long");
1770 font_otf_DeviceTable (device_table
)
1771 OTF_DeviceTable
*device_table
;
1773 int len
= device_table
->StartSize
- device_table
->EndSize
+ 1;
1775 return Fcons (make_number (len
),
1776 make_unibyte_string (device_table
->DeltaValue
, len
));
1780 font_otf_ValueRecord (value_format
, value_record
)
1782 OTF_ValueRecord
*value_record
;
1784 Lisp_Object val
= Fmake_vector (make_number (8), Qnil
);
1786 if (value_format
& OTF_XPlacement
)
1787 ASET (val
, 0, make_number (value_record
->XPlacement
));
1788 if (value_format
& OTF_YPlacement
)
1789 ASET (val
, 1, make_number (value_record
->YPlacement
));
1790 if (value_format
& OTF_XAdvance
)
1791 ASET (val
, 2, make_number (value_record
->XAdvance
));
1792 if (value_format
& OTF_YAdvance
)
1793 ASET (val
, 3, make_number (value_record
->YAdvance
));
1794 if (value_format
& OTF_XPlaDevice
)
1795 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XPlaDevice
));
1796 if (value_format
& OTF_YPlaDevice
)
1797 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YPlaDevice
));
1798 if (value_format
& OTF_XAdvDevice
)
1799 ASET (val
, 4, font_otf_DeviceTable (&value_record
->XAdvDevice
));
1800 if (value_format
& OTF_YAdvDevice
)
1801 ASET (val
, 4, font_otf_DeviceTable (&value_record
->YAdvDevice
));
1806 font_otf_Anchor (anchor
)
1811 val
= Fmake_vector (make_number (anchor
->AnchorFormat
+ 1), Qnil
);
1812 ASET (val
, 0, make_number (anchor
->XCoordinate
));
1813 ASET (val
, 1, make_number (anchor
->YCoordinate
));
1814 if (anchor
->AnchorFormat
== 2)
1815 ASET (val
, 2, make_number (anchor
->f
.f1
.AnchorPoint
));
1818 ASET (val
, 3, font_otf_DeviceTable (&anchor
->f
.f2
.XDeviceTable
));
1819 ASET (val
, 4, font_otf_DeviceTable (&anchor
->f
.f2
.YDeviceTable
));
1824 #endif /* HAVE_LIBOTF */
1826 /* G-string (glyph string) handler */
1828 /* G-string is a vector of the form [HEADER GLYPH ...].
1829 See the docstring of `font-make-gstring' for more detail. */
1832 font_prepare_composition (cmp
, f
)
1833 struct composition
*cmp
;
1837 = AREF (XHASH_TABLE (composition_hash_table
)->key_and_value
,
1838 cmp
->hash_index
* 2);
1840 cmp
->font
= XFONT_OBJECT (LGSTRING_FONT (gstring
));
1841 cmp
->glyph_len
= LGSTRING_LENGTH (gstring
);
1842 cmp
->pixel_width
= LGSTRING_WIDTH (gstring
);
1843 cmp
->lbearing
= LGSTRING_LBEARING (gstring
);
1844 cmp
->rbearing
= LGSTRING_RBEARING (gstring
);
1845 cmp
->ascent
= LGSTRING_ASCENT (gstring
);
1846 cmp
->descent
= LGSTRING_DESCENT (gstring
);
1847 cmp
->width
= cmp
->pixel_width
/ FRAME_COLUMN_WIDTH (f
);
1848 if (cmp
->width
== 0)
1857 static unsigned font_score
P_ ((Lisp_Object
, Lisp_Object
*, Lisp_Object
));
1858 static int font_compare
P_ ((const void *, const void *));
1859 static Lisp_Object font_sort_entites
P_ ((Lisp_Object
, Lisp_Object
,
1860 Lisp_Object
, Lisp_Object
,
1863 /* We sort fonts by scoring each of them against a specified
1864 font-spec. The score value is 32 bit (`unsigned'), and the smaller
1865 the value is, the closer the font is to the font-spec.
1867 The highest 2 bits of the score is used for FAMILY. The exact
1868 match is 0, match with one of face-font-family-alternatives is
1871 The next 2 bits of the score is used for the atomic properties
1872 FOUNDRY and ADSTYLE respectively.
1874 Each 7-bit in the lower 28 bits are used for numeric properties
1875 WEIGHT, SLANT, WIDTH, and SIZE. */
1877 /* How many bits to shift to store the difference value of each font
1878 property in a score. Note that flots for FONT_TYPE_INDEX and
1879 FONT_REGISTRY_INDEX are not used. */
1880 static int sort_shift_bits
[FONT_SIZE_INDEX
+ 1];
1882 /* Score font-entity ENTITY against properties of font-spec SPEC_PROP.
1883 The return value indicates how different ENTITY is compared with
1886 ALTERNATE_FAMILIES, if non-nil, is a pre-calculated list of
1887 alternate family names for AREF (SPEC_PROP, FONT_FAMILY_INDEX). */
1890 font_score (entity
, spec_prop
, alternate_families
)
1891 Lisp_Object entity
, *spec_prop
;
1892 Lisp_Object alternate_families
;
1897 /* Score three atomic fields. Maximum difference is 1 (family is 3). */
1898 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_ADSTYLE_INDEX
; i
++)
1899 if (i
!= FONT_REGISTRY_INDEX
1900 && ! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
1902 Lisp_Object entity_str
= SYMBOL_NAME (AREF (entity
, i
));
1903 Lisp_Object spec_str
= SYMBOL_NAME (spec_prop
[i
]);
1905 if (strcasecmp (SDATA (spec_str
), SDATA (entity_str
)))
1907 if (i
== FONT_FAMILY_INDEX
&& CONSP (alternate_families
))
1911 for (j
= 1; CONSP (alternate_families
);
1912 j
++, alternate_families
= XCDR (alternate_families
))
1914 spec_str
= XCAR (alternate_families
);
1915 if (strcasecmp (SDATA (spec_str
), SDATA (entity_str
)) == 0)
1921 score
|= j
<< sort_shift_bits
[i
];
1924 score
|= 1 << sort_shift_bits
[i
];
1928 /* Score three style numeric fields. Maximum difference is 127. */
1929 for (i
= FONT_WEIGHT_INDEX
; i
<= FONT_WIDTH_INDEX
; i
++)
1930 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
]))
1932 int diff
= (XINT (AREF (entity
, i
)) >> 8) - (XINT (spec_prop
[i
]) >> 8);
1936 /* This is to prefer the exact symbol style. */
1938 score
|= min (diff
, 127) << sort_shift_bits
[i
];
1941 /* Score the size. Maximum difference is 127. */
1942 i
= FONT_SIZE_INDEX
;
1943 if (! NILP (spec_prop
[i
]) && ! EQ (AREF (entity
, i
), spec_prop
[i
])
1944 && XINT (AREF (entity
, i
)) > 0)
1946 /* We use the higher 6-bit for the actual size difference. The
1947 lowest bit is set if the DPI is different. */
1948 int diff
= XINT (spec_prop
[i
]) - XINT (AREF (entity
, i
));
1953 if (! NILP (spec_prop
[FONT_DPI_INDEX
])
1954 && ! EQ (spec_prop
[FONT_DPI_INDEX
], AREF (entity
, FONT_DPI_INDEX
)))
1956 score
|= min (diff
, 127) << sort_shift_bits
[FONT_SIZE_INDEX
];
1963 /* The comparison function for qsort. */
1966 font_compare (d1
, d2
)
1967 const void *d1
, *d2
;
1969 return (*(unsigned *) d1
- *(unsigned *) d2
);
1973 /* The structure for elements being sorted by qsort. */
1974 struct font_sort_data
1981 /* Sort font-entities in vector VEC by closeness to font-spec PREFER.
1982 If PREFER specifies a point-size, calculate the corresponding
1983 pixel-size from QCdpi property of PREFER or from the Y-resolution
1984 of FRAME before sorting. If SPEC is not nil, it is a font-spec to
1985 get the font-entities in VEC.
1987 If BEST-ONLY is nonzero, return the best matching entity. Otherwise,
1988 return the sorted VEC. */
1991 font_sort_entites (vec
, prefer
, frame
, spec
, best_only
)
1992 Lisp_Object vec
, prefer
, frame
, spec
;
1995 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
1997 struct font_sort_data
*data
;
1998 Lisp_Object alternate_families
= Qnil
;
1999 unsigned best_score
;
2000 Lisp_Object best_entity
;
2005 return best_only
? AREF (vec
, 0) : vec
;
2007 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_DPI_INDEX
; i
++)
2008 prefer_prop
[i
] = AREF (prefer
, i
);
2012 /* A font driver may return a font that has a property value
2013 different from the value specified in SPEC if the driver
2014 thinks they are the same. That happens, for instance, such a
2015 generic family name as "serif" is specified. So, to ignore
2016 such a difference, for all properties specified in SPEC, set
2017 the corresponding properties in PREFER_PROP to nil. */
2018 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_REGISTRY_INDEX
; i
++)
2019 if (! NILP (AREF (spec
, i
)))
2020 prefer_prop
[i
] = Qnil
;
2023 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2024 prefer_prop
[FONT_SIZE_INDEX
]
2025 = make_number (font_pixel_size (XFRAME (frame
), prefer
));
2026 if (! NILP (prefer_prop
[FONT_FAMILY_INDEX
]))
2029 = Fassoc_string (prefer_prop
[FONT_FAMILY_INDEX
],
2030 Vface_alternative_font_family_alist
, Qt
);
2031 if (CONSP (alternate_families
))
2032 alternate_families
= XCDR (alternate_families
);
2035 /* Scoring and sorting. */
2036 SAFE_ALLOCA (data
, struct font_sort_data
*, (sizeof *data
) * len
);
2037 best_score
= 0xFFFFFFFF;
2039 for (i
= 0; i
< len
; i
++)
2041 data
[i
].entity
= AREF (vec
, i
);
2042 data
[i
].score
= font_score (data
[i
].entity
, prefer_prop
,
2043 alternate_families
);
2044 if (best_only
&& best_score
> data
[i
].score
)
2046 best_score
= data
[i
].score
;
2047 best_entity
= data
[i
].entity
;
2048 if (best_score
== 0)
2052 if (NILP (best_entity
))
2054 qsort (data
, len
, sizeof *data
, font_compare
);
2055 for (i
= 0; i
< len
; i
++)
2056 ASET (vec
, i
, data
[i
].entity
);
2066 /* API of Font Service Layer. */
2068 /* Reflect ORDER (see the variable font_sort_order in xfaces.c) to
2069 sort_shift_bits. Finternal_set_font_selection_order calls this
2070 function with font_sort_order after setting up it. */
2073 font_update_sort_order (order
)
2078 for (i
= 0, shift_bits
= 21; i
< 4; i
++, shift_bits
-= 7)
2080 int xlfd_idx
= order
[i
];
2082 if (xlfd_idx
== XLFD_WEIGHT_INDEX
)
2083 sort_shift_bits
[FONT_WEIGHT_INDEX
] = shift_bits
;
2084 else if (xlfd_idx
== XLFD_SLANT_INDEX
)
2085 sort_shift_bits
[FONT_SLANT_INDEX
] = shift_bits
;
2086 else if (xlfd_idx
== XLFD_SWIDTH_INDEX
)
2087 sort_shift_bits
[FONT_WIDTH_INDEX
] = shift_bits
;
2089 sort_shift_bits
[FONT_SIZE_INDEX
] = shift_bits
;
2094 /* Check if ENTITY matches with the font specification SPEC. */
2097 font_match_p (spec
, entity
)
2098 Lisp_Object spec
, entity
;
2100 Lisp_Object prefer_prop
[FONT_SPEC_MAX
];
2101 Lisp_Object alternate_families
= Qnil
;
2102 int prefer_style
[3];
2105 for (i
= FONT_FOUNDRY_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
2106 prefer_prop
[i
] = AREF (spec
, i
);
2107 if (FLOATP (prefer_prop
[FONT_SIZE_INDEX
]))
2108 prefer_prop
[FONT_SIZE_INDEX
]
2109 = make_number (font_pixel_size (XFRAME (selected_frame
), spec
));
2110 if (! NILP (prefer_prop
[FONT_FAMILY_INDEX
]))
2113 = Fassoc_string (prefer_prop
[FONT_FAMILY_INDEX
],
2114 Vface_alternative_font_family_alist
, Qt
);
2115 if (CONSP (alternate_families
))
2116 alternate_families
= XCDR (alternate_families
);
2119 return (font_score (entity
, prefer_prop
, alternate_families
) == 0);
2123 /* CHeck a lispy font object corresponding to FONT. */
2126 font_check_object (font
)
2129 Lisp_Object tail
, elt
;
2131 for (tail
= font
->props
[FONT_OBJLIST_INDEX
]; CONSP (tail
);
2135 if (font
== XFONT_OBJECT (elt
))
2144 Each font backend has the callback function get_cache, and it
2145 returns a cons cell of which cdr part can be freely used for
2146 caching fonts. The cons cell may be shared by multiple frames
2147 and/or multiple font drivers. So, we arrange the cdr part as this:
2149 ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...)
2151 where DRIVER-TYPE is a symbol such as `x', `xft', etc., NUM-FRAMES
2152 is a number frames sharing this cache, and FONT-CACHE-DATA is a
2153 cons (FONT-SPEC FONT-ENTITY ...). */
2155 static void font_prepare_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2156 static void font_finish_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2157 static Lisp_Object font_get_cache
P_ ((FRAME_PTR
, struct font_driver
*));
2158 static void font_clear_cache
P_ ((FRAME_PTR
, Lisp_Object
,
2159 struct font_driver
*));
2162 font_prepare_cache (f
, driver
)
2164 struct font_driver
*driver
;
2166 Lisp_Object cache
, val
;
2168 cache
= driver
->get_cache (f
);
2170 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2174 val
= Fcons (driver
->type
, Fcons (make_number (1), Qnil
));
2175 XSETCDR (cache
, Fcons (val
, XCDR (cache
)));
2179 val
= XCDR (XCAR (val
));
2180 XSETCAR (val
, make_number (XINT (XCAR (val
)) + 1));
2186 font_finish_cache (f
, driver
)
2188 struct font_driver
*driver
;
2190 Lisp_Object cache
, val
, tmp
;
2193 cache
= driver
->get_cache (f
);
2195 while (CONSP (val
) && ! EQ (XCAR (XCAR (val
)), driver
->type
))
2196 cache
= val
, val
= XCDR (val
);
2197 xassert (! NILP (val
));
2198 tmp
= XCDR (XCAR (val
));
2199 XSETCAR (tmp
, make_number (XINT (XCAR (tmp
)) - 1));
2200 if (XINT (XCAR (tmp
)) == 0)
2202 font_clear_cache (f
, XCAR (val
), driver
);
2203 XSETCDR (cache
, XCDR (val
));
2209 font_get_cache (f
, driver
)
2211 struct font_driver
*driver
;
2213 Lisp_Object val
= driver
->get_cache (f
);
2214 Lisp_Object type
= driver
->type
;
2216 xassert (CONSP (val
));
2217 for (val
= XCDR (val
); ! EQ (XCAR (XCAR (val
)), type
); val
= XCDR (val
));
2218 xassert (CONSP (val
));
2219 /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */
2220 val
= XCDR (XCAR (val
));
2224 static int num_fonts
;
2227 font_clear_cache (f
, cache
, driver
)
2230 struct font_driver
*driver
;
2232 Lisp_Object tail
, elt
;
2234 /* CACHE = (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) */
2235 for (tail
= XCDR (XCDR (cache
)); CONSP (tail
); tail
= XCDR (tail
))
2238 if (CONSP (elt
) && FONT_SPEC_P (XCAR (elt
)))
2240 Lisp_Object vec
= XCDR (elt
);
2243 for (i
= 0; i
< ASIZE (vec
); i
++)
2245 Lisp_Object entity
= AREF (vec
, i
);
2247 if (EQ (driver
->type
, AREF (entity
, FONT_TYPE_INDEX
)))
2249 Lisp_Object objlist
= AREF (entity
, FONT_OBJLIST_INDEX
);
2251 for (; CONSP (objlist
); objlist
= XCDR (objlist
))
2253 Lisp_Object val
= XCAR (objlist
);
2254 struct font
*font
= XFONT_OBJECT (val
);
2256 xassert (font
&& driver
== font
->driver
);
2257 driver
->close (f
, font
);
2260 if (driver
->free_entity
)
2261 driver
->free_entity (entity
);
2266 XSETCDR (cache
, Qnil
);
2270 static Lisp_Object scratch_font_spec
, scratch_font_prefer
;
2273 font_delete_unmatched (list
, spec
, size
)
2274 Lisp_Object list
, spec
;
2277 Lisp_Object entity
, prev
, tail
;
2278 enum font_property_index prop
;
2280 for (tail
= list
, prev
= Qnil
; CONSP (tail
); )
2282 entity
= XCAR (tail
);
2283 for (prop
= FONT_WEIGHT_INDEX
; prop
< FONT_SIZE_INDEX
; prop
++)
2284 if (INTEGERP (AREF (spec
, prop
))
2285 && ((XINT (AREF (spec
, prop
)) >> 8)
2286 != (XINT (AREF (entity
, prop
)) >> 8)))
2287 prop
= FONT_SPEC_MAX
;
2288 if (prop
++ <= FONT_SIZE_INDEX
2290 && XINT (AREF (entity
, FONT_SIZE_INDEX
)) > 0)
2292 int diff
= XINT (AREF (entity
, FONT_SIZE_INDEX
)) - size
;
2295 && (diff
< 0 ? -diff
> FONT_PIXEL_SIZE_QUANTUM
2296 : diff
> FONT_PIXEL_SIZE_QUANTUM
))
2297 prop
= FONT_SPEC_MAX
;
2299 if (prop
< FONT_SPEC_MAX
2300 && INTEGERP (AREF (spec
, FONT_SPACING_INDEX
))
2301 && ! EQ (AREF (spec
, FONT_SPACING_INDEX
),
2302 AREF (entity
, FONT_SPACING_INDEX
)))
2303 prop
= FONT_SPEC_MAX
;
2304 if (prop
< FONT_SPEC_MAX
)
2305 prev
= tail
, tail
= XCDR (tail
);
2306 else if (NILP (prev
))
2307 list
= tail
= XCDR (tail
);
2309 tail
= XCDR (tail
), XSETCDR (prev
, tail
);
2315 /* Return a vector of font-entities matching with SPEC on FRAME. */
2318 font_list_entities (frame
, spec
)
2319 Lisp_Object frame
, spec
;
2321 FRAME_PTR f
= XFRAME (frame
);
2322 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2323 Lisp_Object ftype
, family
, alternate_familes
;
2326 int need_filtering
= 0;
2330 xassert (FONT_SPEC_P (spec
));
2332 family
= AREF (spec
, FONT_FAMILY_INDEX
);
2334 alternate_familes
= Qnil
;
2337 alternate_familes
= Fassoc_string (family
,
2338 Vface_alternative_font_family_alist
,
2340 if (! NILP (alternate_familes
))
2341 alternate_familes
= XCDR (alternate_familes
);
2342 n_family
+= XINT (Flength (alternate_familes
));
2345 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2346 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2347 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2348 size
= font_pixel_size (f
, spec
);
2352 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2353 for (i
= 0; i
<= FONT_REGISTRY_INDEX
; i
++)
2354 ASET (scratch_font_spec
, i
, AREF (spec
, i
));
2355 for (; i
< FONT_EXTRA_INDEX
; i
++)
2357 ASET (scratch_font_spec
, i
, Qnil
);
2358 if (! NILP (AREF (spec
, i
)))
2361 ASET (scratch_font_spec
, FONT_EXTRA_INDEX
, AREF (spec
, FONT_EXTRA_INDEX
));
2363 vec
= alloca (sizeof (Lisp_Object
) * num_font_drivers
* n_family
);
2367 for (i
= 0; driver_list
; driver_list
= driver_list
->next
)
2369 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2371 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2372 Lisp_Object tail
= alternate_familes
;
2376 Lisp_Object val
= assoc_no_quit (scratch_font_spec
, XCDR (cache
));
2378 if (CONSP (val
) && VECTORP (XCDR (val
)))
2384 val
= driver_list
->driver
->list (frame
, scratch_font_spec
);
2385 if (! NILP (val
) && need_filtering
)
2386 val
= font_delete_unmatched (val
, spec
, size
);
2387 copy
= Fcopy_font_spec (scratch_font_spec
);
2388 XSETCDR (cache
, Fcons (Fcons (copy
, val
), XCDR (cache
)));
2397 ASET (scratch_font_spec
, FONT_FAMILY_INDEX
,
2398 Fintern (XCAR (tail
), Qnil
));
2403 return (i
> 0 ? Fvconcat (i
, vec
) : null_vector
);
2407 /* Return a font entity matching with SPEC on FRAME. ATTRS, if non
2408 nil, is an array of face's attributes, which specifies preferred
2409 font-related attributes. */
2412 font_matching_entity (f
, attrs
, spec
)
2414 Lisp_Object
*attrs
, spec
;
2416 struct font_driver_list
*driver_list
= f
->font_driver_list
;
2417 Lisp_Object ftype
, size
, entity
;
2420 XSETFRAME (frame
, f
);
2421 ftype
= AREF (spec
, FONT_TYPE_INDEX
);
2422 size
= AREF (spec
, FONT_SIZE_INDEX
);
2424 ASET (spec
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2426 for (; driver_list
; driver_list
= driver_list
->next
)
2428 && (NILP (ftype
) || EQ (driver_list
->driver
->type
, ftype
)))
2430 Lisp_Object cache
= font_get_cache (f
, driver_list
->driver
);
2432 ASET (spec
, FONT_TYPE_INDEX
, driver_list
->driver
->type
);
2433 entity
= assoc_no_quit (spec
, XCDR (cache
));
2434 if (CONSP (entity
) && ! VECTORP (XCDR (entity
)))
2435 entity
= XCDR (entity
);
2438 entity
= driver_list
->driver
->match (frame
, spec
);
2439 XSETCDR (cache
, Fcons (Fcons (Fcopy_font_spec (spec
), entity
),
2442 if (! NILP (entity
))
2445 ASET (spec
, FONT_TYPE_INDEX
, ftype
);
2446 ASET (spec
, FONT_SIZE_INDEX
, size
);
2451 /* Open a font of ENTITY and PIXEL_SIZE on frame F, and return the
2452 opened font object. */
2455 font_open_entity (f
, entity
, pixel_size
)
2460 struct font_driver_list
*driver_list
;
2461 Lisp_Object objlist
, size
, val
, font_object
;
2465 xassert (FONT_ENTITY_P (entity
));
2466 size
= AREF (entity
, FONT_SIZE_INDEX
);
2467 if (XINT (size
) != 0)
2468 pixel_size
= XINT (size
);
2470 for (objlist
= AREF (entity
, FONT_OBJLIST_INDEX
); CONSP (objlist
);
2471 objlist
= XCDR (objlist
))
2472 if (XFONT_OBJECT (XCAR (objlist
))->pixel_size
== pixel_size
)
2473 return XCAR (objlist
);
2475 val
= AREF (entity
, FONT_TYPE_INDEX
);
2476 for (driver_list
= f
->font_driver_list
;
2477 driver_list
&& ! EQ (driver_list
->driver
->type
, val
);
2478 driver_list
= driver_list
->next
);
2482 font_object
= driver_list
->driver
->open (f
, entity
, pixel_size
);
2483 if (NILP (font_object
))
2485 ASET (entity
, FONT_OBJLIST_INDEX
,
2486 Fcons (font_object
, AREF (entity
, FONT_OBJLIST_INDEX
)));
2487 ASET (font_object
, FONT_OBJLIST_INDEX
, AREF (entity
, FONT_OBJLIST_INDEX
));
2490 font
= XFONT_OBJECT (font_object
);
2491 min_width
= (font
->min_width
? font
->min_width
2492 : font
->average_width
? font
->average_width
2493 : font
->space_width
? font
->space_width
2495 FRAME_X_DISPLAY_INFO (f
)->n_fonts
++;
2496 if (FRAME_X_DISPLAY_INFO (f
)->n_fonts
== 1)
2498 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
;
2499 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
;
2500 fonts_changed_p
= 1;
2504 if (FRAME_SMALLEST_CHAR_WIDTH (f
) > min_width
)
2505 FRAME_SMALLEST_CHAR_WIDTH (f
) = min_width
, fonts_changed_p
= 1;
2506 if (FRAME_SMALLEST_FONT_HEIGHT (f
) > font
->height
)
2507 FRAME_SMALLEST_FONT_HEIGHT (f
) = font
->height
, fonts_changed_p
= 1;
2514 /* Close FONT_OBJECT that is opened on frame F. */
2517 font_close_object (f
, font_object
)
2519 Lisp_Object font_object
;
2521 struct font
*font
= XFONT_OBJECT (font_object
);
2522 Lisp_Object objlist
;
2523 Lisp_Object tail
, prev
= Qnil
;
2525 objlist
= AREF (font_object
, FONT_OBJLIST_INDEX
);
2526 for (prev
= Qnil
, tail
= objlist
; CONSP (tail
);
2527 prev
= tail
, tail
= XCDR (tail
))
2528 if (EQ (font_object
, XCAR (tail
)))
2530 xassert (FRAME_X_DISPLAY_INFO (f
)->n_fonts
);
2531 font
->driver
->close (f
, font
);
2532 FRAME_X_DISPLAY_INFO (f
)->n_fonts
--;
2534 ASET (font_object
, FONT_OBJLIST_INDEX
, XCDR (objlist
));
2536 XSETCDR (prev
, XCDR (objlist
));
2544 /* Return 1 if FONT on F has a glyph for character C, 0 if not, -1 if
2545 FONT is a font-entity and it must be opened to check. */
2548 font_has_char (f
, font
, c
)
2555 if (FONT_ENTITY_P (font
))
2557 Lisp_Object type
= AREF (font
, FONT_TYPE_INDEX
);
2558 struct font_driver_list
*driver_list
;
2560 for (driver_list
= f
->font_driver_list
;
2561 driver_list
&& ! EQ (driver_list
->driver
->type
, type
);
2562 driver_list
= driver_list
->next
);
2565 if (! driver_list
->driver
->has_char
)
2567 return driver_list
->driver
->has_char (font
, c
);
2570 xassert (FONT_OBJECT_P (font
));
2571 fontp
= XFONT_OBJECT (font
);
2572 if (fontp
->driver
->has_char
)
2574 int result
= fontp
->driver
->has_char (font
, c
);
2579 return (fontp
->driver
->encode_char (fontp
, c
) != FONT_INVALID_CODE
);
2583 /* Return the glyph ID of FONT_OBJECT for character C. */
2586 font_encode_char (font_object
, c
)
2587 Lisp_Object font_object
;
2592 xassert (FONT_OBJECT_P (font_object
));
2593 font
= XFONT_OBJECT (font_object
);
2594 return font
->driver
->encode_char (font
, c
);
2598 /* Return the name of FONT_OBJECT. */
2601 font_get_name (font_object
)
2602 Lisp_Object font_object
;
2606 xassert (FONT_OBJECT_P (font_object
));
2607 return AREF (font_object
, FONT_NAME_INDEX
);
2611 /* Return the specification of FONT_OBJECT. */
2614 font_get_spec (font_object
)
2615 Lisp_Object font_object
;
2617 Lisp_Object spec
= font_make_spec ();
2620 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
2621 ASET (spec
, i
, AREF (font_object
, i
));
2622 ASET (spec
, FONT_SIZE_INDEX
,
2623 make_number (XFONT_OBJECT (font_object
)->pixel_size
));
2628 font_spec_from_name (font_name
)
2629 Lisp_Object font_name
;
2631 Lisp_Object args
[2];
2634 args
[1] = font_name
;
2635 return Ffont_spec (2, args
);
2640 font_clear_prop (attrs
, prop
)
2642 enum font_property_index prop
;
2644 Lisp_Object font
= attrs
[LFACE_FONT_INDEX
];
2645 Lisp_Object extra
, prev
;
2649 if (NILP (AREF (font
, prop
))
2650 && prop
!= FONT_FAMILY_INDEX
&& prop
!= FONT_FAMILY_INDEX
)
2652 font
= Fcopy_font_spec (font
);
2653 ASET (font
, prop
, Qnil
);
2654 if (prop
== FONT_FAMILY_INDEX
)
2656 ASET (font
, FONT_FOUNDRY_INDEX
, Qnil
);
2657 ASET (font
, FONT_ADSTYLE_INDEX
, Qnil
);
2658 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
2659 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2660 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2661 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2663 else if (prop
== FONT_SIZE_INDEX
)
2665 ASET (font
, FONT_DPI_INDEX
, Qnil
);
2666 ASET (font
, FONT_SPACING_INDEX
, Qnil
);
2667 ASET (font
, FONT_AVGWIDTH_INDEX
, Qnil
);
2669 attrs
[LFACE_FONT_INDEX
] = font
;
2673 font_update_lface (f
, attrs
)
2677 Lisp_Object spec
, val
;
2680 spec
= attrs
[LFACE_FONT_INDEX
];
2681 if (! FONT_SPEC_P (spec
))
2684 if (! NILP (AREF (spec
, FONT_FOUNDRY_INDEX
))
2685 || ! NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2689 if (NILP (AREF (spec
, FONT_FOUNDRY_INDEX
)))
2690 family
= AREF (spec
, FONT_FAMILY_INDEX
);
2691 else if (NILP (AREF (spec
, FONT_FAMILY_INDEX
)))
2692 family
= concat2 (SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
)),
2693 build_string ("-*"));
2695 family
= concat3 (SYMBOL_NAME (AREF (spec
, FONT_FOUNDRY_INDEX
)),
2697 SYMBOL_NAME (AREF (spec
, FONT_FAMILY_INDEX
)));
2698 attrs
[LFACE_FAMILY_INDEX
] = family
;
2700 if (! NILP (AREF (spec
, FONT_WEIGHT_INDEX
)))
2701 attrs
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (spec
);
2702 if (! NILP (AREF (spec
, FONT_SLANT_INDEX
)))
2703 attrs
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (spec
);;
2704 if (! NILP (AREF (spec
, FONT_WIDTH_INDEX
)))
2705 attrs
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (spec
);
2706 if (! NILP (AREF (spec
, FONT_SIZE_INDEX
)))
2710 if (INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2715 val
= Ffont_get (spec
, QCdpi
);
2718 point
= PIXEL_TO_POINT (XINT (AREF (spec
, FONT_SIZE_INDEX
)) * 10,
2721 else if (FLOATP (AREF (spec
, FONT_SIZE_INDEX
)))
2722 point
= XFLOAT_DATA (AREF (spec
, FONT_SIZE_INDEX
)) * 10;
2723 attrs
[LFACE_HEIGHT_INDEX
] = make_number (point
);
2728 /* Return a font-entity satisfying SPEC and best matching with face's
2729 font related attributes in ATTRS. C, if not negative, is a
2730 character that the entity must support. */
2733 font_find_for_lface (f
, attrs
, spec
, c
)
2739 Lisp_Object frame
, entities
, val
, props
[FONT_REGISTRY_INDEX
+ 1] ;
2745 Lisp_Object registry
= AREF (spec
, FONT_REGISTRY_INDEX
);
2746 struct charset
*encoding
, *repertory
;
2748 if (font_registry_charsets (registry
, &encoding
, &repertory
) < 0)
2752 if (ENCODE_CHAR (repertory
, c
) == CHARSET_INVALID_CODE (repertory
))
2754 /* Any font of this registry support C. So, let's
2755 suppress the further checking. */
2758 else if (c
> encoding
->max_char
)
2762 XSETFRAME (frame
, f
);
2763 size
= AREF (spec
, FONT_SIZE_INDEX
);
2764 ASET (spec
, FONT_SIZE_INDEX
, Qnil
);
2765 entities
= font_list_entities (frame
, spec
);
2766 ASET (spec
, FONT_SIZE_INDEX
, size
);
2767 if (ASIZE (entities
) == 0)
2769 if (ASIZE (entities
) == 1)
2772 return AREF (entities
, 0);
2776 /* Sort fonts by properties specified in LFACE. */
2777 Lisp_Object prefer
= scratch_font_prefer
;
2779 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
2780 ASET (prefer
, i
, AREF (spec
, i
));
2781 if (NILP (AREF (prefer
, FONT_FAMILY_INDEX
)))
2782 font_parse_family_registry (attrs
[LFACE_FAMILY_INDEX
], Qnil
, prefer
);
2783 if (NILP (AREF (prefer
, FONT_WEIGHT_INDEX
)))
2784 FONT_SET_STYLE (prefer
, FONT_WEIGHT_INDEX
, attrs
[LFACE_WEIGHT_INDEX
]);
2785 if (NILP (AREF (prefer
, FONT_SLANT_INDEX
)))
2786 FONT_SET_STYLE (prefer
, FONT_SLANT_INDEX
, attrs
[LFACE_SLANT_INDEX
]);
2787 if (NILP (AREF (prefer
, FONT_WIDTH_INDEX
)))
2788 FONT_SET_STYLE (prefer
, FONT_WIDTH_INDEX
, attrs
[LFACE_SWIDTH_INDEX
]);
2789 if (INTEGERP (size
))
2790 ASET (prefer
, FONT_SIZE_INDEX
, size
);
2791 else if (FLOATP (size
))
2792 ASET (prefer
, FONT_SIZE_INDEX
, make_number (font_pixel_size (f
, spec
)));
2795 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
2796 int pixel_size
= POINT_TO_PIXEL (pt
/ 10, f
->resy
);
2797 ASET (prefer
, FONT_SIZE_INDEX
, make_number (pixel_size
));
2799 ASET (spec
, FONT_SIZE_INDEX
, Qnil
);
2800 entities
= font_sort_entites (entities
, prefer
, frame
, spec
, c
< 0);
2801 ASET (spec
, FONT_SIZE_INDEX
, size
);
2806 for (i
= 0; i
< ASIZE (entities
); i
++)
2810 val
= AREF (entities
, i
);
2813 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
2814 if (! EQ (AREF (val
, j
), props
[j
]))
2816 if (j
> FONT_REGISTRY_INDEX
)
2819 for (j
= FONT_FOUNDRY_INDEX
; j
<= FONT_REGISTRY_INDEX
; j
++)
2820 props
[j
] = AREF (val
, j
);
2821 result
= font_has_char (f
, val
, c
);
2826 val
= font_open_for_lface (f
, val
, attrs
, spec
);
2829 result
= font_has_char (f
, val
, c
);
2830 font_close_object (f
, val
);
2832 return AREF (entities
, i
);
2839 font_open_for_lface (f
, entity
, attrs
, spec
)
2847 if (FONT_SPEC_P (spec
) && INTEGERP (AREF (spec
, FONT_SIZE_INDEX
)))
2848 size
= XINT (AREF (spec
, FONT_SIZE_INDEX
));
2851 double pt
= XINT (attrs
[LFACE_HEIGHT_INDEX
]);
2854 size
= POINT_TO_PIXEL (pt
, f
->resy
);
2856 return font_open_entity (f
, entity
, size
);
2860 /* Find a font satisfying SPEC and best matching with face's
2861 attributes in ATTRS on FRAME, and return the opened
2865 font_load_for_lface (f
, attrs
, spec
)
2867 Lisp_Object
*attrs
, spec
;
2871 entity
= font_find_for_lface (f
, attrs
, spec
, -1);
2874 /* No font is listed for SPEC, but each font-backend may have
2875 the different criteria about "font matching". So, try
2877 entity
= font_matching_entity (f
, attrs
, spec
);
2881 return font_open_for_lface (f
, entity
, attrs
, spec
);
2885 /* Make FACE on frame F ready to use the font opened for FACE. */
2888 font_prepare_for_face (f
, face
)
2892 if (face
->font
->driver
->prepare_face
)
2893 face
->font
->driver
->prepare_face (f
, face
);
2897 /* Make FACE on frame F stop using the font opened for FACE. */
2900 font_done_for_face (f
, face
)
2904 if (face
->font
->driver
->done_face
)
2905 face
->font
->driver
->done_face (f
, face
);
2910 /* Open a font best matching with NAME on frame F. If no proper font
2911 is found, return Qnil. */
2914 font_open_by_name (f
, name
)
2918 Lisp_Object args
[2];
2919 Lisp_Object spec
, prefer
, size
, entity
, entity_list
;
2924 XSETFRAME (frame
, f
);
2927 args
[1] = make_unibyte_string (name
, strlen (name
));
2928 spec
= Ffont_spec (2, args
);
2929 prefer
= scratch_font_prefer
;
2930 for (i
= 0; i
< FONT_SPEC_MAX
; i
++)
2932 ASET (prefer
, i
, AREF (spec
, i
));
2933 if (NILP (AREF (prefer
, i
))
2934 && i
>= FONT_WEIGHT_INDEX
&& i
<= FONT_WIDTH_INDEX
)
2935 FONT_SET_STYLE (prefer
, i
, make_number (100));
2937 size
= AREF (spec
, FONT_SIZE_INDEX
);
2942 if (INTEGERP (size
))
2943 pixel_size
= XINT (size
);
2944 else /* FLOATP (size) */
2946 double pt
= XFLOAT_DATA (size
);
2948 pixel_size
= POINT_TO_PIXEL (pt
, f
->resy
);
2950 if (pixel_size
== 0)
2951 ASET (spec
, FONT_SIZE_INDEX
, Qnil
);
2953 if (pixel_size
== 0)
2955 pixel_size
= POINT_TO_PIXEL (12.0, f
->resy
);
2956 size
= make_number (pixel_size
);
2957 ASET (prefer
, FONT_SIZE_INDEX
, size
);
2959 if (NILP (AREF (spec
, FONT_REGISTRY_INDEX
)))
2960 ASET (spec
, FONT_REGISTRY_INDEX
, Qiso8859_1
);
2962 entity_list
= Flist_fonts (spec
, frame
, make_number (1), prefer
);
2963 if (NILP (entity_list
))
2964 entity
= font_matching_entity (f
, NULL
, spec
);
2966 entity
= XCAR (entity_list
);
2967 return (NILP (entity
)
2969 : font_open_entity (f
, entity
, pixel_size
));
2973 /* Register font-driver DRIVER. This function is used in two ways.
2975 The first is with frame F non-NULL. In this case, make DRIVER
2976 available (but not yet activated) on F. All frame creaters
2977 (e.g. Fx_create_frame) must call this function at least once with
2978 an available font-driver.
2980 The second is with frame F NULL. In this case, DRIVER is globally
2981 registered in the variable `font_driver_list'. All font-driver
2982 implementations must call this function in its syms_of_XXXX
2983 (e.g. syms_of_xfont). */
2986 register_font_driver (driver
, f
)
2987 struct font_driver
*driver
;
2990 struct font_driver_list
*root
= f
? f
->font_driver_list
: font_driver_list
;
2991 struct font_driver_list
*prev
, *list
;
2993 if (f
&& ! driver
->draw
)
2994 error ("Unusable font driver for a frame: %s",
2995 SDATA (SYMBOL_NAME (driver
->type
)));
2997 for (prev
= NULL
, list
= root
; list
; prev
= list
, list
= list
->next
)
2998 if (EQ (list
->driver
->type
, driver
->type
))
2999 error ("Duplicated font driver: %s", SDATA (SYMBOL_NAME (driver
->type
)));
3001 list
= malloc (sizeof (struct font_driver_list
));
3003 list
->driver
= driver
;
3008 f
->font_driver_list
= list
;
3010 font_driver_list
= list
;
3015 /* Free font-driver list on frame F. It doesn't free font-drivers
3019 free_font_driver_list (f
)
3022 while (f
->font_driver_list
)
3024 struct font_driver_list
*next
= f
->font_driver_list
->next
;
3026 free (f
->font_driver_list
);
3027 f
->font_driver_list
= next
;
3032 /* Make the frame F use font backends listed in NEW_DRIVERS (list of
3033 symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all
3034 available font drivers. If NEW_DRIVERS is nil, finalize all drivers.
3036 A caller must free all realized faces if any in advance. The
3037 return value is a list of font backends actually made used on
3041 font_update_drivers (f
, new_drivers
)
3043 Lisp_Object new_drivers
;
3045 Lisp_Object active_drivers
= Qnil
;
3046 struct font_driver_list
*list
;
3048 for (list
= f
->font_driver_list
; list
; list
= list
->next
)
3051 if (! EQ (new_drivers
, Qt
)
3052 && NILP (Fmemq (list
->driver
->type
, new_drivers
)))
3054 if (list
->driver
->end_for_frame
)
3055 list
->driver
->end_for_frame (f
);
3056 font_finish_cache (f
, list
->driver
);
3062 if (EQ (new_drivers
, Qt
)
3063 || ! NILP (Fmemq (list
->driver
->type
, new_drivers
)))
3065 if (! list
->driver
->start_for_frame
3066 || list
->driver
->start_for_frame (f
) == 0)
3068 font_prepare_cache (f
, list
->driver
);
3070 active_drivers
= nconc2 (active_drivers
,
3071 Fcons (list
->driver
->type
, Qnil
));
3076 return active_drivers
;
3080 font_put_frame_data (f
, driver
, data
)
3082 struct font_driver
*driver
;
3085 struct font_data_list
*list
, *prev
;
3087 for (prev
= NULL
, list
= f
->font_data_list
; list
;
3088 prev
= list
, list
= list
->next
)
3089 if (list
->driver
== driver
)
3096 prev
->next
= list
->next
;
3098 f
->font_data_list
= list
->next
;
3106 list
= malloc (sizeof (struct font_data_list
));
3109 list
->driver
= driver
;
3110 list
->next
= f
->font_data_list
;
3111 f
->font_data_list
= list
;
3119 font_get_frame_data (f
, driver
)
3121 struct font_driver
*driver
;
3123 struct font_data_list
*list
;
3125 for (list
= f
->font_data_list
; list
; list
= list
->next
)
3126 if (list
->driver
== driver
)
3134 /* Return the font used to draw character C by FACE at buffer position
3135 POS in window W. If STRING is non-nil, it is a string containing C
3136 at index POS. If C is negative, get C from the current buffer or
3140 font_at (c
, pos
, face
, w
, string
)
3149 Lisp_Object font_object
;
3155 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3158 EMACS_INT pos_byte
= CHAR_TO_BYTE (pos
);
3160 c
= FETCH_CHAR (pos_byte
);
3163 c
= FETCH_BYTE (pos
);
3169 multibyte
= STRING_MULTIBYTE (string
);
3172 EMACS_INT pos_byte
= string_char_to_byte (string
, pos
);
3174 str
= SDATA (string
) + pos_byte
;
3175 c
= STRING_CHAR (str
, 0);
3178 c
= SDATA (string
)[pos
];
3182 f
= XFRAME (w
->frame
);
3183 if (! FRAME_WINDOW_P (f
))
3190 if (STRINGP (string
))
3191 face_id
= face_at_string_position (w
, string
, pos
, 0, -1, -1, &endptr
,
3192 DEFAULT_FACE_ID
, 0);
3194 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &endptr
,
3196 face
= FACE_FROM_ID (f
, face_id
);
3200 int face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3201 face
= FACE_FROM_ID (f
, face_id
);
3206 xassert (font_check_object ((struct font
*) face
->font
));
3207 XSETFONT (font_object
, face
->font
);
3212 /* Check how many characters after POS (at most to LIMIT) can be
3213 displayed by the same font. FACE is the face selected for the
3214 character as POS on frame F. STRING, if not nil, is the string to
3215 check instead of the current buffer.
3217 The return value is the position of the character that is displayed
3218 by the differnt font than that of the character as POS. */
3221 font_range (pos
, limit
, face
, f
, string
)
3222 EMACS_INT pos
, limit
;
3235 multibyte
= ! NILP (current_buffer
->enable_multibyte_characters
);
3236 pos_byte
= CHAR_TO_BYTE (pos
);
3240 multibyte
= STRING_MULTIBYTE (string
);
3241 pos_byte
= string_char_to_byte (string
, pos
);
3245 /* All unibyte character are displayed by the same font. */
3253 FETCH_CHAR_ADVANCE_NO_CHECK (c
, pos
, pos_byte
);
3255 FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c
, string
, pos
, pos_byte
);
3256 face_id
= FACE_FOR_CHAR (f
, face
, c
, pos
, string
);
3257 face
= FACE_FROM_ID (f
, face_id
);
3264 else if (font
!= face
->font
)
3276 DEFUN ("fontp", Ffontp
, Sfontp
, 1, 2, 0,
3277 doc
: /* Return t if OBJECT is a font-spec, font-entity, or font-object.
3278 Return nil otherwise.
3279 Optional 2nd argument EXTRA-TYPE, if non-nil, specifies to check
3280 which kind of font it is. It must be one of `font-spec', `font-entity'
3282 (object
, extra_type
)
3283 Lisp_Object object
, extra_type
;
3285 if (NILP (extra_type
))
3286 return (FONTP (object
) ? Qt
: Qnil
);
3287 if (EQ (extra_type
, Qfont_spec
))
3288 return (FONT_SPEC_P (object
) ? Qt
: Qnil
);
3289 if (EQ (extra_type
, Qfont_entity
))
3290 return (FONT_ENTITY_P (object
) ? Qt
: Qnil
);
3291 if (EQ (extra_type
, Qfont_object
))
3292 return (FONT_OBJECT_P (object
) ? Qt
: Qnil
);
3293 wrong_type_argument (intern ("font-extra-type"), extra_type
);
3296 DEFUN ("font-spec", Ffont_spec
, Sfont_spec
, 0, MANY
, 0,
3297 doc
: /* Return a newly created font-spec with arguments as properties.
3299 ARGS must come in pairs KEY VALUE of font properties. KEY must be a
3300 valid font property name listed below:
3302 `:family', `:weight', `:slant', `:width'
3304 They are the same as face attributes of the same name. See
3305 `set-face-attribute'.
3309 VALUE must be a string or a symbol specifying the font foundry, e.g. ``misc''.
3313 VALUE must be a string or a symbol specifying the additional
3314 typographic style information of a font, e.g. ``sans''.
3318 VALUE must be a string or a symbol specifying the charset registry and
3319 encoding of a font, e.g. ``iso8859-1''.
3323 VALUE must be a non-negative integer or a floating point number
3324 specifying the font size. It specifies the font size in pixels
3325 (if VALUE is an integer), or in points (if VALUE is a float).
3326 usage: (font-spec ARGS ...) */)
3331 Lisp_Object spec
= font_make_spec ();
3334 for (i
= 0; i
< nargs
; i
+= 2)
3336 Lisp_Object key
= args
[i
], val
= args
[i
+ 1];
3338 if (EQ (key
, QCname
))
3341 font_parse_name ((char *) SDATA (val
), spec
);
3342 font_put_extra (spec
, key
, val
);
3344 else if (EQ (key
, QCfamily
))
3347 font_parse_family_registry (val
, Qnil
, spec
);
3351 int idx
= get_font_prop_index (key
);
3355 val
= font_prop_validate (idx
, Qnil
, val
);
3356 if (idx
< FONT_EXTRA_INDEX
)
3357 ASET (spec
, idx
, val
);
3359 font_put_extra (spec
, key
, val
);
3362 font_put_extra (spec
, key
, font_prop_validate (0, key
, val
));
3368 DEFUN ("copy-font-spec", Fcopy_font_spec
, Scopy_font_spec
, 1, 1, 0,
3369 doc
: /* Return a copy of FONT as a font-spec. */)
3373 Lisp_Object new_spec
, tail
, extra
;
3377 new_spec
= font_make_spec ();
3378 for (i
= 1; i
< FONT_EXTRA_INDEX
; i
++)
3379 ASET (new_spec
, i
, AREF (font
, i
));
3381 for (tail
= AREF (font
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3383 if (! EQ (XCAR (XCAR (tail
)), QCfont_entity
))
3384 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3386 ASET (new_spec
, FONT_EXTRA_INDEX
, extra
);
3390 DEFUN ("merge-font-spec", Fmerge_font_spec
, Smerge_font_spec
, 2, 2, 0,
3391 doc
: /* Merge font-specs FROM and TO, and return a new font-spec.
3392 Every specified properties in FROM override the corresponding
3393 properties in TO. */)
3395 Lisp_Object from
, to
;
3397 Lisp_Object extra
, tail
;
3402 to
= Fcopy_font_spec (to
);
3403 for (i
= 0; i
< FONT_EXTRA_INDEX
; i
++)
3404 ASET (to
, i
, AREF (from
, i
));
3405 extra
= AREF (to
, FONT_EXTRA_INDEX
);
3406 for (tail
= AREF (from
, FONT_EXTRA_INDEX
); CONSP (tail
); tail
= XCDR (tail
))
3407 if (! EQ (XCAR (XCAR (tail
)), Qfont_entity
))
3409 Lisp_Object slot
= assq_no_quit (XCAR (XCAR (tail
)), extra
);
3412 XSETCDR (slot
, XCDR (XCAR (tail
)));
3414 extra
= Fcons (Fcons (XCAR (XCAR (tail
)), XCDR (XCAR (tail
))), extra
);
3416 ASET (to
, FONT_EXTRA_INDEX
, extra
);
3420 DEFUN ("font-get", Ffont_get
, Sfont_get
, 2, 2, 0,
3421 doc
: /* Return the value of FONT's property KEY.
3422 FONT is a font-spec, a font-entity, or a font-object. */)
3424 Lisp_Object font
, key
;
3431 idx
= get_font_prop_index (key
);
3432 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3433 return AREF (font
, idx
);
3434 return Fcdr (Fassq (key
, AREF (font
, FONT_EXTRA_INDEX
)));
3438 DEFUN ("font-put", Ffont_put
, Sfont_put
, 3, 3, 0,
3439 doc
: /* Set one property of FONT-SPEC: give property PROP value VAL. */)
3440 (font_spec
, prop
, val
)
3441 Lisp_Object font_spec
, prop
, val
;
3444 Lisp_Object extra
, slot
;
3446 CHECK_FONT_SPEC (font_spec
);
3447 idx
= get_font_prop_index (prop
);
3448 if (idx
>= 0 && idx
< FONT_EXTRA_INDEX
)
3450 if (idx
== FONT_FAMILY_INDEX
3452 font_parse_family_registry (val
, Qnil
, font_spec
);
3454 ASET (font_spec
, idx
, font_prop_validate (idx
, Qnil
, val
));
3457 font_put_extra (font_spec
, prop
, font_prop_validate (0, prop
, val
));
3461 DEFUN ("list-fonts", Flist_fonts
, Slist_fonts
, 1, 4, 0,
3462 doc
: /* List available fonts matching FONT-SPEC on the current frame.
3463 Optional 2nd argument FRAME specifies the target frame.
3464 Optional 3rd argument NUM, if non-nil, limits the number of returned fonts.
3465 Optional 4th argument PREFER, if non-nil, is a font-spec to
3466 control the order of the returned list. Fonts are sorted by
3467 how they are close to PREFER. */)
3468 (font_spec
, frame
, num
, prefer
)
3469 Lisp_Object font_spec
, frame
, num
, prefer
;
3471 Lisp_Object vec
, list
, tail
;
3475 frame
= selected_frame
;
3476 CHECK_LIVE_FRAME (frame
);
3477 CHECK_FONT_SPEC (font_spec
);
3485 if (! NILP (prefer
))
3486 CHECK_FONT_SPEC (prefer
);
3488 vec
= font_list_entities (frame
, font_spec
);
3493 return Fcons (AREF (vec
, 0), Qnil
);
3495 if (! NILP (prefer
))
3496 vec
= font_sort_entites (vec
, prefer
, frame
, font_spec
, 0);
3498 list
= tail
= Fcons (AREF (vec
, 0), Qnil
);
3499 if (n
== 0 || n
> len
)
3501 for (i
= 1; i
< n
; i
++)
3503 Lisp_Object val
= Fcons (AREF (vec
, i
), Qnil
);
3505 XSETCDR (tail
, val
);
3511 DEFUN ("font-family-list", Ffont_family_list
, Sfont_family_list
, 0, 1, 0,
3512 doc
: /* List available font families on the current frame.
3513 Optional argument FRAME specifies the target frame. */)
3518 struct font_driver_list
*driver_list
;
3522 frame
= selected_frame
;
3523 CHECK_LIVE_FRAME (frame
);
3526 for (driver_list
= f
->font_driver_list
; driver_list
;
3527 driver_list
= driver_list
->next
)
3528 if (driver_list
->driver
->list_family
)
3530 Lisp_Object val
= driver_list
->driver
->list_family (frame
);
3536 Lisp_Object tail
= list
;
3538 for (; CONSP (val
); val
= XCDR (val
))
3539 if (NILP (Fmemq (XCAR (val
), tail
)))
3540 list
= Fcons (XCAR (val
), list
);
3546 DEFUN ("find-font", Ffind_font
, Sfind_font
, 1, 2, 0,
3547 doc
: /* Return a font-entity matching with FONT-SPEC on the current frame.
3548 Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
3550 Lisp_Object font_spec
, frame
;
3552 Lisp_Object val
= Flist_fonts (font_spec
, frame
, make_number (1), Qnil
);
3559 DEFUN ("font-xlfd-name", Ffont_xlfd_name
, Sfont_xlfd_name
, 1, 1, 0,
3560 doc
: /* Return XLFD name of FONT.
3561 FONT is a font-spec, font-entity, or font-object.
3562 If the name is too long for XLFD (maximum 255 chars), return nil. */)
3571 if (FONT_OBJECT_P (font
))
3573 Lisp_Object font_name
= AREF (font
, FONT_NAME_INDEX
);
3575 if (STRINGP (font_name
)
3576 && SDATA (font_name
)[0] == '-')
3578 pixel_size
= XFONT_OBJECT (font
)->pixel_size
;
3580 if (font_unparse_xlfd (font
, pixel_size
, name
, 256) < 0)
3582 return build_string (name
);
3585 DEFUN ("clear-font-cache", Fclear_font_cache
, Sclear_font_cache
, 0, 0, 0,
3586 doc
: /* Clear font cache. */)
3589 Lisp_Object list
, frame
;
3591 FOR_EACH_FRAME (list
, frame
)
3593 FRAME_PTR f
= XFRAME (frame
);
3594 struct font_driver_list
*driver_list
= f
->font_driver_list
;
3596 for (; driver_list
; driver_list
= driver_list
->next
)
3597 if (driver_list
->on
)
3599 Lisp_Object cache
= driver_list
->driver
->get_cache (f
);
3604 && ! EQ (XCAR (XCAR (val
)), driver_list
->driver
->type
))
3606 xassert (! NILP (val
));
3607 val
= XCDR (XCAR (val
));
3608 if (XINT (XCAR (val
)) == 0)
3610 font_clear_cache (f
, XCAR (val
), driver_list
->driver
);
3611 XSETCDR (cache
, XCDR (val
));
3619 DEFUN ("internal-set-font-style-table", Finternal_set_font_style_table
,
3620 Sinternal_set_font_style_table
, 3, 3, 0,
3621 doc
: /* Setup font style table from WEIGHT, SLANT, and WIDTH tables.
3622 WEIGHT, SLANT, WIDTH must be `font-weight-table', `font-slant-table',
3623 `font-width-table' respectivly.
3624 This function is called after those tables are initialized. */)
3625 (weight
, slant
, width
)
3626 Lisp_Object weight
, slant
, width
;
3628 Lisp_Object tables
[3];
3631 tables
[0] = weight
, tables
[1] = slant
, tables
[2] = width
;
3633 font_style_table
= Fmake_vector (make_number (3), Qnil
);
3634 /* In the following loop, we don't use XCAR and XCDR until assuring
3635 the argument is a cons cell so that the error in the tables can
3637 for (i
= 0; i
< 3; i
++)
3639 Lisp_Object tail
, elt
, list
, val
;
3641 for (tail
= tables
[i
], list
= Qnil
; CONSP (tail
); tail
= XCDR (tail
))
3646 CHECK_SYMBOL (Fcar (elt
));
3647 val
= Fcons (XCAR (elt
), Qnil
);
3649 CHECK_NATNUM (Fcar (elt
));
3650 if (numeric
>= XINT (XCAR (elt
)))
3651 error ("Numeric values not unique nor sorted in %s",
3652 (i
== 0 ? "font-weight-table"
3653 : i
== 1 ? "font-slant-table"
3654 : "font-width-table"));
3655 numeric
= XINT (XCAR (elt
));
3656 XSETCDR (val
, XCAR (elt
));
3657 list
= Fcons (val
, list
);
3658 for (elt
= XCDR (elt
); CONSP (elt
); elt
= XCDR (elt
))
3662 list
= Fcons (Fcons (XCAR (elt
), make_number (numeric
)), list
);
3665 list
= Fnreverse (list
);
3666 ASET (font_style_table
, i
, Fvconcat (1, &list
));
3672 /* The following three functions are still expremental. */
3674 DEFUN ("font-make-gstring", Ffont_make_gstring
, Sfont_make_gstring
, 2, 2, 0,
3675 doc
: /* Return a newly created g-string for FONT-OBJECT with NUM glyphs.
3676 FONT-OBJECT may be nil if it is not yet known.
3678 G-string is sequence of glyphs of a specific font,
3679 and is a vector of this form:
3680 [ HEADER GLYPH ... ]
3681 HEADER is a vector of this form:
3682 [FONT-OBJECT WIDTH LBEARING RBEARING ASCENT DESCENT]
3684 FONT-OBJECT is a font-object for all glyphs in the g-string,
3685 WIDTH thry DESCENT are the metrics (in pixels) of the whole G-string.
3686 GLYPH is a vector of this form:
3687 [ FROM-IDX TO-IDX C CODE WIDTH LBEARING RBEARING ASCENT DESCENT
3688 [ [X-OFF Y-OFF WADJUST] | nil] ]
3690 FROM-IDX and TO-IDX are used internally and should not be touched.
3691 C is the character of the glyph.
3692 CODE is the glyph-code of C in FONT-OBJECT.
3693 WIDTH thry DESCENT are the metrics (in pixels) of the glyph.
3694 X-OFF and Y-OFF are offests to the base position for the glyph.
3695 WADJUST is the adjustment to the normal width of the glyph. */)
3697 Lisp_Object font_object
, num
;
3699 Lisp_Object gstring
, g
;
3703 if (! NILP (font_object
))
3704 CHECK_FONT_OBJECT (font_object
);
3707 len
= XINT (num
) + 1;
3708 gstring
= Fmake_vector (make_number (len
), Qnil
);
3709 g
= Fmake_vector (make_number (6), Qnil
);
3710 ASET (g
, 0, font_object
);
3711 ASET (gstring
, 0, g
);
3712 for (i
= 1; i
< len
; i
++)
3713 ASET (gstring
, i
, Fmake_vector (make_number (10), Qnil
));
3717 DEFUN ("font-fill-gstring", Ffont_fill_gstring
, Sfont_fill_gstring
, 4, 5, 0,
3718 doc
: /* Fill in glyph-string GSTRING by characters for FONT-OBJECT.
3719 START and END specify the region to extract characters.
3720 If optional 5rd argument OBJECT is non-nil, it is a buffer or a string from
3721 where to extract characters.
3722 FONT-OBJECT may be nil if GSTRING already already contains one. */)
3723 (gstring
, font_object
, start
, end
, object
)
3724 Lisp_Object gstring
, font_object
, start
, end
, object
;
3730 CHECK_VECTOR (gstring
);
3731 if (NILP (font_object
))
3732 font_object
= LGSTRING_FONT (gstring
);
3733 font
= XFONT_OBJECT (font_object
);
3735 if (STRINGP (object
))
3737 const unsigned char *p
;
3739 CHECK_NATNUM (start
);
3741 if (XINT (start
) > XINT (end
)
3742 || XINT (end
) > ASIZE (object
)
3743 || XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3744 args_out_of_range_3 (object
, start
, end
);
3746 len
= XINT (end
) - XINT (start
);
3747 p
= SDATA (object
) + string_char_to_byte (object
, XINT (start
));
3748 for (i
= 0; i
< len
; i
++)
3750 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3751 /* Shut up GCC warning in comparison with
3752 MOST_POSITIVE_FIXNUM below. */
3755 c
= STRING_CHAR_ADVANCE (p
);
3756 cod
= code
= font
->driver
->encode_char (font
, c
);
3757 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
3759 LGLYPH_SET_FROM (g
, i
);
3760 LGLYPH_SET_TO (g
, i
);
3761 LGLYPH_SET_CHAR (g
, c
);
3762 LGLYPH_SET_CODE (g
, code
);
3769 if (! NILP (object
))
3770 Fset_buffer (object
);
3771 validate_region (&start
, &end
);
3772 if (XINT (end
) - XINT (start
) > LGSTRING_LENGTH (gstring
))
3773 args_out_of_range (start
, end
);
3774 len
= XINT (end
) - XINT (start
);
3776 pos_byte
= CHAR_TO_BYTE (pos
);
3777 for (i
= 0; i
< len
; i
++)
3779 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3780 /* Shut up GCC warning in comparison with
3781 MOST_POSITIVE_FIXNUM below. */
3784 FETCH_CHAR_ADVANCE (c
, pos
, pos_byte
);
3785 cod
= code
= font
->driver
->encode_char (font
, c
);
3786 if (cod
> MOST_POSITIVE_FIXNUM
|| code
== FONT_INVALID_CODE
)
3788 LGLYPH_SET_FROM (g
, i
);
3789 LGLYPH_SET_TO (g
, i
);
3790 LGLYPH_SET_CHAR (g
, c
);
3791 LGLYPH_SET_CODE (g
, code
);
3794 for (; i
< LGSTRING_LENGTH (gstring
); i
++)
3795 LGSTRING_SET_GLYPH (gstring
, i
, Qnil
);
3799 DEFUN ("font-shape-text", Ffont_shape_text
, Sfont_shape_text
, 3, 4, 0,
3800 doc
: /* Shape text between FROM and TO by FONT-OBJECT.
3801 If optional 4th argument STRING is non-nil, it is a string to shape,
3802 and FROM and TO are indices to the string.
3803 The value is the end position of the text that can be shaped by
3805 (from
, to
, font_object
, string
)
3806 Lisp_Object from
, to
, font_object
, string
;
3809 struct font_metrics metrics
;
3810 EMACS_INT start
, end
;
3811 Lisp_Object gstring
, n
;
3814 if (! FONT_OBJECT_P (font_object
))
3816 font
= XFONT_OBJECT (font_object
);
3817 if (! font
->driver
->shape
)
3822 validate_region (&from
, &to
);
3823 start
= XFASTINT (from
);
3824 end
= XFASTINT (to
);
3825 modify_region (current_buffer
, start
, end
, 0);
3829 CHECK_STRING (string
);
3830 start
= XINT (from
);
3832 if (start
< 0 || start
> end
|| end
> SCHARS (string
))
3833 args_out_of_range_3 (string
, from
, to
);
3837 gstring
= Ffont_make_gstring (font_object
, make_number (len
));
3838 Ffont_fill_gstring (gstring
, font_object
, from
, to
, string
);
3840 /* Try at most three times with larger gstring each time. */
3841 for (i
= 0; i
< 3; i
++)
3843 Lisp_Object args
[2];
3845 n
= font
->driver
->shape (gstring
);
3849 args
[1] = Fmake_vector (make_number (len
), Qnil
);
3850 gstring
= Fvconcat (2, args
);
3852 if (! INTEGERP (n
) || XINT (n
) == 0)
3856 for (i
= 0; i
< len
;)
3859 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3860 EMACS_INT this_from
= LGLYPH_FROM (g
);
3861 EMACS_INT this_to
= LGLYPH_TO (g
) + 1;
3863 int need_composition
= 0;
3865 metrics
.lbearing
= LGLYPH_LBEARING (g
);
3866 metrics
.rbearing
= LGLYPH_RBEARING (g
);
3867 metrics
.ascent
= LGLYPH_ASCENT (g
);
3868 metrics
.descent
= LGLYPH_DESCENT (g
);
3869 if (NILP (LGLYPH_ADJUSTMENT (g
)))
3871 metrics
.width
= LGLYPH_WIDTH (g
);
3872 if (LGLYPH_CHAR (g
) == 0 || metrics
.width
== 0)
3873 need_composition
= 1;
3877 metrics
.width
= LGLYPH_WADJUST (g
);
3878 metrics
.lbearing
+= LGLYPH_XOFF (g
);
3879 metrics
.rbearing
+= LGLYPH_XOFF (g
);
3880 metrics
.ascent
-= LGLYPH_YOFF (g
);
3881 metrics
.descent
+= LGLYPH_YOFF (g
);
3882 need_composition
= 1;
3884 for (j
= i
+ 1; j
< len
; j
++)
3888 g
= LGSTRING_GLYPH (gstring
, j
);
3889 if (this_from
!= LGLYPH_FROM (g
))
3891 need_composition
= 1;
3892 x
= metrics
.width
+ LGLYPH_LBEARING (g
) + LGLYPH_XOFF (g
);
3893 if (metrics
.lbearing
> x
)
3894 metrics
.lbearing
= x
;
3895 x
= metrics
.width
+ LGLYPH_RBEARING (g
) + LGLYPH_XOFF (g
);
3896 if (metrics
.rbearing
< x
)
3897 metrics
.rbearing
= x
;
3898 x
= LGLYPH_ASCENT (g
) - LGLYPH_YOFF (g
);
3899 if (metrics
.ascent
< x
)
3901 x
= LGLYPH_DESCENT (g
) - LGLYPH_YOFF (g
);
3902 if (metrics
.descent
< x
)
3903 metrics
.descent
= x
;
3904 if (NILP (LGLYPH_ADJUSTMENT (g
)))
3905 metrics
.width
+= LGLYPH_WIDTH (g
);
3907 metrics
.width
+= LGLYPH_WADJUST (g
);
3910 if (need_composition
)
3912 gstr
= Ffont_make_gstring (font_object
, make_number (j
- i
));
3913 LGSTRING_SET_WIDTH (gstr
, metrics
.width
);
3914 LGSTRING_SET_LBEARING (gstr
, metrics
.lbearing
);
3915 LGSTRING_SET_RBEARING (gstr
, metrics
.rbearing
);
3916 LGSTRING_SET_ASCENT (gstr
, metrics
.ascent
);
3917 LGSTRING_SET_DESCENT (gstr
, metrics
.descent
);
3918 for (k
= i
; i
< j
; i
++)
3920 Lisp_Object g
= LGSTRING_GLYPH (gstring
, i
);
3922 LGLYPH_SET_FROM (g
, LGLYPH_FROM (g
) - this_from
);
3923 LGLYPH_SET_TO (g
, LGLYPH_TO (g
) - this_from
);
3924 LGSTRING_SET_GLYPH (gstr
, i
- k
, LGSTRING_GLYPH (gstring
, i
));
3926 from
= make_number (start
+ this_from
);
3927 to
= make_number (start
+ this_to
);
3929 Fcompose_region_internal (from
, to
, gstr
, Qnil
);
3931 Fcompose_string_internal (string
, from
, to
, gstr
, Qnil
);
3940 DEFUN ("font-drive-otf", Ffont_drive_otf
, Sfont_drive_otf
, 6, 6, 0,
3941 doc
: /* Apply OpenType features on glyph-string GSTRING-IN.
3942 OTF-FEATURES specifies which features to apply in this format:
3943 (SCRIPT LANGSYS GSUB GPOS)
3945 SCRIPT is a symbol specifying a script tag of OpenType,
3946 LANGSYS is a symbol specifying a langsys tag of OpenType,
3947 GSUB and GPOS, if non-nil, are lists of symbols specifying feature tags.
3949 If LANGYS is nil, the default langsys is selected.
3951 The features are applied in the order they appear in the list. The
3952 symbol `*' means to apply all available features not present in this
3953 list, and the remaining features are ignored. For instance, (vatu
3954 pstf * haln) is to apply vatu and pstf in this order, then to apply
3955 all available features other than vatu, pstf, and haln.
3957 The features are applied to the glyphs in the range FROM and TO of
3958 the glyph-string GSTRING-IN.
3960 If some feature is actually applicable, the resulting glyphs are
3961 produced in the glyph-string GSTRING-OUT from the index INDEX. In
3962 this case, the value is the number of produced glyphs.
3964 If no feature is applicable, no glyph is produced in GSTRING-OUT, and
3967 If GSTRING-OUT is too short to hold produced glyphs, no glyphs are
3968 produced in GSTRING-OUT, and the value is nil.
3970 See the documentation of `font-make-gstring' for the format of
3972 (otf_features
, gstring_in
, from
, to
, gstring_out
, index
)
3973 Lisp_Object otf_features
, gstring_in
, from
, to
, gstring_out
, index
;
3975 Lisp_Object font_object
= LGSTRING_FONT (gstring_in
);
3980 check_otf_features (otf_features
);
3981 CHECK_FONT_OBJECT (font_object
);
3982 font
= XFONT_OBJECT (font_object
);
3983 if (! font
->driver
->otf_drive
)
3984 error ("Font backend %s can't drive OpenType GSUB table",
3985 SDATA (SYMBOL_NAME (font
->driver
->type
)));
3986 CHECK_CONS (otf_features
);
3987 CHECK_SYMBOL (XCAR (otf_features
));
3988 val
= XCDR (otf_features
);
3989 CHECK_SYMBOL (XCAR (val
));
3990 val
= XCDR (otf_features
);
3993 len
= check_gstring (gstring_in
);
3994 CHECK_VECTOR (gstring_out
);
3995 CHECK_NATNUM (from
);
3997 CHECK_NATNUM (index
);
3999 if (XINT (from
) >= XINT (to
) || XINT (to
) > len
)
4000 args_out_of_range_3 (from
, to
, make_number (len
));
4001 if (XINT (index
) >= ASIZE (gstring_out
))
4002 args_out_of_range (index
, make_number (ASIZE (gstring_out
)));
4003 num
= font
->driver
->otf_drive (font
, otf_features
,
4004 gstring_in
, XINT (from
), XINT (to
),
4005 gstring_out
, XINT (index
), 0);
4008 return make_number (num
);
4011 DEFUN ("font-otf-alternates", Ffont_otf_alternates
, Sfont_otf_alternates
,
4013 doc
: /* Return a list of alternate glyphs of CHARACTER in FONT-OBJECT.
4014 OTF-FEATURES specifies which features of the font FONT-OBJECT to apply
4016 (SCRIPT LANGSYS FEATURE ...)
4017 See the documentation of `font-otf-gsub' for more detail.
4019 The value is a list of cons cells of the format (GLYPH-ID . CHARACTER),
4020 where GLYPH-ID is a glyph index of the font, and CHARACTER is a
4021 character code corresponding to the glyph or nil if there's no
4022 corresponding character. */)
4023 (font_object
, character
, otf_features
)
4024 Lisp_Object font_object
, character
, otf_features
;
4027 Lisp_Object gstring_in
, gstring_out
, g
;
4028 Lisp_Object alternates
;
4031 CHECK_FONT_GET_OBJECT (font_object
, font
);
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_CHARACTER (character
);
4036 CHECK_CONS (otf_features
);
4038 gstring_in
= Ffont_make_gstring (font_object
, make_number (1));
4039 g
= LGSTRING_GLYPH (gstring_in
, 0);
4040 LGLYPH_SET_CHAR (g
, XINT (character
));
4041 gstring_out
= Ffont_make_gstring (font_object
, make_number (10));
4042 while ((num
= font
->driver
->otf_drive (font
, otf_features
, gstring_in
, 0, 1,
4043 gstring_out
, 0, 1)) < 0)
4044 gstring_out
= Ffont_make_gstring (font_object
,
4045 make_number (ASIZE (gstring_out
) * 2));
4047 for (i
= 0; i
< num
; i
++)
4049 Lisp_Object g
= LGSTRING_GLYPH (gstring_out
, i
);
4050 int c
= LGLYPH_CHAR (g
);
4051 unsigned code
= LGLYPH_CODE (g
);
4053 alternates
= Fcons (Fcons (make_number (code
),
4054 c
> 0 ? make_number (c
) : Qnil
),
4057 return Fnreverse (alternates
);
4063 DEFUN ("open-font", Fopen_font
, Sopen_font
, 1, 3, 0,
4064 doc
: /* Open FONT-ENTITY. */)
4065 (font_entity
, size
, frame
)
4066 Lisp_Object font_entity
;
4072 CHECK_FONT_ENTITY (font_entity
);
4074 frame
= selected_frame
;
4075 CHECK_LIVE_FRAME (frame
);
4078 isize
= XINT (AREF (font_entity
, FONT_SIZE_INDEX
));
4081 CHECK_NUMBER_OR_FLOAT (size
);
4083 isize
= POINT_TO_PIXEL (- isize
, XFRAME (frame
)->resy
);
4085 isize
= XINT (size
);
4089 return font_open_entity (XFRAME (frame
), font_entity
, isize
);
4092 DEFUN ("close-font", Fclose_font
, Sclose_font
, 1, 2, 0,
4093 doc
: /* Close FONT-OBJECT. */)
4094 (font_object
, frame
)
4095 Lisp_Object font_object
, frame
;
4097 CHECK_FONT_OBJECT (font_object
);
4099 frame
= selected_frame
;
4100 CHECK_LIVE_FRAME (frame
);
4101 font_close_object (XFRAME (frame
), font_object
);
4105 DEFUN ("query-font", Fquery_font
, Squery_font
, 1, 1, 0,
4106 doc
: /* Return information about FONT-OBJECT.
4107 The value is a vector:
4108 [ NAME FILENAME PIXEL-SIZE SIZE ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH
4111 NAME is a string of the font name (or nil if the font backend doesn't
4114 FILENAME is a string of the font file (or nil if the font backend
4115 doesn't provide a file name).
4117 PIXEL-SIZE is a pixel size by which the font is opened.
4119 SIZE is a maximum advance width of the font in pixel.
4121 ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font in
4124 CAPABILITY is a list whose first element is a symbol representing the
4125 font format \(x, opentype, truetype, type1, pcf, or bdf) and the
4126 remaining elements describes a detail of the font capability.
4128 If the font is OpenType font, the form of the list is
4129 \(opentype GSUB GPOS)
4130 where GSUB shows which "GSUB" features the font supports, and GPOS
4131 shows which "GPOS" features the font supports. Both GSUB and GPOS are
4132 lists of the format:
4133 \((SCRIPT (LANGSYS FEATURE ...) ...) ...)
4135 If the font is not OpenType font, currently the length of the form is
4138 SCRIPT is a symbol representing OpenType script tag.
4140 LANGSYS is a symbol representing OpenType langsys tag, or nil
4141 representing the default langsys.
4143 FEATURE is a symbol representing OpenType feature tag.
4145 If the font is not OpenType font, CAPABILITY is nil. */)
4147 Lisp_Object font_object
;
4152 CHECK_FONT_GET_OBJECT (font_object
, font
);
4154 val
= Fmake_vector (make_number (9), Qnil
);
4155 ASET (val
, 0, AREF (font_object
, FONT_NAME_INDEX
));
4156 ASET (val
, 1, AREF (font_object
, FONT_FILE_INDEX
));
4157 ASET (val
, 2, make_number (font
->pixel_size
));
4158 ASET (val
, 3, make_number (font
->max_width
));
4159 ASET (val
, 4, make_number (font
->ascent
));
4160 ASET (val
, 5, make_number (font
->descent
));
4161 ASET (val
, 6, make_number (font
->space_width
));
4162 ASET (val
, 7, make_number (font
->average_width
));
4163 if (font
->driver
->otf_capability
)
4164 ASET (val
, 8, Fcons (Qopentype
, font
->driver
->otf_capability (font
)));
4168 DEFUN ("get-font-glyphs", Fget_font_glyphs
, Sget_font_glyphs
, 2, 2, 0,
4169 doc
: /* Return a vector of glyphs of FONT-OBJECT for drawing STRING.
4170 Each element is a vector [GLYPH-CODE LBEARING RBEARING WIDTH ASCENT DESCENT]. */)
4171 (font_object
, string
)
4172 Lisp_Object font_object
, string
;
4178 CHECK_FONT_GET_OBJECT (font_object
, font
);
4179 CHECK_STRING (string
);
4180 len
= SCHARS (string
);
4181 vec
= Fmake_vector (make_number (len
), Qnil
);
4182 for (i
= 0; i
< len
; i
++)
4184 Lisp_Object ch
= Faref (string
, make_number (i
));
4189 struct font_metrics metrics
;
4191 cod
= code
= font
->driver
->encode_char (font
, c
);
4192 if (code
== FONT_INVALID_CODE
)
4194 val
= Fmake_vector (make_number (6), Qnil
);
4195 if (cod
<= MOST_POSITIVE_FIXNUM
)
4196 ASET (val
, 0, make_number (code
));
4198 ASET (val
, 0, Fcons (make_number (code
>> 16),
4199 make_number (code
& 0xFFFF)));
4200 font
->driver
->text_extents (font
, &code
, 1, &metrics
);
4201 ASET (val
, 1, make_number (metrics
.lbearing
));
4202 ASET (val
, 2, make_number (metrics
.rbearing
));
4203 ASET (val
, 3, make_number (metrics
.width
));
4204 ASET (val
, 4, make_number (metrics
.ascent
));
4205 ASET (val
, 5, make_number (metrics
.descent
));
4211 DEFUN ("font-match-p", Ffont_match_p
, Sfont_match_p
, 2, 2, 0,
4212 doc
: /* Return t if and only if font-spec SPEC matches with FONT.
4213 FONT is a font-spec, font-entity, or font-object. */)
4215 Lisp_Object spec
, font
;
4217 CHECK_FONT_SPEC (spec
);
4220 return (font_match_p (spec
, font
) ? Qt
: Qnil
);
4223 DEFUN ("font-at", Ffont_at
, Sfont_at
, 1, 3, 0,
4224 doc
: /* Return a font-object for displaying a character at POSITION.
4225 Optional second arg WINDOW, if non-nil, is a window displaying
4226 the current buffer. It defaults to the currently selected window. */)
4227 (position
, window
, string
)
4228 Lisp_Object position
, window
, string
;
4235 CHECK_NUMBER_COERCE_MARKER (position
);
4236 pos
= XINT (position
);
4237 if (pos
< BEGV
|| pos
>= ZV
)
4238 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
4242 CHECK_NUMBER (position
);
4243 CHECK_STRING (string
);
4244 pos
= XINT (position
);
4245 if (pos
< 0 || pos
>= SCHARS (string
))
4246 args_out_of_range (string
, position
);
4249 window
= selected_window
;
4250 CHECK_LIVE_WINDOW (window
);
4251 w
= XWINDOW (window
);
4253 return font_at (-1, pos
, NULL
, w
, string
);
4257 DEFUN ("draw-string", Fdraw_string
, Sdraw_string
, 2, 2, 0,
4258 doc
: /* Draw STRING by FONT-OBJECT on the top left corner of the current frame.
4259 The value is a number of glyphs drawn.
4260 Type C-l to recover what previously shown. */)
4261 (font_object
, string
)
4262 Lisp_Object font_object
, string
;
4264 Lisp_Object frame
= selected_frame
;
4265 FRAME_PTR f
= XFRAME (frame
);
4271 CHECK_FONT_GET_OBJECT (font_object
, font
);
4272 CHECK_STRING (string
);
4273 len
= SCHARS (string
);
4274 code
= alloca (sizeof (unsigned) * len
);
4275 for (i
= 0; i
< len
; i
++)
4277 Lisp_Object ch
= Faref (string
, make_number (i
));
4281 code
[i
] = font
->driver
->encode_char (font
, c
);
4282 if (code
[i
] == FONT_INVALID_CODE
)
4285 face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4287 if (font
->driver
->prepare_face
)
4288 font
->driver
->prepare_face (f
, face
);
4289 width
= font
->driver
->text_extents (font
, code
, i
, NULL
);
4290 len
= font
->driver
->draw_text (f
, face
, 0, font
->ascent
, code
, i
, width
);
4291 if (font
->driver
->done_face
)
4292 font
->driver
->done_face (f
, face
);
4294 return make_number (len
);
4298 #endif /* FONT_DEBUG */
4301 extern void syms_of_ftfont
P_ (());
4302 extern void syms_of_xfont
P_ (());
4303 extern void syms_of_xftfont
P_ (());
4304 extern void syms_of_ftxfont
P_ (());
4305 extern void syms_of_bdffont
P_ (());
4306 extern void syms_of_w32font
P_ (());
4307 extern void syms_of_atmfont
P_ (());
4312 sort_shift_bits
[FONT_SLANT_INDEX
] = 0;
4313 sort_shift_bits
[FONT_WEIGHT_INDEX
] = 7;
4314 sort_shift_bits
[FONT_SIZE_INDEX
] = 14;
4315 sort_shift_bits
[FONT_WIDTH_INDEX
] = 21;
4316 sort_shift_bits
[FONT_ADSTYLE_INDEX
] = 28;
4317 sort_shift_bits
[FONT_FOUNDRY_INDEX
] = 29;
4318 sort_shift_bits
[FONT_FAMILY_INDEX
] = 30;
4319 /* Note that sort_shift_bits[FONT_SORT_TYPE] and
4320 sort_shift_bits[FONT_SORT_REGISTRY] are never used. */
4322 staticpro (&font_style_table
);
4323 font_style_table
= Fmake_vector (make_number (3), Qnil
);
4325 staticpro (&font_charset_alist
);
4326 font_charset_alist
= Qnil
;
4328 DEFSYM (Qfont_spec
, "font-spec");
4329 DEFSYM (Qfont_entity
, "font-entity");
4330 DEFSYM (Qfont_object
, "font-object");
4332 DEFSYM (Qopentype
, "opentype");
4334 DEFSYM (Qiso8859_1
, "iso8859-1");
4335 DEFSYM (Qiso10646_1
, "iso10646-1");
4336 DEFSYM (Qunicode_bmp
, "unicode-bmp");
4337 DEFSYM (Qunicode_sip
, "unicode-sip");
4339 DEFSYM (QCotf
, ":otf");
4340 DEFSYM (QClang
, ":lang");
4341 DEFSYM (QCscript
, ":script");
4342 DEFSYM (QCantialias
, ":antialias");
4344 DEFSYM (QCfoundry
, ":foundry");
4345 DEFSYM (QCadstyle
, ":adstyle");
4346 DEFSYM (QCregistry
, ":registry");
4347 DEFSYM (QCspacing
, ":spacing");
4348 DEFSYM (QCdpi
, ":dpi");
4349 DEFSYM (QCscalable
, ":scalable");
4350 DEFSYM (QCavgwidth
, ":avgwidth");
4351 DEFSYM (QCfont_entity
, ":font-entity");
4352 DEFSYM (QCfc_unknown_spec
, ":fc-unknown-spec");
4359 staticpro (&null_vector
);
4360 null_vector
= Fmake_vector (make_number (0), Qnil
);
4362 staticpro (&scratch_font_spec
);
4363 scratch_font_spec
= Ffont_spec (0, NULL
);
4364 staticpro (&scratch_font_prefer
);
4365 scratch_font_prefer
= Ffont_spec (0, NULL
);
4368 staticpro (&otf_list
);
4373 defsubr (&Sfont_spec
);
4374 defsubr (&Sfont_get
);
4375 defsubr (&Sfont_put
);
4376 defsubr (&Slist_fonts
);
4377 defsubr (&Sfont_family_list
);
4378 defsubr (&Sfind_font
);
4379 defsubr (&Sfont_xlfd_name
);
4380 defsubr (&Sclear_font_cache
);
4381 defsubr (&Sinternal_set_font_style_table
);
4382 defsubr (&Sfont_make_gstring
);
4383 defsubr (&Sfont_fill_gstring
);
4384 defsubr (&Sfont_shape_text
);
4385 defsubr (&Sfont_drive_otf
);
4386 defsubr (&Sfont_otf_alternates
);
4389 defsubr (&Sopen_font
);
4390 defsubr (&Sclose_font
);
4391 defsubr (&Squery_font
);
4392 defsubr (&Sget_font_glyphs
);
4393 defsubr (&Sfont_match_p
);
4394 defsubr (&Sfont_at
);
4396 defsubr (&Sdraw_string
);
4398 #endif /* FONT_DEBUG */
4400 #ifdef HAVE_FREETYPE
4402 #ifdef HAVE_X_WINDOWS
4407 #endif /* HAVE_XFT */
4408 #endif /* HAVE_X_WINDOWS */
4409 #else /* not HAVE_FREETYPE */
4410 #ifdef HAVE_X_WINDOWS
4412 #endif /* HAVE_X_WINDOWS */
4413 #endif /* not HAVE_FREETYPE */
4416 #endif /* HAVE_BDFFONT */
4419 #endif /* WINDOWSNT */
4425 /* arch-tag: 74c9475d-5976-4c93-a327-942ae3072846
4426 (do not change this comment) */