Message's text-properties in *Messages* (was: edebug: regrettable loss of information in Emacs 26.1 when printing a variable's value)

[Stefan Monnier]

> blue), but it isn't, not sure why. The button property doesn't seem to
> make it into *Messages* at all, we would probably need some special
> casing for that.

Indeed, text-properties aren't copied to the *Messages* buffer.
I think this should be fixed.

I'm playing with the work-in-progress below for that, but I have
a question about message_dolog.  Its comment says:

    /* Add a string M of length NBYTES to the message log, optionally
       terminated with a newline when NLFLAG is true.  MULTIBYTE, if
       true, means interpret the contents of M as multibyte.  This
       function calls low-level routines in order to bypass text property
       hooks, etc. which might not be safe to run.
    
       This may GC (insert may run before/after change hooks),
       so the buffer M must NOT point to a Lisp string.  */

I find this somewhat confusing:
- Not sure which text property hooks it's referring to.
- It first says "... hooks, etc. which might not be safe to run" but later
  "(insert may run before/after change hooks)".
  Aren't before/after hooks just as dangerous as others?
- The code actually doesn't seem to run before/after change hooks.
- But the code does call `messages-buffer-mode` (when (re)creating the
  buffer), so it does run potentially arbitrary Lisp code.
- Why would arbitrary Lisp code be dangerous (I understand that message_dolog
  can be called from within redisplay, but redisplay runs Elisp code
  at several places, so "from redidplay" doesn't inherently imply you
  can't run Elisp code).

The work-in-progress patch below adds a new message_dolog_lisp which
uses higher-level operations which preserve text-properties.  It tries
to avoid running hooks by temporarily binding inhibit-<foo>-hooks.

To a large extent my question is whether those inhibit-<foo>-hooks would
make it safe enough to replace message_dolog with message_dolog_lisp
(aka rather reimplement message_dolog on top of message_dolog_lisp), or
whether we really need to keep the "safer" message_dolog (in which case
I'll have to work harder at sharing more code between the two).


        Stefan


diff --git a/src/lisp.h b/src/lisp.h
index 23e3989c27..ed163fa86c 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3737,6 +3737,7 @@ extern void message1_nolog (const char *);
 extern void message3 (Lisp_Object);
 extern void message3_nolog (Lisp_Object);
 extern void message_dolog (const char *, ptrdiff_t, bool, bool);
+extern void message_dolog_lisp (Lisp_Object s, bool nlflag);
 extern void message_with_string (const char *, Lisp_Object, bool);
 extern void message_log_maybe_newline (void);
 extern void update_echo_area (void);
diff --git a/src/xdisp.c b/src/xdisp.c
index f2f4392493..2af0bbc02f 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -10334,6 +10334,21 @@ message_log_maybe_newline (void)
     message_dolog ("", 0, true, false);
 }
 
+static void message_postprocess_log (void);
+
+static void message_set_log_buffer (void)
+{
+  /* Ensure the Messages buffer exists, and switch to it.
+     If we created it, set the major-mode.  */
+  bool newbuffer = NILP (Fget_buffer (Vmessages_buffer_name));
+  Fset_buffer (Fget_buffer_create (Vmessages_buffer_name));
+  if (newbuffer
+      && !NILP (Ffboundp (intern ("messages-buffer-mode"))))
+    call0 (intern ("messages-buffer-mode"));
+
+  bset_undo_list (current_buffer, Qt);
+  bset_cache_long_scans (current_buffer, Qnil);
+}
 
 /* Add a string M of length NBYTES to the message log, optionally
    terminated with a newline when NLFLAG is true.  MULTIBYTE, if
@@ -10355,40 +10370,21 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool 
nlflag, bool multibyte)
   if (!NILP (Vmessage_log_max))
     {
       struct buffer *oldbuf;
-      Lisp_Object oldpoint, oldbegv, oldzv;
+      Lisp_Object oldpoint, oldzv;
       int old_windows_or_buffers_changed = windows_or_buffers_changed;
-      ptrdiff_t point_at_end = 0;
-      ptrdiff_t zv_at_end = 0;
-      Lisp_Object old_deactivate_mark;
-
-      old_deactivate_mark = Vdeactivate_mark;
+      Lisp_Object old_deactivate_mark = Vdeactivate_mark;
       oldbuf = current_buffer;
 
-      /* Ensure the Messages buffer exists, and switch to it.
-         If we created it, set the major-mode.  */
-      bool newbuffer = NILP (Fget_buffer (Vmessages_buffer_name));
-      Fset_buffer (Fget_buffer_create (Vmessages_buffer_name));
-      if (newbuffer
-         && !NILP (Ffboundp (intern ("messages-buffer-mode"))))
-       call0 (intern ("messages-buffer-mode"));
-
-      bset_undo_list (current_buffer, Qt);
-      bset_cache_long_scans (current_buffer, Qnil);
+      message_set_log_buffer ();
 
       oldpoint = message_dolog_marker1;
       set_marker_restricted_both (oldpoint, Qnil, PT, PT_BYTE);
-      oldbegv = message_dolog_marker2;
-      set_marker_restricted_both (oldbegv, Qnil, BEGV, BEGV_BYTE);
       oldzv = message_dolog_marker3;
       set_marker_restricted_both (oldzv, Qnil, ZV, ZV_BYTE);
 
-      if (PT == Z)
-       point_at_end = 1;
-      if (ZV == Z)
-       zv_at_end = 1;
+      bool point_at_end = (PT == Z);
+      bool zv_at_end = (ZV == Z);
 
-      BEGV = BEG;
-      BEGV_BYTE = BEG_BYTE;
       ZV = Z;
       ZV_BYTE = Z_BYTE;
       TEMP_SET_PT_BOTH (Z, Z_BYTE);
@@ -10432,58 +10428,7 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool 
nlflag, bool multibyte)
                       true, false, false);
 
       if (nlflag)
