Re: Redisplay hook error backtraces

[Alan Mackenzie <acm@muc.de>]

Hello, Eli.

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

> > > You want to distinguish errors inside condition-case?

> > More, distinguish the different condition-cases in which errors might
> > occur.

> What else is exposed to Lisp?

I don't understand this question.

> We are talking about catching Lisp errors only, right?

Yes.

> > > > > Can we discuss how to implement it without introducing a
> > > > > special handler and without adding new safe_run_hooks_*
> > > > > functions?

> > I think we need the new function safe_run_hooks_2_with_backtrace (see
> > below), since there is currently no "safe" function for hooks with
> > two arguments.  But some of the other ones could disappear (see
> > below).

> What is the second argument, and why do we need it?

There are three arguments, the non-standard hook, and the two arguments
which will be fed to that hook.

Currently, that hook (window-scroll-functions) is called with
run_hook_with_args_2, which doesn't have a "safe" in its functionality,
which we need.  My change is to use safe_run_hooks_2 (a new function)
instead.

> > OK, I have an idea.  I restore the variable redisplay_lisping back
> > into the code (I took it out last night), binding it to true (or Qt?)
> > at every place in xdisp.c where redisplay calls a Lisp hook.

> These all go through a single function, so there's just one place to
> do that.

I disagree.  There are seven places, for the seven different Lisp hooks
currently called from redisplay.

> > I then test that variable in internal_condition_case_n in place of
> > having the extra bool argument to that function.

Done.

> > That would then get rid of the new functions
> > safe_run_hooks_with_backtrace_funcall and safe_run_hooks_with_backtrace.
> > We could also rename safe_run_hooks_2_with_backtrace by removing
> > "_with_backtrace" from the name.

Also done.

> > What do you think?

> Sounds good, but let's see the code.

See below.

> And I still would like you to explore Stefan's suggestion, since doing
> too much non-trivial Lisp stuff in signal_or_quit is better avoided.

I still don't understand this.  The Lisp in debug-early.el is about as
trivial as you can get whilst still doing anything at all.  It doesn't
use any other Lisp libraries, only the C primitives.  (At least, that was
the case, and could and should be restored.)

But can we talk about this in the other branch of this thread which
already goes into some detail about this, please?

Here's the current version of the patch:



diff --git a/src/dispextern.h b/src/dispextern.h
index ca7834dec5..af490f574e 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -3410,6 +3410,7 @@ int partial_line_height (struct it *it_origin);
 bool in_display_vector_p (struct it *);
 int frame_mode_line_height (struct frame *);
 extern bool redisplaying_p;
+extern bool redisplay_lisping;
 extern bool display_working_on_window_p;
 extern void unwind_display_working_on_window (void);
 extern bool help_echo_showing_p;
diff --git a/src/eval.c b/src/eval.c
index 141d2546f0..edadf64434 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;
@@ -333,7 +339,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);
@@ -1553,11 +1560,14 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
 						Lisp_Object *args))
 {
   struct handler *c = push_handler (handlers, CONDITION_CASE);
+  if (redisplay_lisping)
+    redisplay_deep_handler = c;
   if (sys_setjmp (c->jmp))
     {
       Lisp_Object val = handlerlist->val;
       clobbered_eassert (handlerlist == c);
       handlerlist = handlerlist->next;
+      redisplay_deep_handler = NULL;
       return hfun (val, nargs, args);
     }
   else
@@ -1565,6 +1575,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 = NULL;
       return val;
     }
 }
@@ -1697,6 +1708,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 +1828,39 @@ 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 *Backtrace*.  */
+  if (!debugger_called && !NILP (error_symbol)
+      && backtrace_on_redisplay_lisp_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 (backtrace, "*Backtrace*");
+      Lisp_Object backtrace_buffer;
+      AUTO_STRING (gap, "\n\n\n\n"); /* Separates backtraces in *Backtrace* */
+      Lisp_Object delayed_warning;
+      max_ensure_room (&max_specpdl_size, counti, 200);
+      backtrace_buffer = Fget_buffer_create (backtrace, Qnil);
+      current_buffer = XBUFFER (backtrace_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, backtrace_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 *Backtrace*", 55);
+
+      Vdelayed_warnings_list = Fcons (list2 (Qerror, delayed_warning),
+				      Vdelayed_warnings_list);
+    }
+
   if (!NILP (clause))
     {
       Lisp_Object unwind_data
@@ -4274,6 +4323,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-lisp-error", backtrace_on_redisplay_lisp_error,
+	       doc: /* Non-nil means create a backtrace if a lisp error occurs in a redisplay hook.
+The backtrace is written to buffer *Backtrace*.  */);
+  backtrace_on_redisplay_lisp_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 c729d5dfb3..e886f571ce 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
@@ -1823,12 +1824,18 @@ adjust_point_for_property (ptrdiff_t last_pt, bool modified)
 }
 
 /* Subroutine for safe_run_hooks: run the hook, which is ARGS[1].  */
