From: Stefan Monnier <monnier@iro.umontreal.ca>
To: emacs-devel@gnu.org
Subject: Message's text-properties in *Messages* (was: edebug: regrettable loss of information in Emacs 26.1 when printing a variable's value)
Date: Wed, 23 May 2018 12:03:45 -0400 [thread overview]
Message-ID: <jwvo9h6e5gw.fsf-monnier+gmane.emacs.devel@gnu.org> (raw)
In-Reply-To: CAM-tV-_mr7fGfQHo9fqG79uf6UEypRdduZnECc=w3sHo0xmN8Q@mail.gmail.com
> 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
next prev parent reply other threads:[~2018-05-23 16:03 UTC|newest]
Thread overview: 28+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-05-21 17:10 edebug: regrettable loss of information in Emacs 26.1 when printing a variable's value Alan Mackenzie
2018-05-21 17:47 ` Noam Postavsky
2018-05-21 18:23 ` Alan Mackenzie
2018-05-21 18:30 ` Eli Zaretskii
2018-05-21 21:20 ` Noam Postavsky
2018-05-22 16:53 ` Eli Zaretskii
2018-05-21 17:58 ` Eli Zaretskii
2018-05-21 19:04 ` Alan Mackenzie
2018-05-21 18:05 ` Stefan Monnier
2018-05-21 21:24 ` Noam Postavsky
2018-05-22 0:52 ` Stefan Monnier
2018-05-23 17:28 ` Stefan Monnier
2018-05-23 16:03 ` Stefan Monnier [this message]
2018-05-23 16:10 ` Message's text-properties in *Messages* (was: edebug: regrettable loss of information in Emacs 26.1 when printing a variable's value) Drew Adams
2018-05-23 16:46 ` Message's text-properties in *Messages* Stefan Monnier
2018-05-26 0:48 ` John Wiegley
2018-05-26 15:52 ` Stefan Monnier
2018-05-26 19:50 ` Amin Bandali
2018-05-27 14:36 ` John Wiegley
2018-05-27 21:28 ` Amin Bandali
2018-05-23 17:22 ` Message's text-properties in *Messages* (was: edebug: regrettable loss of information in Emacs 26.1 when printing a variable's value) Eli Zaretskii
2018-05-23 17:41 ` Message's text-properties in *Messages* Stefan Monnier
2018-05-23 18:07 ` Eli Zaretskii
2018-05-30 17:19 ` Eli Zaretskii
2018-05-30 19:44 ` Stefan Monnier
2018-05-30 19:55 ` Eli Zaretskii
2018-05-31 2:09 ` Stefan Monnier
2018-05-31 2:40 ` Eli Zaretskii
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
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=jwvo9h6e5gw.fsf-monnier+gmane.emacs.devel@gnu.org \
--to=monnier@iro.umontreal.ca \
--cc=emacs-devel@gnu.org \
/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 external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.