Permit XLFD names to exceed 255 characters

* doc/lispref/display.texi (Low-Level Font)
<font-xlfd-name>: Document new argument `long-xlfds'.

* etc/NEWS: Mention removal of XLFD length restrictions.

* src/font.c (font_build_object): Dynamically allocate XLFD,
permitting them to surpass 255 characters in length.
(font_parse_xlfd_1): Cease rejecting XLFDs more than 255
characters in length.
(font_dynamic_unparse_xlfd): New function.  Like
font_unparse_xlfd, but allocate the XLFD dynamically.
(font_delete_unmatched): Dynamically allocate XLFD if necessary.
(Ffont_xlfd_name): New arg LONG_XLFDs.  If t, return a
dynamically allocated XLFD.  All callers changed.

* src/font.h: Update prototypes.

* src/fontset.c (Fnew_fontset): Dynamically allocate XLFD when
establishing fontset name.
This commit is contained in:
Po Lu 2023-09-08 10:37:18 +08:00
parent b1bcd396ed
commit c933f5081f
10 changed files with 287 additions and 46 deletions

View file

@ -4254,14 +4254,18 @@ key-attribute pairs may be omitted from the list if they are not
specified by @var{font}.
@end defun
@defun font-xlfd-name font &optional fold-wildcards
@defun font-xlfd-name font &optional fold-wildcards long-xlfds
This function returns the XLFD (X Logical Font Descriptor), a string,
matching @var{font}. @xref{Fonts,,, emacs, The GNU Emacs Manual}, for
information about XLFDs. If the name is too long for an XLFD (which
can contain at most 255 characters), the function returns @code{nil}.
information about XLFDs.
If the optional argument @var{fold-wildcards} is non-@code{nil},
consecutive wildcards in the XLFD are folded into one.
If the optional argument @var{long-xlfds} is @code{nil}, then
@code{nil} is returned if the XLFD would otherwise exceed 255
characters in length; this is for compatibility with the X protocol,
which mandates that XLFDs be restricted to that length.
@end defun
The following two functions return important information about a font.

View file

@ -893,6 +893,14 @@ Use 'define-minor-mode' and 'define-globalized-minor-mode' instead.
* Lisp Changes in Emacs 30.1
+++
** XLFDs are no longer restricted to 255 characters.
'font-xlfd-name' now returns an XLFD even if it is greater than 255
characters in length, provided that the LONG_XLFDs argument is true.
Other features in Emacs which employ XLFDs have been modified to
produce and understand XLFDs larger than 255 characters.
** 'defadvice' is marked as obsolete.
See the "(elisp) Porting Old Advice" node for help converting them
to use 'advice-add' or 'define-advice' instead.

View file

@ -776,7 +776,7 @@ androidfont_open_font (struct frame *f, Lisp_Object font_entity,
#undef DO_CARDINAL_FIELD
/* This should eventually become unnecessary. */
font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil);
font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil, Qt);
return font_object;
}

View file

@ -252,12 +252,20 @@ font_build_object (int vectorsize, Lisp_Object type,
{
int len;
char name[256];
Lisp_Object font_object = font_make_object (vectorsize, entity, pixelsize);
char *xlfd_name;
Lisp_Object font_object;
font_object = font_make_object (vectorsize, entity, pixelsize);
ASET (font_object, FONT_TYPE_INDEX, type);
len = font_unparse_xlfd (entity, pixelsize, name, sizeof name);
if (len > 0)
ASET (font_object, FONT_NAME_INDEX, make_string (name, len));
xlfd_name = font_dynamic_unparse_xlfd (entity, pixelsize);
if (xlfd_name)
{
ASET (font_object, FONT_NAME_INDEX, build_string (xlfd_name));
xfree (xlfd_name);
}
len = font_unparse_fcname (entity, pixelsize, name, sizeof name);
if (len > 0)
ASET (font_object, FONT_FULLNAME_INDEX, make_string (name, len));
@ -1067,8 +1075,8 @@ font_parse_xlfd_1 (char *name, ptrdiff_t len, Lisp_Object font, int segments)
Lisp_Object val;
char *p;
if (len > 255 || !len)
/* Maximum XLFD name length is 255. */
/* Reject empty XLFDs. */
if (!len)
return -1;
/* Accept "*-.." as a fully specified XLFD. */
@ -1276,6 +1284,167 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font)
return -1;
}
/* Return the XLFD name of FONT as a NULL terminated string, or NULL
if the font is invalid. If FONT is a scalable font, return
PIXEL_SIZE as the XLFD's pixel size in lieu of its
FONT_SIZE_INDEX. */
char *
font_dynamic_unparse_xlfd (Lisp_Object font, int pixel_size)
{
char *p;
const char *f[XLFD_REGISTRY_INDEX + 1];
Lisp_Object val;
int i, j, len;
char *name;
USE_SAFE_ALLOCA;
eassert (FONTP (font));
for (i = FONT_FOUNDRY_INDEX, j = XLFD_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX;
i++, j++)
{
if (i == FONT_ADSTYLE_INDEX)
j = XLFD_ADSTYLE_INDEX;
else if (i == FONT_REGISTRY_INDEX)
j = XLFD_REGISTRY_INDEX;
val = AREF (font, i);
if (NILP (val))
{
if (j == XLFD_REGISTRY_INDEX)
f[j] = "*-*";
else
f[j] = "*";
}
else
{
if (SYMBOLP (val))
val = SYMBOL_NAME (val);
if (j == XLFD_REGISTRY_INDEX
&& ! strchr (SSDATA (val), '-'))
{
ptrdiff_t alloc = SBYTES (val) + 4;
/* Change "jisx0208*" and "jisx0208" to "jisx0208*-*". */
f[j] = p = SAFE_ALLOCA (alloc);
sprintf (p, "%s%s-*", SDATA (val),
&"*"[SDATA (val)[SBYTES (val) - 1] == '*']);
}
else
f[j] = SSDATA (val);
}
}
for (i = FONT_WEIGHT_INDEX, j = XLFD_WEIGHT_INDEX; i <= FONT_WIDTH_INDEX;
i++, j++)
{
val = font_style_symbolic (font, i, 0);
if (NILP (val))
f[j] = "*";
else
{
int c, k, l;
ptrdiff_t alloc;
val = SYMBOL_NAME (val);
alloc = SBYTES (val) + 1;
f[j] = p = SAFE_ALLOCA (alloc);
/* Copy the name while excluding '-', '?', ',', and '"'. */
for (k = l = 0; k < alloc; k++)
{
c = SREF (val, k);
if (c != '-' && c != '?' && c != ',' && c != '"')
p[l++] = c;
}
}
}
val = AREF (font, FONT_SIZE_INDEX);
eassert (NUMBERP (val) || NILP (val));
char font_size_index_buf[sizeof "-*"
+ max (INT_STRLEN_BOUND (EMACS_INT),
1 + DBL_MAX_10_EXP + 1)];
if (INTEGERP (val))
{
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, "%"PRIdMAX"-*", v);
}
else
f[XLFD_PIXEL_INDEX] = "*-*";
}
else if (FLOATP (val))
{
double v = XFLOAT_DATA (val) * 10;
f[XLFD_PIXEL_INDEX] = p = font_size_index_buf;
sprintf (p, "*-%.0f", v);
}
else
f[XLFD_PIXEL_INDEX] = "*-*";
char dpi_index_buf[sizeof "-" + 2 * INT_STRLEN_BOUND (EMACS_INT)];
if (FIXNUMP (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 (FIXNUMP (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"
: spacing <= FONT_SPACING_MONO ? "m"
: "c");
}
else
f[XLFD_SPACING_INDEX] = "*";
char avgwidth_index_buf[INT_BUFSIZE_BOUND (EMACS_INT)];
if (FIXNUMP (AREF (font, FONT_AVGWIDTH_INDEX)))
{
f[XLFD_AVGWIDTH_INDEX] = p = avgwidth_index_buf;
sprintf (p, "%"pI"d", XFIXNUM (AREF (font, FONT_AVGWIDTH_INDEX)));
}
else
f[XLFD_AVGWIDTH_INDEX] = "*";
/* Allocate a buffer large enough to accommodate the entire
XLFD. */
name = xmalloc (strlen (f[XLFD_FOUNDRY_INDEX])
+ strlen (f[XLFD_FAMILY_INDEX])
+ strlen (f[XLFD_WEIGHT_INDEX])
+ strlen (f[XLFD_SLANT_INDEX])
+ strlen (f[XLFD_SWIDTH_INDEX])
+ strlen (f[XLFD_ADSTYLE_INDEX])
+ strlen (f[XLFD_PIXEL_INDEX])
+ strlen (f[XLFD_RESX_INDEX])
+ strlen (f[XLFD_SPACING_INDEX])
+ strlen (f[XLFD_AVGWIDTH_INDEX])
+ strlen (f[XLFD_REGISTRY_INDEX])
+ sizeof "-----------");
/* Return the XLFD. */
sprintf (name, "-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s-%s",
f[XLFD_FOUNDRY_INDEX], f[XLFD_FAMILY_INDEX],
f[XLFD_WEIGHT_INDEX], f[XLFD_SLANT_INDEX],
f[XLFD_SWIDTH_INDEX], f[XLFD_ADSTYLE_INDEX],
f[XLFD_PIXEL_INDEX], f[XLFD_RESX_INDEX],
f[XLFD_SPACING_INDEX], f[XLFD_AVGWIDTH_INDEX],
f[XLFD_REGISTRY_INDEX]);
SAFE_FREE ();
return name;
}
/* 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
@ -1878,7 +2047,7 @@ font_rescale_ratio (Lisp_Object font_entity)
if (STRINGP (XCAR (elt)))
{
if (NILP (name))
name = Ffont_xlfd_name (font_entity, Qnil);
name = Ffont_xlfd_name (font_entity, Qnil, Qt);
/* N.B. that `name' is set to nil if the resulting XLFD
is too long. */
@ -2490,12 +2659,30 @@ font_delete_unmatched (Lisp_Object vec, Lisp_Object spec, int size)
entity = AREF (vec, i);
if (! NILP (Vface_ignored_fonts))
{
char name[256];
char name[256], *xlfd;
ptrdiff_t namelen;
namelen = font_unparse_xlfd (entity, 0, name, 256);
if (namelen >= 0)
if (font_is_ignored (name, namelen))
{
if (font_is_ignored (name, namelen))
continue;
}
else
{
/* The font family or foundry is too long for a 256
character xlfd to accommodate. */
xlfd = font_dynamic_unparse_xlfd (entity, 0);
if (xlfd && font_is_ignored (xlfd, sizeof (xlfd)))
{
xfree (xlfd);
continue;
}
xfree (xlfd);
}
}
if (NILP (spec))
{
@ -4239,16 +4426,20 @@ Optional 2nd argument FRAME, if non-nil, specifies the target frame. */)
return val;
}
DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 2, 0,
DEFUN ("font-xlfd-name", Ffont_xlfd_name, Sfont_xlfd_name, 1, 3, 0,
doc: /* Return XLFD name of FONT.
FONT is a font-spec, font-entity, or font-object.
If the name is too long for XLFD (maximum 255 chars), return nil.
If the name is too long to be represented as an XLFD (maximum 255
chars) and LONG_XLFDS is nil, return nil.
If the 2nd optional arg FOLD-WILDCARDS is non-nil,
the consecutive wildcards are folded into one. */)
(Lisp_Object font, Lisp_Object fold_wildcards)
(Lisp_Object font, Lisp_Object fold_wildcards, Lisp_Object long_xlfds)
{
char name[256];
char name_buffer[256], *name;
int namelen, pixel_size = 0;
Lisp_Object string;
CHECK_FONT (font);
@ -4267,9 +4458,25 @@ the consecutive wildcards are folded into one. */)
}
pixel_size = XFONT_OBJECT (font)->pixel_size;
}
namelen = font_unparse_xlfd (font, pixel_size, name, 256);
if (namelen < 0)
return Qnil;
if (NILP (long_xlfds))
{
name = name_buffer;
namelen = font_unparse_xlfd (font, pixel_size, name, 256);
if (namelen < 0)
return Qnil;
}
else
{
/* Dynamically allocate the XLFD. */
name = font_dynamic_unparse_xlfd (font, pixel_size);
if (!name)
return Qnil;
namelen = strlen (name);
}
done:
if (! NILP (fold_wildcards))
{
@ -4283,7 +4490,14 @@ the consecutive wildcards are folded into one. */)
}
}
return make_string (name, namelen);
/* If NAME is dynamically allocated, free it. */
string = make_string (name, namelen);
if (name != name_buffer)
xfree (name);
return string;
}
void
@ -5487,7 +5701,7 @@ font_add_log (const char *action, Lisp_Object arg, Lisp_Object result)
Lisp_Object tail, elt;
AUTO_STRING (equal, "=");
val = Ffont_xlfd_name (arg, Qt);
val = Ffont_xlfd_name (arg, Qt, Qt);
for (tail = AREF (arg, FONT_EXTRA_INDEX); CONSP (tail);
tail = XCDR (tail))
{
@ -5515,7 +5729,7 @@ font_add_log (const char *action, Lisp_Object arg, Lisp_Object result)
result = font_vconcat_entity_vectors (result);
if (FONTP (result))
{
val = Ffont_xlfd_name (result, Qt);
val = Ffont_xlfd_name (result, Qt, Qt);
if (! FONT_SPEC_P (result))
{
AUTO_STRING (colon, ":");
@ -5532,7 +5746,7 @@ font_add_log (const char *action, Lisp_Object arg, Lisp_Object result)
{
val = XCAR (tail);
if (FONTP (val))
val = Ffont_xlfd_name (val, Qt);
val = Ffont_xlfd_name (val, Qt, Qt);
XSETCAR (tail, val);
}
}
@ -5543,7 +5757,7 @@ font_add_log (const char *action, Lisp_Object arg, Lisp_Object result)
{
val = AREF (result, i);
if (FONTP (val))
val = Ffont_xlfd_name (val, Qt);
val = Ffont_xlfd_name (val, Qt, Qt);
ASET (result, i, val);
}
}

View file

@ -885,8 +885,8 @@ extern void font_parse_family_registry (Lisp_Object family,
Lisp_Object spec);
extern int font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font);
extern ptrdiff_t font_unparse_xlfd (Lisp_Object font, int pixel_size,
char *name, int bytes);
extern char *font_dynamic_unparse_xlfd (Lisp_Object, int);
extern ptrdiff_t font_unparse_xlfd (Lisp_Object, int, char *, int);
extern void register_font_driver (struct font_driver const *, struct frame *);
extern void free_font_driver_list (struct frame *f);
#ifdef ENABLE_CHECKING

