bug#39067: shell-command-dont-erase-buffer strange behaviour

[Tino Calancha]

Eli Zaretskii <eliz@gnu.org> writes:

>> (let ((shell-command-dont-erase-buffer 'beg-last-out))
>>   (with-current-buffer (get-buffer-create "OUT")
>>     (erase-buffer)
>>     (shell-command "/bin/echo FOO" t)
>>     (shell-command "/bin/echo FOO" t)))
>> 
>> The result (as expected) is a buffer named OUT with 2 lines FOO.
>> The same result is expected with the following code:
>> 
>> (let ((shell-command-dont-erase-buffer 'beg-last-out))
>>   (with-current-buffer (get-buffer-create "OUT")
>>     (erase-buffer)
>>     (shell-command "/bin/echo FOO" "OUT")
>>     (shell-command "/bin/echo FOO" "OUT")))

> IOW, this feature is not working as advertised in several important
> use case, and never did AFAICT.  Its implementation is incomplete.
I agree; there was some contradictory info (hopefully fixed now).

The value nil shouldn't erase the output buffer when such a buffer
is the current one (for backward compatibility: we never erased the
buffer in that case); I have updated docstrings and tags to
clarify that point.

Also, I've added the value 'erase for this option:
this value will always erase the output buffer (i.e., even when the output
buffer is the current one).

Fixed the logic to cover the side case reported in this thread.

> The current implementation in simple.el uses
> shell-command--save-pos-or-erase and shell-command--set-point-after-cmd,
> both are internal functions. Could we make them first class citizens,
> that Tramp could profit from?
Renamed them to shell-command-save-pos-or-erase, 
shell-command--set-point-after-cmd.

> Test cases for this (and other shell-command functionality) would also
> be appreciated.
Added some.

--8<-----------------------------cut here---------------start------------->8---
commit bc201a4133bf5c62573fec1a1b38dbf5a618cd9e
Author: Tino Calancha <tino.calancha@gmail.com>
Date:   Mon Jan 13 20:55:02 2020 +0100

    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.

diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index ab3318c4a2..05ebae7145 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -826,12 +826,14 @@ Single Shell
 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 variable @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 variable also controls where to set the point in the output buffer
+after the command completes; see the documentation of the variable for details.
 
 @node Interactive Shell
 @subsection Interactive Subshell
diff --git a/etc/NEWS b/etc/NEWS
index 031ddf5800..c658f2e858 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2008,6 +2008,13 @@ 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 execute the command.
+
+*** New functions shell-command-save-pos-or-erase' and
+'shell-command-set-point-after-cmd'.
+
 +++
 *** '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 e6e5847402..11983df7b6 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -3431,19 +3431,28 @@ shell-command-prompt-show-cwd
   :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 execute
+the shell command, except when the output buffer is the current one.
+
+The value `erase' ensures the output buffer is erased before
+execute the shell command.
+
+Other non-nil values prevent the output buffer from be erased and
+set the point after execute 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 @@ shell-command-saved-pos
 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 @@ shell-command--save-pos-or-erase
     (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 @@ shell-command--save-pos-or-erase
       (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 @@ shell-command--set-point-after-cmd
       (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
+          ;; sucesive 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 @@ shell-command
     (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 @@ shell-command
                                              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 @@ shell-command
            ;; 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 @@ shell-command
                      (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 @@ display-message-or-buffer
 ;; `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 @@ shell-command-on-region
           (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 @@ shell-command-on-region
                   (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 @@ shell-command-on-region
                 ;; 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 2611519d07..ace3a8463c 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -711,5 +711,59 @@ simple-tests-async-shell-command-30280
           (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 with 
`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 execute 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

--8<-----------------------------cut here---------------end--------------->8---

In GNU Emacs 27.0.60 (build 44, x86_64-pc-linux-gnu, GTK+ Version 3.24.5)
 of 2020-01-13 built on calancha-pc.dy.bbexcite.jp
[On top of] Repository revision: d645628e3cf6ebe5eaea3b40100bd77b9c823f8b
('Always use lexical-binding in lisp-interaction-mode (bug#38835)')
Repository branch: emacs-27
Windowing system distributor 'The X.Org Foundation', version 11.0.12004000
System Description: Debian GNU/Linux 10 (buster)