Implement `debug-on-message'.

This allows tracking down what piece of code is outputting stuff in
the echo area.

* eval.c (call_debugger): Make the function non-static so that we
can call it from set_message.

* xdisp.c (set_message): Implement the new variable `debug-on-message'.
(syms_of_xdisp): Defvar it and `inhibit-debug-on-message'.

4 files changed, 31 insertions, 2 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index ea3b3a92e01..d7a263df229 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,11 @@
+2012-09-04  Lars Ingebrigtsen  <larsi@gnus.org>
+
+        * eval.c (call_debugger): Make the function non-static so that we
+        can call it from set_message.
+
+        * xdisp.c (set_message): Implement the new variable `debug-on-message'.
+        (syms_of_xdisp): Defvar it and `inhibit-debug-on-message'.
+
 2012-09-04  Paul Eggert  <eggert@cs.ucla.edu>
 
         Give more-useful info on a fatal error (Bug#12328).
diff --git a/src/eval.c b/src/eval.c
index 1015b013a26..4f0d6c69a51 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -191,7 +191,7 @@ restore_stack_limits (Lisp_Object data)
 
 /* Call the Lisp debugger, giving it argument ARG.  */
 
-static Lisp_Object
+Lisp_Object
 call_debugger (Lisp_Object arg)
 {
   bool debug_while_redisplaying;
diff --git a/src/lisp.h b/src/lisp.h
index 9ee9cd74b56..78c418f3051 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3076,6 +3076,7 @@ extern _Noreturn void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
 extern _Noreturn void verror (const char *, va_list)
   ATTRIBUTE_FORMAT_PRINTF (1, 0);
 extern Lisp_Object un_autoload (Lisp_Object);
+extern Lisp_Object call_debugger (Lisp_Object arg);
 extern void init_eval_once (void);
 extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...);
 extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object);
diff --git a/src/xdisp.c b/src/xdisp.c
index f543a96d6b3..90a8de0be27 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -364,6 +364,7 @@ static Lisp_Object Qslice;
 Lisp_Object Qcenter;
 static Lisp_Object Qmargin, Qpointer;
 static Lisp_Object Qline_height;
+Lisp_Object Qinhibit_debug_on_message;
 
 /* These setters are used only in this file, so they can be private.  */
 static inline void
@@ -10571,7 +10572,6 @@ truncate_message_1 (ptrdiff_t nchars, Lisp_Object a2, ptrdiff_t a3, ptrdiff_t a4
   return 0;
 }
 
-
 /* Set the current message to a substring of S or STRING.
 
    If STRING is a Lisp string, set the message to the first NBYTES
@@ -10590,6 +10590,8 @@ static void
 set_message (const char *s, Lisp_Object string,
              ptrdiff_t nbytes, int multibyte_p)
 {
+  ptrdiff_t count = SPECPDL_INDEX ();
+
   message_enable_multibyte
     = ((s && multibyte_p)
        || (STRINGP (string) && STRING_MULTIBYTE (string)));
@@ -10598,6 +10600,15 @@ set_message (const char *s, Lisp_Object string,
                          (intptr_t) s, string, nbytes, multibyte_p);
   message_buf_print = 0;
   help_echo_showing_p = 0;
+
+  if (NILP (Vinhibit_debug_on_message) &&
+      STRINGP (Vdebug_on_message) &&
+      fast_string_match (Vdebug_on_message, string) >= 0) {
+    specbind (Qinhibit_debug_on_message, Qt);
+    call_debugger (Fcons (Qerror, Fcons (string, Qnil)));
+  }
+
+  unbind_to (count, Qnil);
 }
 
 
@@ -29299,6 +29310,15 @@ Its value should be an ASCII acronym string, `hex-code', `empty-box', or
   Vglyphless_char_display = Fmake_char_table (Qglyphless_char_display, Qnil);
   Fset_char_table_extra_slot (Vglyphless_char_display, make_number (0),
                               Qempty_box);
+
+  DEFVAR_LISP ("debug-on-message", Vdebug_on_message,
+               doc: /* If non-nil, debug if a message matching this regexp is displayed.  */);
+  Vdebug_on_message = Qnil;
+
+  DEFVAR_LISP ("inhibit-debug-on-message", Vinhibit_debug_on_message,
+               doc: /* If non-nil, inhibit `debug-on-message' from entering the debugger.  */);
+  Vinhibit_debug_on_message = Qnil;
+  DEFSYM(Qinhibit_debug_on_message, "inhibit-debug-on-message");
 }