From 2eb0b7835d1a9cd4b804436e33c71058cb38f178 Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Sun, 19 Jan 2020 11:13:02 +0100 Subject: [PATCH] Fix shell-command-dont-erase-buffer feature * lisp/simple.el (shell-command-dont-erase-buffer): The default, nil, is backward compatible, i.e. it erases the buffer only if the output buffer is not the current one; the new value 'erase always erases the output buffer. Update docstring. (shell-command-save-pos-or-erase): Add optional arg output-to-current-buffer. Rename it so that it's not internal. All callers updated. (shell-command-set-point-after-cmd): Rename it so that it's not internal. All callers updated. Adjust it to cover a side case. (shell-command): Adjust logic to match the specification (Bug#39067). Enable the feature when the output buffer is the current one. (shell-command-on-region): Little tweak to follow `shell-command-dont-erase-buffer' specification. * test/lisp/simple-tests.el (with-shell-command-dont-erase-buffer): Add helper macro. (simple-tests-shell-command-39067) (simple-tests-shell-command-dont-erase-buffer): Add tests. * doc/emacs/misc.texi (Single Shell): Update manual. * etc/NEWS (Single shell commands): Announce the change. --- doc/emacs/misc.texi | 14 +++++----- etc/NEWS | 8 ++++++ lisp/simple.el | 57 ++++++++++++++++++++++++++++----------- test/lisp/simple-tests.el | 54 +++++++++++++++++++++++++++++++++++++ 4 files changed, 111 insertions(+), 22 deletions(-) diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index ab3318c4a24..6b95b12a846 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -826,12 +826,14 @@ the output buffer. But if you change the value of the variable inserted into a buffer of that name. @vindex shell-command-dont-erase-buffer - By default, the output buffer is erased between shell commands. -If you change the value of the variable -@code{shell-command-dont-erase-buffer} to a non-@code{nil} value, -the output buffer is not erased. This variable also controls where to -set the point in the output buffer after the command completes; see the -documentation of the variable for details. + By default, the output buffer is erased between shell commands, except +when the output goes to the current buffer. If you change the value +of the option @code{shell-command-dont-erase-buffer} to @code{erase}, +then the output buffer is always erased. Any other non-@code{nil} +value prevents to erase the output buffer. + +This option also controls where to set the point in the output buffer +after the command completes; see the documentation of the option for details. @node Interactive Shell @subsection Interactive Subshell diff --git a/etc/NEWS b/etc/NEWS index a6092736cec..d06b2a2f205 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2037,6 +2037,14 @@ variable for remote shells. It still defaults to "/bin/sh". ** Single shell commands ++++ +*** 'shell-command-dont-erase-buffer' accepts the value 'erase' to +force to erase the output buffer before execution of the command. + +*** The new functions shell-command-save-pos-or-erase' and +'shell-command-set-point-after-cmd' control how point is handled +between two consecutive shell commands in the same buffer. + +++ *** 'async-shell-command-width' defines the number of display columns available for output of asynchronous shell commands. diff --git a/lisp/simple.el b/lisp/simple.el index 693d8a160df..9a2586d244c 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3431,19 +3431,28 @@ This affects `shell-command' and `async-shell-command'." :version "27.1") (defcustom shell-command-dont-erase-buffer nil - "If non-nil, output buffer is not erased between shell commands. -Also, a non-nil value sets the point in the output buffer -once the command completes. + "Control if the output buffer is erased before the command. + +A nil value erases the output buffer before execution of the +shell command, except when the output buffer is the current one. + +The value `erase' ensures the output buffer is erased before +execution of the shell command. + +Other non-nil values prevent the output buffer from being erased and +set the point after execution of the shell command. + The value `beg-last-out' sets point at the beginning of the output, `end-last-out' sets point at the end of the buffer, `save-point' restores the buffer position before the command." :type '(choice - (const :tag "Erase buffer" nil) + (const :tag "Erase output buffer if not the current one" nil) + (const :tag "Always erase output buffer" erase) (const :tag "Set point to beginning of last output" beg-last-out) (const :tag "Set point to end of last output" end-last-out) (const :tag "Save point" save-point)) :group 'shell - :version "26.1") + :version "27.1") (defvar shell-command-saved-pos nil "Record of point positions in output buffers after command completion. @@ -3452,8 +3461,11 @@ where BUFFER is the output buffer, and POS is the point position in BUFFER once the command finishes. This variable is used when `shell-command-dont-erase-buffer' is non-nil.") -(defun shell-command--save-pos-or-erase () +(defun shell-command-save-pos-or-erase (&optional output-to-current-buffer) "Store a buffer position or erase the buffer. +Optional argument OUTPUT-TO-CURRENT-BUFFER, if non-nil, means that the output +of the shell command goes to the caller current buffer. + See `shell-command-dont-erase-buffer'." (let ((sym shell-command-dont-erase-buffer) pos) @@ -3464,7 +3476,9 @@ See `shell-command-dont-erase-buffer'." (setq pos (cond ((eq sym 'save-point) (point)) ((eq sym 'beg-last-out) (point-max)) - ((not sym) + ;;((not sym) + ((or (eq sym 'erase) + (and (null sym) (not output-to-current-buffer))) (let ((inhibit-read-only t)) (erase-buffer) nil)))) (when pos @@ -3472,7 +3486,7 @@ See `shell-command-dont-erase-buffer'." (push (cons (current-buffer) pos) shell-command-saved-pos)))) -(defun shell-command--set-point-after-cmd (&optional buffer) +(defun shell-command-set-point-after-cmd (&optional buffer) "Set point in BUFFER after command complete. BUFFER is the output buffer of the command; if nil, then defaults to the current BUFFER. @@ -3487,12 +3501,19 @@ whose `car' is BUFFER." (when (buffer-live-p buf) (let ((win (car (get-buffer-window-list buf))) (pmax (with-current-buffer buf (point-max)))) - (unless (and pos (memq sym '(save-point beg-last-out))) + + ;; The first time we run a command in a fresh created buffer + ;; we have not saved positions yet; advance to `point-max', so that + ;; succesive commands knows the position where the new comman start. + ;; (unless (and pos (memq sym '(save-point beg-last-out))) + (unless (and pos (memq sym '(save-point beg-last-out end-last-out))) (setq pos pmax)) ;; Set point in the window displaying buf, if any; otherwise ;; display buf temporary in selected frame and set the point. (if win (set-window-point win pos) + (when pos + (with-current-buffer buf (goto-char pos))) (save-window-excursion (let ((win (display-buffer buf @@ -3620,7 +3641,9 @@ impose the use of a shell (with its need to quote arguments)." (if handler (funcall handler 'shell-command command output-buffer error-buffer) (if (and output-buffer - (not (or (bufferp output-buffer) (stringp output-buffer)))) + (or (eq output-buffer (current-buffer)) + (and (stringp output-buffer) (eq (get-buffer output-buffer) (current-buffer))) + (not (or (bufferp output-buffer) (stringp output-buffer))))) ; Bug#39067 ;; Output goes in current buffer. (let ((error-file (and error-buffer @@ -3630,6 +3653,7 @@ impose the use of a shell (with its need to quote arguments)." temporary-file-directory)))))) (barf-if-buffer-read-only) (push-mark nil t) + (shell-command-save-pos-or-erase 'output-to-current-buffer) ;; We do not use -f for csh; we will not support broken use of ;; .cshrcs. Even the BSD csh manual says to use ;; "if ($?prompt) exit" before things that are not useful @@ -3658,7 +3682,8 @@ impose the use of a shell (with its need to quote arguments)." ;; because we inserted text. (goto-char (prog1 (mark t) (set-marker (mark-marker) (point) - (current-buffer))))) + (current-buffer)))) + (shell-command-set-point-after-cmd)) ;; Output goes in a separate buffer. ;; Preserve the match data in case called from a program. ;; FIXME: It'd be ridiculous for an Elisp function to call @@ -3703,7 +3728,7 @@ impose the use of a shell (with its need to quote arguments)." (rename-uniquely)) (setq buffer (get-buffer-create bname))))) (with-current-buffer buffer - (shell-command--save-pos-or-erase) + (shell-command-save-pos-or-erase) (setq default-directory directory) (let ((process-environment (if (natnump async-shell-command-width) @@ -3809,7 +3834,7 @@ and are used only if a pop-up buffer is displayed." ;; `shell-command-dont-erase-buffer' is non-nil. (defun shell-command-sentinel (process signal) (when (memq (process-status process) '(exit signal)) - (shell-command--set-point-after-cmd (process-buffer process)) + (shell-command-set-point-after-cmd (process-buffer process)) (message "%s: %s." (car (cdr (cdr (process-command process)))) (substring signal 0 -1)))) @@ -3928,7 +3953,7 @@ interactively, this is t." (set-buffer-major-mode buffer) ; Enable globalized modes (bug#38111) (unwind-protect (if (and (eq buffer (current-buffer)) - (or (not shell-command-dont-erase-buffer) + (or (memq shell-command-dont-erase-buffer '(nil erase)) (and (not (eq buffer (get-buffer "*Shell Command Output*"))) (not (region-active-p))))) ;; If the input is the same buffer as the output, @@ -3951,7 +3976,7 @@ interactively, this is t." (with-current-buffer buffer (if (not output-buffer) (setq default-directory directory)) - (shell-command--save-pos-or-erase))) + (shell-command-save-pos-or-erase))) (setq exit-status (call-shell-region start end command nil (if error-file @@ -3970,7 +3995,7 @@ interactively, this is t." ;; There's some output, display it (progn (display-message-or-buffer buffer) - (shell-command--set-point-after-cmd buffer)) + (shell-command-set-point-after-cmd buffer)) ;; No output; error? (let ((output (if (and error-file diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index 2611519d074..0b12cee5855 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -711,5 +711,59 @@ See Bug#21722." (when process (delete-process process)) (when buffer (kill-buffer buffer))))))) + +;;; Tests for shell-command-dont-erase-buffer + +(defmacro with-shell-command-dont-erase-buffer (str output-buffer-is-current &rest body) + (declare (debug (form &body)) (indent 2)) + (let ((expected (make-symbol "expected")) + (command (make-symbol "command")) + (caller-buf (make-symbol "caller-buf")) + (output-buf (make-symbol "output-buf"))) + `(let* ((,caller-buf (generate-new-buffer "caller-buf")) + (,output-buf (if ,output-buffer-is-current ,caller-buf + (generate-new-buffer "output-buf"))) + (,command (format "%s --batch --eval '(princ \"%s\")'" invocation-name ,str)) + (inhibit-message t)) + (unwind-protect + ;; Feature must work the same regardless how we specify the 2nd arg of `shell-command', ie, + ;; as a buffer, buffer name (or t, if the output must go to the current buffer). + (dolist (output (append (list ,output-buf (buffer-name ,output-buf)) + (if ,output-buffer-is-current '(t) nil))) + (dolist (save-pos '(erase nil beg-last-out end-last-out save-point)) + (let ((shell-command-dont-erase-buffer save-pos)) + (with-current-buffer ,output-buf (erase-buffer)) + (with-current-buffer ,caller-buf + (dotimes (_ 2) (shell-command ,command output))) + (with-current-buffer ,output-buf + ,@body)))) + (kill-buffer ,caller-buf) + (when (buffer-live-p ,output-buf) + (kill-buffer ,output-buf)))))) + +(ert-deftest simple-tests-shell-command-39067 () + "The output buffer is erased or not according to `shell-command-dont-erase-buffer'." + (let ((str "foo\n")) + (dolist (output-current '(t nil)) + (with-shell-command-dont-erase-buffer str output-current + (let ((expected (cond ((eq shell-command-dont-erase-buffer 'erase) str) + ((null shell-command-dont-erase-buffer) + (if output-current (concat str str) + str)) + (t (concat str str))))) + (should (string= expected (buffer-string)))))))) + +(ert-deftest simple-tests-shell-command-dont-erase-buffer () + "The point is set at the expected position after execution of the command." + (let* ((str "foo\n") + (expected-point `((beg-last-out . ,(1+ (length str))) + (end-last-out . ,(1+ (* 2 (length str)))) + (save-point . 1)))) + (dolist (output-buffer-is-current '(t ni)) + (with-shell-command-dont-erase-buffer str output-buffer-is-current + (when (memq shell-command-dont-erase-buffer '(beg-last-out end-last-out save-point)) + (should (= (point) (alist-get shell-command-dont-erase-buffer expected-point)))))))) + + (provide 'simple-test) ;;; simple-test.el ends here -- 2.39.2