View file

@ -1546,7 +1546,7 @@ overwrites the previous settings. */)
font_parse_family_registry (XCAR (font_spec), XCDR (font_spec), spec);
font_spec = spec;
fontname = Ffont_xlfd_name (font_spec, Qnil);
fontname = Ffont_xlfd_name (font_spec, Qnil, Qt);
}
else if (STRINGP (font_spec))
{
@ -1554,7 +1554,7 @@ overwrites the previous settings. */)
font_spec = CALLN (Ffont_spec, QCname, fontname);
}
else if (FONT_SPEC_P (font_spec))
fontname = Ffont_xlfd_name (font_spec, Qnil);
fontname = Ffont_xlfd_name (font_spec, Qnil, Qt);
else if (! NILP (font_spec))
Fsignal (Qfont, list2 (build_string ("Invalid font-spec"), font_spec));
@ -1740,6 +1740,7 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of
{
Lisp_Object fontset, tail;
int id;
char *string;
CHECK_STRING (name);
@ -1749,8 +1750,6 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of
{
Lisp_Object font_spec = Ffont_spec (0, NULL);
Lisp_Object short_name;
char xlfd[256];
int len;
if (font_parse_xlfd (SSDATA (name), SBYTES (name), font_spec) < 0)
error ("Fontset name must be in XLFD format");
@ -1762,10 +1761,11 @@ FONT-SPEC is a vector, a cons, or a string. See the documentation of
Vfontset_alias_alist);
ASET (font_spec, FONT_REGISTRY_INDEX, Qiso8859_1);
fontset = make_fontset (Qnil, name, Qnil);
len = font_unparse_xlfd (font_spec, 0, xlfd, 256);
if (len < 0)
string = font_dynamic_unparse_xlfd (font_spec, 0);
if (!string)
error ("Invalid fontset name (perhaps too long): %s", SDATA (name));
set_fontset_ascii (fontset, make_unibyte_string (xlfd, len));
set_fontset_ascii (fontset, build_unibyte_string (string));
xfree (string);
}
else
{
@ -1816,7 +1816,7 @@ fontset_from_font (Lisp_Object font_object)
Lisp_Object font_spec = copy_font_spec (font_object);
Lisp_Object registry = AREF (font_spec, FONT_REGISTRY_INDEX);
Lisp_Object fontset_spec, alias, name, fontset;
Lisp_Object val;
Lisp_Object val, xlfd;
val = assoc_no_quit (font_spec, auto_fontset_alist);
if (CONSP (val))
@ -1832,14 +1832,27 @@ fontset_from_font (Lisp_Object font_object)
}
fontset_spec = copy_font_spec (font_spec);
ASET (fontset_spec, FONT_REGISTRY_INDEX, alias);
name = Ffont_xlfd_name (fontset_spec, Qnil);
name = Ffont_xlfd_name (fontset_spec, Qnil, Qt);
eassert (!NILP (name));
fontset = make_fontset (Qnil, name, Qnil);
Vfontset_alias_alist = Fcons (Fcons (name, SYMBOL_NAME (alias)),
Vfontset_alias_alist);
alias = Fdowncase (AREF (font_object, FONT_NAME_INDEX));
Vfontset_alias_alist = Fcons (Fcons (name, alias), Vfontset_alias_alist);
auto_fontset_alist = Fcons (Fcons (font_spec, fontset), auto_fontset_alist);
xlfd = AREF (font_object, FONT_NAME_INDEX);
/* XLFD can be nil if the font's registry or family name gives rise
to an XLFD name that cannot be represented within 255
characters. (bug#65800) */
if (!NILP (xlfd))
{
alias = Fdowncase (xlfd);
Vfontset_alias_alist
= Fcons (Fcons (name, alias), Vfontset_alias_alist);
auto_fontset_alist
= Fcons (Fcons (font_spec, fontset), auto_fontset_alist);
}
font_spec = Ffont_spec (0, NULL);
ASET (font_spec, FONT_REGISTRY_INDEX, registry);
{
@ -2006,7 +2019,7 @@ format is the same as above. */)
for (; CONSP (alist); alist = XCDR (alist))
{
elt = XCAR (alist);
XSETCAR (elt, Ffont_xlfd_name (XCAR (elt), Qnil));
XSETCAR (elt, Ffont_xlfd_name (XCAR (elt), Qnil, Qt));
}
}
c = to + 1;