-       {
-         ptrdiff_t this_bol, this_bol_byte, prev_bol, prev_bol_byte;
-         printmax_t dups;
-
-         insert_1_both ("\n", 1, 1, true, false, false);
-
-         scan_newline (Z, Z_BYTE, BEG, BEG_BYTE, -2, false);
-         this_bol = PT;
-         this_bol_byte = PT_BYTE;
-
-         /* See if this line duplicates the previous one.
-            If so, combine duplicates.  */
-         if (this_bol > BEG)
-           {
-             scan_newline (PT, PT_BYTE, BEG, BEG_BYTE, -2, false);
-             prev_bol = PT;
-             prev_bol_byte = PT_BYTE;
-
-             dups = message_log_check_duplicate (prev_bol_byte,
-                                                  this_bol_byte);
-             if (dups)
-               {
-                 del_range_both (prev_bol, prev_bol_byte,
-                                 this_bol, this_bol_byte, false);
-                 if (dups > 1)
-                   {
-                     char dupstr[sizeof " [ times]"
-                                 + INT_STRLEN_BOUND (printmax_t)];
-
-                     /* If you change this format, don't forget to also
-                        change message_log_check_duplicate.  */
-                     int duplen = sprintf (dupstr, " [%"pMd" times]", dups);
-                     TEMP_SET_PT_BOTH (Z - 1, Z_BYTE - 1);
-                     insert_1_both (dupstr, duplen, duplen,
-                                    true, false, true);
-                   }
-               }
-           }
-
-         /* If we have more than the desired maximum number of lines
-            in the *Messages* buffer now, delete the oldest ones.
-            This is safe because we don't have undo in this buffer.  */
-
-         if (NATNUMP (Vmessage_log_max))
-           {
-             scan_newline (Z, Z_BYTE, BEG, BEG_BYTE,
-                           -XFASTINT (Vmessage_log_max) - 1, false);
-             del_range_both (BEG, BEG_BYTE, PT, PT_BYTE, false);
-           }
-       }
-      BEGV = marker_position (oldbegv);
-      BEGV_BYTE = marker_byte_position (oldbegv);
+        message_postprocess_log ();
 
       if (zv_at_end)
        {
@@ -10505,7 +10450,6 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool 
nlflag, bool multibyte)
                          marker_byte_position (oldpoint));
 
       unchain_marker (XMARKER (oldpoint));
