From: "Mattias Engdegård" <mattiase@acm.org>
To: "Mattias Engdegård" <mattiase@acm.org>
Cc: gusbrs.2016@gmail.com, Ihor Radchenko <yantar92@posteo.net>,
62847@debbugs.gnu.org, Eli Zaretskii <eliz@gnu.org>,
Stefan Monnier <monnier@iro.umontreal.ca>
Subject: bug#62847: 29.0.90; Propertized space in Org Agenda's mode-name
Date: Sun, 16 Apr 2023 16:53:54 +0200 [thread overview]
Message-ID: <EC33F871-1584-47D0-997E-E49D91205D2D@acm.org> (raw)
In-Reply-To: <9F74A07C-5B48-448F-B284-17FD05E7AC94@acm.org>
[-- Attachment #1: Type: text/plain, Size: 67 bytes --]
> Here's a patch
And here's one that I actually attached. Sorry!
[-- Attachment #2: string-literal-prop-change.diff --]
[-- Type: application/octet-stream, Size: 6743 bytes --]
diff --git a/src/alloc.c b/src/alloc.c
index d09fc41dec6..616b4fa7a66 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -2606,6 +2606,9 @@ make_clear_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes, bool clearit)
s = allocate_string ();
s->u.s.intervals = NULL;
+#ifdef CHECK_STRING_LITERALS
+ s->u.s.literal = false;
+#endif
allocate_string_data (s, nchars, nbytes, clearit, false);
XSETSTRING (string, s);
string_chars_consed += nbytes;
diff --git a/src/lisp.h b/src/lisp.h
index 4e17e369312..30c0a001c34 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1560,6 +1560,8 @@ CDR_SAFE (Lisp_Object c)
return CONSP (c) ? XCDR (c) : Qnil;
}
+#define CHECK_STRING_LITERALS 1
+
/* In a string or vector, the sign bit of u.s.size is the gc mark bit. */
struct Lisp_String
@@ -1579,6 +1581,10 @@ CDR_SAFE (Lisp_Object c)
INTERVAL intervals; /* Text properties in this string. */
unsigned char *data;
+#ifdef CHECK_STRING_LITERALS
+ /* Whether this string originated as a string literal in Lisp code. */
+ bool literal;
+#endif
} s;
struct Lisp_String *next;
GCALIGNED_UNION_MEMBER
diff --git a/src/lread.c b/src/lread.c
index 273120315df..23d8a1489c1 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1411,6 +1411,10 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
specbind (Qlread_unescaped_character_literals, Qnil);
record_unwind_protect (load_warn_unescaped_character_literals, file);
+#ifdef CHECK_STRING_LITERALS
+ specbind (Qlread_unescaped_character_literals, Qnil);
+#endif
+
bool is_elc = suffix_p (found, ".elc");
if (is_elc
/* version = 1 means the file is empty, in which case we can
@@ -2230,6 +2234,10 @@ readevalloop (Lisp_Object readcharfun,
? Qnil : list1 (Qt)));
specbind (Qmacroexp__dynvars, Vmacroexp__dynvars);
+#ifdef CHECK_STRING_LITERALS
+ specbind (Qread_string_literals, Qt);
+#endif
+
/* Ensure sourcename is absolute, except whilst preloading. */
if (!will_dump_p ()
&& !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename)))
@@ -3163,6 +3171,10 @@ read_string_literal (Lisp_Object readcharfun)
Lisp_Object obj = make_specified_string (read_buffer, nchars, p - read_buffer,
(force_multibyte
|| (p - read_buffer != nchars)));
+#ifdef CHECK_STRING_LITERALS
+ if (!NILP (Vread_string_literals))
+ XSTRING (obj)->u.s.literal = true;
+#endif
return unbind_to (count, obj);
}
@@ -3363,7 +3375,14 @@ string_props_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun)
invalid_syntax ("Invalid string property list", readcharfun);
Lisp_Object plist = XCAR (tl);
tl = XCDR (tl);
+#ifdef CHECK_STRING_LITERALS
+ bool lit = XSTRING (obj)->u.s.literal;
+ XSTRING (obj)->u.s.literal = false;
+#endif
Fset_text_properties (beg, end, plist, obj);
+#ifdef CHECK_STRING_LITERALS
+ XSTRING (obj)->u.s.literal = lit;
+#endif
}
return obj;
}
@@ -5452,6 +5471,21 @@ syms_of_lread (void)
doc: /* Non-nil means read recursive structures using #N= and #N# syntax. */);
Vread_circle = Qt;
+#ifdef CHECK_STRING_LITERALS
+ DEFVAR_LISP ("read-string-literals", Vread_string_literals,
+ doc: /* Non-nil means read string literals as literals. */);
+ Vread_string_literals = Qnil;
+ DEFSYM (Qread_string_literals, "read-string-literals");
+ DEFVAR_LISP ("string-literal-property-change",
+ Vstring_literal_property_change,
+ doc: /* How to handle changes to properties in literal strings.
+If `error', raise an error.
+If `warn', emit a warning.
+If `nil', do nothing. */);
+ Vstring_literal_property_change = Qerror;
+ DEFSYM (Qwarn, "warn");
+#endif
+
DEFVAR_LISP ("load-path", Vload_path,
doc: /* List of directories to search for files to load.
Each element is a string (directory file name) or nil (meaning
diff --git a/src/textprop.c b/src/textprop.c
index f88fff19c59..2a57262ec67 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -1164,6 +1164,36 @@ DEFUN ("previous-single-property-change", Fprevious_single_property_change,
return make_fixnum (previous->position + LENGTH (previous));
}
\f
+
+#ifdef CHECK_STRING_LITERALS
+__attribute__((noinline)) void
+string_literal_prop_change (Lisp_Object object);
+
+__attribute__((noinline)) void
+string_literal_prop_change (Lisp_Object object)
+{
+ Lisp_Object how = Vstring_literal_property_change;
+ if (EQ (how, Qerror))
+ error ("Attempt to modify properties of literal string \"%s\"",
+ SSDATA (object));
+ else if (EQ (how, Qwarn))
+ call2 (intern ("warn"),
+ build_string
+ ("Attempt to modify properties of literal string %S"),
+ object);
+}
+#endif
+
+static void
+check_string_literal_prop_change (Lisp_Object object)
+{
+#ifdef CHECK_STRING_LITERALS
+ if (STRINGP (object) && XSTRING (object)->u.s.literal
+ && SCHARS (object) > 0)
+ string_literal_prop_change (object);
+#endif
+}
+
/* Used by add-text-properties and add-face-text-property. */
static Lisp_Object
@@ -1184,6 +1214,8 @@ add_text_properties_1 (Lisp_Object start, Lisp_Object end,
destructive));
}
+ check_string_literal_prop_change (object);
+
INTERVAL i, unchanged;
ptrdiff_t s, len;
bool modified = false;
@@ -1399,6 +1431,15 @@ set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties,
object, coherent_change_p));
}
+#ifdef CHECK_STRING_LITERALS
+ // Don't complain about removal of properties from a string without any.
+ if (STRINGP (object) && !(!string_intervals (object)
+ && NILP (properties)
+ && BASE_EQ (start, make_fixnum (0))
+ && BASE_EQ (end, make_fixnum (SCHARS (object)))))
+ check_string_literal_prop_change (object);
+#endif
+
INTERVAL i;
bool first_time = true;
@@ -1483,6 +1524,8 @@ set_text_properties_1 (Lisp_Object start, Lisp_Object end,
return;
}
+ check_string_literal_prop_change (object);
+
INTERVAL prev_changed = NULL;
ptrdiff_t s = XFIXNUM (start);
ptrdiff_t len = XFIXNUM (end) - s;
@@ -1578,6 +1621,8 @@ DEFUN ("remove-text-properties", Fremove_text_properties,
object));
}
+ check_string_literal_prop_change (object);
+
INTERVAL i, unchanged;
ptrdiff_t s, len;
bool modified = false;
@@ -1704,6 +1749,8 @@ DEFUN ("remove-list-of-text-properties", Fremove_list_of_text_properties,
object));
}
+ check_string_literal_prop_change (object);
+
INTERVAL i, unchanged;
ptrdiff_t s, len;
bool modified = false;
next prev parent reply other threads:[~2023-04-16 14:53 UTC|newest]
Thread overview: 29+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-04-14 23:04 bug#62847: 29.0.90; Propertized space in Org Agenda's mode-name Gustavo Barros
2023-04-15 9:38 ` Ihor Radchenko
2023-04-15 9:49 ` Eli Zaretskii
2023-04-15 10:02 ` Ihor Radchenko
2023-04-15 10:24 ` Eli Zaretskii
2023-04-15 10:40 ` Ihor Radchenko
2023-04-15 10:55 ` Eli Zaretskii
2023-04-15 11:28 ` Gustavo Barros
2023-04-15 11:44 ` Ihor Radchenko
2023-04-15 11:49 ` Gustavo Barros
2023-04-15 12:08 ` Ihor Radchenko
2023-04-15 13:21 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-04-16 11:23 ` Ihor Radchenko
2023-04-16 11:49 ` Gustavo Barros
2023-04-15 11:38 ` Eli Zaretskii
2023-04-15 11:44 ` Ihor Radchenko
2023-04-15 11:45 ` Eli Zaretskii
2023-04-15 13:15 ` Mattias Engdegård
2023-04-16 11:29 ` Ihor Radchenko
2023-04-16 12:02 ` Mattias Engdegård
2023-04-16 12:17 ` Ihor Radchenko
2023-04-16 12:58 ` Eli Zaretskii
2023-04-16 13:14 ` Ihor Radchenko
2023-04-16 14:43 ` Eli Zaretskii
2023-04-16 14:52 ` Ihor Radchenko
2023-04-16 15:17 ` Eli Zaretskii
2023-04-16 14:51 ` Mattias Engdegård
2023-04-16 14:53 ` Mattias Engdegård [this message]
2023-04-16 12:38 ` Daniel Mendler
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=EC33F871-1584-47D0-997E-E49D91205D2D@acm.org \
--to=mattiase@acm.org \
--cc=62847@debbugs.gnu.org \
--cc=eliz@gnu.org \
--cc=gusbrs.2016@gmail.com \
--cc=monnier@iro.umontreal.ca \
--cc=yantar92@posteo.net \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).