From e24e27be18156e7af5e8ec15a723225dfc7e22da Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Mon, 19 Sep 2011 17:14:23 -0400
Subject: [PATCH] * lisp/emacs-lisp/debug.el (debugger-args): Give it a
 docstring. (debugger-return-value): Signal an error if the debugging context
 does not await any return value.

---
 lisp/ChangeLog           |  4 +++
 lisp/emacs-lisp/debug.el | 67 ++++++++++++++++++++++++----------------
 2 files changed, 45 insertions(+), 26 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 258b0067d98..91bf69aa7a6 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,9 @@
 2011-09-19  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+	* emacs-lisp/debug.el (debugger-args): Give it a docstring.
+	(debugger-return-value): Signal an error if the debugging context does
+	not await any return value.
+
 	* ps-mule.el (ps-mule-plot-string): Don't inf-loop (bug#5108).
 	* image-mode.el (image-toggle-display-text)
 	(image-toggle-display-image): Stay away from evil `intangible'.
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 16258a5a3a1..d7021a46165 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -98,6 +98,16 @@ and `debugger-reenable' to temporarily disable debug-on-entry.")
 
 (defvar inhibit-trace)                  ;Not yet implemented.
 
+(defvar debugger-args nil
+  "Arguments with which the debugger was called.
+It is a list expected to take the form (CAUSE . REST)
+where CAUSE can be:
+- debug: called for entry to a flagged function.
+- t: called because of debug-on-next-call.
+- lambda: same thing but via `funcall'.
+- exit: called because of exit of a flagged function.
+- error: called because of `debug-on-error'.")
+
 ;;;###autoload
 (setq debugger 'debug)
 ;;;###autoload
@@ -296,32 +306,33 @@ That buffer should be current already."
   (insert "Debugger entered")
   ;; lambda is for debug-on-call when a function call is next.
   ;; debug is for debug-on-entry function called.
-  (cond ((memq (car debugger-args) '(lambda debug))
-	 (insert "--entering a function:\n"))
-	;; Exiting a function.
-	((eq (car debugger-args) 'exit)
-	 (insert "--returning value: ")
-	 (setq debugger-value (nth 1 debugger-args))
-	 (prin1 debugger-value (current-buffer))
-	 (insert ?\n)
-	 (delete-char 1)
-	 (insert ? )
-	 (beginning-of-line))
-	;; Debugger entered for an error.
-	((eq (car debugger-args) 'error)
-	 (insert "--Lisp error: ")
-	 (prin1 (nth 1 debugger-args) (current-buffer))
-	 (insert ?\n))
-	;; debug-on-call, when the next thing is an eval.
-	((eq (car debugger-args) t)
-	 (insert "--beginning evaluation of function call form:\n"))
-	;; User calls debug directly.
-	(t
-	 (insert ": ")
-	 (prin1 (if (eq (car debugger-args) 'nil)
-		    (cdr debugger-args) debugger-args)
-		(current-buffer))
-	 (insert ?\n)))
+  (pcase (car debugger-args)
+    ((or `lambda `debug)
+     (insert "--entering a function:\n"))
+    ;; Exiting a function.
+    (`exit
+     (insert "--returning value: ")
+     (setq debugger-value (nth 1 debugger-args))
+     (prin1 debugger-value (current-buffer))
+     (insert ?\n)
+     (delete-char 1)
+     (insert ? )
+     (beginning-of-line))
+    ;; Debugger entered for an error.
+    (`error
+     (insert "--Lisp error: ")
+     (prin1 (nth 1 debugger-args) (current-buffer))
+     (insert ?\n))
+    ;; debug-on-call, when the next thing is an eval.
+    (`t
+     (insert "--beginning evaluation of function call form:\n"))
+    ;; User calls debug directly.
+    (_
+     (insert ": ")
+     (prin1 (if (eq (car debugger-args) 'nil)
+                (cdr debugger-args) debugger-args)
+            (current-buffer))
+     (insert ?\n)))
   ;; After any frame that uses eval-buffer,
   ;; insert a line that states the buffer position it's reading at.
   (save-excursion
@@ -439,6 +450,10 @@ Enter another debugger on next entry to eval, apply or funcall."
 This is only useful when the value returned from the debugger
 will be used, such as in a debug on exit from a frame."
   (interactive "XReturn value (evaluated): ")
+  (when (memq (car debugger-args) '(t lambda error debug))
+    (error "Cannot return a value %s"
+           (if (eq (car debugger-args) 'error)
+               "from an error" "at function entrance")))
   (setq debugger-value val)
   (princ "Returning " t)
   (prin1 debugger-value)
-- 
2.39.2