Function: tramp-handle-shell-command
tramp-handle-shell-command is a byte-compiled function defined in
tramp.el.gz.
Signature
(tramp-handle-shell-command COMMAND &optional OUTPUT-BUFFER ERROR-BUFFER)
Documentation
Like shell-command for Tramp files.
Source Code
;; Defined in /usr/src/emacs/lisp/net/tramp.el.gz
(defun tramp-handle-shell-command (command &optional output-buffer error-buffer)
"Like `shell-command' for Tramp files."
(let* ((asynchronous (string-match-p (rx (* blank) "&" (* blank) eos) command))
(command (substring command 0 asynchronous))
current-buffer-p
(output-buffer-p output-buffer)
(output-buffer
(cond
((bufferp output-buffer)
(setq current-buffer-p (eq (current-buffer) output-buffer))
output-buffer)
((stringp output-buffer)
(setq current-buffer-p
(eq (buffer-name (current-buffer)) output-buffer))
(get-buffer-create output-buffer))
(output-buffer
(setq current-buffer-p t)
(current-buffer))
(t (get-buffer-create
;; These variables have been introduced with Emacs 28.1.
(if asynchronous
(or (bound-and-true-p shell-command-buffer-name-async)
"*Async Shell Command*")
(or (bound-and-true-p shell-command-buffer-name)
"*Shell Command Output*"))))))
(error-buffer
(cond
((bufferp error-buffer) error-buffer)
((stringp error-buffer) (get-buffer-create error-buffer))))
(error-file
(and error-buffer
(with-parsed-tramp-file-name default-directory nil
(tramp-make-tramp-file-name
v (tramp-make-tramp-temp-file v)))))
(bname (buffer-name output-buffer))
(p (get-buffer-process output-buffer))
(dir default-directory)
buffer)
;; The following code is taken from `shell-command', slightly
;; adapted. Shouldn't it be factored out?
(when (and (integerp asynchronous) p)
(cond
((eq async-shell-command-buffer 'confirm-kill-process)
;; If will kill a process, query first.
(if (yes-or-no-p
"A command is running in the default buffer. Kill it?")
(kill-process p)
(tramp-user-error p "Shell command in progress")))
((eq async-shell-command-buffer 'confirm-new-buffer)
;; If will create a new buffer, query first.
(if (yes-or-no-p
"A command is running in the default buffer. Use a new buffer?")
(setq output-buffer (generate-new-buffer bname))
(tramp-user-error p "Shell command in progress")))
((eq async-shell-command-buffer 'new-buffer)
;; It will create a new buffer.
(setq output-buffer (generate-new-buffer bname)))
((eq async-shell-command-buffer 'confirm-rename-buffer)
;; If will rename the buffer, query first.
(if (yes-or-no-p
"A command is running in the default buffer. Rename it?")
(progn
(with-current-buffer output-buffer
(rename-uniquely))
(setq output-buffer (get-buffer-create bname)))
(tramp-user-error p "Shell command in progress")))
((eq async-shell-command-buffer 'rename-buffer)
;; It will rename the buffer.
(with-current-buffer output-buffer
(rename-uniquely))
(setq output-buffer (get-buffer-create bname)))))
(unless output-buffer-p
(with-current-buffer output-buffer
(setq default-directory dir)))
(setq buffer (if error-file (list output-buffer error-file) output-buffer))
(with-current-buffer output-buffer
(when current-buffer-p
(barf-if-buffer-read-only)
(push-mark nil t))
(shell-command-save-pos-or-erase current-buffer-p))
(if (integerp asynchronous)
(let ((tramp-remote-process-environment
(if (natnump async-shell-command-width)
(cons (format "COLUMNS=%d"
(bound-and-true-p async-shell-command-width))
tramp-remote-process-environment)
tramp-remote-process-environment)))
(prog1
;; Run the process.
(setq p (start-file-process-shell-command
(buffer-name output-buffer) buffer command))
(when (process-live-p p)
;; Display output.
(with-current-buffer output-buffer
(setq mode-line-process '(":%s"))
(cond
((boundp 'async-shell-command-mode)
;; Emacs 30+
(unless (eq major-mode async-shell-command-mode)
(funcall async-shell-command-mode)))
((not (eq major-mode 'shell-mode))
(shell-mode)))
(set-process-filter p #'comint-output-filter)
(set-process-sentinel p #'shell-command-sentinel)
(when error-file
(add-function
:after (process-sentinel p)
(lambda (_proc _string)
(ignore-errors
(with-current-buffer error-buffer
(insert-file-contents-literally
error-file nil nil nil 'replace))
(delete-file error-file)))))
(if async-shell-command-display-buffer
;; Display buffer immediately.
(display-buffer output-buffer '(nil (allow-no-window . t)))
;; Defer displaying buffer until first process output.
;; Use disposable named advice so that the buffer is
;; displayed at most once per process lifetime.
(let ((nonce (make-symbol "nonce")))
(add-function
:before (process-filter p)
(lambda (proc _string)
(let ((buf (process-buffer proc)))
(when (buffer-live-p buf)
(remove-function (process-filter proc)
nonce)
(display-buffer buf '(nil (allow-no-window . t))))))
`((name . ,nonce)))))))
;; Insert error messages if they were separated.
(when (and error-file (not (process-live-p p)))
(ignore-errors
(with-current-buffer error-buffer
(insert-file-contents-literally error-file))
(delete-file error-file)))))
;; Synchronous case.
(prog1
;; Run the process.
(process-file-shell-command command nil buffer)
;; Insert error messages if they were separated.
(when error-file
(ignore-errors
(with-current-buffer error-buffer
(insert-file-contents-literally error-file))
(delete-file error-file)))
(if current-buffer-p
;; This is like exchange-point-and-mark, but doesn't
;; activate the mark. It is cleaner to avoid activation,
;; even though the command loop would deactivate the mark
;; because we inserted text.
(progn
(goto-char (prog1 (mark t)
(set-marker (mark-marker) (point)
(current-buffer))))
(shell-command-set-point-after-cmd))
;; There's some output, display it.
(when (with-current-buffer output-buffer (> (point-max) (point-min)))
(display-message-or-buffer output-buffer)))))))