aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorTino Calancha2020-01-19 11:13:02 +0100
committerTino Calancha2020-01-19 11:13:02 +0100
commit2eb0b7835d1a9cd4b804436e33c71058cb38f178 (patch)
tree9edfabae5617c7d9113eec228e9b09f0319321ec
parentc134978a769a27c10de4a1c3d28c073f3de87a3c (diff)
downloademacs-2eb0b7835d1a9cd4b804436e33c71058cb38f178.tar.gz
emacs-2eb0b7835d1a9cd4b804436e33c71058cb38f178.zip
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.
-rw-r--r--doc/emacs/misc.texi14
-rw-r--r--etc/NEWS8
-rw-r--r--lisp/simple.el57
-rw-r--r--test/lisp/simple-tests.el54
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
826inserted into a buffer of that name. 826inserted into a buffer of that name.
827 827
828@vindex shell-command-dont-erase-buffer 828@vindex shell-command-dont-erase-buffer
829 By default, the output buffer is erased between shell commands. 829 By default, the output buffer is erased between shell commands, except
830If you change the value of the variable 830when the output goes to the current buffer. If you change the value
831@code{shell-command-dont-erase-buffer} to a non-@code{nil} value, 831of the option @code{shell-command-dont-erase-buffer} to @code{erase},
832the output buffer is not erased. This variable also controls where to 832then the output buffer is always erased. Any other non-@code{nil}
833set the point in the output buffer after the command completes; see the 833value prevents to erase the output buffer.
834documentation of the variable for details. 834
835This option also controls where to set the point in the output buffer
836after the command completes; see the documentation of the option for details.
835 837
836@node Interactive Shell 838@node Interactive Shell
837@subsection Interactive Subshell 839@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".
2038** Single shell commands 2038** Single shell commands
2039 2039
2040+++ 2040+++
2041*** 'shell-command-dont-erase-buffer' accepts the value 'erase' to
2042force to erase the output buffer before execution of the command.
2043
2044*** The new functions shell-command-save-pos-or-erase' and
2045'shell-command-set-point-after-cmd' control how point is handled
2046between two consecutive shell commands in the same buffer.
2047
2048+++
2041*** 'async-shell-command-width' defines the number of display columns 2049*** 'async-shell-command-width' defines the number of display columns
2042available for output of asynchronous shell commands. 2050available for output of asynchronous shell commands.
2043 2051
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'."
3431 :version "27.1") 3431 :version "27.1")
3432 3432
3433(defcustom shell-command-dont-erase-buffer nil 3433(defcustom shell-command-dont-erase-buffer nil
3434 "If non-nil, output buffer is not erased between shell commands. 3434 "Control if the output buffer is erased before the command.
3435Also, a non-nil value sets the point in the output buffer 3435
3436once the command completes. 3436A nil value erases the output buffer before execution of the
3437shell command, except when the output buffer is the current one.
3438
3439The value `erase' ensures the output buffer is erased before
3440execution of the shell command.
3441
3442Other non-nil values prevent the output buffer from being erased and
3443set the point after execution of the shell command.
3444
3437The value `beg-last-out' sets point at the beginning of the output, 3445The value `beg-last-out' sets point at the beginning of the output,
3438`end-last-out' sets point at the end of the buffer, `save-point' 3446`end-last-out' sets point at the end of the buffer, `save-point'
3439restores the buffer position before the command." 3447restores the buffer position before the command."
3440 :type '(choice 3448 :type '(choice
3441 (const :tag "Erase buffer" nil) 3449 (const :tag "Erase output buffer if not the current one" nil)
3450 (const :tag "Always erase output buffer" erase)
3442 (const :tag "Set point to beginning of last output" beg-last-out) 3451 (const :tag "Set point to beginning of last output" beg-last-out)
3443 (const :tag "Set point to end of last output" end-last-out) 3452 (const :tag "Set point to end of last output" end-last-out)
3444 (const :tag "Save point" save-point)) 3453 (const :tag "Save point" save-point))
3445 :group 'shell 3454 :group 'shell
3446 :version "26.1") 3455 :version "27.1")
3447 3456
3448(defvar shell-command-saved-pos nil 3457(defvar shell-command-saved-pos nil
3449 "Record of point positions in output buffers after command completion. 3458 "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
3452in BUFFER once the command finishes. 3461in BUFFER once the command finishes.
3453This variable is used when `shell-command-dont-erase-buffer' is non-nil.") 3462This variable is used when `shell-command-dont-erase-buffer' is non-nil.")
3454 3463
3455(defun shell-command--save-pos-or-erase () 3464(defun shell-command-save-pos-or-erase (&optional output-to-current-buffer)
3456 "Store a buffer position or erase the buffer. 3465 "Store a buffer position or erase the buffer.
3466Optional argument OUTPUT-TO-CURRENT-BUFFER, if non-nil, means that the output
3467of the shell command goes to the caller current buffer.
3468
3457See `shell-command-dont-erase-buffer'." 3469See `shell-command-dont-erase-buffer'."
3458 (let ((sym shell-command-dont-erase-buffer) 3470 (let ((sym shell-command-dont-erase-buffer)
3459 pos) 3471 pos)
@@ -3464,7 +3476,9 @@ See `shell-command-dont-erase-buffer'."
3464 (setq pos 3476 (setq pos
3465 (cond ((eq sym 'save-point) (point)) 3477 (cond ((eq sym 'save-point) (point))
3466 ((eq sym 'beg-last-out) (point-max)) 3478 ((eq sym 'beg-last-out) (point-max))
3467 ((not sym) 3479 ;;((not sym)
3480 ((or (eq sym 'erase)
3481 (and (null sym) (not output-to-current-buffer)))
3468 (let ((inhibit-read-only t)) 3482 (let ((inhibit-read-only t))
3469 (erase-buffer) nil)))) 3483 (erase-buffer) nil))))
3470 (when pos 3484 (when pos
@@ -3472,7 +3486,7 @@ See `shell-command-dont-erase-buffer'."
3472 (push (cons (current-buffer) pos) 3486 (push (cons (current-buffer) pos)
3473 shell-command-saved-pos)))) 3487 shell-command-saved-pos))))
3474 3488
3475(defun shell-command--set-point-after-cmd (&optional buffer) 3489(defun shell-command-set-point-after-cmd (&optional buffer)
3476 "Set point in BUFFER after command complete. 3490 "Set point in BUFFER after command complete.
3477BUFFER is the output buffer of the command; if nil, then defaults 3491BUFFER is the output buffer of the command; if nil, then defaults
3478to the current BUFFER. 3492to the current BUFFER.
@@ -3487,12 +3501,19 @@ whose `car' is BUFFER."
3487 (when (buffer-live-p buf) 3501 (when (buffer-live-p buf)
3488 (let ((win (car (get-buffer-window-list buf))) 3502 (let ((win (car (get-buffer-window-list buf)))
3489 (pmax (with-current-buffer buf (point-max)))) 3503 (pmax (with-current-buffer buf (point-max))))
3490 (unless (and pos (memq sym '(save-point beg-last-out))) 3504
3505 ;; The first time we run a command in a fresh created buffer
3506 ;; we have not saved positions yet; advance to `point-max', so that
3507 ;; succesive commands knows the position where the new comman start.
3508 ;; (unless (and pos (memq sym '(save-point beg-last-out)))
3509 (unless (and pos (memq sym '(save-point beg-last-out end-last-out)))
3491 (setq pos pmax)) 3510 (setq pos pmax))
3492 ;; Set point in the window displaying buf, if any; otherwise 3511 ;; Set point in the window displaying buf, if any; otherwise
3493 ;; display buf temporary in selected frame and set the point. 3512 ;; display buf temporary in selected frame and set the point.
3494 (if win 3513 (if win
3495 (set-window-point win pos) 3514 (set-window-point win pos)
3515 (when pos
3516 (with-current-buffer buf (goto-char pos)))
3496 (save-window-excursion 3517 (save-window-excursion
3497 (let ((win (display-buffer 3518 (let ((win (display-buffer
3498 buf 3519 buf
@@ -3620,7 +3641,9 @@ impose the use of a shell (with its need to quote arguments)."
3620 (if handler 3641 (if handler
3621 (funcall handler 'shell-command command output-buffer error-buffer) 3642 (funcall handler 'shell-command command output-buffer error-buffer)
3622 (if (and output-buffer 3643 (if (and output-buffer
3623 (not (or (bufferp output-buffer) (stringp output-buffer)))) 3644 (or (eq output-buffer (current-buffer))
3645 (and (stringp output-buffer) (eq (get-buffer output-buffer) (current-buffer)))
3646 (not (or (bufferp output-buffer) (stringp output-buffer))))) ; Bug#39067
3624 ;; Output goes in current buffer. 3647 ;; Output goes in current buffer.
3625 (let ((error-file 3648 (let ((error-file
3626 (and error-buffer 3649 (and error-buffer
@@ -3630,6 +3653,7 @@ impose the use of a shell (with its need to quote arguments)."
3630 temporary-file-directory)))))) 3653 temporary-file-directory))))))
3631 (barf-if-buffer-read-only) 3654 (barf-if-buffer-read-only)
3632 (push-mark nil t) 3655 (push-mark nil t)
3656 (shell-command-save-pos-or-erase 'output-to-current-buffer)
3633 ;; We do not use -f for csh; we will not support broken use of 3657 ;; We do not use -f for csh; we will not support broken use of
3634 ;; .cshrcs. Even the BSD csh manual says to use 3658 ;; .cshrcs. Even the BSD csh manual says to use
3635 ;; "if ($?prompt) exit" before things that are not useful 3659 ;; "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)."
3658 ;; because we inserted text. 3682 ;; because we inserted text.
3659 (goto-char (prog1 (mark t) 3683 (goto-char (prog1 (mark t)
3660 (set-marker (mark-marker) (point) 3684 (set-marker (mark-marker) (point)
3661 (current-buffer))))) 3685 (current-buffer))))
3686 (shell-command-set-point-after-cmd))
3662 ;; Output goes in a separate buffer. 3687 ;; Output goes in a separate buffer.
3663 ;; Preserve the match data in case called from a program. 3688 ;; Preserve the match data in case called from a program.
3664 ;; FIXME: It'd be ridiculous for an Elisp function to call 3689 ;; 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)."
3703 (rename-uniquely)) 3728 (rename-uniquely))
3704 (setq buffer (get-buffer-create bname))))) 3729 (setq buffer (get-buffer-create bname)))))
3705 (with-current-buffer buffer 3730 (with-current-buffer buffer
3706 (shell-command--save-pos-or-erase) 3731 (shell-command-save-pos-or-erase)
3707 (setq default-directory directory) 3732 (setq default-directory directory)
3708 (let ((process-environment 3733 (let ((process-environment
3709 (if (natnump async-shell-command-width) 3734 (if (natnump async-shell-command-width)
@@ -3809,7 +3834,7 @@ and are used only if a pop-up buffer is displayed."
3809;; `shell-command-dont-erase-buffer' is non-nil. 3834;; `shell-command-dont-erase-buffer' is non-nil.
3810(defun shell-command-sentinel (process signal) 3835(defun shell-command-sentinel (process signal)
3811 (when (memq (process-status process) '(exit signal)) 3836 (when (memq (process-status process) '(exit signal))
3812 (shell-command--set-point-after-cmd (process-buffer process)) 3837 (shell-command-set-point-after-cmd (process-buffer process))
3813 (message "%s: %s." 3838 (message "%s: %s."
3814 (car (cdr (cdr (process-command process)))) 3839 (car (cdr (cdr (process-command process))))
3815 (substring signal 0 -1)))) 3840 (substring signal 0 -1))))
@@ -3928,7 +3953,7 @@ interactively, this is t."
3928 (set-buffer-major-mode buffer) ; Enable globalized modes (bug#38111) 3953 (set-buffer-major-mode buffer) ; Enable globalized modes (bug#38111)
3929 (unwind-protect 3954 (unwind-protect
3930 (if (and (eq buffer (current-buffer)) 3955 (if (and (eq buffer (current-buffer))
3931 (or (not shell-command-dont-erase-buffer) 3956 (or (memq shell-command-dont-erase-buffer '(nil erase))
3932 (and (not (eq buffer (get-buffer "*Shell Command Output*"))) 3957 (and (not (eq buffer (get-buffer "*Shell Command Output*")))
3933 (not (region-active-p))))) 3958 (not (region-active-p)))))
3934 ;; If the input is the same buffer as the output, 3959 ;; If the input is the same buffer as the output,
@@ -3951,7 +3976,7 @@ interactively, this is t."
3951 (with-current-buffer buffer 3976 (with-current-buffer buffer
3952 (if (not output-buffer) 3977 (if (not output-buffer)
3953 (setq default-directory directory)) 3978 (setq default-directory directory))
3954 (shell-command--save-pos-or-erase))) 3979 (shell-command-save-pos-or-erase)))
3955 (setq exit-status 3980 (setq exit-status
3956 (call-shell-region start end command nil 3981 (call-shell-region start end command nil
3957 (if error-file 3982 (if error-file
@@ -3970,7 +3995,7 @@ interactively, this is t."
3970 ;; There's some output, display it 3995 ;; There's some output, display it
3971 (progn 3996 (progn
3972 (display-message-or-buffer buffer) 3997 (display-message-or-buffer buffer)
3973 (shell-command--set-point-after-cmd buffer)) 3998 (shell-command-set-point-after-cmd buffer))
3974 ;; No output; error? 3999 ;; No output; error?
3975 (let ((output 4000 (let ((output
3976 (if (and error-file 4001 (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."
711 (when process (delete-process process)) 711 (when process (delete-process process))
712 (when buffer (kill-buffer buffer))))))) 712 (when buffer (kill-buffer buffer)))))))
713 713
714
715;;; Tests for shell-command-dont-erase-buffer
716
717(defmacro with-shell-command-dont-erase-buffer (str output-buffer-is-current &rest body)
718 (declare (debug (form &body)) (indent 2))
719 (let ((expected (make-symbol "expected"))
720 (command (make-symbol "command"))
721 (caller-buf (make-symbol "caller-buf"))
722 (output-buf (make-symbol "output-buf")))
723 `(let* ((,caller-buf (generate-new-buffer "caller-buf"))
724 (,output-buf (if ,output-buffer-is-current ,caller-buf
725 (generate-new-buffer "output-buf")))
726 (,command (format "%s --batch --eval '(princ \"%s\")'" invocation-name ,str))
727 (inhibit-message t))
728 (unwind-protect
729 ;; Feature must work the same regardless how we specify the 2nd arg of `shell-command', ie,
730 ;; as a buffer, buffer name (or t, if the output must go to the current buffer).
731 (dolist (output (append (list ,output-buf (buffer-name ,output-buf))
732 (if ,output-buffer-is-current '(t) nil)))
733 (dolist (save-pos '(erase nil beg-last-out end-last-out save-point))
734 (let ((shell-command-dont-erase-buffer save-pos))
735 (with-current-buffer ,output-buf (erase-buffer))
736 (with-current-buffer ,caller-buf
737 (dotimes (_ 2) (shell-command ,command output)))
738 (with-current-buffer ,output-buf
739 ,@body))))
740 (kill-buffer ,caller-buf)
741 (when (buffer-live-p ,output-buf)
742 (kill-buffer ,output-buf))))))
743
744(ert-deftest simple-tests-shell-command-39067 ()
745 "The output buffer is erased or not according to `shell-command-dont-erase-buffer'."
746 (let ((str "foo\n"))
747 (dolist (output-current '(t nil))
748 (with-shell-command-dont-erase-buffer str output-current
749 (let ((expected (cond ((eq shell-command-dont-erase-buffer 'erase) str)
750 ((null shell-command-dont-erase-buffer)
751 (if output-current (concat str str)
752 str))
753 (t (concat str str)))))
754 (should (string= expected (buffer-string))))))))
755
756(ert-deftest simple-tests-shell-command-dont-erase-buffer ()
757 "The point is set at the expected position after execution of the command."
758 (let* ((str "foo\n")
759 (expected-point `((beg-last-out . ,(1+ (length str)))
760 (end-last-out . ,(1+ (* 2 (length str))))
761 (save-point . 1))))
762 (dolist (output-buffer-is-current '(t ni))
763 (with-shell-command-dont-erase-buffer str output-buffer-is-current
764 (when (memq shell-command-dont-erase-buffer '(beg-last-out end-last-out save-point))
765 (should (= (point) (alist-get shell-command-dont-erase-buffer expected-point))))))))
766
767
714(provide 'simple-test) 768(provide 'simple-test)
715;;; simple-test.el ends here 769;;; simple-test.el ends here