aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorTino Calancha2020-01-19 11:13:02 +0100
committerTino Calancha2020-01-19 11:13:02 +0100
commit2eb0b7835d1a9cd4b804436e33c71058cb38f178 (patch)
tree9edfabae5617c7d9113eec228e9b09f0319321ec /lisp
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.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/simple.el57
1 files changed, 41 insertions, 16 deletions
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