branch: externals/listen
commit 6890398566c93cfe9a6af7eabb0c9b50c5b22305
Author: Adam Porter <[email protected]>
Commit: Adam Porter <[email protected]>
Add: (listen-debug) New macro
---
listen-lib.el | 59 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 59 insertions(+)
diff --git a/listen-lib.el b/listen-lib.el
index 852b5beed6..0af5d79edb 100644
--- a/listen-lib.el
+++ b/listen-lib.el
@@ -27,6 +27,65 @@
;;;; Macros
+(cl-defmacro listen-debug (&rest args)
+ "Display a debug warning showing the runtime value of ARGS.
+The warning automatically includes the name of the containing
+function, and it is only displayed if `warning-minimum-log-level'
+is `:debug' at expansion time (otherwise the macro expands to a
+call to `ignore' with ARGS and is eliminated by the
+byte-compiler). When debugging, the form also returns nil so,
+e.g. it may be used in a conditional in place of nil.
+
+Each of ARGS may be a string, which is displayed as-is, or a
+symbol, the value of which is displayed prefixed by its name, or
+a Lisp form, which is displayed prefixed by its first symbol.
+
+Before the actual ARGS arguments, you can write keyword
+arguments, i.e. alternating keywords and values. The following
+keywords are supported:
+
+ :buffer BUFFER Name of buffer to pass to `display-warning'.
+ :level LEVEL Level passed to `display-warning', which see.
+ Default is :debug."
+ ;; TODO: Can we use a compiler macro to handle this more elegantly?
+ (pcase-let* ((fn-name (when byte-compile-current-buffer
+ (with-current-buffer byte-compile-current-buffer
+ ;; This is a hack, but a nifty one.
+ (save-excursion
+ (beginning-of-defun)
+ (cl-second (read (current-buffer)))))))
+ (plist-args (cl-loop while (keywordp (car args))
+ collect (pop args)
+ collect (pop args)))
+ ((map (:buffer buffer) (:level level)) plist-args)
+ (level (or level :debug))
+ (string (cl-loop for arg in args
+ concat (pcase arg
+ ((pred stringp) "%S ")
+ ((pred symbolp)
+ (concat (upcase (symbol-name arg))
":%S "))
+ ((pred listp)
+ (concat "(" (upcase (symbol-name
(car arg)))
+ (pcase (length arg)
+ (1 ")")
+ (_ "...)"))
+ ":%S "))))))
+ (if (eq :debug warning-minimum-log-level)
+ `(let ((fn-name ,(if fn-name
+ `',fn-name
+ ;; In an interpreted function: use
`backtrace-frame' to get the
+ ;; function name (we have to use a little hackery
to figure out
+ ;; how far up the frame to look, but this seems to
work).
+ `(cl-loop for frame in (backtrace-frames)
+ for fn = (cl-second frame)
+ when (not (or (subrp fn)
+ (special-form-p fn)
+ (eq 'backtrace-frames fn)))
+ return (make-symbol (format "%s
[interpreted]" fn))))))
+ (display-warning fn-name (format ,string ,@args) ,level ,buffer)
+ nil)
+ `(ignore ,@args))))
+
(defmacro listen-once-per (value-form &rest body)
"Evaluate BODY at most once while VALUE-FORM has the same value."
(declare (indent defun))
