From f3c77d11af65f3b319b1784b4c3cf08c51aa7997 Mon Sep 17 00:00:00 2001 From: Dima Kogan Date: Mon, 5 Dec 2016 21:42:20 -0800 Subject: stash --- lisp/emacs-lisp/debug.el | 54 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index cb77148c285..faa323f733a 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -816,6 +816,60 @@ Redefining FUNCTION also cancels it." '((depth . -100))) function) +;;;###autoload +;; (defun debug-on-set (symbol) +;; "Request FUNCTION to invoke debugger each time it is called. + +;; When called interactively, prompt for FUNCTION in the minibuffer. + +;; This works by modifying the definition of FUNCTION. If you tell the +;; debugger to continue, FUNCTION's execution proceeds. If FUNCTION is a +;; normal function or a macro written in Lisp, you can also step through +;; its execution. FUNCTION can also be a primitive that is not a special +;; form, in which case stepping is not possible. Break-on-entry for +;; primitive functions only works when that function is called from Lisp. + +;; Use \\[cancel-debug-on-entry] to cancel the effect of this command. +;; Redefining FUNCTION also cancels it." +;; (interactive +;; (let ((v (variable-at-point)) +;; (enable-recursive-minibuffers t) +;; (orig-buffer (current-buffer)) +;; val) +;; (setq val (completing-read +;; (if (symbolp v) +;; (format +;; "Debug on set to symbol (default %s): " v) +;; "Debug on set to symbol: ") +;; #'help--symbol-completion-table +;; (lambda (vv) +;; ;; In case the variable only exists in the buffer +;; ;; the command we switch back to that buffer before +;; ;; we examine the variable. +;; (with-current-buffer orig-buffer +;; (or (get vv 'variable-documentation) +;; (and (boundp vv) (not (keywordp vv)))))) +;; t nil nil +;; (if (symbolp v) (symbol-name v)))) +;; (list (if (equal val "") +;; v (intern val))))) + + + +;; (interactive +;; (let* ((var-default (variable-at-point)) +;; (var (completing-read +;; (if var-default +;; (format "Debug on set to symbol (default %s): " var-default) +;; "Debug on set to symbol: ") +;; nil +;; #'boundp +;; t nil nil (symbol-name var-default)))) +;; (list (if (equal var "") var-default (intern var))))) +;; (advice-add function :before #'debug--implement-debug-on-entry +;; '((depth . -100))) +;; function) + (defun debug--function-list () "List of functions currently set for debug on entry." (let ((funs '())) -- cgit v1.2.3 From fbf74c158ea81ff6349f68760f8861c1c497c989 Mon Sep 17 00:00:00 2001 From: Dima Kogan Date: Tue, 31 Jan 2017 07:46:10 -0800 Subject: Revert two accidental commits This reverts commit f3c77d11af65f3b319b1784b4c3cf08c51aa7997. This reverts commit 3c941b900007c9e79c00af0f21d88154f6d8af1a. --- lisp/comint.el | 11 +++++----- lisp/emacs-lisp/debug.el | 54 ------------------------------------------------ lisp/shell.el | 2 -- src/data.c | 50 -------------------------------------------- src/fns.c | 4 ---- 5 files changed, 5 insertions(+), 116 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/comint.el b/lisp/comint.el index c82c3d09df3..830f4ca88f9 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1879,7 +1879,6 @@ Similarly for Soar, Scheme, etc." (let ((echo-len (- comint-last-input-end comint-last-input-start))) ;; Wait for all input to be echoed: - (while (and (> (+ comint-last-input-end echo-len) (point-max)) (accept-process-output proc) @@ -1891,7 +1890,6 @@ Similarly for Soar, Scheme, etc." ;; (+ comint-last-input-start ;; (- (point-max) comint-last-input-end)) nil comint-last-input-end (point-max))))) - (if (and (<= (+ comint-last-input-end echo-len) (point-max)) @@ -1903,7 +1901,6 @@ Similarly for Soar, Scheme, etc." ;; Certain parts of the text to be deleted may have ;; been mistaken for prompts. We have to prevent ;; problems when `comint-prompt-read-only' is non-nil. - (let ((inhibit-read-only t)) (delete-region comint-last-input-end (+ comint-last-input-end echo-len)) @@ -1912,7 +1909,6 @@ Similarly for Soar, Scheme, etc." (goto-char comint-last-input-end) (comint-update-fence))))))) - ;; This used to call comint-output-filter-functions, ;; but that scrolled the buffer in undesirable ways. (run-hook-with-args 'comint-output-filter-functions ""))))) @@ -2243,7 +2239,10 @@ the current line with any initial string matching the regexp (null (get-char-property (setq bof (field-beginning)) 'field))) (field-string-no-properties bof) (comint-bol) - (buffer-substring-no-properties (point) (line-end-position))))) + (buffer-substring-no-properties (point) + (if comint-use-prompt-regexp + (line-end-position) + (field-end)))))) (defun comint-copy-old-input () "Insert after prompt old input at point as new input to be edited. @@ -2670,7 +2669,7 @@ This command is like `M-.' in bash." (set-marker comint-insert-previous-argument-last-start-pos (point)) ;; Insert the argument. (let ((input-string (comint-previous-input-string 0))) - (when (string-match "[ \t\n]*&[ \t\n]*$" input-string) + (when (string-match "[ \t\n]*&" input-string) ;; strip terminating '&' (setq input-string (substring input-string 0 (match-beginning 0)))) (insert (comint-arguments input-string index index))) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index faa323f733a..cb77148c285 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -816,60 +816,6 @@ Redefining FUNCTION also cancels it." '((depth . -100))) function) -;;;###autoload -;; (defun debug-on-set (symbol) -;; "Request FUNCTION to invoke debugger each time it is called. - -;; When called interactively, prompt for FUNCTION in the minibuffer. - -;; This works by modifying the definition of FUNCTION. If you tell the -;; debugger to continue, FUNCTION's execution proceeds. If FUNCTION is a -;; normal function or a macro written in Lisp, you can also step through -;; its execution. FUNCTION can also be a primitive that is not a special -;; form, in which case stepping is not possible. Break-on-entry for -;; primitive functions only works when that function is called from Lisp. - -;; Use \\[cancel-debug-on-entry] to cancel the effect of this command. -;; Redefining FUNCTION also cancels it." -;; (interactive -;; (let ((v (variable-at-point)) -;; (enable-recursive-minibuffers t) -;; (orig-buffer (current-buffer)) -;; val) -;; (setq val (completing-read -;; (if (symbolp v) -;; (format -;; "Debug on set to symbol (default %s): " v) -;; "Debug on set to symbol: ") -;; #'help--symbol-completion-table -;; (lambda (vv) -;; ;; In case the variable only exists in the buffer -;; ;; the command we switch back to that buffer before -;; ;; we examine the variable. -;; (with-current-buffer orig-buffer -;; (or (get vv 'variable-documentation) -;; (and (boundp vv) (not (keywordp vv)))))) -;; t nil nil -;; (if (symbolp v) (symbol-name v)))) -;; (list (if (equal val "") -;; v (intern val))))) - - - -;; (interactive -;; (let* ((var-default (variable-at-point)) -;; (var (completing-read -;; (if var-default -;; (format "Debug on set to symbol (default %s): " var-default) -;; "Debug on set to symbol: ") -;; nil -;; #'boundp -;; t nil nil (symbol-name var-default)))) -;; (list (if (equal var "") var-default (intern var))))) -;; (advice-add function :before #'debug--implement-debug-on-entry -;; '((depth . -100))) -;; function) - (defun debug--function-list () "List of functions currently set for debug on entry." (let ((funs '())) diff --git a/lisp/shell.el b/lisp/shell.el index c7ba64ecf4e..c8a8555d632 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -1000,8 +1000,6 @@ command again." (let ((pt (point)) (regexp (concat - ;; comint-process-echoes is the thing that breaks the - ;; throbber (if comint-process-echoes ;; Skip command echo if the process echoes (concat "\\(" (regexp-quote shell-dirstack-query) "\n\\)") diff --git a/src/data.c b/src/data.c index 26ff9948828..8e07bf01b44 100644 --- a/src/data.c +++ b/src/data.c @@ -1304,56 +1304,6 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, default: emacs_abort (); } - - const char* symname = SDATA(sym->name); - - if( EQ(Vwatch_object, symbol) ) - { - static int nest_level = 0; - if(nest_level++ == 0) - { - switch(sym->redirect) - { - case SYMBOL_PLAINVAL: - { - AUTO_STRING (format, "Setting symbol '%s'; redirect: SYMBOL_PLAINVAL"); - CALLN (Fmessage, format, SYMBOL_NAME (symbol)); - break; - } - case SYMBOL_VARALIAS: - { - AUTO_STRING (format, "Setting symbol '%s'; redirect: SYMBOL_VARALIAS"); - CALLN (Fmessage, format, SYMBOL_NAME (symbol)); - break; - } - case SYMBOL_LOCALIZED: - { - AUTO_STRING (format, "Setting symbol '%s'; redirect: SYMBOL_LOCALIZED"); - CALLN (Fmessage, format, SYMBOL_NAME (symbol)); - break; - } - case SYMBOL_FORWARDED: - { - AUTO_STRING (format, "Setting symbol '%s'; redirect: SYMBOL_FORWARDED"); - CALLN (Fmessage, format, SYMBOL_NAME (symbol)); - break; - } - - default: - { - AUTO_STRING (format, "Setting symbol '%s'; redirect: UNKNOWN"); - CALLN (Fmessage, format, SYMBOL_NAME (symbol)); - break; - } - } - } - nest_level--; - } - - - - - start: switch (sym->redirect) { diff --git a/src/fns.c b/src/fns.c index 9eabc1414f4..136a2198c2c 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5120,10 +5120,6 @@ On some platforms, file selection dialogs are also enabled if this is non-nil. */); use_dialog_box = 1; - DEFVAR_LISP("watch-object", Vwatch_object, - doc: /* Symbol to watch. */); - Vwatch_object = Qnil; - DEFVAR_BOOL ("use-file-dialog", use_file_dialog, doc: /* Non-nil means mouse commands use a file dialog to ask for files. This applies to commands from menus and tool bar buttons even when -- cgit v1.2.3 From 5af51bd4451ae6d00ab878a7cfc6782280a81c84 Mon Sep 17 00:00:00 2001 From: Ted Zlatanov Date: Tue, 31 Jan 2017 14:17:58 -0500 Subject: read-multiple-choice: explain dialog popups more * lisp/emacs-lisp/subr-x.el (read-multiple-choice): Explain when a graphical popup is used and how it can be avoided. --- lisp/emacs-lisp/subr-x.el | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 7736225b5fa..52331b9ad36 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -214,6 +214,11 @@ user enters `recenter', `scroll-up', or `scroll-down' responses, perform the requested window recentering or scrolling and ask again. +When `use-dialog-box' is t (the default), this function can pop +up a dialog window to collect the user input. That functionality +requires `display-popup-menus-p' to return t. Otherwise, a text +dialog will be used. + The return value is the matching entry from the CHOICES list. Usage example: -- cgit v1.2.3 From 12da2a5beafc4595fe4dd922431ba9f013b84830 Mon Sep 17 00:00:00 2001 From: Mark Oteiza Date: Tue, 31 Jan 2017 19:46:28 -0500 Subject: ; Bump let-alist * lisp/emacs-lisp/let-alist.el: Bump micro version (bug#24641). --- lisp/emacs-lisp/let-alist.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/let-alist.el b/lisp/emacs-lisp/let-alist.el index a45fc0a05c3..cf82fe3ec63 100644 --- a/lisp/emacs-lisp/let-alist.el +++ b/lisp/emacs-lisp/let-alist.el @@ -4,7 +4,7 @@ ;; Author: Artur Malabarba ;; Package-Requires: ((emacs "24.1")) -;; Version: 1.0.4 +;; Version: 1.0.5 ;; Keywords: extensions lisp ;; Prefix: let-alist ;; Separator: - -- cgit v1.2.3 From be10c00d3d64d53a7f31441d42f6c5b1f75b9916 Mon Sep 17 00:00:00 2001 From: Mark Oteiza Date: Fri, 3 Feb 2017 21:42:42 -0500 Subject: Rename to if-let* and when-let* Make the existing if-let and when-let aliases. * lisp/emacs-lisp/subr-x.el (if-let*, when-let*): New macros. Rewrite docstrings, incorporating that from let* and the existing if-let. (if-let, when-let, and-let*): Alias them. --- etc/NEWS | 4 ++++ lisp/emacs-lisp/subr-x.el | 36 ++++++++++++++++++++++++------------ 2 files changed, 28 insertions(+), 12 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/etc/NEWS b/etc/NEWS index 617f39f9b4c..930e1c893b4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -885,6 +885,10 @@ collection). +++ ** 'car' and 'cdr' compositions 'cXXXr' and 'cXXXXr' are now part of Elisp. +--- +** 'if-let*', 'when-let*', and 'and-let*' are new in subr-x.el. +The incumbent 'if-let' and 'when-let' are now aliases. + +++ ** The new functions 'make-nearby-temp-file' and 'temporary-file-directory' can be used for creation of temporary files of remote or mounted directories. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 52331b9ad36..f7a846927c0 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -115,12 +115,16 @@ threading." binding)) bindings))) -(defmacro if-let (bindings then &rest else) - "Process BINDINGS and if all values are non-nil eval THEN, else ELSE. -Argument BINDINGS is a list of tuples whose car is a symbol to be -bound and (optionally) used in THEN, and its cadr is a sexp to be -evalled to set symbol's value. In the special case you only want -to bind a single value, BINDINGS can just be a plain tuple." +(defmacro if-let* (bindings then &rest else) + "Bind variables according to VARLIST and eval THEN or ELSE. +Each binding is evaluated in turn with `let*', and evaluation +stops if a 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 symbol (which is bound to nil) +or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). +In the special case you only want to bind a single value, +VARLIST can just be a plain tuple. +\n(fn VARLIST THEN ELSE...)" (declare (indent 2) (debug ([&or (&rest (symbolp form)) (symbolp form)] form body))) (when (and (<= (length bindings) 2) @@ -132,15 +136,23 @@ to bind a single value, BINDINGS can just be a plain tuple." ,then ,@else))) -(defmacro when-let (bindings &rest body) - "Process BINDINGS and if all values are non-nil eval BODY. -Argument BINDINGS is a list of tuples whose car is a symbol to be -bound and (optionally) used in BODY, and its cadr is a sexp to be -evalled to set symbol's value. In the special case you only want -to bind a single value, BINDINGS can just be a plain tuple." +(defmacro when-let* (bindings &rest body) + "Bind variables according to VARLIST and conditionally eval BODY. +Each binding is evaluated in turn with `let*', and evaluation +stops if a binding value is nil. If all are non-nil, the value +of the last form in BODY is returned. +Each element of VARLIST is a symbol (which is bound to nil) +or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). +In the special case you only want to bind a single value, +VARLIST can just be a plain tuple. +\n(fn VARLIST BODY...)" (declare (indent 1) (debug if-let)) (list 'if-let bindings (macroexp-progn body))) +(defalias 'if-let 'if-let*) +(defalias 'when-let 'when-let*) +(defalias 'and-let* 'when-let*) + (defsubst hash-table-empty-p (hash-table) "Check whether HASH-TABLE is empty (has 0 elements)." (zerop (hash-table-count hash-table))) -- cgit v1.2.3 From 78f841d6db77f8b72d6d7d221af26efb956ab6cb Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Sat, 4 Feb 2017 12:56:19 +0200 Subject: Change edebug-max-depth from defconst to defcustom * lisp/emacs-lisp/edebug.el (edebug-max-depth): Add defcustom. (Bug#24713) * etc/NEWS: Mention edebug-max-depth. * doc/lispref/edebug.texi (Checking Whether to Stop): Mention edebug-max-depth and index it. Add cross-references for max-lisp-eval-depth and max-specpdl-size. Co-authored-by: Eli Zaretskii --- doc/lispref/edebug.texi | 10 +++++++--- etc/NEWS | 5 +++++ lisp/emacs-lisp/edebug.el | 13 ++++++++++++- 3 files changed, 24 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index f6f73ea8947..da72c9b700c 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -979,9 +979,13 @@ program. @itemize @bullet @item -@code{max-lisp-eval-depth} and @code{max-specpdl-size} are both -increased to reduce Edebug's impact on the stack. You could, however, -still run out of stack space when using Edebug. +@vindex edebug-max-depth +@code{max-lisp-eval-depth} (@pxref{Eval}) and @code{max-specpdl-size} +(@pxref{Local Variables}) are both increased to reduce Edebug's impact +on the stack. You could, however, still run out of stack space when +using Edebug. You can also enlarge the value of +@code{edebug-max-depth} if Edebug reaches the limit of recursion depth +instrumenting code that contains very large quoted lists. @item The state of keyboard macro execution is saved and restored. While diff --git a/etc/NEWS b/etc/NEWS index 270f8803d53..cbf2b70c821 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -464,6 +464,11 @@ viewing HTML files and the like. breakpoint (e.g. with "f" and "o") by customizing the new option 'edebug-sit-on-break'. ++++ +*** New customizable option 'edebug-max-depth' +This allows to enlarge the maximum recursion depth when instrumenting +code. + ** Eshell *** 'eshell-input-filter's value is now a named function diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index db54d1eeb20..ec0f08de356 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -112,6 +112,18 @@ and some not, use `def-edebug-spec' to specify an `edebug-form-spec'." :type 'boolean :group 'edebug) +(defcustom edebug-max-depth 150 + "Maximum recursion depth when instrumenting code. +This limit is intended to stop recursion if an Edebug specification +contains an infinite loop. When Edebug is instrumenting code +containing very large quoted lists, it may reach this limit and give +the error message \"Too deep - perhaps infinite loop in spec?\". +Make this limit larger to countermand that, but you may also need to +increase `max-lisp-eval-depth' and `max-specpdl-size'." + :type 'integer + :group 'edebug + :version "26.1") + (defcustom edebug-save-windows t "If non-nil, Edebug saves and restores the window configuration. That takes some time, so if your program does not care what happens to @@ -1452,7 +1464,6 @@ expressions; a `progn' form will be returned enclosing these forms." (defvar edebug-after-dotted-spec nil) (defvar edebug-matching-depth 0) ;; initial value -(defconst edebug-max-depth 150) ;; maximum number of matching recursions. ;;; Failure to match -- cgit v1.2.3 From a46a61904de6cc57e6a740a3006f48023859a1b3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 4 Feb 2017 13:12:14 +0200 Subject: Fix a syntax error when evaluating pcase.el under Edebug * lisp/emacs-lisp/pcase.el (pcase-MACRO): Replace def-edebug-spec with an explicit 'put' form. Suggested by Gemini Lasswell . (Bug#24717) --- lisp/emacs-lisp/pcase.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 54678c5f324..46a5eedd150 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -89,7 +89,8 @@ (functionp &rest form) sexp)) -(def-edebug-spec pcase-MACRO pcase--edebug-match-macro) +;; See bug#24717 +(put 'pcase-MACRO 'edebug-form-spec 'pcase--edebug-match-macro) ;; Only called from edebug. (declare-function get-edebug-spec "edebug" (symbol)) -- cgit v1.2.3 From 8ba27b7ce2f4a98e3c14fe752042c60fd7576fef Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Sat, 4 Feb 2017 13:18:29 +0200 Subject: Avoid invalid read syntax errors due to 'ert-with-test-buffer' * lisp/emacs-lisp/ert-x.el (ert-with-test-buffer): Fix the 'declare' form. (Bug#24722) --- lisp/emacs-lisp/ert-x.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 7d99cb30274..8530253d5b4 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -97,7 +97,7 @@ To be used in ERT tests. If BODY finishes successfully, the test buffer is killed; if there is an error, the test buffer is kept around on error for further inspection. Its name is derived from the name of the test and the result of NAME-FORM." - (declare (debug ((form) body)) + (declare (debug ((":name" form) body)) (indent 1)) `(ert--call-with-test-buffer ,name-form (lambda () ,@body))) -- cgit v1.2.3 From ef3d8d6f7226e570209e913d2754e828d0cb121c Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Sat, 4 Feb 2017 13:36:43 +0200 Subject: New macro 'ert-with-message-capture' * lisp/emacs-lisp/ert-x.el (ert-with-message-capture): New macro. (Bug#25158) * test/lisp/autorevert-tests.el (auto-revert--wait-for-revert) (auto-revert-test00-auto-revert-mode) (auto-revert-test01-auto-revert-several-files) (auto-revert-test02-auto-revert-deleted-file) (auto-revert-test03-auto-revert-tail-mode) (auto-revert-test04-auto-revert-mode-dired): * test/lisp/filenotify-tests.el (file-notify-test03-autorevert): Use ert-with-message-capture. --- lisp/emacs-lisp/ert-x.el | 24 ++++++ test/lisp/autorevert-tests.el | 166 +++++++++++++++++++----------------------- test/lisp/filenotify-tests.el | 56 +++++++------- 3 files changed, 125 insertions(+), 121 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 8530253d5b4..4cf9d9609e9 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -285,6 +285,30 @@ BUFFER defaults to current buffer. Does not modify BUFFER." (kill-buffer clone))))))) +(defmacro ert-with-message-capture (var &rest body) + "Execute BODY while collecting anything written with `message' in VAR. + +Capture all messages produced by `message' when it is called from +Lisp, and concatenate them separated by newlines into one string. + +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 (cl-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) + (unwind-protect + (progn ,@body) + (advice-remove 'message ,g-advice))))) + + (provide 'ert-x) ;;; ert-x.el ends here diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index aea855ae02f..c082ba95639 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -24,24 +24,29 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'autorevert) (setq auto-revert-notify-exclude-dir-regexp "nothing-to-be-excluded" auto-revert-stop-on-user-input nil) (defconst auto-revert--timeout 10 - "Time to wait until a message appears in the *Messages* buffer.") + "Time to wait for a message.") + +(defvar auto-revert--messages nil + "Used to collect messages issued during a section of a test.") (defun auto-revert--wait-for-revert (buffer) - "Wait until the *Messages* buffer reports reversion of BUFFER." + "Wait until a message reports reversion of BUFFER. +This expects `auto-revert--messages' to be bound by +`ert-with-message-capture' before calling." (with-timeout (auto-revert--timeout nil) - (with-current-buffer "*Messages*" - (while - (null (string-match - (format-message "Reverting buffer `%s'." (buffer-name buffer)) - (buffer-string))) - (if (with-current-buffer buffer auto-revert-use-notify) - (read-event nil nil 0.1) - (sleep-for 0.1)))))) + (while + (null (string-match + (format-message "Reverting buffer `%s'." (buffer-name buffer)) + auto-revert--messages)) + (if (with-current-buffer buffer auto-revert-use-notify) + (read-event nil nil 0.1) + (sleep-for 0.1))))) (ert-deftest auto-revert-test00-auto-revert-mode () "Check autorevert for a file." @@ -51,41 +56,38 @@ buf) (unwind-protect (progn - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) - (write-region "any text" nil tmpfile nil 'no-message) + (write-region "any text" nil tmpfile nil 'no-message) (setq buf (find-file-noselect tmpfile)) - (with-current-buffer buf - (should (string-equal (buffer-string) "any text")) - ;; `buffer-stale--default-function' checks for - ;; `verify-visited-file-modtime'. We must ensure that it - ;; returns nil. - (sleep-for 1) - (auto-revert-mode 1) - (should auto-revert-mode) + (with-current-buffer buf + (ert-with-message-capture auto-revert--messages + (should (string-equal (buffer-string) "any text")) + ;; `buffer-stale--default-function' checks for + ;; `verify-visited-file-modtime'. We must ensure that it + ;; returns nil. + (sleep-for 1) + (auto-revert-mode 1) + (should auto-revert-mode) - ;; Modify file. We wait for a second, in order to have - ;; another timestamp. - (sleep-for 1) - (write-region "another text" nil tmpfile nil 'no-message) + ;; Modify file. We wait for a second, in order to have + ;; another timestamp. + (sleep-for 1) + (write-region "another text" nil tmpfile nil 'no-message) - ;; Check, that the buffer has been reverted. - (auto-revert--wait-for-revert buf) + ;; Check, that the buffer has been reverted. + (auto-revert--wait-for-revert buf)) (should (string-match "another text" (buffer-string))) ;; When the buffer is modified, it shall not be reverted. - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) - (set-buffer-modified-p t) - (sleep-for 1) - (write-region "any text" nil tmpfile nil 'no-message) + (ert-with-message-capture auto-revert--messages + (set-buffer-modified-p t) + (sleep-for 1) + (write-region "any text" nil tmpfile nil 'no-message) - ;; Check, that the buffer hasn't been reverted. - (auto-revert--wait-for-revert buf) + ;; Check, that the buffer hasn't been reverted. + (auto-revert--wait-for-revert buf)) (should-not (string-match "any text" (buffer-string))))) ;; Exit. - (with-current-buffer "*Messages*" (widen)) (ignore-errors (with-current-buffer buf (set-buffer-modified-p nil)) (kill-buffer buf)) @@ -106,13 +108,11 @@ (make-temp-file (expand-file-name "auto-revert-test" tmpdir1))) buf1 buf2) (unwind-protect - (progn - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) - (write-region "any text" nil tmpfile1 nil 'no-message) - (setq buf1 (find-file-noselect tmpfile1)) - (write-region "any text" nil tmpfile2 nil 'no-message) - (setq buf2 (find-file-noselect tmpfile2)) + (ert-with-message-capture auto-revert--messages + (write-region "any text" nil tmpfile1 nil 'no-message) + (setq buf1 (find-file-noselect tmpfile1)) + (write-region "any text" nil tmpfile2 nil 'no-message) + (setq buf2 (find-file-noselect tmpfile2)) (dolist (buf (list buf1 buf2)) (with-current-buffer buf @@ -148,7 +148,6 @@ (should (string-match "another text" (buffer-string)))))) ;; Exit. - (with-current-buffer "*Messages*" (widen)) (ignore-errors (dolist (buf (list buf1 buf2)) (with-current-buffer buf (set-buffer-modified-p nil)) @@ -165,8 +164,6 @@ buf) (unwind-protect (progn - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) (write-region "any text" nil tmpfile nil 'no-message) (setq buf (find-file-noselect tmpfile)) (with-current-buffer buf @@ -184,42 +181,36 @@ 'before-revert-hook (lambda () (delete-file buffer-file-name)) nil t) - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) - (sleep-for 1) - (write-region "another text" nil tmpfile nil 'no-message) - ;; Check, that the buffer hasn't been reverted. File - ;; notification should be disabled, falling back to - ;; polling. - (auto-revert--wait-for-revert buf) + (ert-with-message-capture auto-revert--messages + (sleep-for 1) + (write-region "another text" nil tmpfile nil 'no-message) + (auto-revert--wait-for-revert buf)) + ;; Check, that the buffer hasn't been reverted. File + ;; notification should be disabled, falling back to + ;; polling. (should (string-match "any text" (buffer-string))) (should-not auto-revert-use-notify) ;; Once the file has been recreated, the buffer shall be ;; reverted. (kill-local-variable 'before-revert-hook) - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) - (sleep-for 1) - (write-region "another text" nil tmpfile nil 'no-message) - - ;; Check, that the buffer has been reverted. - (auto-revert--wait-for-revert buf) + (ert-with-message-capture auto-revert--messages + (sleep-for 1) + (write-region "another text" nil tmpfile nil 'no-message) + (auto-revert--wait-for-revert buf)) + ;; Check, that the buffer has been reverted. (should (string-match "another text" (buffer-string))) ;; An empty file shall still be reverted. - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) - (sleep-for 1) - (write-region "" nil tmpfile nil 'no-message) - - ;; Check, that the buffer has been reverted. - (auto-revert--wait-for-revert buf) + (ert-with-message-capture auto-revert--messages + (sleep-for 1) + (write-region "" nil tmpfile nil 'no-message) + (auto-revert--wait-for-revert buf)) + ;; Check, that the buffer has been reverted. (should (string-equal "" (buffer-string))))) ;; Exit. - (with-current-buffer "*Messages*" (widen)) (ignore-errors (with-current-buffer buf (set-buffer-modified-p nil)) (kill-buffer buf)) @@ -232,9 +223,7 @@ (let ((tmpfile (make-temp-file "auto-revert-test")) buf) (unwind-protect - (progn - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) + (ert-with-message-capture auto-revert--messages (write-region "any text" nil tmpfile nil 'no-message) (setq buf (find-file-noselect tmpfile)) (with-current-buffer buf @@ -259,7 +248,6 @@ (string-match "modified text\nanother text" (buffer-string))))) ;; Exit. - (with-current-buffer "*Messages*" (widen)) (ignore-errors (kill-buffer buf)) (ignore-errors (delete-file tmpfile))))) @@ -283,33 +271,29 @@ (should (string-match name (substring-no-properties (buffer-string)))) - ;; Delete file. We wait for a second, in order to have - ;; another timestamp. - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) - (sleep-for 1) - (delete-file tmpfile) - - ;; Check, that the buffer has been reverted. - (auto-revert--wait-for-revert buf) + (ert-with-message-capture auto-revert--messages + ;; Delete file. We wait for a second, in order to have + ;; another timestamp. + (sleep-for 1) + (delete-file tmpfile) + (auto-revert--wait-for-revert buf)) + ;; Check, that the buffer has been reverted. (should-not (string-match name (substring-no-properties (buffer-string)))) - ;; Make dired buffer modified. Check, that the buffer has - ;; been still reverted. - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) - (set-buffer-modified-p t) - (sleep-for 1) - (write-region "any text" nil tmpfile nil 'no-message) + (ert-with-message-capture auto-revert--messages + ;; Make dired buffer modified. Check, that the buffer has + ;; been still reverted. + (set-buffer-modified-p t) + (sleep-for 1) + (write-region "any text" nil tmpfile nil 'no-message) - ;; Check, that the buffer has been reverted. - (auto-revert--wait-for-revert buf) + (auto-revert--wait-for-revert buf)) + ;; Check, that the buffer has been reverted. (should (string-match name (substring-no-properties (buffer-string)))))) ;; Exit. - (with-current-buffer "*Messages*" (widen)) (ignore-errors (with-current-buffer buf (set-buffer-modified-p nil)) (kill-buffer buf)) diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index db7f55e8fc5..27434bcef20 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -36,6 +36,7 @@ ;;; Code: (require 'ert) +(require 'ert-x) (require 'filenotify) (require 'tramp) @@ -703,21 +704,19 @@ delivered." (should auto-revert-notify-watch-descriptor) ;; Modify file. We wait for a second, in order to have - ;; another timestamp. - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) - (sleep-for 1) - (write-region - "another text" nil file-notify--test-tmpfile nil 'no-message) - - ;; Check, that the buffer has been reverted. - (with-current-buffer (get-buffer-create "*Messages*") - (file-notify--wait-for-events - timeout - (string-match + ;; another timestamp. + (ert-with-message-capture captured-messages + (sleep-for 1) + (write-region + "another text" nil file-notify--test-tmpfile nil 'no-message) + + ;; Check, that the buffer has been reverted. + (file-notify--wait-for-events + timeout + (string-match (format-message "Reverting buffer `%s'." (buffer-name buf)) - (buffer-string)))) - (should (string-match "another text" (buffer-string))) + captured-messages)) + (should (string-match "another text" (buffer-string)))) ;; Stop file notification. Autorevert shall still work via polling. (file-notify-rm-watch auto-revert-notify-watch-descriptor) @@ -728,27 +727,24 @@ delivered." ;; Modify file. We wait for two seconds, in order to ;; have another timestamp. One second seems to be too - ;; short. - (with-current-buffer (get-buffer-create "*Messages*") - (narrow-to-region (point-max) (point-max))) - (sleep-for 2) - (write-region - "foo bla" nil file-notify--test-tmpfile nil 'no-message) - - ;; Check, that the buffer has been reverted. - (with-current-buffer (get-buffer-create "*Messages*") - (file-notify--wait-for-events - timeout - (string-match - (format-message "Reverting buffer `%s'." (buffer-name buf)) - (buffer-string)))) - (should (string-match "foo bla" (buffer-string)))) + ;; short. + (ert-with-message-capture captured-messages + (sleep-for 2) + (write-region + "foo bla" nil file-notify--test-tmpfile nil 'no-message) + + ;; Check, that the buffer has been reverted. + (file-notify--wait-for-events + timeout + (string-match + (format-message "Reverting buffer `%s'." (buffer-name buf)) + captured-messages)) + (should (string-match "foo bla" (buffer-string))))) ;; The environment shall be cleaned up. (file-notify--test-cleanup-p)) ;; Cleanup. - (with-current-buffer "*Messages*" (widen)) (ignore-errors (kill-buffer buf)) (file-notify--test-cleanup)))) -- cgit v1.2.3