View file

@ -873,7 +873,8 @@ haikufont_open (struct frame *f, Lisp_Object font_entity, int pixel_size)
font->baseline_offset = 0;
font->relative_compose = 0;
font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil);
font->props[FONT_NAME_INDEX]
= Ffont_xlfd_name (font_object, Qnil, Qt);
unblock_input ();
return font_object;

View file

@ -3293,7 +3293,7 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity,
cancel_blend:
/* Calculate the xfld name. */
font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil);
font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil, Qt);
#ifdef HAVE_HARFBUZZ
/* HarfBuzz will potentially read font tables after the font has

View file

@ -1072,7 +1072,7 @@ w32font_open_internal (struct frame *f, Lisp_Object font_entity,
name to be usable in x-list-fonts. Eventually we expect to change
x-list-fonts and other places that use fonts so that this can be
an fcname or similar. */
font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil);
font->props[FONT_NAME_INDEX] = Ffont_xlfd_name (font_object, Qnil, Qt);
return 1;
}

View file

@ -1629,7 +1629,7 @@ the face font sort order, see `face-font-selection-order'. */)
make_fixnum
(FONT_SPACING_PROPORTIONAL)))
? Qnil : Qt,
Ffont_xlfd_name (font, Qnil),
Ffont_xlfd_name (font, Qnil, Qt),
AREF (font, FONT_REGISTRY_INDEX));
result = Fcons (v, result);
}
@ -1738,7 +1738,7 @@ the WIDTH times as wide as FACE on FRAME. */)
ASET (font_entity, FONT_SIZE_INDEX,
AREF (font_spec, FONT_SIZE_INDEX));
}
XSETCAR (tail, Ffont_xlfd_name (font_entity, Qnil));
XSETCAR (tail, Ffont_xlfd_name (font_entity, Qnil, Qt));
}
if (NILP (frame))
/* We don't have to check fontsets. */
@ -4018,7 +4018,8 @@ x_update_menu_appearance (struct frame *f)
|| !UNSPECIFIEDP (LFACE_SLANT (lface))
|| !UNSPECIFIEDP (LFACE_HEIGHT (lface))))
{
Lisp_Object xlfd = Ffont_xlfd_name (LFACE_FONT (lface), Qnil);
Lisp_Object xlfd = Ffont_xlfd_name (LFACE_FONT (lface), Qnil,
Qnil);
#ifdef USE_MOTIF
const char *suffix = "List";
bool motif = true;