diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/ert-x.el | 57 | ||||
| -rw-r--r-- | lisp/emacs-lisp/subr-x.el | 2 | ||||
| -rw-r--r-- | lisp/emacs-lisp/timer-list.el | 6 |
3 files changed, 49 insertions, 16 deletions
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 6d9a7d9211a..71d46c11077 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -286,27 +286,60 @@ BUFFER defaults to current buffer. Does not modify BUFFER." (defmacro ert-with-message-capture (var &rest body) - "Execute BODY while collecting anything written with `message' in VAR. + "Execute BODY while collecting messages in VAR. -Capture all messages produced by `message' when it is called from -Lisp, and concatenate them separated by newlines into one string. +Capture messages issued by Lisp code and concatenate them +separated by newlines into one string. This includes messages +written by `message' as well as objects printed by `print', +`prin1' and `princ' to the echo area. Messages issued from C +code using the above mentioned functions will not be captured. This is useful for separating the issuance of messages by the code under test from the behavior of the *Messages* buffer." (declare (debug (symbolp body)) (indent 1)) - (let ((g-advice (gensym))) + (let ((g-message-advice (gensym)) + (g-print-advice (gensym)) + (g-collector (gensym))) `(let* ((,var "") - (,g-advice (lambda (func &rest args) - (if (or (null args) (equal (car args) "")) - (apply func args) - (let ((msg (apply #'format-message args))) - (setq ,var (concat ,var msg "\n")) - (funcall func "%s" msg)))))) - (advice-add 'message :around ,g-advice) + (,g-collector (lambda (msg) (setq ,var (concat ,var msg)))) + (,g-message-advice (ert--make-message-advice ,g-collector)) + (,g-print-advice (ert--make-print-advice ,g-collector))) + (advice-add 'message :around ,g-message-advice) + (advice-add 'prin1 :around ,g-print-advice) + (advice-add 'princ :around ,g-print-advice) + (advice-add 'print :around ,g-print-advice) (unwind-protect (progn ,@body) - (advice-remove 'message ,g-advice))))) + (advice-remove 'print ,g-print-advice) + (advice-remove 'princ ,g-print-advice) + (advice-remove 'prin1 ,g-print-advice) + (advice-remove 'message ,g-message-advice))))) + +(defun ert--make-message-advice (collector) + "Create around advice for `message' for `ert-collect-messages'. +COLLECTOR will be called with the message before it is passed +to the real `message'." + (lambda (func &rest args) + (if (or (null args) (equal (car args) "")) + (apply func args) + (let ((msg (apply #'format-message args))) + (funcall collector (concat msg "\n")) + (funcall func "%s" msg))))) + +(defun ert--make-print-advice (collector) + "Create around advice for print functions for `ert-collect-messages'. +The created advice function will just call the original function +unless the output is going to the echo area (when PRINTCHARFUN is +t or PRINTCHARFUN is nil and `standard-output' is t). If the +output is destined for the echo area, the advice function will +convert it to a string and pass it to COLLECTOR first." + (lambda (func object &optional printcharfun) + (if (not (eq t (or printcharfun standard-output))) + (funcall func object printcharfun) + (funcall collector (with-output-to-string + (funcall func object))) + (funcall func object printcharfun)))) (provide 'ert-x) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 077ad22c75d..edba6550fa2 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -128,7 +128,7 @@ binding value is nil. If all are non-nil, the value of THEN is returned, or the last form in ELSE is returned. Each element of VARLIST is a list (SYMBOL VALUEFORM) which binds -SYMBOL to the value of VALUEFORM). An element can additionally +SYMBOL to the value of VALUEFORM. An element can additionally be of the form (VALUEFORM), which is evaluated and checked for nil; i.e. SYMBOL can be omitted if only the test result is of interest." diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el index 44a315f9806..69c67419835 100644 --- a/lisp/emacs-lisp/timer-list.el +++ b/lisp/emacs-lisp/timer-list.el @@ -25,7 +25,7 @@ ;;; Code: ;;;###autoload -(defun timer-list (&optional _ignore-auto _nonconfirm) +(defun list-timers (&optional _ignore-auto _nonconfirm) "List all timers in a buffer." (interactive) (pop-to-buffer-same-window (get-buffer-create "*timer-list*")) @@ -67,7 +67,7 @@ (goto-char (point-min))) ;; This command can be destructive if they don't know what they are ;; doing. Kids, don't try this at home! -;;;###autoload (put 'timer-list 'disabled "Beware: manually canceling timers can ruin your Emacs session.") +;;;###autoload (put 'list-timers 'disabled "Beware: manually canceling timers can ruin your Emacs session.") (defvar timer-list-mode-map (let ((map (make-sparse-keymap))) @@ -84,7 +84,7 @@ (setq bidi-paragraph-direction 'left-to-right) (setq truncate-lines t) (buffer-disable-undo) - (setq-local revert-buffer-function 'timer-list) + (setq-local revert-buffer-function #'list-timers) (setq buffer-read-only t) (setq header-line-format (format "%4s %10s %8s %s" |