-      unchain_marker (XMARKER (oldbegv));
       unchain_marker (XMARKER (oldzv));
 
       /* We called insert_1_both above with its 5th argument (PREPARE)
@@ -10524,6 +10468,129 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool 
nlflag, bool multibyte)
     }
 }
 
+static void
+message_postprocess_log (void)
+{
+  ptrdiff_t this_bol, this_bol_byte, prev_bol, prev_bol_byte;
+  printmax_t dups;
+
+  Lisp_Object oldbegv = message_dolog_marker2;
+  set_marker_restricted_both (oldbegv, Qnil, BEGV, BEGV_BYTE);
+  BEGV = BEG;
+  BEGV_BYTE = BEG_BYTE;
+
+  insert_1_both ("\n", 1, 1, true, false, false);
+
+  scan_newline (Z, Z_BYTE, BEG, BEG_BYTE, -2, false);
+  this_bol = PT;
+  this_bol_byte = PT_BYTE;
+
+  /* See if this line duplicates the previous one.
+            If so, combine duplicates.  */
+  if (this_bol > BEG)
+    {
+      scan_newline (PT, PT_BYTE, BEG, BEG_BYTE, -2, false);
+      prev_bol = PT;
+      prev_bol_byte = PT_BYTE;
+
+      dups = message_log_check_duplicate (prev_bol_byte,
+                                          this_bol_byte);
+      if (dups)
+       {
+         del_range_both (prev_bol, prev_bol_byte,
+                         this_bol, this_bol_byte, false);
+         if (dups > 1)
+           {
+             char dupstr[sizeof " [ times]"
+                         + INT_STRLEN_BOUND (printmax_t)];
+
+             /* If you change this format, don't forget to also
+                        change message_log_check_duplicate.  */
+             int duplen = sprintf (dupstr, " [%"pMd" times]", dups);
+             TEMP_SET_PT_BOTH (Z - 1, Z_BYTE - 1);
+             insert_1_both (dupstr, duplen, duplen,
+                            true, false, true);
+           }
+       }
+    }
+
+  /* If we have more than the desired maximum number of lines
+            in the *Messages* buffer now, delete the oldest ones.
+            This is safe because we don't have undo in this buffer.  */
+
+  if (NATNUMP (Vmessage_log_max))
+    {
+      scan_newline (Z, Z_BYTE, BEG, BEG_BYTE,
+                   -XFASTINT (Vmessage_log_max) - 1, false);
+      del_range_both (BEG, BEG_BYTE, PT, PT_BYTE, false);
+    }
+
+  BEGV = marker_position (oldbegv);
+  BEGV_BYTE = marker_byte_position (oldbegv);
+
+  unchain_marker (XMARKER (oldbegv));
+}
+
+/* Add a string S to the message log, optionally
+   terminated with a newline when NLFLAG is true.  */
+void message_dolog_lisp (Lisp_Object s, bool nlflag)
+{
+  if (!NILP (Vmemory_full) || NILP (Vmessage_log_max))
+    return;
+
+  struct buffer *oldbuf = current_buffer;
+  ptrdiff_t count = SPECPDL_INDEX ();
+  Lisp_Object old_deactivate_mark = Vdeactivate_mark;
+
+  message_set_log_buffer ();
+  specbind (Qinhibit_modification_hooks, Qt);
+  specbind (Qinhibit_read_only, Qt);
+  specbind (Qinhibit_point_motion_hooks, Qt);
+
+  Lisp_Object oldpoint = message_dolog_marker1;
+  set_marker_restricted_both (oldpoint, Qnil, PT, PT_BYTE);
+  Lisp_Object oldzv = message_dolog_marker3;
+  set_marker_restricted_both (oldzv, Qnil, ZV, ZV_BYTE);
+
+  bool point_at_end = PT == Z;
+  bool zv_at_end = (ZV == Z);
+
+  ZV = Z;
+  ZV_BYTE = Z_BYTE;
+  TEMP_SET_PT_BOTH (ZV, ZV_BYTE);
+  insert_from_string (s, 0, 0, SCHARS (s), SBYTES (s), true);
+
+  if (nlflag)
+    message_postprocess_log ();
+
+  if (zv_at_end)
+    {
+      ZV = Z;
+      ZV_BYTE = Z_BYTE;
+    }
+  else
+    {
+      ZV = marker_position (oldzv);
+      ZV_BYTE = marker_byte_position (oldzv);
+    }
+
+  if (point_at_end)
+    TEMP_SET_PT_BOTH (ZV, ZV_BYTE);
+  else
+    /* We can't do Fgoto_char (oldpoint) because it will run some
+       Lisp code.  */
+    TEMP_SET_PT_BOTH (marker_position (oldpoint),
+                     marker_byte_position (oldpoint));
+
+  unchain_marker (XMARKER (oldpoint));
+  unchain_marker (XMARKER (oldzv));
+
+  set_buffer_internal (oldbuf);
+  message_log_need_newline = !nlflag;
+  Vdeactivate_mark = old_deactivate_mark;
+  unbind_to (count, Qnil);
+}
+
 
 /* We are at the end of the buffer after just having inserted a newline.
    (Note: We depend on the fact we won't be crossing the gap.)
@@ -10577,15 +10644,7 @@ message3 (Lisp_Object m)
   /* First flush out any partial line written with print.  */
   message_log_maybe_newline ();
   if (STRINGP (m))
-    {
-      ptrdiff_t nbytes = SBYTES (m);
-      bool multibyte = STRING_MULTIBYTE (m);
-      char *buffer;
-      USE_SAFE_ALLOCA;
-      SAFE_ALLOCA_STRING (buffer, m);
-      message_dolog (buffer, nbytes, true, multibyte);
-      SAFE_FREE ();
-    }
+    message_dolog_lisp (m, true);
   if (! inhibit_message)
     message3_nolog (m);
 }
@@ -32567,6 +32626,10 @@ They are still logged to the *Messages* buffer.  */);
   staticpro (&message_dolog_marker2);
   message_dolog_marker3 = Fmake_marker ();
   staticpro (&message_dolog_marker3);
+  /* marker1 and marker3 are used for PT and ZV respectively and insertion
+     should "push them down".  */
+  XMARKER (message_dolog_marker1)->insertion_type = true;
+  XMARKER (message_dolog_marker3)->insertion_type = true;
 
   defsubr (&Sset_buffer_redisplay);
 #ifdef GLYPH_DEBUG