diff options
Diffstat (limited to 'lisp/shell.el')
| -rw-r--r-- | lisp/shell.el | 274 |
1 files changed, 171 insertions, 103 deletions
diff --git a/lisp/shell.el b/lisp/shell.el index f0115b90a50..85225b128ab 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -98,6 +98,7 @@ (require 'comint) (require 'pcomplete) (eval-when-compile (require 'files-x)) ;with-connection-local-variables +(require 'subr-x) ;;; Customization and Buffer Variables @@ -330,6 +331,12 @@ Useful for shells like zsh that has this feature." :group 'shell-directories :version "28.1") +(defcustom shell-kill-buffer-on-exit nil + "Kill a shell buffer after the shell process terminates." + :type 'boolean + :group 'shell + :version "29.1") + (defvar shell-mode-map (let ((map (make-sparse-keymap))) (define-key map "\C-c\C-f" 'shell-forward-command) @@ -433,12 +440,11 @@ Useful for shells like zsh that has this feature." (push (point) begins) (let ((arg ())) (while (looking-at - (eval-when-compile - (concat - "\\(?:[^\s\t\n\\\"';]+" - "\\|'\\([^']*\\)'?" - "\\|\"\\(\\(?:[^\"\\]\\|\\\\.\\)*\\)\"?" - "\\|\\\\\\(\\(?:.\\|\n\\)?\\)\\)"))) + (concat + "\\(?:[^\s\t\n\\\"';]+" + "\\|'\\([^']*\\)'?" + "\\|\"\\(\\(?:[^\"\\]\\|\\\\.\\)*\\)\"?" + "\\|\\\\\\(\\(?:.\\|\n\\)?\\)\\)")) (goto-char (match-end 0)) (cond ((match-beginning 3) ;Backslash escape. @@ -527,7 +533,7 @@ Shell buffers. It implements `shell-completion-execonly' for the shell. This is useful for entering passwords. Or, add the function `comint-watch-for-password-prompt' to `comint-output-filter-functions'. -If you want to make multiple shell buffers, rename the `*shell*' buffer +If you want to make multiple shell buffers, rename the \"*shell*\" buffer using \\[rename-buffer] or \\[rename-uniquely] and start a new shell. If you want to make shell buffers limited in length, add the function @@ -570,7 +576,14 @@ the initialization of the input ring history, and history expansion. Variables `comint-output-filter-functions', a hook, and `comint-scroll-to-bottom-on-input' and `comint-scroll-to-bottom-on-output' control whether input and output cause the window to scroll to the end of the -buffer." +buffer. + +By default, shell mode does nothing special when it receives a +\"bell\" character (C-g or ^G). If you + (add-hook \\='comint-output-filter-functions #\\='shell-filter-ring-bell nil t) +from `shell-mode-hook', Emacs will call the `ding' function +whenever it receives the bell character in output from a +command." :interactive nil (setq comint-prompt-regexp shell-prompt-pattern) (shell-completion-vars) @@ -681,6 +694,13 @@ This function can be put on `comint-preoutput-filter-functions'." (replace-regexp-in-string "[\C-a\C-b]" "" string t t) string)) +(defun shell-filter-ring-bell (string) + "Call `ding' if STRING contains a \"^G\" character. +This function can be put on `comint-output-filter-functions'." + (when (string-search "\a" string) + (ding)) + string) + (defun shell-write-history-on-exit (process event) "Called when the shell process is stopped. @@ -698,7 +718,7 @@ Sentinels will always get the two parameters PROCESS and EVENT." (insert (format "\nProcess %s %s\n" process event)))))) ;;;###autoload -(defun shell (&optional buffer) +(defun shell (&optional buffer file-name) "Run an inferior shell, with I/O through BUFFER (which defaults to `*shell*'). Interactively, a prefix arg means to prompt for BUFFER. If `default-directory' is a remote file name, it is also prompted @@ -709,6 +729,8 @@ If BUFFER exists and shell process is running, just switch to BUFFER. Program used comes from variable `explicit-shell-file-name', or (if that is nil) from the ESHELL environment variable, or (if that is nil) from `shell-file-name'. +Non-interactively, it can also be specified via the FILE-NAME arg. + If a file `~/.emacs_SHELLNAME' exists, or `~/.emacs.d/init_SHELLNAME.sh', it is given as initial input (but this may be lost, due to a timing error, if the shell discards input when it starts up). @@ -732,25 +754,47 @@ Make the shell buffer the current buffer, and return it. \(Type \\[describe-mode] in the shell buffer for a list of commands.)" (interactive - (list - (and current-prefix-arg - (prog1 - (read-buffer "Shell buffer: " - ;; If the current buffer is an inactive - ;; shell buffer, use it as the default. - (if (and (eq major-mode 'shell-mode) - (null (get-buffer-process (current-buffer)))) - (buffer-name) - (generate-new-buffer-name "*shell*"))) - (if (file-remote-p default-directory) - ;; It must be possible to declare a local default-directory. - ;; FIXME: This can't be right: it changes the default-directory - ;; of the current-buffer rather than of the *shell* buffer. - (setq default-directory - (expand-file-name - (read-directory-name - "Default directory: " default-directory default-directory - t nil)))))))) + (let* ((buffer + (and current-prefix-arg + (read-buffer "Shell buffer: " + ;; If the current buffer is an inactive + ;; shell buffer, use it as the default. + (if (and (eq major-mode 'shell-mode) + (null (get-buffer-process + (current-buffer)))) + (buffer-name) + (generate-new-buffer-name "*shell*"))))) + (buf (if (or buffer (not (derived-mode-p 'shell-mode)) + (comint-check-proc (current-buffer))) + (get-buffer-create (or buffer "*shell*")) + ;; If the current buffer is a dead shell buffer, use it. + (current-buffer)))) + + (with-current-buffer buf + (when (and buffer (file-remote-p default-directory)) + ;; It must be possible to declare a local default-directory. + (setq default-directory + (expand-file-name + (read-directory-name + "Default directory: " default-directory default-directory + t nil)))) + (list + buffer + ;; On remote hosts, the local `shell-file-name' might be useless. + (with-connection-local-variables + (when (and (file-remote-p default-directory) + (null explicit-shell-file-name) + (null (getenv "ESHELL"))) + ;; `expand-file-name' shall not add the MS Windows volume letter + ;; (Bug#49229). + (replace-regexp-in-string + "^[[:alpha:]]:" "" + (file-local-name + (expand-file-name + (read-file-name "Remote shell path: " default-directory + shell-file-name t shell-file-name + #'file-remote-p)))))))))) + (setq buffer (if (or buffer (not (derived-mode-p 'shell-mode)) (comint-check-proc (current-buffer))) (get-buffer-create (or buffer "*shell*")) @@ -758,24 +802,11 @@ Make the shell buffer the current buffer, and return it. (current-buffer))) ;; The buffer's window must be correctly set when we call comint ;; (so that comint sets the COLUMNS env var properly). - (pop-to-buffer-same-window buffer) + (pop-to-buffer buffer display-comint-buffer-action) (with-connection-local-variables - ;; On remote hosts, the local `shell-file-name' might be useless. - (when (and (file-remote-p default-directory) - (called-interactively-p 'any) - (null explicit-shell-file-name) - (null (getenv "ESHELL"))) - ;; `expand-file-name' shall not add the MS Windows volume letter - ;; (Bug#49229). - (setq-local explicit-shell-file-name - (replace-regexp-in-string - "^[[:alpha:]]:" "" - (file-local-name - (expand-file-name - (read-file-name "Remote shell path: " default-directory - shell-file-name t shell-file-name - #'file-remote-p)))))) + (when file-name + (setq-local explicit-shell-file-name file-name)) ;; Rain or shine, BUFFER must be current by now. (unless (comint-check-proc buffer) @@ -783,16 +814,37 @@ Make the shell buffer the current buffer, and return it. (getenv "ESHELL") shell-file-name)) (name (file-name-nondirectory prog)) (startfile (concat "~/.emacs_" name)) - (xargs-name (intern-soft (concat "explicit-" name "-args")))) + (xargs-name (intern-soft (concat "explicit-" name "-args"))) + (start-point (point))) (unless (file-exists-p startfile) - (setq startfile (concat user-emacs-directory "init_" name ".sh"))) + (setq startfile (locate-user-emacs-file + (concat "init_" name ".sh")))) (setq-local shell--start-prog (file-name-nondirectory prog)) (apply #'make-comint-in-buffer "shell" buffer prog - (if (file-exists-p startfile) startfile) + nil (if (and xargs-name (boundp xargs-name)) (symbol-value xargs-name) '("-i"))) - (shell-mode)))) + (shell-mode) + (when (file-exists-p startfile) + ;; Wait until the prompt has appeared. + (while (= start-point (point)) + (sleep-for 0.1)) + (shell-eval-command + (with-temp-buffer + (insert-file-contents startfile) + (buffer-string))))))) + (when shell-kill-buffer-on-exit + (let* ((buffer (current-buffer)) + (process (get-buffer-process buffer)) + (sentinel (process-sentinel process))) + (set-process-sentinel + process + (lambda (proc event) + (when sentinel + (funcall sentinel proc event)) + (unless (buffer-live-p proc) + (kill-buffer buffer)))))) buffer) ;;; Directory tracking @@ -1008,7 +1060,9 @@ Environment variables are expanded, see function `substitute-in-file-name'." "Toggle directory tracking in this shell buffer (Shell Dirtrack mode). The `dirtrack' package provides an alternative implementation of -this feature; see the function `dirtrack-mode'." +this feature; see the function `dirtrack-mode'. Also see +`comint-osc-directory-tracker' for an escape-sequence based +solution." :lighter nil (setq list-buffers-directory (if shell-dirtrack-mode default-directory)) (if shell-dirtrack-mode @@ -1025,61 +1079,45 @@ this feature; see the function `dirtrack-mode'." "Resync the buffer's idea of the current directory stack. This command queries the shell with the command bound to `shell-dirstack-query' (default \"dirs\"), reads the next -line output and parses it to form the new directory stack. -DON'T issue this command unless the buffer is at a shell prompt. -Also, note that if some other subprocess decides to do output -immediately after the query, its output will be taken as the -new directory stack -- you lose. If this happens, just do the -command again." +line output and parses it to form the new directory stack." (interactive) - (let* ((proc (get-buffer-process (current-buffer))) - (pmark (process-mark proc)) - (started-at-pmark (= (point) (marker-position pmark)))) - (save-excursion - (goto-char pmark) - ;; If the process echoes commands, don't insert a fake command in - ;; the buffer or it will appear twice. - (unless comint-process-echoes - (insert shell-dirstack-query) (insert "\n")) - (sit-for 0) ; force redisplay - (comint-send-string proc shell-dirstack-query) - (comint-send-string proc "\n") - (set-marker pmark (point)) - (let ((pt (point)) - (regexp - (concat - (if comint-process-echoes - ;; Skip command echo if the process echoes - (concat "\\(" (regexp-quote shell-dirstack-query) "\n\\)") - "\\(\\)") - "\\(.+\n\\)"))) - ;; This extra newline prevents the user's pending input from spoofing us. - (insert "\n") (backward-char 1) - ;; Wait for one line. - (while (not (looking-at regexp)) - (accept-process-output proc) - (goto-char pt))) - (goto-char pmark) (delete-char 1) ; remove the extra newline - ;; That's the dirlist. grab it & parse it. - (let* ((dl (buffer-substring (match-beginning 2) (1- (match-end 2)))) - (dl-len (length dl)) - (ds '()) ; new dir stack - (i 0)) - (while (< i dl-len) - ;; regexp = optional whitespace, (non-whitespace), optional whitespace - (string-match "\\s *\\(\\S +\\)\\s *" dl i) ; pick off next dir - (setq ds (cons (concat comint-file-name-prefix - (substring dl (match-beginning 1) - (match-end 1))) - ds)) - (setq i (match-end 0))) - (let ((ds (nreverse ds))) - (with-demoted-errors "Couldn't cd: %s" - (shell-cd (car ds)) - (setq shell-dirstack (cdr ds) - shell-last-dir (car shell-dirstack)) - (shell-dirstack-message))))) - (if started-at-pmark (goto-char (marker-position pmark))))) + (let* ((dls (car + (last + (string-lines + (string-chop-newline + (shell-eval-command (concat shell-dirstack-query "\n"))))))) + (dlsl nil) + (pos 0) + (ds nil)) + ;; Split the dirlist into whitespace and non-whitespace chunks. + ;; dlsl will be a reversed list of tokens. + (while (string-match "\\(\\S-+\\|\\s-+\\)" dls pos) + (push (match-string 1 dls) dlsl) + (setq pos (match-end 1))) + + ;; Prepend trailing entries until they form an existing directory, + ;; whitespace and all. Discard the next whitespace and repeat. + (while dlsl + (let ((newelt "") + tem1 tem2) + (while newelt + ;; We need tem1 because we don't want to prepend + ;; `comint-file-name-prefix' repeatedly into newelt via tem2. + (setq tem1 (pop dlsl) + tem2 (concat comint-file-name-prefix tem1 newelt)) + (cond ((file-directory-p tem2) + (push tem2 ds) + (when (string= " " (car dlsl)) + (pop dlsl)) + (setq newelt nil)) + (t + (setq newelt (concat tem1 newelt))))))) + + (with-demoted-errors "Couldn't cd: %s" + (shell-cd (car ds)) + (setq shell-dirstack (cdr ds) + shell-last-dir (car shell-dirstack)) + (shell-dirstack-message)))) ;; For your typing convenience: (defalias 'dirs 'shell-resync-dirs) @@ -1414,6 +1452,36 @@ Returns t if successful." (point-max) (shell--prompt-begin-position)))))) +(defun shell-eval-command (command) + "Eval COMMAND in the current shell process and return the result." + (let* ((proc (get-buffer-process (current-buffer))) + (old-filter (process-filter proc)) + (result "") + prev) + (unwind-protect + (progn + (set-process-filter + proc + (lambda (_proc string) + (setq result (concat result string)))) + (process-send-string proc command) + ;; Wait until we get a prompt (which will be a line without + ;; a newline). This is far from fool-proof -- if something + ;; outputs incomplete data and then sleeps, we'll think + ;; we've received the prompt. + (while (not (let* ((lines (string-lines result)) + (last (car (last lines)))) + (and (length> lines 0) + (not (equal last "")) + (or (not prev) + (not (equal last prev))) + (setq prev last)))) + (accept-process-output proc 0 100))) + ;; Restore old filter. + (set-process-filter proc old-filter)) + ;; Remove the prompt. + (replace-regexp-in-string "\n.*\\'" "\n" result))) + (provide 'shell) ;;; shell.el ends here |