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.

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
@@ -2038,6 +2038,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