diff options
| author | Tino Calancha | 2020-01-19 11:13:02 +0100 |
|---|---|---|
| committer | Tino Calancha | 2020-01-19 11:13:02 +0100 |
| commit | 2eb0b7835d1a9cd4b804436e33c71058cb38f178 (patch) | |
| tree | 9edfabae5617c7d9113eec228e9b09f0319321ec | |
| parent | c134978a769a27c10de4a1c3d28c073f3de87a3c (diff) | |
| download | emacs-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.texi | 14 | ||||
| -rw-r--r-- | etc/NEWS | 8 | ||||
| -rw-r--r-- | lisp/simple.el | 57 | ||||
| -rw-r--r-- | 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 | |||
| 826 | inserted into a buffer of that name. | 826 | inserted 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 |
| 830 | If you change the value of the variable | 830 | when 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, | 831 | of the option @code{shell-command-dont-erase-buffer} to @code{erase}, |
| 832 | the output buffer is not erased. This variable also controls where to | 832 | then the output buffer is always erased. Any other non-@code{nil} |
| 833 | set the point in the output buffer after the command completes; see the | 833 | value prevents to erase the output buffer. |
| 834 | documentation of the variable for details. | 834 | |
| 835 | This option also controls where to set the point in the output buffer | ||
| 836 | after 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 |
| @@ -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 | ||
| 2042 | force 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 | ||
| 2046 | between 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 |
| 2042 | available for output of asynchronous shell commands. | 2050 | available 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. |
| 3435 | Also, a non-nil value sets the point in the output buffer | 3435 | |
| 3436 | once the command completes. | 3436 | A nil value erases the output buffer before execution of the |
| 3437 | shell command, except when the output buffer is the current one. | ||
| 3438 | |||
| 3439 | The value `erase' ensures the output buffer is erased before | ||
| 3440 | execution of the shell command. | ||
| 3441 | |||
| 3442 | Other non-nil values prevent the output buffer from being erased and | ||
| 3443 | set the point after execution of the shell command. | ||
| 3444 | |||
| 3437 | The value `beg-last-out' sets point at the beginning of the output, | 3445 | The 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' |
| 3439 | restores the buffer position before the command." | 3447 | restores 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 | |||
| 3452 | in BUFFER once the command finishes. | 3461 | in BUFFER once the command finishes. |
| 3453 | This variable is used when `shell-command-dont-erase-buffer' is non-nil.") | 3462 | This 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. |
| 3466 | Optional argument OUTPUT-TO-CURRENT-BUFFER, if non-nil, means that the output | ||
| 3467 | of the shell command goes to the caller current buffer. | ||
| 3468 | |||
| 3457 | See `shell-command-dont-erase-buffer'." | 3469 | See `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. |
| 3477 | BUFFER is the output buffer of the command; if nil, then defaults | 3491 | BUFFER is the output buffer of the command; if nil, then defaults |
| 3478 | to the current BUFFER. | 3492 | to 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 |