diff options
Diffstat (limited to 'src/font.c')
| -rw-r--r-- | src/font.c | 1077 |
1 files changed, 684 insertions, 393 deletions
diff --git a/src/font.c b/src/font.c index 51625b49fa8..413cb381eeb 100644 --- a/src/font.c +++ b/src/font.c @@ -1,6 +1,6 @@ /* font.c -- "Font" primitives. -Copyright (C) 2006-2017 Free Software Foundation, Inc. +Copyright (C) 2006-2022 Free Software Foundation, Inc. Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011 National Institute of Advanced Industrial Science and Technology (AIST) Registration Number H13PRO009 @@ -38,6 +38,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "fontset.h" #include "font.h" #include "termhooks.h" +#include "pdumper.h" #ifdef HAVE_WINDOW_SYSTEM #include TERM_HEADER @@ -56,24 +57,28 @@ struct table_entry int numeric; /* The first one is a valid name as a face attribute. The second one (if any) is a typical name in XLFD field. */ - const char *names[5]; + const char *names[6]; }; +/* The following tables should be in sync with 'custom-face-attributes'. */ + /* Table of weight numeric values and their names. This table must be - sorted by numeric values in ascending order. */ + sorted by numeric values in ascending order and the numeric values + must approximately match the weights in the font files. */ static const struct table_entry weight_table[] = { { 0, { "thin" }}, - { 20, { "ultra-light", "ultralight" }}, - { 40, { "extra-light", "extralight" }}, + { 40, { "ultra-light", "ultralight", "extra-light", "extralight" }}, { 50, { "light" }}, - { 75, { "semi-light", "semilight", "demilight", "book" }}, - { 100, { "normal", "medium", "regular", "unspecified" }}, - { 180, { "semi-bold", "semibold", "demibold", "demi" }}, + { 55, { "semi-light", "semilight", "demilight" }}, + { 80, { "regular", "normal", "unspecified", "book" }}, + { 100, { "medium" }}, + { 180, { "semi-bold", "semibold", "demibold", "demi-bold", "demi" }}, { 200, { "bold" }}, - { 205, { "extra-bold", "extrabold" }}, - { 210, { "ultra-bold", "ultrabold", "black" }} + { 205, { "extra-bold", "extrabold", "ultra-bold", "ultrabold" }}, + { 210, { "black", "heavy" }}, + { 250, { "ultra-heavy", "ultraheavy" }} }; /* Table of slant numeric values and their names. This table must be @@ -187,6 +192,9 @@ font_make_object (int size, Lisp_Object entity, int pixelsize) FONT_OBJECT_MAX, PVEC_FONT); int i; + /* Poison the max_width, so we can detect when it hasn't been set. */ + eassert (font->max_width = 1024 * 1024 * 1024); + /* GC can happen before the driver is set up, so avoid dangling pointer here (Bug#17771). */ font->driver = NULL; @@ -201,7 +209,7 @@ font_make_object (int size, Lisp_Object entity, int pixelsize) = Fcopy_alist (AREF (entity, FONT_EXTRA_INDEX)); } if (size > 0) - font->props[FONT_SIZE_INDEX] = make_number (pixelsize); + font->props[FONT_SIZE_INDEX] = make_fixnum (pixelsize); return font_object; } @@ -270,7 +278,7 @@ font_intern_prop (const char *str, ptrdiff_t len, bool force_symbol) (n += str[i++] - '0') <= MOST_POSITIVE_FIXNUM; ) { if (i == len) - return make_number (n); + return make_fixnum (n); if (INT_MULTIPLY_WRAPV (n, 10, &n)) break; } @@ -302,8 +310,8 @@ font_pixel_size (struct frame *f, Lisp_Object spec) int dpi, pixel_size; Lisp_Object val; - if (INTEGERP (size)) - return XINT (size); + if (FIXNUMP (size)) + return XFIXNUM (size); if (NILP (size)) return 0; if (FRAME_WINDOW_P (f)) @@ -311,8 +319,8 @@ font_pixel_size (struct frame *f, Lisp_Object spec) eassert (FLOATP (size)); point_size = XFLOAT_DATA (size); val = AREF (spec, FONT_DPI_INDEX); - if (INTEGERP (val)) - dpi = XINT (val); + if (FIXNUMP (val)) + dpi = XFIXNUM (val); else dpi = FRAME_RES_Y (f); pixel_size = POINT_TO_PIXEL (point_size, dpi); @@ -353,8 +361,8 @@ font_style_to_value (enum font_property_index prop, Lisp_Object val, for (j = 1; j < ASIZE (AREF (table, i)); j++) if (EQ (val, AREF (AREF (table, i), j))) { - CHECK_NUMBER (AREF (AREF (table, i), 0)); - return ((XINT (AREF (AREF (table, i), 0)) << 8) + CHECK_FIXNUM (AREF (AREF (table, i), 0)); + return ((XFIXNUM (AREF (AREF (table, i), 0)) << 8) | (i << 4) | (j - 1)); } } @@ -366,32 +374,32 @@ font_style_to_value (enum font_property_index prop, Lisp_Object val, elt = AREF (AREF (table, i), j); if (xstrcasecmp (s, SSDATA (SYMBOL_NAME (elt))) == 0) { - CHECK_NUMBER (AREF (AREF (table, i), 0)); - return ((XINT (AREF (AREF (table, i), 0)) << 8) + CHECK_FIXNUM (AREF (AREF (table, i), 0)); + return ((XFIXNUM (AREF (AREF (table, i), 0)) << 8) | (i << 4) | (j - 1)); } } if (! noerror) return -1; eassert (len < 255); - elt = Fmake_vector (make_number (2), make_number (100)); + elt = make_vector (2, make_fixnum (100)); ASET (elt, 1, val); ASET (font_style_table, prop - FONT_WEIGHT_INDEX, - CALLN (Fvconcat, table, Fmake_vector (make_number (1), elt))); + CALLN (Fvconcat, table, make_vector (1, elt))); return (100 << 8) | (i << 4); } else { int i, last_n; - EMACS_INT numeric = XINT (val); + EMACS_INT numeric = XFIXNUM (val); for (i = 0, last_n = -1; i < len; i++) { int n; CHECK_VECTOR (AREF (table, i)); - CHECK_NUMBER (AREF (AREF (table, i), 0)); - n = XINT (AREF (AREF (table, i), 0)); + CHECK_FIXNUM (AREF (AREF (table, i), 0)); + n = XFIXNUM (AREF (AREF (table, i), 0)); if (numeric == n) return (n << 8) | (i << 4); if (numeric < n) @@ -421,7 +429,7 @@ font_style_symbolic (Lisp_Object font, enum font_property_index prop, return Qnil; table = AREF (font_style_table, prop - FONT_WEIGHT_INDEX); CHECK_VECTOR (table); - i = XINT (val) & 0xFF; + i = XFIXNUM (val) & 0xFF; eassert (((i >> 4) & 0xF) < ASIZE (table)); elt = AREF (table, ((i >> 4) & 0xF)); CHECK_VECTOR (elt); @@ -470,33 +478,33 @@ font_registry_charsets (Lisp_Object registry, struct charset **encoding, struct val = XCDR (val); if (NILP (val)) return -1; - encoding_id = XINT (XCAR (val)); - repertory_id = XINT (XCDR (val)); + encoding_id = XFIXNUM (XCAR (val)); + repertory_id = XFIXNUM (XCDR (val)); } else { val = find_font_encoding (SYMBOL_NAME (registry)); if (SYMBOLP (val) && CHARSETP (val)) { - encoding_id = repertory_id = XINT (CHARSET_SYMBOL_ID (val)); + encoding_id = repertory_id = XFIXNUM (CHARSET_SYMBOL_ID (val)); } else if (CONSP (val)) { if (! CHARSETP (XCAR (val))) goto invalid_entry; - encoding_id = XINT (CHARSET_SYMBOL_ID (XCAR (val))); + encoding_id = XFIXNUM (CHARSET_SYMBOL_ID (XCAR (val))); if (NILP (XCDR (val))) repertory_id = -1; else { if (! CHARSETP (XCDR (val))) goto invalid_entry; - repertory_id = XINT (CHARSET_SYMBOL_ID (XCDR (val))); + repertory_id = XFIXNUM (CHARSET_SYMBOL_ID (XCDR (val))); } } else goto invalid_entry; - val = Fcons (make_number (encoding_id), make_number (repertory_id)); + val = Fcons (make_fixnum (encoding_id), make_fixnum (repertory_id)); font_charset_alist = nconc2 (font_charset_alist, list1 (Fcons (registry, val))); } @@ -543,9 +551,9 @@ font_prop_validate_style (Lisp_Object style, Lisp_Object val) enum font_property_index prop = (EQ (style, QCweight) ? FONT_WEIGHT_INDEX : EQ (style, QCslant) ? FONT_SLANT_INDEX : FONT_WIDTH_INDEX); - if (INTEGERP (val)) + if (FIXNUMP (val)) { - EMACS_INT n = XINT (val); + EMACS_INT n = XFIXNUM (val); CHECK_VECTOR (AREF (font_style_table, prop - FONT_WEIGHT_INDEX)); if (((n >> 4) & 0xF) >= ASIZE (AREF (font_style_table, prop - FONT_WEIGHT_INDEX))) @@ -559,8 +567,8 @@ font_prop_validate_style (Lisp_Object style, Lisp_Object val) val = Qerror; else { - CHECK_NUMBER (AREF (elt, 0)); - if (XINT (AREF (elt, 0)) != (n >> 8)) + CHECK_FIXNUM (AREF (elt, 0)); + if (XFIXNUM (AREF (elt, 0)) != (n >> 8)) val = Qerror; } } @@ -569,7 +577,7 @@ font_prop_validate_style (Lisp_Object style, Lisp_Object val) { int n = font_style_to_value (prop, val, 0); - val = n >= 0 ? make_number (n) : Qerror; + val = n >= 0 ? make_fixnum (n) : Qerror; } else val = Qerror; @@ -579,27 +587,27 @@ font_prop_validate_style (Lisp_Object style, Lisp_Object val) static Lisp_Object font_prop_validate_non_neg (Lisp_Object prop, Lisp_Object val) { - return (NATNUMP (val) || (FLOATP (val) && XFLOAT_DATA (val) >= 0) + return (FIXNATP (val) || (FLOATP (val) && XFLOAT_DATA (val) >= 0) ? val : Qerror); } static Lisp_Object font_prop_validate_spacing (Lisp_Object prop, Lisp_Object val) { - if (NILP (val) || (NATNUMP (val) && XINT (val) <= FONT_SPACING_CHARCELL)) + if (NILP (val) || (FIXNATP (val) && XFIXNUM (val) <= FONT_SPACING_CHARCELL)) return val; if (SYMBOLP (val) && SBYTES (SYMBOL_NAME (val)) == 1) { char spacing = SDATA (SYMBOL_NAME (val))[0]; if (spacing == 'c' || spacing == 'C') - return make_number (FONT_SPACING_CHARCELL); + return make_fixnum (FONT_SPACING_CHARCELL); if (spacing == 'm' || spacing == 'M') - return make_number (FONT_SPACING_MONO); + return make_fixnum (FONT_SPACING_MONO); if (spacing == 'p' || spacing == 'P') - return make_number (FONT_SPACING_PROPORTIONAL); + return make_fixnum (FONT_SPACING_PROPORTIONAL); if (spacing == 'd' || spacing == 'D') - return make_number (FONT_SPACING_DUAL); + return make_fixnum (FONT_SPACING_DUAL); } return Qerror; } @@ -709,7 +717,9 @@ font_prop_validate (int idx, Lisp_Object prop, Lisp_Object val) /* Store VAL as a value of extra font property PROP in FONT while - keeping the sorting order. Don't check the validity of VAL. */ + keeping the sorting order. Don't check the validity of VAL. If + VAL is Qunbound, delete the slot for PROP from the list of extra + properties. */ Lisp_Object font_put_extra (Lisp_Object font, Lisp_Object prop, Lisp_Object val) @@ -721,6 +731,8 @@ font_put_extra (Lisp_Object font, Lisp_Object prop, Lisp_Object val) { Lisp_Object prev = Qnil; + if (BASE_EQ (val, Qunbound)) + return val; while (CONSP (extra) && NILP (Fstring_lessp (prop, XCAR (XCAR (extra))))) prev = extra, extra = XCDR (extra); @@ -733,7 +745,7 @@ font_put_extra (Lisp_Object font, Lisp_Object prop, Lisp_Object val) return val; } XSETCDR (slot, val); - if (NILP (val)) + if (BASE_EQ (val, Qunbound)) ASET (font, FONT_EXTRA_INDEX, Fdelq (slot, extra)); return val; } @@ -875,9 +887,9 @@ font_expand_wildcards (Lisp_Object *field, int n) int from, to; unsigned mask; - if (INTEGERP (val)) + if (FIXNUMP (val)) { - EMACS_INT numeric = XINT (val); + EMACS_INT numeric = XFIXNUM (val); if (i + 1 == n) from = to = XLFD_ENCODING_INDEX, @@ -999,7 +1011,7 @@ font_expand_wildcards (Lisp_Object *field, int n) if (! NILP (tmp[n - 1]) && j < XLFD_REGISTRY_INDEX) return -1; memclear (field + j, (XLFD_LAST_INDEX - j) * word_size); - if (INTEGERP (field[XLFD_ENCODING_INDEX])) + if (FIXNUMP (field[XLFD_ENCODING_INDEX])) field[XLFD_ENCODING_INDEX] = Fintern (Fnumber_to_string (field[XLFD_ENCODING_INDEX]), Qnil); return 0; @@ -1021,8 +1033,8 @@ font_expand_wildcards (Lisp_Object *field, int n) X font backend driver, it is a font-entity. In that case, NAME is a fully specified XLFD. */ -int -font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) +static int +font_parse_xlfd_1 (char *name, ptrdiff_t len, Lisp_Object font, int segments) { int i, j, n; char *f[XLFD_LAST_INDEX + 1]; @@ -1032,17 +1044,27 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) if (len > 255 || !len) /* Maximum XLFD name length is 255. */ return -1; + /* Accept "*-.." as a fully specified XLFD. */ if (name[0] == '*' && (len == 1 || name[1] == '-')) i = 1, f[XLFD_FOUNDRY_INDEX] = name; else i = 0; + + /* Split into segments. */ for (p = name + i; *p; p++) if (*p == '-') { - f[i++] = p + 1; - if (i == XLFD_LAST_INDEX) - break; + /* If we have too many segments, then gather them up into the + FAMILY part of the name. This allows using fonts with + dashes in the FAMILY bit. */ + if (segments > XLFD_LAST_INDEX && i == XLFD_WEIGHT_INDEX) + segments--; + else { + f[i++] = p + 1; + if (i == XLFD_LAST_INDEX) + break; + } } f[i] = name + len; @@ -1064,7 +1086,7 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) { if ((n = font_style_to_value (j, INTERN_FIELD_SYM (i), 0)) < 0) return -1; - ASET (font, j, make_number (n)); + ASET (font, j, make_fixnum (n)); } } ASET (font, FONT_ADSTYLE_INDEX, INTERN_FIELD_SYM (XLFD_ADSTYLE_INDEX)); @@ -1077,11 +1099,11 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) 1)); p = f[XLFD_PIXEL_INDEX]; if (*p == '[' && (pixel_size = parse_matrix (p)) >= 0) - ASET (font, FONT_SIZE_INDEX, make_number (pixel_size)); + ASET (font, FONT_SIZE_INDEX, make_fixnum (pixel_size)); else { val = INTERN_FIELD (XLFD_PIXEL_INDEX); - if (INTEGERP (val)) + if (FIXNUMP (val)) ASET (font, FONT_SIZE_INDEX, val); else if (FONT_ENTITY_P (font)) return -1; @@ -1101,14 +1123,14 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) } val = INTERN_FIELD (XLFD_RESY_INDEX); - if (! NILP (val) && ! INTEGERP (val)) + if (! NILP (val) && ! FIXNUMP (val)) return -1; ASET (font, FONT_DPI_INDEX, val); val = INTERN_FIELD (XLFD_SPACING_INDEX); if (! NILP (val)) { val = font_prop_validate_spacing (QCspacing, val); - if (! INTEGERP (val)) + if (! FIXNUMP (val)) return -1; ASET (font, FONT_SPACING_INDEX, val); } @@ -1116,7 +1138,7 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) if (*p == '~') p++; val = font_intern_prop (p, f[XLFD_REGISTRY_INDEX] - 1 - p, 0); - if (! NILP (val) && ! INTEGERP (val)) + if (! NILP (val) && ! FIXNUMP (val)) return -1; ASET (font, FONT_AVGWIDTH_INDEX, val); } @@ -1154,7 +1176,7 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) { if ((n = font_style_to_value (j, prop[i], 1)) < 0) return -1; - ASET (font, j, make_number (n)); + ASET (font, j, make_fixnum (n)); } ASET (font, FONT_ADSTYLE_INDEX, prop[XLFD_ADSTYLE_INDEX]); val = prop[XLFD_REGISTRY_INDEX]; @@ -1181,32 +1203,54 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) if (! NILP (val)) ASET (font, FONT_REGISTRY_INDEX, Fintern (val, Qnil)); - if (INTEGERP (prop[XLFD_PIXEL_INDEX])) + if (FIXNUMP (prop[XLFD_PIXEL_INDEX])) ASET (font, FONT_SIZE_INDEX, prop[XLFD_PIXEL_INDEX]); - else if (INTEGERP (prop[XLFD_POINT_INDEX])) + else if (FIXNUMP (prop[XLFD_POINT_INDEX])) { - double point_size = XINT (prop[XLFD_POINT_INDEX]); + double point_size = XFIXNUM (prop[XLFD_POINT_INDEX]); ASET (font, FONT_SIZE_INDEX, make_float (point_size / 10)); } - if (INTEGERP (prop[XLFD_RESX_INDEX])) + if (FIXNUMP (prop[XLFD_RESX_INDEX])) ASET (font, FONT_DPI_INDEX, prop[XLFD_RESY_INDEX]); if (! NILP (prop[XLFD_SPACING_INDEX])) { val = font_prop_validate_spacing (QCspacing, prop[XLFD_SPACING_INDEX]); - if (! INTEGERP (val)) + if (! FIXNUMP (val)) return -1; ASET (font, FONT_SPACING_INDEX, val); } - if (INTEGERP (prop[XLFD_AVGWIDTH_INDEX])) + if (FIXNUMP (prop[XLFD_AVGWIDTH_INDEX])) ASET (font, FONT_AVGWIDTH_INDEX, prop[XLFD_AVGWIDTH_INDEX]); } return 0; } +int +font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) +{ + int found = font_parse_xlfd_1 (name, len, font, -1); + if (found > -1) + return found; + + int segments = 0; + /* Count how many segments we have. */ + for (char *p = name; *p; p++) + if (*p == '-') + segments++; + + /* If we have a surplus of segments, then we try to parse again, in + case there's a font with dashes in the family name. */ + if (segments > XLFD_LAST_INDEX) + return font_parse_xlfd_1 (name, len, font, segments); + else + return -1; +} + + /* Store XLFD name of FONT (font-spec or font-entity) in NAME (NBYTES length), and return the name length. If FONT_SIZE_INDEX of FONT is 0, use PIXEL_SIZE instead. */ @@ -1289,13 +1333,13 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes) 1 + DBL_MAX_10_EXP + 1)]; if (INTEGERP (val)) { - EMACS_INT v = XINT (val); - if (v <= 0) + intmax_t v; + if (! (integer_to_intmax (val, &v) && 0 < v)) v = pixel_size; if (v > 0) { f[XLFD_PIXEL_INDEX] = p = font_size_index_buf; - sprintf (p, "%"pI"d-*", v); + sprintf (p, "%"PRIdMAX"-*", v); } else f[XLFD_PIXEL_INDEX] = "*-*"; @@ -1310,18 +1354,18 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes) f[XLFD_PIXEL_INDEX] = "*-*"; char dpi_index_buf[sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT)]; - if (INTEGERP (AREF (font, FONT_DPI_INDEX))) + if (FIXNUMP (AREF (font, FONT_DPI_INDEX))) { - EMACS_INT v = XINT (AREF (font, FONT_DPI_INDEX)); + EMACS_INT v = XFIXNUM (AREF (font, FONT_DPI_INDEX)); f[XLFD_RESX_INDEX] = p = dpi_index_buf; sprintf (p, "%"pI"d-%"pI"d", v, v); } else f[XLFD_RESX_INDEX] = "*-*"; - if (INTEGERP (AREF (font, FONT_SPACING_INDEX))) + if (FIXNUMP (AREF (font, FONT_SPACING_INDEX))) { - EMACS_INT spacing = XINT (AREF (font, FONT_SPACING_INDEX)); + EMACS_INT spacing = XFIXNUM (AREF (font, FONT_SPACING_INDEX)); f[XLFD_SPACING_INDEX] = (spacing <= FONT_SPACING_PROPORTIONAL ? "p" : spacing <= FONT_SPACING_DUAL ? "d" @@ -1332,10 +1376,10 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes) f[XLFD_SPACING_INDEX] = "*"; char avgwidth_index_buf[INT_BUFSIZE_BOUND (EMACS_INT)]; - if (INTEGERP (AREF (font, FONT_AVGWIDTH_INDEX))) + if (FIXNUMP (AREF (font, FONT_AVGWIDTH_INDEX))) { f[XLFD_AVGWIDTH_INDEX] = p = avgwidth_index_buf; - sprintf (p, "%"pI"d", XINT (AREF (font, FONT_AVGWIDTH_INDEX))); + sprintf (p, "%"pI"d", XFIXNUM (AREF (font, FONT_AVGWIDTH_INDEX))); } else f[XLFD_AVGWIDTH_INDEX] = "*"; @@ -1444,11 +1488,20 @@ font_parse_fcname (char *name, ptrdiff_t len, Lisp_Object font) #define PROP_MATCH(STR) (word_len == strlen (STR) \ && memcmp (p, STR, strlen (STR)) == 0) - if (PROP_MATCH ("light") + if (PROP_MATCH ("thin") + || PROP_MATCH ("ultra-light") + || PROP_MATCH ("light") + || PROP_MATCH ("semi-light") + || PROP_MATCH ("book") || PROP_MATCH ("medium") + || PROP_MATCH ("normal") + || PROP_MATCH ("semibold") || PROP_MATCH ("demibold") || PROP_MATCH ("bold") - || PROP_MATCH ("black")) + || PROP_MATCH ("ultra-bold") + || PROP_MATCH ("black") + || PROP_MATCH ("heavy") + || PROP_MATCH ("ultra-heavy")) FONT_SET_STYLE (font, FONT_WEIGHT_INDEX, val); else if (PROP_MATCH ("roman") || PROP_MATCH ("italic") @@ -1456,19 +1509,19 @@ font_parse_fcname (char *name, ptrdiff_t len, Lisp_Object font) FONT_SET_STYLE (font, FONT_SLANT_INDEX, val); else if (PROP_MATCH ("charcell")) ASET (font, FONT_SPACING_INDEX, - make_number (FONT_SPACING_CHARCELL)); + make_fixnum (FONT_SPACING_CHARCELL)); else if (PROP_MATCH ("mono")) ASET (font, FONT_SPACING_INDEX, - make_number (FONT_SPACING_MONO)); + make_fixnum (FONT_SPACING_MONO)); else if (PROP_MATCH ("proportional")) ASET (font, FONT_SPACING_INDEX, - make_number (FONT_SPACING_PROPORTIONAL)); + make_fixnum (FONT_SPACING_PROPORTIONAL)); #undef PROP_MATCH } else { /* KEY=VAL pairs */ - Lisp_Object key; + Lisp_Object key UNINIT; int prop; if (q - p == 10 && memcmp (p + 1, "pixelsize", 9) == 0) @@ -1621,10 +1674,10 @@ font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes) } val = AREF (font, FONT_SIZE_INDEX); - if (INTEGERP (val)) + if (FIXNUMP (val)) { - if (XINT (val) != 0) - pixel_size = XINT (val); + if (XFIXNUM (val) != 0) + pixel_size = XFIXNUM (val); point_size = -1; } else @@ -1688,28 +1741,28 @@ font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes) p += len; } - if (INTEGERP (AREF (font, FONT_DPI_INDEX))) + if (FIXNUMP (AREF (font, FONT_DPI_INDEX))) { int len = snprintf (p, lim - p, ":dpi=%"pI"d", - XINT (AREF (font, FONT_DPI_INDEX))); + XFIXNUM (AREF (font, FONT_DPI_INDEX))); if (! (0 <= len && len < lim - p)) return -1; p += len; } - if (INTEGERP (AREF (font, FONT_SPACING_INDEX))) + if (FIXNUMP (AREF (font, FONT_SPACING_INDEX))) { int len = snprintf (p, lim - p, ":spacing=%"pI"d", - XINT (AREF (font, FONT_SPACING_INDEX))); + XFIXNUM (AREF (font, FONT_SPACING_INDEX))); if (! (0 <= len && len < lim - p)) return -1; p += len; } - if (INTEGERP (AREF (font, FONT_AVGWIDTH_INDEX))) + if (FIXNUMP (AREF (font, FONT_AVGWIDTH_INDEX))) { int len = snprintf (p, lim - p, - (XINT (AREF (font, FONT_AVGWIDTH_INDEX)) == 0 + (XFIXNUM (AREF (font, FONT_AVGWIDTH_INDEX)) == 0 ? ":scalable=true" : ":scalable=false")); if (! (0 <= len && len < lim - p)) @@ -1807,15 +1860,15 @@ check_gstring (Lisp_Object gstring) goto err; CHECK_FONT_OBJECT (LGSTRING_FONT (gstring)); if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING))) - CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING)); + CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_LBEARING)); if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING))) - CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING)); + CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_RBEARING)); if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH))) - CHECK_NATNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH)); + CHECK_FIXNAT (LGSTRING_SLOT (gstring, LGSTRING_IX_WIDTH)); if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT))) - CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)); + CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)); if (!NILP (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT))) - CHECK_NUMBER (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)); + CHECK_FIXNUM (LGSTRING_SLOT (gstring, LGSTRING_IX_ASCENT)); for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++) { @@ -1825,13 +1878,13 @@ check_gstring (Lisp_Object gstring) goto err; if (NILP (AREF (val, LGLYPH_IX_CHAR))) break; - CHECK_NATNUM (AREF (val, LGLYPH_IX_FROM)); - CHECK_NATNUM (AREF (val, LGLYPH_IX_TO)); + CHECK_FIXNAT (AREF (val, LGLYPH_IX_FROM)); + CHECK_FIXNAT (AREF (val, LGLYPH_IX_TO)); CHECK_CHARACTER (AREF (val, LGLYPH_IX_CHAR)); if (!NILP (AREF (val, LGLYPH_IX_CODE))) - CHECK_NATNUM (AREF (val, LGLYPH_IX_CODE)); + CHECK_FIXNAT (AREF (val, LGLYPH_IX_CODE)); if (!NILP (AREF (val, LGLYPH_IX_WIDTH))) - CHECK_NATNUM (AREF (val, LGLYPH_IX_WIDTH)); + CHECK_FIXNAT (AREF (val, LGLYPH_IX_WIDTH)); if (!NILP (AREF (val, LGLYPH_IX_ADJUSTMENT))) { val = AREF (val, LGLYPH_IX_ADJUSTMENT); @@ -1839,7 +1892,7 @@ check_gstring (Lisp_Object gstring) if (ASIZE (val) < 3) goto err; for (j = 0; j < 3; j++) - CHECK_NUMBER (AREF (val, j)); + CHECK_FIXNUM (AREF (val, j)); } } return i; @@ -1897,11 +1950,11 @@ otf_open (Lisp_Object file) OTF *otf; if (! NILP (val)) - otf = XSAVE_POINTER (XCDR (val), 0); + otf = xmint_pointer (XCDR (val)); else { otf = STRINGP (file) ? OTF_open (SSDATA (file)) : NULL; - val = make_save_ptr (otf); + val = make_mint_ptr (otf); otf_list = Fcons (Fcons (file, val), otf_list); } return otf; @@ -2026,23 +2079,23 @@ font_otf_DeviceTable (OTF_DeviceTable *device_table) { int len = device_table->StartSize - device_table->EndSize + 1; - return Fcons (make_number (len), + return Fcons (make_fixnum (len), make_unibyte_string (device_table->DeltaValue, len)); } Lisp_Object font_otf_ValueRecord (int value_format, OTF_ValueRecord *value_record) { - Lisp_Object val = Fmake_vector (make_number (8), Qnil); + Lisp_Object val = make_nil_vector (8); if (value_format & OTF_XPlacement) - ASET (val, 0, make_number (value_record->XPlacement)); + ASET (val, 0, make_fixnum (value_record->XPlacement)); if (value_format & OTF_YPlacement) - ASET (val, 1, make_number (value_record->YPlacement)); + ASET (val, 1, make_fixnum (value_record->YPlacement)); if (value_format & OTF_XAdvance) - ASET (val, 2, make_number (value_record->XAdvance)); + ASET (val, 2, make_fixnum (value_record->XAdvance)); if (value_format & OTF_YAdvance) - ASET (val, 3, make_number (value_record->YAdvance)); + ASET (val, 3, make_fixnum (value_record->YAdvance)); if (value_format & OTF_XPlaDevice) ASET (val, 4, font_otf_DeviceTable (&value_record->XPlaDevice)); if (value_format & OTF_YPlaDevice) @@ -2057,13 +2110,11 @@ font_otf_ValueRecord (int value_format, OTF_ValueRecord *value_record) Lisp_Object font_otf_Anchor (OTF_Anchor *anchor) { - Lisp_Object val; - - val = Fmake_vector (make_number (anchor->AnchorFormat + 1), Qnil); - ASET (val, 0, make_number (anchor->XCoordinate)); - ASET (val, 1, make_number (anchor->YCoordinate)); + Lisp_Object val = make_nil_vector (anchor->AnchorFormat + 1); + ASET (val, 0, make_fixnum (anchor->XCoordinate)); + ASET (val, 1, make_fixnum (anchor->YCoordinate)); if (anchor->AnchorFormat == 2) - ASET (val, 2, make_number (anchor->f.f1.AnchorPoint)); + ASET (val, 2, make_fixnum (anchor->f.f1.AnchorPoint)); else { ASET (val, 3, font_otf_DeviceTable (&anchor->f.f2.XDeviceTable)); @@ -2132,22 +2183,24 @@ font_score (Lisp_Object entity, Lisp_Object *spec_prop) /* Score three style numeric fields. Maximum difference is 127. */ for (i = FONT_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX; i++) - if (! NILP (spec_prop[i]) && ! EQ (AREF (entity, i), spec_prop[i])) + if (! NILP (spec_prop[i]) + && ! EQ (AREF (entity, i), spec_prop[i]) + && FIXNUMP (AREF (entity, i))) { - EMACS_INT diff = ((XINT (AREF (entity, i)) >> 8) - - (XINT (spec_prop[i]) >> 8)); + EMACS_INT diff = ((XFIXNUM (AREF (entity, i)) >> 8) + - (XFIXNUM (spec_prop[i]) >> 8)); score |= min (eabs (diff), 127) << sort_shift_bits[i]; } /* Score the size. Maximum difference is 127. */ if (! NILP (spec_prop[FONT_SIZE_INDEX]) - && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0) + && XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) > 0) { /* We use the higher 6-bit for the actual size difference. The lowest bit is set if the DPI is different. */ EMACS_INT diff; - EMACS_INT pixel_size = XINT (spec_prop[FONT_SIZE_INDEX]); - EMACS_INT entity_size = XINT (AREF (entity, FONT_SIZE_INDEX)); + EMACS_INT pixel_size = XFIXNUM (spec_prop[FONT_SIZE_INDEX]); + EMACS_INT entity_size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX)); if (CONSP (Vface_font_rescale_alist)) pixel_size *= font_rescale_ratio (entity); @@ -2174,13 +2227,12 @@ font_score (Lisp_Object entity, Lisp_Object *spec_prop) static Lisp_Object font_vconcat_entity_vectors (Lisp_Object list) { - EMACS_INT nargs = XFASTINT (Flength (list)); + ptrdiff_t nargs = list_length (list); Lisp_Object *args; USE_SAFE_ALLOCA; SAFE_ALLOCA_LISP (args, nargs); - ptrdiff_t i; - for (i = 0; i < nargs; i++, list = XCDR (list)) + for (ptrdiff_t i = 0; i < nargs; i++, list = XCDR (list)) args[i] = XCAR (list); Lisp_Object result = Fvconcat (nargs, args); SAFE_FREE (); @@ -2244,7 +2296,7 @@ font_sort_entities (Lisp_Object list, Lisp_Object prefer, prefer_prop[i] = AREF (prefer, i); if (FLOATP (prefer_prop[FONT_SIZE_INDEX])) prefer_prop[FONT_SIZE_INDEX] - = make_number (font_pixel_size (f, prefer)); + = make_fixnum (font_pixel_size (f, prefer)); if (NILP (XCDR (list))) { @@ -2446,7 +2498,7 @@ font_match_p (Lisp_Object spec, Lisp_Object font) for (i = FONT_FOUNDRY_INDEX; i < FONT_SIZE_INDEX; i++) prop[i] = AREF (spec, i); prop[FONT_SIZE_INDEX] - = make_number (font_pixel_size (XFRAME (selected_frame), spec)); + = make_fixnum (font_pixel_size (XFRAME (selected_frame), spec)); props = prop; } @@ -2492,7 +2544,7 @@ font_match_p (Lisp_Object spec, Lisp_Object font) { if (! CHARACTERP (XCAR (val2))) continue; - if (font_encode_char (font, XFASTINT (XCAR (val2))) + if (font_encode_char (font, XFIXNAT (XCAR (val2))) == FONT_INVALID_CODE) return 0; } @@ -2504,7 +2556,7 @@ font_match_p (Lisp_Object spec, Lisp_Object font) { if (! CHARACTERP (AREF (val2, i))) continue; - if (font_encode_char (font, XFASTINT (AREF (val2, i))) + if (font_encode_char (font, XFIXNAT (AREF (val2, i))) != FONT_INVALID_CODE) break; } @@ -2559,13 +2611,13 @@ font_prepare_cache (struct frame *f, struct font_driver const *driver) val = XCDR (val); if (NILP (val)) { - val = list2 (driver->type, make_number (1)); + val = list2 (driver->type, make_fixnum (1)); XSETCDR (cache, Fcons (val, XCDR (cache))); } else { val = XCDR (XCAR (val)); - XSETCAR (val, make_number (XINT (XCAR (val)) + 1)); + XSETCAR (val, make_fixnum (XFIXNUM (XCAR (val)) + 1)); } } @@ -2582,8 +2634,8 @@ font_finish_cache (struct frame *f, struct font_driver const *driver) cache = val, val = XCDR (val); eassert (! NILP (val)); tmp = XCDR (XCAR (val)); - XSETCAR (tmp, make_number (XINT (XCAR (tmp)) - 1)); - if (XINT (XCAR (tmp)) == 0) + XSETCAR (tmp, make_fixnum (XFIXNUM (XCAR (tmp)) - 1)); + if (XFIXNUM (XCAR (tmp)) == 0) { font_clear_cache (f, XCAR (val), driver); XSETCDR (cache, XCDR (val)); @@ -2640,7 +2692,12 @@ font_clear_cache (struct frame *f, Lisp_Object cache, if (! NILP (AREF (val, FONT_TYPE_INDEX))) { eassert (font && driver == font->driver); - driver->close (font); + /* We are going to close the font, so make + sure we don't have any lgstrings lying + around in lgstring cache that reference + the font. */ + composition_gstring_cache_clear_font (val); + driver->close_font (font); } } if (driver->free_entity) @@ -2653,6 +2710,26 @@ font_clear_cache (struct frame *f, Lisp_Object cache, } +/* Check whether NAME should be ignored based on Vface_ignored_fonts. + This is reused by xg_font_filter to apply the same checks to the + GTK font chooser. */ + +bool +font_is_ignored (const char *name, ptrdiff_t namelen) +{ + Lisp_Object tail = Vface_ignored_fonts; + Lisp_Object regexp; + + FOR_EACH_TAIL_SAFE (tail) + { + regexp = XCAR (tail); + if (STRINGP (regexp) + && fast_c_string_match_ignore_case (regexp, name, + namelen) >= 0) + return true; + } + return false; +} static Lisp_Object scratch_font_spec, scratch_font_prefer; /* Check each font-entity in VEC, and return a list of font-entities @@ -2675,22 +2752,10 @@ font_delete_unmatched (Lisp_Object vec, Lisp_Object spec, int size) { char name[256]; ptrdiff_t namelen; - Lisp_Object tail, regexp; - namelen = font_unparse_xlfd (entity, 0, name, 256); if (namelen >= 0) - { - for (tail = Vface_ignored_fonts; CONSP (tail); tail = XCDR (tail)) - { - regexp = XCAR (tail); - if (STRINGP (regexp) - && fast_c_string_match_ignore_case (regexp, name, - namelen) >= 0) - break; - } - if (CONSP (tail)) - continue; - } + if (font_is_ignored (name, namelen)) + continue; } if (NILP (spec)) { @@ -2698,29 +2763,55 @@ font_delete_unmatched (Lisp_Object vec, Lisp_Object spec, int size) continue; } for (prop = FONT_WEIGHT_INDEX; prop < FONT_SIZE_INDEX; prop++) - if (INTEGERP (AREF (spec, prop)) - && ((XINT (AREF (spec, prop)) >> 8) - != (XINT (AREF (entity, prop)) >> 8))) - prop = FONT_SPEC_MAX; + { + if (FIXNUMP (AREF (spec, prop))) + { + if (!FIXNUMP (AREF (entity, prop))) + prop = FONT_SPEC_MAX; + else + { + int required = XFIXNUM (AREF (spec, prop)) >> 8; + int candidate = XFIXNUM (AREF (entity, prop)) >> 8; + + if (candidate != required +#ifdef HAVE_NTGUI + /* A kludge for w32 font search, where listing a + family returns only 4 standard weights: regular, + italic, bold, bold-italic. For other values one + must specify the font, not just the family in the + :family attribute of the face. But specifying + :family in the face attributes looks for regular + weight, so if we require exact match, the + non-regular font will be rejected. So we relax + the accuracy of the match here, and let + font_sort_entities find the best match. */ + && (prop != FONT_WEIGHT_INDEX + || eabs (candidate - required) > 100) +#endif + ) + prop = FONT_SPEC_MAX; + } + } + } if (prop < FONT_SPEC_MAX && size - && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0) + && XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) > 0) { - int diff = XINT (AREF (entity, FONT_SIZE_INDEX)) - size; + int diff = XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) - size; if (eabs (diff) > FONT_PIXEL_SIZE_QUANTUM) prop = FONT_SPEC_MAX; } if (prop < FONT_SPEC_MAX - && INTEGERP (AREF (spec, FONT_DPI_INDEX)) - && INTEGERP (AREF (entity, FONT_DPI_INDEX)) - && XINT (AREF (entity, FONT_DPI_INDEX)) != 0 + && FIXNUMP (AREF (spec, FONT_DPI_INDEX)) + && FIXNUMP (AREF (entity, FONT_DPI_INDEX)) + && XFIXNUM (AREF (entity, FONT_DPI_INDEX)) != 0 && ! EQ (AREF (spec, FONT_DPI_INDEX), AREF (entity, FONT_DPI_INDEX))) prop = FONT_SPEC_MAX; if (prop < FONT_SPEC_MAX - && INTEGERP (AREF (spec, FONT_AVGWIDTH_INDEX)) - && INTEGERP (AREF (entity, FONT_AVGWIDTH_INDEX)) - && XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) != 0 + && FIXNUMP (AREF (spec, FONT_AVGWIDTH_INDEX)) + && FIXNUMP (AREF (entity, FONT_AVGWIDTH_INDEX)) + && XFIXNUM (AREF (entity, FONT_AVGWIDTH_INDEX)) != 0 && ! EQ (AREF (spec, FONT_AVGWIDTH_INDEX), AREF (entity, FONT_AVGWIDTH_INDEX))) prop = FONT_SPEC_MAX; @@ -2747,8 +2838,8 @@ font_list_entities (struct frame *f, Lisp_Object spec) eassert (FONT_SPEC_P (spec)); - if (INTEGERP (AREF (spec, FONT_SIZE_INDEX))) - size = XINT (AREF (spec, FONT_SIZE_INDEX)); + if (FIXNUMP (AREF (spec, FONT_SIZE_INDEX))) + size = XFIXNUM (AREF (spec, FONT_SIZE_INDEX)); else if (FLOATP (AREF (spec, FONT_SIZE_INDEX))) size = font_pixel_size (f, spec); else @@ -2781,7 +2872,7 @@ font_list_entities (struct frame *f, Lisp_Object spec) { Lisp_Object copy; - val = driver_list->driver->list (f, scratch_font_spec); + val = (driver_list->driver->list) (f, scratch_font_spec); /* We put zero_vector in the font-cache to indicate that no fonts matching SPEC were found on the system. Failure to have this indication in the font cache can @@ -2800,7 +2891,13 @@ font_list_entities (struct frame *f, Lisp_Object spec) || ! NILP (Vface_ignored_fonts))) val = font_delete_unmatched (val, need_filtering ? spec : Qnil, size); if (ASIZE (val) > 0) - list = Fcons (val, list); + { + list = Fcons (val, list); + /* Querying further backends can be very slow, so we only do + it if the user has explicitly requested it (Bug#43177). */ + if (query_all_font_backends == false) + break; + } } list = Fnreverse (list); @@ -2824,7 +2921,7 @@ font_matching_entity (struct frame *f, Lisp_Object *attrs, Lisp_Object spec) size = AREF (spec, FONT_SIZE_INDEX); if (FLOATP (size)) - ASET (work, FONT_SIZE_INDEX, make_number (font_pixel_size (f, spec))); + ASET (work, FONT_SIZE_INDEX, make_fixnum (font_pixel_size (f, spec))); FONT_SET_STYLE (work, FONT_WEIGHT_INDEX, attrs[LFACE_WEIGHT_INDEX]); FONT_SET_STYLE (work, FONT_SLANT_INDEX, attrs[LFACE_SLANT_INDEX]); FONT_SET_STYLE (work, FONT_WIDTH_INDEX, attrs[LFACE_SWIDTH_INDEX]); @@ -2873,8 +2970,8 @@ font_open_entity (struct frame *f, Lisp_Object entity, int pixel_size) eassert (FONT_ENTITY_P (entity)); size = AREF (entity, FONT_SIZE_INDEX); - if (XINT (size) != 0) - pixel_size = XINT (size); + if (XFIXNUM (size) != 0) + pixel_size = XFIXNUM (size); val = AREF (entity, FONT_TYPE_INDEX); for (driver_list = f->font_driver_list; @@ -2900,14 +2997,17 @@ font_open_entity (struct frame *f, Lisp_Object entity, int pixel_size) width and height. */ for (psize = pixel_size; ; psize++) { - font_object = driver_list->driver->open (f, entity, psize); + font_object = driver_list->driver->open_font (f, entity, psize); if (NILP (font_object)) return Qnil; font = XFONT_OBJECT (font_object); if (font->average_width > 0 && font->height > 0) break; + /* Avoid an infinite loop. */ + if (psize > pixel_size + 15) + return Qnil; } - ASET (font_object, FONT_SIZE_INDEX, make_number (pixel_size)); + ASET (font_object, FONT_SIZE_INDEX, make_fixnum (pixel_size)); FONT_ADD_LOG ("open", entity, font_object); ASET (entity, FONT_OBJLIST_INDEX, Fcons (font_object, AREF (entity, FONT_OBJLIST_INDEX))); @@ -2957,7 +3057,7 @@ font_close_object (struct frame *f, Lisp_Object font_object) /* Already closed. */ return; FONT_ADD_LOG ("close", font_object, Qnil); - font->driver->close (font); + font->driver->close_font (font); #ifdef HAVE_WINDOW_SYSTEM eassert (FRAME_DISPLAY_INFO (f)->n_fonts); FRAME_DISPLAY_INFO (f)->n_fonts--; @@ -3052,7 +3152,7 @@ font_clear_prop (Lisp_Object *attrs, enum font_property_index prop) if (! NILP (Ffont_get (font, QCname))) { font = copy_font_spec (font); - font_put_extra (font, QCname, Qnil); + font_put_extra (font, QCname, Qunbound); } if (NILP (AREF (font, prop)) @@ -3092,8 +3192,9 @@ font_clear_prop (Lisp_Object *attrs, enum font_property_index prop) attrs[LFACE_FONT_INDEX] = font; } -/* Select a font from ENTITIES (list of font-entity vectors) that - supports C and is the best match for ATTRS and PIXEL_SIZE. */ +/* Select a font from ENTITIES (list of one or more font-entity + vectors) that supports the character C (if non-negative) and is the + best match for ATTRS and PIXEL_SIZE. */ static Lisp_Object font_select_entity (struct frame *f, Lisp_Object entities, @@ -3103,6 +3204,7 @@ font_select_entity (struct frame *f, Lisp_Object entities, Lisp_Object prefer; int i; + /* If we have a single candidate, return it if it supports C. */ if (NILP (XCDR (entities)) && ASIZE (XCAR (entities)) == 1) { @@ -3112,7 +3214,10 @@ font_select_entity (struct frame *f, Lisp_Object entities, return Qnil; } - /* Sort fonts by properties specified in ATTRS. */ + /* If we have several candidates, find the best match by sorting + them by properties specified in ATTRS. Style attributes (weight, + slant, width, and size) are taken from the font spec in ATTRS (if + that is non-nil), or from ATTRS, or left as nil. */ prefer = scratch_font_prefer; for (i = FONT_WEIGHT_INDEX; i <= FONT_SIZE_INDEX; i++) @@ -3130,7 +3235,7 @@ font_select_entity (struct frame *f, Lisp_Object entities, FONT_SET_STYLE (prefer, FONT_SLANT_INDEX, attrs[LFACE_SLANT_INDEX]); if (NILP (AREF (prefer, FONT_WIDTH_INDEX))) FONT_SET_STYLE (prefer, FONT_WIDTH_INDEX, attrs[LFACE_SWIDTH_INDEX]); - ASET (prefer, FONT_SIZE_INDEX, make_number (pixel_size)); + ASET (prefer, FONT_SIZE_INDEX, make_fixnum (pixel_size)); return font_sort_entities (entities, prefer, f, c); } @@ -3149,6 +3254,8 @@ font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int int i, j, k, l; USE_SAFE_ALLOCA; + /* Registry specification alternatives: from the most specific to + the least specific and finally an unspecified one. */ registry[0] = AREF (spec, FONT_REGISTRY_INDEX); if (NILP (registry[0])) { @@ -3176,15 +3283,18 @@ font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int work = copy_font_spec (spec); ASET (work, FONT_TYPE_INDEX, AREF (spec, FONT_TYPE_INDEX)); pixel_size = font_pixel_size (f, spec); - if (pixel_size == 0 && INTEGERP (attrs[LFACE_HEIGHT_INDEX])) + if (pixel_size == 0 && FIXNUMP (attrs[LFACE_HEIGHT_INDEX])) { - double pt = XINT (attrs[LFACE_HEIGHT_INDEX]); + double pt = XFIXNUM (attrs[LFACE_HEIGHT_INDEX]); pixel_size = POINT_TO_PIXEL (pt / 10, FRAME_RES_Y (f)); if (pixel_size < 1) pixel_size = 1; } ASET (work, FONT_SIZE_INDEX, Qnil); + + /* Foundry specification alternatives: from the most specific to the + least specific and finally an unspecified one. */ foundry[0] = AREF (work, FONT_FOUNDRY_INDEX); if (! NILP (foundry[0])) foundry[1] = zero_vector; @@ -3198,6 +3308,8 @@ font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int else foundry[0] = Qnil, foundry[1] = zero_vector; + /* Additional style specification alternatives: from the most + specific to the least specific and finally an unspecified one. */ adstyle[0] = AREF (work, FONT_ADSTYLE_INDEX); if (! NILP (adstyle[0])) adstyle[1] = zero_vector; @@ -3218,6 +3330,8 @@ font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int adstyle[0] = Qnil, adstyle[1] = zero_vector; + /* Family specification alternatives: from the most specific to + the least specific and finally an unspecified one. */ val = AREF (work, FONT_FAMILY_INDEX); if (NILP (val) && STRINGP (attrs[LFACE_FAMILY_INDEX])) { @@ -3238,7 +3352,7 @@ font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int if (! NILP (alters)) { - EMACS_INT alterslen = XFASTINT (Flength (alters)); + EMACS_INT alterslen = list_length (alters); SAFE_ALLOCA_LISP (family, alterslen + 2); for (i = 0; CONSP (alters); i++, alters = XCDR (alters)) family[i] = XCAR (alters); @@ -3257,6 +3371,8 @@ font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int } } + /* Now look up suitable fonts, from the most specific spec to the + least specific spec. Accept the first one that matches. */ for (i = 0; SYMBOLP (family[i]); i++) { ASET (work, FONT_FAMILY_INDEX, family[i]); @@ -3269,9 +3385,12 @@ font_find_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec, int for (l = 0; SYMBOLP (adstyle[l]); l++) { ASET (work, FONT_ADSTYLE_INDEX, adstyle[l]); + /* Produce the list of candidates for the spec in WORK. */ entities = font_list_entities (f, work); if (! NILP (entities)) { + /* If there are several candidates, select the + best match for PIXEL_SIZE and attributes in ATTRS. */ val = font_select_entity (f, entities, attrs, pixel_size, c); if (! NILP (val)) @@ -3295,9 +3414,9 @@ font_open_for_lface (struct frame *f, Lisp_Object entity, Lisp_Object *attrs, Li { int size; - if (INTEGERP (AREF (entity, FONT_SIZE_INDEX)) - && XINT (AREF (entity, FONT_SIZE_INDEX)) > 0) - size = XINT (AREF (entity, FONT_SIZE_INDEX)); + if (FIXNUMP (AREF (entity, FONT_SIZE_INDEX)) + && XFIXNUM (AREF (entity, FONT_SIZE_INDEX)) > 0) + size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX)); else { if (FONT_SPEC_P (spec) && ! NILP (AREF (spec, FONT_SIZE_INDEX))) @@ -3305,14 +3424,18 @@ font_open_for_lface (struct frame *f, Lisp_Object entity, Lisp_Object *attrs, Li else { double pt; - if (INTEGERP (attrs[LFACE_HEIGHT_INDEX])) - pt = XINT (attrs[LFACE_HEIGHT_INDEX]); + if (FIXNUMP (attrs[LFACE_HEIGHT_INDEX])) + pt = XFIXNUM (attrs[LFACE_HEIGHT_INDEX]); else { + /* We need the default face to be valid below. */ + if (FRAME_FACE_CACHE (f)->used == 0) + recompute_basic_faces (f); + struct face *def = FACE_FROM_ID (f, DEFAULT_FACE_ID); Lisp_Object height = def->lface[LFACE_HEIGHT_INDEX]; - eassert (INTEGERP (height)); - pt = XINT (height); + eassert (FIXNUMP (height)); + pt = XFIXNUM (height); } pt /= 10; @@ -3322,7 +3445,8 @@ font_open_for_lface (struct frame *f, Lisp_Object entity, Lisp_Object *attrs, Li { Lisp_Object ffsize = get_frame_param (f, Qfontsize); size = (NUMBERP (ffsize) - ? POINT_TO_PIXEL (XINT (ffsize), FRAME_RES_Y (f)) : 0); + ? POINT_TO_PIXEL (XFLOATINT (ffsize), FRAME_RES_Y (f)) + : 0); } #endif } @@ -3369,7 +3493,7 @@ font_load_for_lface (struct frame *f, Lisp_Object *attrs, Lisp_Object spec) Lisp_Object lsize = Ffont_get (spec, QCsize); if ((FLOATP (lsize) && XFLOAT_DATA (lsize) == font_size) - || (INTEGERP (lsize) && XINT (lsize) == font_size)) + || (FIXNUMP (lsize) && XFIXNUM (lsize) == font_size)) { ASET (spec, FONT_FAMILY_INDEX, font_intern_prop (p, tail - p, 1)); @@ -3430,9 +3554,9 @@ font_open_by_spec (struct frame *f, Lisp_Object spec) attrs[LFACE_SWIDTH_INDEX] = attrs[LFACE_WEIGHT_INDEX] = attrs[LFACE_SLANT_INDEX] = Qnormal; #ifndef HAVE_NS - attrs[LFACE_HEIGHT_INDEX] = make_number (120); + attrs[LFACE_HEIGHT_INDEX] = make_fixnum (120); #else - attrs[LFACE_HEIGHT_INDEX] = make_number (0); + attrs[LFACE_HEIGHT_INDEX] = make_fixnum (0); #endif attrs[LFACE_FONT_INDEX] = Qnil; @@ -3465,8 +3589,8 @@ font_open_by_name (struct frame *f, Lisp_Object name) The second is with frame F NULL. In this case, DRIVER is globally registered in the variable `font_driver_list'. All font-driver - implementations must call this function in its syms_of_XXXX - (e.g. syms_of_xfont). */ + implementations must call this function in its + syms_of_XXXX_for_pdumper (e.g. syms_of_xfont_for_pdumper). */ void register_font_driver (struct font_driver const *driver, struct frame *f) @@ -3514,7 +3638,10 @@ free_font_driver_list (struct frame *f) /* Make the frame F use font backends listed in NEW_DRIVERS (list of symbols, e.g. xft, x). If NEW_DRIVERS is t, make F use all - available font drivers. If NEW_DRIVERS is nil, finalize all drivers. + available font drivers that are not superseded by another driver. + (A font driver SYMBOL is superseded by the driver specified by + SYMBOL's 'font-driver-superseded-by property if it is a non-nil + symbol.) If NEW_DRIVERS is nil, finalize all drivers. A caller must free all realized faces if any in advance. The return value is a list of font backends actually made used on @@ -3523,16 +3650,33 @@ free_font_driver_list (struct frame *f) Lisp_Object font_update_drivers (struct frame *f, Lisp_Object new_drivers) { - Lisp_Object active_drivers = Qnil; + Lisp_Object active_drivers = Qnil, default_drivers = Qnil; struct font_driver_list *list; + /* Collect all unsuperseded driver symbols into + `default_drivers'. */ + Lisp_Object all_drivers = Qnil; + for (list = f->font_driver_list; list; list = list->next) + all_drivers = Fcons (list->driver->type, all_drivers); + for (Lisp_Object rest = all_drivers; CONSP (rest); rest = XCDR (rest)) + { + Lisp_Object superseded_by + = Fget (XCAR (rest), Qfont_driver_superseded_by); + + if (NILP (superseded_by) + || NILP (Fmemq (superseded_by, all_drivers))) + default_drivers = Fcons (XCAR (rest), default_drivers); + } + + if (EQ (new_drivers, Qt)) + new_drivers = default_drivers; + /* At first, turn off non-requested drivers, and turn on requested drivers. */ for (list = f->font_driver_list; list; list = list->next) { struct font_driver const *driver = list->driver; - if ((EQ (new_drivers, Qt) || ! NILP (Fmemq (driver->type, new_drivers))) - != list->on) + if ((! NILP (Fmemq (driver->type, new_drivers))) != list->on) { if (list->on) { @@ -3555,8 +3699,7 @@ font_update_drivers (struct frame *f, Lisp_Object new_drivers) if (NILP (new_drivers)) return Qnil; - - if (! EQ (new_drivers, Qt)) + else { /* Re-order the driver list according to new_drivers. */ struct font_driver_list **list_table, **next; @@ -3595,6 +3738,8 @@ font_update_drivers (struct frame *f, Lisp_Object new_drivers) { struct font_driver const *driver = list->driver; eassert (! list->on); + if (NILP (Fmemq (driver->type, default_drivers))) + continue; if (! driver->start_for_frame || driver->start_for_frame (f) == 0) { @@ -3611,7 +3756,7 @@ font_update_drivers (struct frame *f, Lisp_Object new_drivers) return active_drivers; } -#if defined (HAVE_XFT) || defined (HAVE_FREETYPE) +#if (defined HAVE_XFT || defined HAVE_FREETYPE) && !defined USE_CAIRO static void fset_font_data (struct frame *f, Lisp_Object val) @@ -3629,10 +3774,10 @@ font_put_frame_data (struct frame *f, Lisp_Object driver, void *data) else { if (NILP (val)) - fset_font_data (f, Fcons (Fcons (driver, make_save_ptr (data)), + fset_font_data (f, Fcons (Fcons (driver, make_mint_ptr (data)), f->font_data)); else - XSETCDR (val, make_save_ptr (data)); + XSETCDR (val, make_mint_ptr (data)); } } @@ -3641,10 +3786,10 @@ font_get_frame_data (struct frame *f, Lisp_Object driver) { Lisp_Object val = assq_no_quit (driver, f->font_data); - return NILP (val) ? NULL : XSAVE_POINTER (XCDR (val), 0); + return NILP (val) ? NULL : xmint_pointer (XCDR (val)); } -#endif /* HAVE_XFT || HAVE_FREETYPE */ +#endif /* (HAVE_XFT || HAVE_FREETYPE) && !USE_CAIRO */ /* Sets attributes on a font. Any properties that appear in ALIST and BOOLEAN_PROPERTIES or NON_BOOLEAN_PROPERTIES are set on the font. @@ -3670,7 +3815,7 @@ font_filter_properties (Lisp_Object font, if (strcmp (boolean_properties[i], keystr) == 0) { - const char *str = INTEGERP (val) ? (XINT (val) ? "true" : "false") + const char *str = FIXNUMP (val) ? (XFIXNUM (val) ? "true" : "false") : SYMBOLP (val) ? SSDATA (SYMBOL_NAME (val)) : "true"; @@ -3754,10 +3899,10 @@ font_at (int c, ptrdiff_t pos, struct face *face, struct window *w, if (STRINGP (string)) face_id = face_at_string_position (w, string, pos, 0, &endptr, - DEFAULT_FACE_ID, false); + DEFAULT_FACE_ID, false, 0); else face_id = face_at_buffer_position (w, pos, &endptr, - pos + 100, false, -1); + pos + 100, false, -1, 0); face = FACE_FROM_ID (f, face_id); } if (multibyte) @@ -3775,12 +3920,32 @@ font_at (int c, ptrdiff_t pos, struct face *face, struct window *w, #ifdef HAVE_WINDOW_SYSTEM +/* Check if CH is a codepoint for which we should attempt to use the + emoji font, even if the codepoint itself has Emoji_Presentation = + No. Vauto_composition_emoji_eligible_codepoints is filled in for + us by admin/unidata/emoji-zwj.awk. */ +static bool +codepoint_is_emoji_eligible (int ch) +{ + if (EQ (CHAR_TABLE_REF (Vchar_script_table, ch), Qemoji)) + return true; + + if (! NILP (Fmemq (make_fixnum (ch), + Vauto_composition_emoji_eligible_codepoints))) + return true; + + return false; +} + /* Check how many characters after character/byte position POS/POS_BYTE (at most to *LIMIT) can be displayed by the same font in the window W. FACE, if non-NULL, is the face selected for the character at POS. If STRING is not nil, it is the string to check instead of the current buffer. In that case, FACE must be not NULL. + CH is the character that actually caused the composition + process to start, it may be different from the character at POS. + The return value is the font-object for the character at POS. *LIMIT is set to the position where that font can't be used. @@ -3788,37 +3953,59 @@ font_at (int c, ptrdiff_t pos, struct face *face, struct window *w, Lisp_Object font_range (ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t *limit, - struct window *w, struct face *face, Lisp_Object string) + struct window *w, struct face *face, Lisp_Object string, + int ch) { ptrdiff_t ignore; int c; Lisp_Object font_object = Qnil; + struct frame *f = XFRAME (w->frame); - if (NILP (string)) + if (!face) { - if (! face) + int face_id; + + if (NILP (string)) + face_id = face_at_buffer_position (w, pos, &ignore, *limit, + false, -1, 0); + else { - int face_id; + face_id = + NILP (Vface_remapping_alist) + ? DEFAULT_FACE_ID + : lookup_basic_face (w, f, DEFAULT_FACE_ID); - face_id = face_at_buffer_position (w, pos, &ignore, - *limit, false, -1); - face = FACE_FROM_ID (XFRAME (w->frame), face_id); + face_id = face_at_string_position (w, string, pos, 0, &ignore, + face_id, false, 0); } + face = FACE_FROM_ID (f, face_id); } - else - eassert (face); - while (pos < *limit) + /* If the composition was triggered by an emoji, use a character + from 'script-representative-chars', rather than the first + character in the string, to determine the font to use. */ + if (codepoint_is_emoji_eligible (ch)) { - Lisp_Object category; + Lisp_Object val = assq_no_quit (Qemoji, Vscript_representative_chars); + if (CONSP (val)) + { + val = XCDR (val); + if (CONSP (val)) + val = XCAR (val); + else if (VECTORP (val)) + val = AREF (val, 0); + font_object = font_for_char (face, XFIXNAT (val), pos, string); + } + } - if (NILP (string)) - FETCH_CHAR_ADVANCE_NO_CHECK (c, pos, pos_byte); - else - FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, pos, pos_byte); - category = CHAR_TABLE_REF (Vunicode_category_table, c); - if (INTEGERP (category) - && (XINT (category) == UNICODE_CATEGORY_Cf + while (pos < *limit) + { + c = (NILP (string) + ? fetch_char_advance_no_check (&pos, &pos_byte) + : fetch_string_char_advance_no_check (string, &pos, &pos_byte)); + Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c); + if (FIXNUMP (category) + && (XFIXNUM (category) == UNICODE_CATEGORY_Cf || CHAR_VARIATION_SELECTOR_P (c))) continue; if (NILP (font_object)) @@ -3854,7 +4041,7 @@ which kind of font it is. It must be one of `font-spec', `font-entity', return (FONT_ENTITY_P (object) ? Qt : Qnil); if (EQ (extra_type, Qfont_object)) return (FONT_OBJECT_P (object) ? Qt : Qnil); - wrong_type_argument (intern ("font-extra-type"), extra_type); + wrong_type_argument (Qfont_extra_type, extra_type); ; } DEFUN ("font-spec", Ffont_spec, Sfont_spec, 0, MANY, 0, @@ -3888,6 +4075,23 @@ VALUE must be a non-negative integer or a floating point number specifying the font size. It specifies the font size in pixels (if VALUE is an integer), or in points (if VALUE is a float). +`:dpi' + +VALUE must be a non-negative number that specifies the resolution +(dot per inch) for which the font is designed. + +`:spacing' + +VALUE specifies the spacing of the font: mono, proportional, charcell, +or dual. It can be either a number (0 for proportional, 90 for dual, +100 for mono, 110 for charcell) or a 1-letter symbol: `P', `D', `M', +or `C' (lower-case variants are also accepted). + +`:avgwidth' + +VALUE must be a non-negative integer specifying the average width of +the font in 1/10 pixel units. + `:name' VALUE must be a string of XLFD-style or fontconfig-style font name. @@ -4033,26 +4237,33 @@ merge_font_spec (Lisp_Object from, Lisp_Object to) DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0, doc: /* Return the value of FONT's property KEY. FONT is a font-spec, a font-entity, or a font-object. -KEY is any symbol, but these are reserved for specific meanings: - :family, :weight, :slant, :width, :foundry, :adstyle, :registry, - :size, :name, :script, :otf +KEY can be any symbol, but these are reserved for specific meanings: + :foundry, :family, :adstyle, :registry, :weight, :slant, :width, + :size, :dpi, :spacing, :avgwidth, :script, :lang, :otf See the documentation of `font-spec' for their meanings. -In addition, if FONT is a font-entity or a font-object, values of -:script and :otf are different from those of a font-spec as below: -The value of :script may be a list of scripts that are supported by the font. +If FONT is a font-entity or a font-object, then values of +:script and :otf properties are different from those of a font-spec +as below: -The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists -representing the OpenType features supported by the font by this form: - ((SCRIPT (LANGSYS FEATURE ...) ...) ...) -SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType -Layout tags. + The value of :script may be a list of scripts that are supported by + the font. + + The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are + lists representing the OpenType features supported by the font, of + this form: ((SCRIPT (LANGSYS FEATURE ...) ...) ...), where + SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType + Layout tags. See `otf-script-alist' for the OpenType script tags. -In addition to the keys listed abobe, the following keys are reserved +In addition to the keys listed above, the following keys are reserved for the specific meanings as below: -The value of :combining-capability is non-nil if the font-backend of -FONT supports rendering of combining characters for non-OTF fonts. */) + The value of :type is a symbol that identifies the font backend to be + used, such as `ftcrhb' or `xfthb' on X , `harfbuzz' or `uniscribe' on + MS-Windows, `ns' on Cocoa/GNUstep, etc. + + The value of :combining-capability is non-nil if the font-backend of + FONT supports rendering of combining characters for non-OTF fonts. */) (Lisp_Object font, Lisp_Object key) { int idx; @@ -4132,17 +4343,17 @@ are to be displayed on. If omitted, the selected frame is used. */) } val = AREF (font, FONT_SIZE_INDEX); - if (INTEGERP (val)) + if (FIXNUMP (val)) { Lisp_Object font_dpi = AREF (font, FONT_DPI_INDEX); - int dpi = INTEGERP (font_dpi) ? XINT (font_dpi) : FRAME_RES_Y (f); + int dpi = FIXNUMP (font_dpi) ? XFIXNUM (font_dpi) : FRAME_RES_Y (f); plist[n++] = QCheight; - plist[n++] = make_number (PIXEL_TO_POINT (XINT (val) * 10, dpi)); + plist[n++] = make_fixnum (PIXEL_TO_POINT (XFIXNUM (val) * 10, dpi)); } else if (FLOATP (val)) { plist[n++] = QCheight; - plist[n++] = make_number (10 * (int) XFLOAT_DATA (val)); + plist[n++] = make_fixnum (10 * (int) XFLOAT_DATA (val)); } val = FONT_WEIGHT_FOR_FACE (font); @@ -4180,7 +4391,9 @@ accepted by the function `font-spec' (which see), VAL must be what allowed in `font-spec'. If FONT is a font-entity or a font-object, KEY must not be the one -accepted by `font-spec'. */) +accepted by `font-spec'. + +See also `font-get' for KEYs that have special meanings. */) (Lisp_Object font, Lisp_Object prop, Lisp_Object val) { int idx; @@ -4221,8 +4434,8 @@ how close they are to PREFER. */) CHECK_FONT_SPEC (font_spec); if (! NILP (num)) { - CHECK_NUMBER (num); - n = XINT (num); + CHECK_FIXNUM (num); + n = XFIXNUM (num); if (n <= 0) return Qnil; } @@ -4279,7 +4492,7 @@ DEFUN ("find-font", Ffind_font, Sfind_font, 1, 2, 0, Optional 2nd argument FRAME, if non-nil, specifies the target frame. */) (Lisp_Object font_spec, Lisp_Object frame) { - Lisp_Object val = Flist_fonts (font_spec, frame, make_number (1), Qnil); + Lisp_Object val = Flist_fonts (font_spec, frame, make_fixnum (1), Qnil); if (CONSP (val)) val = XCAR (val); @@ -4324,7 +4537,7 @@ the consecutive wildcards are folded into one. */) while ((p1 = strstr (p0, "-*-*"))) { - strcpy (p1, p1 + 2); + memmove (p1, p1 + 2, (name + namelen + 1) - (p1 + 2)); namelen -= 2; p0 = p1; } @@ -4344,12 +4557,11 @@ clear_font_cache (struct frame *f) Lisp_Object val, tmp, cache = driver_list->driver->get_cache (f); val = XCDR (cache); - while (! NILP (val) - && ! EQ (XCAR (XCAR (val)), driver_list->driver->type)) + while (eassert (CONSP (val)), + ! EQ (XCAR (XCAR (val)), driver_list->driver->type)) val = XCDR (val); - eassert (! NILP (val)); tmp = XCDR (XCAR (val)); - if (XINT (XCAR (tmp)) == 0) + if (XFIXNUM (XCAR (tmp)) == 0) { font_clear_cache (f, XCAR (val), driver_list->driver); XSETCDR (cache, XCDR (val)); @@ -4371,10 +4583,8 @@ DEFUN ("clear-font-cache", Fclear_font_cache, Sclear_font_cache, 0, 0, 0, void -font_fill_lglyph_metrics (Lisp_Object glyph, Lisp_Object font_object) +font_fill_lglyph_metrics (Lisp_Object glyph, struct font *font, unsigned int code) { - struct font *font = XFONT_OBJECT (font_object); - unsigned code = font->driver->encode_char (font, LGLYPH_CHAR (glyph)); struct font_metrics metrics; LGLYPH_SET_CODE (glyph, code); @@ -4387,18 +4597,22 @@ font_fill_lglyph_metrics (Lisp_Object glyph, Lisp_Object font_object) } -DEFUN ("font-shape-gstring", Ffont_shape_gstring, Sfont_shape_gstring, 1, 1, 0, - doc: /* Shape the glyph-string GSTRING. +DEFUN ("font-shape-gstring", Ffont_shape_gstring, Sfont_shape_gstring, 2, 2, 0, + doc: /* Shape the glyph-string GSTRING subject to bidi DIRECTION. Shaping means substituting glyphs and/or adjusting positions of glyphs to get the correct visual image of character sequences set in the header of the glyph-string. +DIRECTION should be produced by the UBA, the Unicode Bidirectional +Algorithm, and should be a symbol, either L2R or R2L. It can also +be nil if the bidi context is unknown. + If the shaping was successful, the value is GSTRING itself or a newly created glyph-string. Otherwise, the value is nil. See the documentation of `composition-get-gstring' for the format of GSTRING. */) - (Lisp_Object gstring) + (Lisp_Object gstring, Lisp_Object direction) { struct font *font; Lisp_Object font_object, n, glyph; @@ -4408,6 +4622,10 @@ GSTRING. */) signal_error ("Invalid glyph-string: ", gstring); if (! NILP (LGSTRING_ID (gstring))) return gstring; + Lisp_Object cached_gstring = + composition_gstring_lookup_cache (LGSTRING_HEADER (gstring)); + if (! NILP (cached_gstring)) + return cached_gstring; font_object = LGSTRING_FONT (gstring); CHECK_FONT_OBJECT (font_object); font = XFONT_OBJECT (font_object); @@ -4417,16 +4635,16 @@ GSTRING. */) /* Try at most three times with larger gstring each time. */ for (i = 0; i < 3; i++) { - n = font->driver->shape (gstring); - if (INTEGERP (n)) + n = font->driver->shape (gstring, direction); + if (FIXNUMP (n)) break; gstring = larger_vector (gstring, LGSTRING_GLYPH_LEN (gstring), -1); } - if (i == 3 || XINT (n) == 0) + if (i == 3 || XFIXNUM (n) == 0) return Qnil; - if (XINT (n) < LGSTRING_GLYPH_LEN (gstring)) - LGSTRING_SET_GLYPH (gstring, XINT (n), Qnil); + if (XFIXNUM (n) < LGSTRING_GLYPH_LEN (gstring)) + LGSTRING_SET_GLYPH (gstring, XFIXNUM (n), Qnil); /* Check FROM_IDX and TO_IDX of each GLYPH in GSTRING to assure that GLYPHS covers all characters (except for the last few ones) in @@ -4460,7 +4678,7 @@ GSTRING. */) from = LGLYPH_FROM (glyph); to = LGLYPH_TO (glyph); } - return composition_gstring_put_cache (gstring, XINT (n)); + return composition_gstring_put_cache (gstring, XFIXNUM (n)); shaper_error: return Qnil; @@ -4468,12 +4686,12 @@ GSTRING. */) DEFUN ("font-variation-glyphs", Ffont_variation_glyphs, Sfont_variation_glyphs, 2, 2, 0, - doc: /* Return a list of variation glyphs for CHAR in FONT-OBJECT. + doc: /* Return a list of variation glyphs for CHARACTER in FONT-OBJECT. Each element of the value is a cons (VARIATION-SELECTOR . GLYPH-ID), where - VARIATION-SELECTOR is a character code of variation selection - (#xFE00..#xFE0F or #xE0100..#xE01EF) - GLYPH-ID is a glyph code of the corresponding variation glyph. */) + VARIATION-SELECTOR is a character code of variation selector + (#xFE00..#xFE0F or #xE0100..#xE01EF). + GLYPH-ID is a glyph code of the corresponding variation glyph, an integer. */) (Lisp_Object font_object, Lisp_Object character) { unsigned variations[256]; @@ -4486,7 +4704,7 @@ where font = XFONT_OBJECT (font_object); if (! font->driver->get_variation_glyphs) return Qnil; - n = font->driver->get_variation_glyphs (font, XINT (character), variations); + n = font->driver->get_variation_glyphs (font, XFIXNUM (character), variations); if (! n) return Qnil; val = Qnil; @@ -4494,8 +4712,8 @@ where if (variations[i]) { int vs = (i < 16 ? 0xFE00 + i : 0xE0100 + (i - 16)); - Lisp_Object code = INTEGER_TO_CONS (variations[i]); - val = Fcons (Fcons (make_number (vs), code), val); + Lisp_Object code = INT_TO_INTEGER (variations[i]); + val = Fcons (Fcons (make_fixnum (vs), code), val); } return val; } @@ -4510,7 +4728,7 @@ where that apply to POSITION. POSITION may be nil, in which case, FONT-SPEC is the font for displaying the character CH with the default face. GLYPH-CODE is the glyph code in the font to use for - the character. + the character, as an integer. For a text terminal, return a nonnegative integer glyph code for the character, or a negative integer if the character is not @@ -4547,9 +4765,9 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0, if (NILP (position)) { CHECK_CHARACTER (ch); - c = XINT (ch); + c = XFIXNUM (ch); f = XFRAME (selected_frame); - face_id = lookup_basic_face (f, DEFAULT_FACE_ID); + face_id = lookup_basic_face (NULL, f, DEFAULT_FACE_ID); pos = -1; } else @@ -4557,17 +4775,17 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0, Lisp_Object window; struct window *w; - CHECK_NUMBER_COERCE_MARKER (position); - if (! (BEGV <= XINT (position) && XINT (position) < ZV)) - args_out_of_range_3 (position, make_number (BEGV), make_number (ZV)); - pos = XINT (position); + EMACS_INT fixed_pos = fix_position (position); + if (! (BEGV <= fixed_pos && fixed_pos < ZV)) + args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); + pos = fixed_pos; pos_byte = CHAR_TO_BYTE (pos); if (NILP (ch)) c = FETCH_CHAR (pos_byte); else { - CHECK_NATNUM (ch); - c = XINT (ch); + CHECK_FIXNAT (ch); + c = XFIXNUM (ch); } window = Fget_buffer_window (Fcurrent_buffer (), Qnil); if (NILP (window)) @@ -4575,7 +4793,7 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0, w = XWINDOW (window); f = XFRAME (w->frame); face_id = face_at_buffer_position (w, pos, &dummy, - pos + 100, false, -1); + pos + 100, false, -1, 0); } if (! CHAR_VALID_P (c)) return Qnil; @@ -4597,7 +4815,7 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0, return Qnil; Lisp_Object font_object; XSETFONT (font_object, face->font); - return Fcons (font_object, INTEGER_TO_CONS (code)); + return Fcons (font_object, INT_TO_INTEGER (code)); } #if 0 @@ -4656,20 +4874,20 @@ glyph-string. */) CHECK_CONS (val); len = check_gstring (gstring_in); CHECK_VECTOR (gstring_out); - CHECK_NATNUM (from); - CHECK_NATNUM (to); - CHECK_NATNUM (index); - - if (XINT (from) >= XINT (to) || XINT (to) > len) - args_out_of_range_3 (from, to, make_number (len)); - if (XINT (index) >= ASIZE (gstring_out)) - args_out_of_range (index, make_number (ASIZE (gstring_out))); + CHECK_FIXNAT (from); + CHECK_FIXNAT (to); + CHECK_FIXNAT (index); + + if (XFIXNUM (from) >= XFIXNUM (to) || XFIXNUM (to) > len) + args_out_of_range_3 (from, to, make_fixnum (len)); + if (XFIXNUM (index) >= ASIZE (gstring_out)) + args_out_of_range (index, make_fixnum (ASIZE (gstring_out))); num = font->driver->otf_drive (font, otf_features, - gstring_in, XINT (from), XINT (to), - gstring_out, XINT (index), 0); + gstring_in, XFIXNUM (from), XFIXNUM (to), + gstring_out, XFIXNUM (index), 0); if (num < 0) return Qnil; - return make_number (num); + return make_fixnum (num); } DEFUN ("font-otf-alternates", Ffont_otf_alternates, Sfont_otf_alternates, @@ -4697,14 +4915,14 @@ corresponding character. */) CHECK_CHARACTER (character); CHECK_CONS (otf_features); - gstring_in = Ffont_make_gstring (font_object, make_number (1)); + gstring_in = Ffont_make_gstring (font_object, make_fixnum (1)); g = LGSTRING_GLYPH (gstring_in, 0); - LGLYPH_SET_CHAR (g, XINT (character)); - gstring_out = Ffont_make_gstring (font_object, make_number (10)); + LGLYPH_SET_CHAR (g, XFIXNUM (character)); + gstring_out = Ffont_make_gstring (font_object, make_fixnum (10)); while ((num = font->driver->otf_drive (font, otf_features, gstring_in, 0, 1, gstring_out, 0, 1)) < 0) gstring_out = Ffont_make_gstring (font_object, - make_number (ASIZE (gstring_out) * 2)); + make_fixnum (ASIZE (gstring_out) * 2)); alternates = Qnil; for (i = 0; i < num; i++) { @@ -4712,8 +4930,8 @@ corresponding character. */) int c = LGLYPH_CHAR (g); unsigned code = LGLYPH_CODE (g); - alternates = Fcons (Fcons (make_number (code), - c > 0 ? make_number (c) : Qnil), + alternates = Fcons (Fcons (make_fixnum (code), + c > 0 ? make_fixnum (c) : Qnil), alternates); } return Fnreverse (alternates); @@ -4726,20 +4944,20 @@ DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0, doc: /* Open FONT-ENTITY. */) (Lisp_Object font_entity, Lisp_Object size, Lisp_Object frame) { - EMACS_INT isize; + intmax_t isize; struct frame *f = decode_live_frame (frame); CHECK_FONT_ENTITY (font_entity); if (NILP (size)) - isize = XINT (AREF (font_entity, FONT_SIZE_INDEX)); + isize = XFIXNUM (AREF (font_entity, FONT_SIZE_INDEX)); else { - CHECK_NUMBER_OR_FLOAT (size); + CHECK_NUMBER (size); if (FLOATP (size)) isize = POINT_TO_PIXEL (XFLOAT_DATA (size), FRAME_RES_Y (f)); - else - isize = XINT (size); + else if (! integer_to_intmax (size, &isize)) + args_out_of_range (font_entity, size); if (! (INT_MIN <= isize && isize <= INT_MAX)) args_out_of_range (font_entity, size); if (isize == 0) @@ -4801,21 +5019,45 @@ If the font is not OpenType font, CAPABILITY is nil. */) (Lisp_Object font_object) { struct font *font = CHECK_FONT_GET_OBJECT (font_object); - Lisp_Object val = make_uninit_vector (9); - - ASET (val, 0, AREF (font_object, FONT_NAME_INDEX)); - ASET (val, 1, AREF (font_object, FONT_FILE_INDEX)); - ASET (val, 2, make_number (font->pixel_size)); - ASET (val, 3, make_number (font->max_width)); - ASET (val, 4, make_number (font->ascent)); - ASET (val, 5, make_number (font->descent)); - ASET (val, 6, make_number (font->space_width)); - ASET (val, 7, make_number (font->average_width)); - if (font->driver->otf_capability) - ASET (val, 8, Fcons (Qopentype, font->driver->otf_capability (font))); + return CALLN (Fvector, + AREF (font_object, FONT_NAME_INDEX), + AREF (font_object, FONT_FILE_INDEX), + make_fixnum (font->pixel_size), + make_fixnum (font->max_width), + make_fixnum (font->ascent), + make_fixnum (font->descent), + make_fixnum (font->space_width), + make_fixnum (font->average_width), + (font->driver->otf_capability + ? Fcons (Qopentype, font->driver->otf_capability (font)) + : Qnil)); +} + +DEFUN ("font-has-char-p", Ffont_has_char_p, Sfont_has_char_p, 2, 3, 0, + doc: + /* Return non-nil if FONT on FRAME has a glyph for character CH. +FONT can be either a font-entity or a font-object. If it is +a font-entity and the result is nil, it means the font needs to be +opened (with `open-font') to check. +FRAME defaults to the selected frame if it is nil or omitted. */) + (Lisp_Object font, Lisp_Object ch, Lisp_Object frame) +{ + struct frame *f; + CHECK_FONT (font); + CHECK_CHARACTER (ch); + + if (NILP (frame)) + f = XFRAME (selected_frame); else - ASET (val, 8, Qnil); - return val; + { + CHECK_FRAME (frame); + f = XFRAME (frame); + } + + if (font_has_char (f, font, XFIXNAT (ch)) <= 0) + return Qnil; + else + return Qt; } DEFUN ("font-get-glyphs", Ffont_get_glyphs, Sfont_get_glyphs, 3, 4, 0, @@ -4836,14 +5078,19 @@ where CODE is the glyph-code of C in FONT-OBJECT. WIDTH thru DESCENT are the metrics (in pixels) of the glyph. ADJUSTMENT is always nil. -If FONT-OBJECT doesn't have a glyph for a character, -the corresponding element is nil. */) + +If FONT-OBJECT doesn't have a glyph for a character, the corresponding +element is nil. + +Also see `font-has-char-p', which is more efficient than this function +if you just want to check whether FONT-OBJECT has a glyph for a +character. */) (Lisp_Object font_object, Lisp_Object from, Lisp_Object to, Lisp_Object object) { struct font *font = CHECK_FONT_GET_OBJECT (font_object); - ptrdiff_t i, len; - Lisp_Object *chars, vec; + ptrdiff_t len; + Lisp_Object *chars; USE_SAFE_ALLOCA; if (NILP (object)) @@ -4853,15 +5100,14 @@ the corresponding element is nil. */) validate_region (&from, &to); if (EQ (from, to)) return Qnil; - len = XFASTINT (to) - XFASTINT (from); + len = XFIXNAT (to) - XFIXNAT (from); SAFE_ALLOCA_LISP (chars, len); - charpos = XFASTINT (from); + charpos = XFIXNAT (from); bytepos = CHAR_TO_BYTE (charpos); - for (i = 0; charpos < XFASTINT (to); i++) + for (ptrdiff_t i = 0; charpos < XFIXNAT (to); i++) { - int c; - FETCH_CHAR_ADVANCE (c, charpos, bytepos); - chars[i] = make_number (c); + int c = fetch_char_advance (&charpos, &bytepos); + chars[i] = make_fixnum (c); } } else if (STRINGP (object)) @@ -4880,19 +5126,19 @@ the corresponding element is nil. */) int c; /* Skip IFROM characters from the beginning. */ - for (i = 0; i < ifrom; i++) - c = STRING_CHAR_ADVANCE (p); + for (ptrdiff_t i = 0; i < ifrom; i++) + p += BYTES_BY_CHAR_HEAD (*p); /* Now fetch an interesting characters. */ - for (i = 0; i < len; i++) - { - c = STRING_CHAR_ADVANCE (p); - chars[i] = make_number (c); - } + for (ptrdiff_t i = 0; i < len; i++) + { + c = string_char_advance (&p); + chars[i] = make_fixnum (c); + } } else - for (i = 0; i < len; i++) - chars[i] = make_number (p[ifrom + i]); + for (ptrdiff_t i = 0; i < len; i++) + chars[i] = make_fixnum (p[ifrom + i]); } else if (VECTORP (object)) { @@ -4902,7 +5148,7 @@ the corresponding element is nil. */) if (ifrom == ito) return Qnil; len = ito - ifrom; - for (i = 0; i < len; i++) + for (ptrdiff_t i = 0; i < len; i++) { Lisp_Object elt = AREF (object, ifrom + i); CHECK_CHARACTER (elt); @@ -4912,11 +5158,11 @@ the corresponding element is nil. */) else wrong_type_argument (Qarrayp, object); - vec = make_uninit_vector (len); - for (i = 0; i < len; i++) + Lisp_Object vec = make_nil_vector (len); + for (ptrdiff_t i = 0; i < len; i++) { Lisp_Object g; - int c = XFASTINT (chars[i]); + int c = XFIXNAT (chars[i]); unsigned code; struct font_metrics metrics; @@ -4964,24 +5210,26 @@ character at index specified by POSITION. */) (Lisp_Object position, Lisp_Object window, Lisp_Object string) { struct window *w = decode_live_window (window); + EMACS_INT pos; if (NILP (string)) { if (XBUFFER (w->contents) != current_buffer) error ("Specified window is not displaying the current buffer"); - CHECK_NUMBER_COERCE_MARKER (position); - if (! (BEGV <= XINT (position) && XINT (position) < ZV)) - args_out_of_range_3 (position, make_number (BEGV), make_number (ZV)); + pos = fix_position (position); + if (! (BEGV <= pos && pos < ZV)) + args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV)); } else { - CHECK_NUMBER (position); + CHECK_FIXNUM (position); CHECK_STRING (string); - if (! (0 <= XINT (position) && XINT (position) < SCHARS (string))) + pos = XFIXNUM (position); + if (! (0 <= pos && pos < SCHARS (string))) args_out_of_range (string, position); } - return font_at (-1, XINT (position), NULL, w, string); + return font_at (-1, pos, NULL, w, string); } #if 0 @@ -5004,9 +5252,9 @@ Type C-l to recover what previously shown. */) code = alloca (sizeof (unsigned) * len); for (i = 0; i < len; i++) { - Lisp_Object ch = Faref (string, make_number (i)); + Lisp_Object ch = Faref (string, make_fixnum (i)); Lisp_Object val; - int c = XINT (ch); + int c = XFIXNUM (ch); code[i] = font->driver->encode_char (font, c); if (code[i] == FONT_INVALID_CODE) @@ -5021,7 +5269,7 @@ Type C-l to recover what previously shown. */) if (font->driver->done_face) font->driver->done_face (f, face); face->fontp = NULL; - return make_number (len); + return make_fixnum (len); } #endif @@ -5048,10 +5296,10 @@ DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0, doc: /* Return information about a font named NAME on frame FRAME. If FRAME is omitted or nil, use the selected frame. -The returned value is a vector: +The returned value is a vector of 14 elements: [ OPENED-NAME FULL-NAME SIZE HEIGHT BASELINE-OFFSET RELATIVE-COMPOSE DEFAULT-ASCENT MAX-WIDTH ASCENT DESCENT SPACE-WIDTH AVERAGE-WIDTH - CAPABILITY ] + FILENAME CAPABILITY ] where OPENED-NAME is the name used for opening the font, FULL-NAME is the full name of the font, @@ -5061,12 +5309,12 @@ where RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling how to compose characters, MAX-WIDTH is the maximum advance width of the font, - ASCENT, DESCENT, SPACE-WIDTH, AVERAGE-WIDTH are metrics of the font - in pixels, + ASCENT, DESCENT, SPACE-WIDTH, and AVERAGE-WIDTH are metrics of + the font in pixels, FILENAME is the font file name, a string (or nil if the font backend doesn't provide a file name). CAPABILITY is a list whose first element is a symbol representing the - font format, one of x, opentype, truetype, type1, pcf, or bdf. + font format, one of `x', `opentype', `truetype', `type1', `pcf', or `bdf'. The remaining elements describe the details of the font capabilities, as follows: @@ -5086,7 +5334,7 @@ where If the font is not an OpenType font, there are no elements in CAPABILITY except the font format symbol. -If the named font is not yet loaded, return nil. */) +If the named font cannot be opened and loaded, return nil. */) (Lisp_Object name, Lisp_Object frame) { struct frame *f; @@ -5121,24 +5369,26 @@ If the named font is not yet loaded, return nil. */) return Qnil; font = XFONT_OBJECT (font_object); - info = make_uninit_vector (14); - ASET (info, 0, AREF (font_object, FONT_NAME_INDEX)); - ASET (info, 1, AREF (font_object, FONT_FULLNAME_INDEX)); - ASET (info, 2, make_number (font->pixel_size)); - ASET (info, 3, make_number (font->height)); - ASET (info, 4, make_number (font->baseline_offset)); - ASET (info, 5, make_number (font->relative_compose)); - ASET (info, 6, make_number (font->default_ascent)); - ASET (info, 7, make_number (font->max_width)); - ASET (info, 8, make_number (font->ascent)); - ASET (info, 9, make_number (font->descent)); - ASET (info, 10, make_number (font->space_width)); - ASET (info, 11, make_number (font->average_width)); - ASET (info, 12, AREF (font_object, FONT_FILE_INDEX)); - if (font->driver->otf_capability) - ASET (info, 13, Fcons (Qopentype, font->driver->otf_capability (font))); - else - ASET (info, 13, Qnil); + /* Sanity check to make sure we have initialized max_width. */ + eassert (XFONT_OBJECT (font_object)->max_width < 1024 * 1024 * 1024); + + info = CALLN (Fvector, + AREF (font_object, FONT_NAME_INDEX), + AREF (font_object, FONT_FULLNAME_INDEX), + make_fixnum (font->pixel_size), + make_fixnum (font->height), + make_fixnum (font->baseline_offset), + make_fixnum (font->relative_compose), + make_fixnum (font->default_ascent), + make_fixnum (font->max_width), + make_fixnum (font->ascent), + make_fixnum (font->descent), + make_fixnum (font->space_width), + make_fixnum (font->average_width), + AREF (font_object, FONT_FILE_INDEX), + (font->driver->otf_capability + ? Fcons (Qopentype, font->driver->otf_capability (font)) + : Qnil)); #if 0 /* As font_object is still in FONT_OBJLIST of the entity, we can't @@ -5156,15 +5406,14 @@ If the named font is not yet loaded, return nil. */) static Lisp_Object build_style_table (const struct table_entry *entry, int nelement) { - int i, j; - Lisp_Object table, elt; - - table = make_uninit_vector (nelement); - for (i = 0; i < nelement; i++) + Lisp_Object table = make_nil_vector (nelement); + for (int i = 0; i < nelement; i++) { - for (j = 0; entry[i].names[j]; j++); - elt = Fmake_vector (make_number (j + 1), Qnil); - ASET (elt, 0, make_number (entry[i].numeric)); + int j; + for (j = 0; entry[i].names[j]; j++) + continue; + Lisp_Object elt = make_nil_vector (j + 1); + ASET (elt, 0, make_fixnum (entry[i].numeric)); for (j = 0; entry[i].names[j]; j++) ASET (elt, j + 1, intern_c_string (entry[i].names[j])); ASET (table, i, elt); @@ -5299,17 +5548,23 @@ syms_of_font (void) sort_shift_bits[FONT_SIZE_INDEX] = 16; sort_shift_bits[FONT_WIDTH_INDEX] = 23; /* Note that the other elements in sort_shift_bits are not used. */ + PDUMPER_REMEMBER_SCALAR (sort_shift_bits); - staticpro (&font_charset_alist); font_charset_alist = Qnil; + staticpro (&font_charset_alist); DEFSYM (Qopentype, "opentype"); + /* Currently used by hbfont.c, which has no syms_of_hbfont function + of its own. */ + DEFSYM (Qcanonical_combining_class, "canonical-combining-class"); + /* Important character set symbols. */ DEFSYM (Qascii_0, "ascii-0"); DEFSYM (Qiso8859_1, "iso8859-1"); DEFSYM (Qiso10646_1, "iso10646-1"); DEFSYM (Qunicode_bmp, "unicode-bmp"); + DEFSYM (Qemoji, "emoji"); /* Symbols representing keys of font extra info. */ DEFSYM (QCotf, ":otf"); @@ -5339,13 +5594,20 @@ syms_of_font (void) DEFSYM (QCuser_spec, ":user-spec"); - staticpro (&scratch_font_spec); + /* For shapers that need to know text directionality. */ + DEFSYM (QL2R, "L2R"); + DEFSYM (QR2L, "R2L"); + + DEFSYM (Qfont_extra_type, "font-extra-type"); + DEFSYM (Qfont_driver_superseded_by, "font-driver-superseded-by"); + scratch_font_spec = Ffont_spec (0, NULL); - staticpro (&scratch_font_prefer); + staticpro (&scratch_font_spec); scratch_font_prefer = Ffont_spec (0, NULL); + staticpro (&scratch_font_prefer); + Vfont_log_deferred = make_nil_vector (3); staticpro (&Vfont_log_deferred); - Vfont_log_deferred = Fmake_vector (make_number (3), Qnil); #if 0 #ifdef HAVE_LIBOTF @@ -5379,6 +5641,7 @@ syms_of_font (void) defsubr (&Sclose_font); defsubr (&Squery_font); defsubr (&Sfont_get_glyphs); + defsubr (&Sfont_has_char_p); defsubr (&Sfont_match_p); defsubr (&Sfont_at); #if 0 @@ -5421,27 +5684,28 @@ gets the repertory information by an opened font and ENCODING. */); doc: /* Vector of valid font weight values. Each element has the form: [NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...] -NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */); +NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. +This variable cannot be set; trying to do so will signal an error. */); Vfont_weight_table = BUILD_STYLE_TABLE (weight_table); make_symbol_constant (intern_c_string ("font-weight-table")); DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table, doc: /* Vector of font slant symbols vs the corresponding numeric values. -See `font-weight-table' for the format of the vector. */); +See `font-weight-table' for the format of the vector. +This variable cannot be set; trying to do so will signal an error. */); Vfont_slant_table = BUILD_STYLE_TABLE (slant_table); make_symbol_constant (intern_c_string ("font-slant-table")); DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table, doc: /* Alist of font width symbols vs the corresponding numeric values. -See `font-weight-table' for the format of the vector. */); +See `font-weight-table' for the format of the vector. +This variable cannot be set; trying to do so will signal an error. */); Vfont_width_table = BUILD_STYLE_TABLE (width_table); make_symbol_constant (intern_c_string ("font-width-table")); staticpro (&font_style_table); - font_style_table = make_uninit_vector (3); - ASET (font_style_table, 0, Vfont_weight_table); - ASET (font_style_table, 1, Vfont_slant_table); - ASET (font_style_table, 2, Vfont_width_table); + font_style_table = CALLN (Fvector, Vfont_weight_table, Vfont_slant_table, + Vfont_width_table); DEFVAR_LISP ("font-log", Vfont_log, doc: /* A list that logs font-related actions and results, for debugging. @@ -5461,22 +5725,46 @@ and cannot switch to a smaller font for those characters, set this variable non-nil. Disabling compaction of font caches might enlarge the Emacs memory footprint in sessions that use lots of different fonts. */); + +#ifdef WINDOWSNT + /* Compacting font caches causes slow redisplay on Windows with many + large fonts, so we disable it by default. */ + inhibit_compacting_font_caches = 1; +#else inhibit_compacting_font_caches = 0; +#endif + + DEFVAR_BOOL ("xft-ignore-color-fonts", + xft_ignore_color_fonts, + doc: /* +Non-nil means don't query fontconfig for color fonts, since they often +cause Xft crashes. Only has an effect in Xft builds. */); + xft_ignore_color_fonts = true; + + DEFVAR_BOOL ("query-all-font-backends", query_all_font_backends, + doc: /* +If non-nil, attempt to query all available font backends. +By default Emacs will stop searching for a matching font at the first +match. */); + query_all_font_backends = false; #ifdef HAVE_WINDOW_SYSTEM #ifdef HAVE_FREETYPE syms_of_ftfont (); #ifdef HAVE_X_WINDOWS + syms_of_xfont (); #ifdef USE_CAIRO syms_of_ftcrfont (); #else - syms_of_xfont (); - syms_of_ftxfont (); #ifdef HAVE_XFT syms_of_xftfont (); #endif /* HAVE_XFT */ #endif /* not USE_CAIRO */ -#endif /* HAVE_X_WINDOWS */ +#else /* not HAVE_X_WINDOWS */ +#ifdef USE_CAIRO + syms_of_ftcrfont (); +#endif +#endif /* not HAVE_X_WINDOWS */ #else /* not HAVE_FREETYPE */ #ifdef HAVE_X_WINDOWS syms_of_xfont (); @@ -5488,6 +5776,9 @@ footprint in sessions that use lots of different fonts. */); #ifdef HAVE_NTGUI syms_of_w32font (); #endif /* HAVE_NTGUI */ +#ifdef USE_BE_CAIRO + syms_of_ftcrfont (); +#endif #endif /* HAVE_WINDOW_SYSTEM */ } |