Re: Redisplay hook error backtraces

[Alan Mackenzie]

Hello, Eli.

On Sat, Jul 16, 2022 at 09:12:48 +0300, Eli Zaretskii wrote:
> > Date: Thu, 14 Jul 2022 19:33:09 +0000
> > Cc: larsi@gnus.org, monnier@iro.umontreal.ca, emacs-devel@gnu.org
> > From: Alan Mackenzie <acm@muc.de>

> > > > I think I understand what you're saying, now.  That a condition-case
> > > > called from Lisp will not use any of the internal_condition_case*
> > > > functions.  So we could just assume that if i_c_case* triggers, it must 
> > > > be
> > > > one of the hooks we're interested in that called it.

> > > > I don't think that's right.  It might well be that Lisp code calls a C
> > > > primitive function that itself uses an internal_condition_case.  In this
> > > > scenario, we would not want to generate a backtrace for that nested
> > > > internal_condition_case.

> > > And we won't, because redisplaying_p won't be set.

> > I don't understand.  If redisplay is called normally, it will go through
> > redisplay_internal which sets redisplaying_p to true.  And it will stay
> > true till the end of redisplay_internal, unless one of two special things
> > happen: (i) We enter the debugger; (ii) there's a recursive edit.

> > I don't see how the new backtrace facility can get any useful information
> > out of redisplaying_p; if there were a nested internal_condition_case*,
> > redisplaying_p would still be true, surely?

> > What am I missing?

> My point is that redisplaying_p tells you the code which runs was
> invoked from redisplay, and that allows you to distinguish calls to
> internal_condition_case* that are of interest (i.e. should produce a
> backtrace in the *Backtrace* buffer) from those which aren't of
> interest.  Which was the issue you raised against my suggestion to
> rely on the fact that Lisp only ever uses a single form of
> internal_condition_case* functions.

> To recap: this sub-thread started when you said you don't want to
> cause all calls to internal_condition_case* to generate backtrace in
> this new way.  To which I suggested to bind a variable in
> internal_condition_case that would prevent generation of backtrace,
> relying on redisplaying_p to tell us when the other
> internal_condition_case* functions are called outside of redisplay.

OK.  I'm a little concerned that we'll be getting too many backtraces.
But my "solution" to that wouldn't have done any good anyhow.

I've got rid of redisplay_lisping, renamed backtrace_.... to
backtrace-on-redisplay-error (without the s), and the patch, somewhat
smaller than before, is below.

I'll amend the documentation later.



diff --git a/src/eval.c b/src/eval.c
index 141d2546f0..2940f33512 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -57,6 +57,12 @@ Lisp_Object Vrun_hooks;
 /* FIXME: We should probably get rid of this!  */
 Lisp_Object Vsignaling_function;
 
+/* The handler structure which will catch errors in Lisp hooks called
+   from redisplay.  We do not use it for this; we compare it with the
+   handler which is about to be used in signal_or_quit, and if it
+   matches, cause a backtrace to be generated.  */
+static struct handler *redisplay_deep_handler;
+
 /* These would ordinarily be static, but they need to be visible to GDB.  */
 bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE;
 Lisp_Object *backtrace_args (union specbinding *) EXTERNALLY_VISIBLE;
@@ -246,6 +252,7 @@ init_eval (void)
   lisp_eval_depth = 0;
   /* This is less than the initial value of num_nonmacro_input_events.  */
   when_entered_debugger = -1;
+  redisplay_deep_handler = NULL;
 }
 
 /* Ensure that *M is at least A + B if possible, or is its maximum
@@ -333,7 +340,8 @@ call_debugger (Lisp_Object arg)
   /* Interrupting redisplay and resuming it later is not safe under
      all circumstances.  So, when the debugger returns, abort the
      interrupted redisplay by going back to the top-level.  */
-  if (debug_while_redisplaying)
+  if (debug_while_redisplaying
+      && !EQ (Vdebugger, Qdebug_early))
     Ftop_level ();
 
   return unbind_to (count, val);
