unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
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;

  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).