-
 static Lisp_Object
 safe_run_hooks_1 (ptrdiff_t nargs, Lisp_Object *args)
 {
-  eassert (nargs == 2);
-  return call0 (args[1]);
+  eassert (nargs >= 2 && nargs <= 4);
+  switch (nargs) {
+  case 2:
+    return call0 (args[1]);
+  case 3:
+    return call1 (args[1], args[2]);
+  default:
+    return call2 (args[1], args[2], args[3]);
+  }
 }
 
 /* Subroutine for safe_run_hooks: handle an error by clearing out the function
@@ -1837,7 +1844,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 +1902,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);
+}
+
 \f
 /* 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 f205327cc3..092b1f2be2 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -1030,6 +1030,11 @@ static struct glyph_slice null_glyph_slice = { 0, 0, 0, 0 };
 
 bool redisplaying_p;
 
+/* True if a call to a Lisp hook from redisplay is currently in
+   progress.  */
+
+bool redisplay_lisping = false;
+
 /* True while some display-engine code is working on layout of some
    window.
 
@@ -3137,6 +3142,12 @@ CHECK_WINDOW_END (struct window *w)
 #endif
 }
 
+static void
+unwind_redisplay_lisping (int arg)
+{
+  redisplay_lisping = arg;
+}
+
 /***********************************************************************
 		       Iterator initialization
  ***********************************************************************/
@@ -4332,6 +4343,8 @@ handle_fontified_prop (struct it *it)
 
       val = Vfontification_functions;
       specbind (Qfontification_functions, Qnil);
+      record_unwind_protect_int (unwind_redisplay_lisping, redisplay_lisping);
+      redisplay_lisping = true;
 
       eassert (it->end_charpos == ZV);
 
@@ -12628,6 +12641,8 @@ set_message (Lisp_Object string)
     {
       specpdl_ref count = SPECPDL_INDEX ();
       specbind (Qinhibit_quit, Qt);
+      record_unwind_protect_int (unwind_redisplay_lisping, redisplay_lisping);
+      redisplay_lisping = true;
       message = safe_call1 (Vset_message_function, string);
       unbind_to (count, Qnil);
 
@@ -12705,6 +12720,8 @@ clear_message (bool current_p, bool last_displayed_p)
         {
           specpdl_ref count = SPECPDL_INDEX ();
           specbind (Qinhibit_quit, Qt);
+	  record_unwind_protect_int (unwind_redisplay_lisping, redisplay_lisping);
+	  redisplay_lisping = true;
           preserve = safe_call (1, Vclear_message_function);
           unbind_to (count, Qnil);
         }
@@ -13289,6 +13306,7 @@ prepare_menu_bars (void)
 {
   bool all_windows = windows_or_buffers_changed || update_mode_lines;
   bool some_windows = REDISPLAY_SOME_P ();
+  specpdl_ref count = SPECPDL_INDEX ();
 
   if (FUNCTIONP (Vpre_redisplay_function))
     {
@@ -13306,7 +13324,10 @@ prepare_menu_bars (void)
 		windows = Fcons (this, windows);
 	    }
 	}
+      record_unwind_protect_int (unwind_redisplay_lisping, redisplay_lisping);
+      redisplay_lisping = true;
       safe__call1 (true, Vpre_redisplay_function, windows);
+      unbind_to (count, Qnil);
     }
 
   /* Update all frame titles based on their buffer names, etc.  We do
@@ -13463,8 +13484,8 @@ update_menu_bar (struct frame *f, bool save_match_data, bool hooks_run)
 
 	  if (!hooks_run)
 	    {
-	      /* Run the Lucid hook.  */
-	      safe_run_hooks (Qactivate_menubar_hook);
+	      record_unwind_protect_int (unwind_redisplay_lisping, redisplay_lisping);
+	      redisplay_lisping = true;
 
 	      /* If it has changed current-menubar from previous value,
 		 really recompute the menu-bar from the value.  */
@@ -17915,8 +17936,10 @@ 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)));
+      record_unwind_protect_int (unwind_redisplay_lisping, redisplay_lisping);
+      redisplay_lisping = true;
+      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.  */
@@ -19419,6 +19442,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
 	 now actually do it.  */
       if (new_vpos >= 0)
 	{
+	  specpdl_ref count = SPECPDL_INDEX ();
 	  struct glyph_row *row;
 
 	  row = MATRIX_FIRST_TEXT_ROW (w->desired_matrix);
@@ -19444,7 +19468,10 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
 	     propagated its info to `w' anyway.  */
 	  w->redisplay = false;
 	  XBUFFER (w->contents)->text->redisplay = false;
+	  record_unwind_protect_int (unwind_redisplay_lisping, redisplay_lisping);
+	  redisplay_lisping = true;
 	  safe__call1 (true, Vpre_redisplay_function, Fcons (window, Qnil));
+	  unbind_to (count, Qnil);
 
 	  if (w->redisplay || XBUFFER (w->contents)->text->redisplay
 	      || ((EQ (Vdisplay_line_numbers, Qrelative)
@@ -36882,6 +36909,7 @@ init_xdisp (void)
   }
 
   help_echo_showing_p = false;
+  redisplay_lisping = false;
 }
 
 #ifdef HAVE_WINDOW_SYSTEM




> Thanks.

-- 
Alan Mackenzie (Nuremberg, Germany).