@@ -1552,12 +1560,16 @@ internal_condition_case_n (Lisp_Object (*bfun) 
(ptrdiff_t, Lisp_Object *),
                                                ptrdiff_t nargs,
                                                Lisp_Object *args))
 {
+  struct handler *old_deep = redisplay_deep_handler;
   struct handler *c = push_handler (handlers, CONDITION_CASE);
+  if (redisplaying_p)
+    redisplay_deep_handler = c;
   if (sys_setjmp (c->jmp))
     {
       Lisp_Object val = handlerlist->val;
       clobbered_eassert (handlerlist == c);
       handlerlist = handlerlist->next;
+      redisplay_deep_handler = old_deep;
       return hfun (val, nargs, args);
     }
   else
@@ -1565,6 +1577,7 @@ internal_condition_case_n (Lisp_Object (*bfun) 
(ptrdiff_t, Lisp_Object *),
       Lisp_Object val = bfun (nargs, args);
       eassert (handlerlist == c);
       handlerlist = c->next;
+      redisplay_deep_handler = old_deep;
       return val;
     }
 }
@@ -1697,6 +1710,11 @@ quit (void)
   return signal_or_quit (Qquit, Qnil, true);
 }
 
+/* Has an error in redisplay giving rise to a backtrace occurred as
+   yet in the current command?  This gets reset in the command
+   loop.  */
+bool backtrace_yet = false;
+
 /* Signal an error, or quit.  ERROR_SYMBOL and DATA are as with Fsignal.
    If KEYBOARD_QUIT, this is a quit; ERROR_SYMBOL should be
    Qquit and DATA should be Qnil, and this function may return.
@@ -1812,6 +1830,40 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object 
data, bool keyboard_quit)
       unbind_to (count, Qnil);
     }
 
+  /* If an error is signalled during a Lisp hook in redisplay, write a
+     backtrace into the buffer *Redisplay-trace*.  */
+  if (!debugger_called && !NILP (error_symbol)
+      && backtrace_on_redisplay_error
+      && (NILP (clause) || h == redisplay_deep_handler)
+      && NILP (Vinhibit_debugger)
+      && !NILP (Ffboundp (Qdebug_early)))
+    {
+      max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100);
+      specpdl_ref count = SPECPDL_INDEX ();
+      ptrdiff_t counti = specpdl_ref_to_count (count);
+      AUTO_STRING (redisplay_trace, "*Redisplay_trace*");
+      Lisp_Object redisplay_trace_buffer;
+      AUTO_STRING (gap, "\n\n\n\n"); /* Separates things in *Redisplay-trace* 
*/
+      Lisp_Object delayed_warning;
+      max_ensure_room (&max_specpdl_size, counti, 200);
+      redisplay_trace_buffer = Fget_buffer_create (redisplay_trace, Qnil);
+      current_buffer = XBUFFER (redisplay_trace_buffer);
+      if (!backtrace_yet) /* Are we on the first backtrace of the command?  */
+       Ferase_buffer ();
+      else
+       Finsert (1, &gap);
+      backtrace_yet = true;
+      specbind (Qstandard_output, redisplay_trace_buffer);
+      specbind (Qdebugger, Qdebug_early);
+      call_debugger (list2 (Qerror, Fcons (error_symbol, data)));
+      unbind_to (count, Qnil);
+      delayed_warning = make_string
+       ("Error in a redisplay Lisp hook.  See buffer *Redisplay_trace*", 61);
+
+      Vdelayed_warnings_list = Fcons (list2 (Qerror, delayed_warning),
+                                     Vdelayed_warnings_list);
+    }
+
   if (!NILP (clause))
     {
       Lisp_Object unwind_data
@@ -4274,6 +4326,11 @@ Does not apply if quit is handled by a `condition-case'. 
 */);
   DEFVAR_BOOL ("debug-on-next-call", debug_on_next_call,
               doc: /* Non-nil means enter debugger before next `eval', `apply' 
or `funcall'.  */);
 
+  DEFVAR_BOOL ("backtrace-on-redisplay-error", backtrace_on_redisplay_error,
+              doc: /* Non-nil means create a backtrace if a lisp error occurs 
in redisplay.
+The backtrace is written to buffer *Redisplay-trace*.  */);
+  backtrace_on_redisplay_error = false;
+
   DEFVAR_BOOL ("debugger-may-continue", debugger_may_continue,
               doc: /* Non-nil means debugger may continue execution.
 This is nil when the debugger is called under circumstances where it
diff --git a/src/keyboard.c b/src/keyboard.c
index 2863058d63..6b2757f5b1 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -1330,6 +1330,7 @@ command_loop_1 (void)
        display_malloc_warning ();
 
       Vdeactivate_mark = Qnil;
+      backtrace_yet = false;
 
       /* Don't ignore mouse movements for more than a single command
         loop.  (This flag is set in xdisp.c whenever the tool bar is
@@ -1837,7 +1838,7 @@ safe_run_hooks_1 (ptrdiff_t nargs, Lisp_Object *args)
 static Lisp_Object
 safe_run_hooks_error (Lisp_Object error, ptrdiff_t nargs, Lisp_Object *args)
 {
-  eassert (nargs == 2);
+  eassert (nargs >= 2 && nargs <= 4);
   AUTO_STRING (format, "Error in %s (%S): %S");
   Lisp_Object hook = args[0];
   Lisp_Object fun = args[1];
@@ -1895,6 +1896,17 @@ safe_run_hooks (Lisp_Object hook)
   unbind_to (count, Qnil);
 }
 
+void
+safe_run_hooks_2 (Lisp_Object hook, Lisp_Object arg1, Lisp_Object arg2)
+{
+  specpdl_ref count = SPECPDL_INDEX ();
+
+  specbind (Qinhibit_quit, Qt);
+  run_hook_with_args (4, ((Lisp_Object []) {hook, hook, arg1, arg2}),
+                     safe_run_hook_funcall);
+  unbind_to (count, Qnil);
+}
+
 
 /* Nonzero means polling for input is temporarily suppressed.  */
 
diff --git a/src/lisp.h b/src/lisp.h
index dc496cc165..7caf5e2745 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4526,6 +4526,7 @@ extern Lisp_Object Vrun_hooks;
 extern Lisp_Object Vsignaling_function;
 extern Lisp_Object inhibit_lisp_code;
 extern bool signal_quit_p (Lisp_Object);
+extern bool backtrace_yet;
 
 /* To run a normal hook, use the appropriate function from the list below.
    The calling convention:
@@ -4823,6 +4824,7 @@ extern bool detect_input_pending (void);
 extern bool detect_input_pending_ignore_squeezables (void);
 extern bool detect_input_pending_run_timers (bool);
 extern void safe_run_hooks (Lisp_Object);
+extern void safe_run_hooks_2 (Lisp_Object, Lisp_Object, Lisp_Object);
 extern void cmd_error_internal (Lisp_Object, const char *);
 extern Lisp_Object command_loop_2 (Lisp_Object);
 extern Lisp_Object read_menu_command (void);
diff --git a/src/xdisp.c b/src/xdisp.c
index 1940d16a01..086875410c 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -17915,8 +17915,8 @@ run_window_scroll_functions (Lisp_Object window, struct 
text_pos startp)
     {
       specpdl_ref count = SPECPDL_INDEX ();
       specbind (Qinhibit_quit, Qt);
-      run_hook_with_args_2 (Qwindow_scroll_functions, window,
-                           make_fixnum (CHARPOS (startp)));
+      safe_run_hooks_2
+       (Qwindow_scroll_functions, window, make_fixnum (CHARPOS (startp)));
       unbind_to (count, Qnil);
       SET_TEXT_POS_FROM_MARKER (startp, w->start);
       /* In case the hook functions switch buffers.  */


-- 
Alan Mackenzie (Nuremberg, Germany).