1 ;;; multishell.el --- facilitate multiple local and remote shell buffers
3 ;; Copyright (C) 1999-2016 Free Software Foundation, Inc. and Ken Manheimer
5 ;; Author: Ken Manheimer <ken.manheimer@gmail.com>
7 ;; Created: 1999 -- first public availability
9 ;; URL: https://github.com/kenmanheimer/EmacsMultishell
13 ;; Easily use and navigate multiple shell buffers, including remote shells.
14 ;; Fundamentally, multishell is the function `multishell-pop-to-shell' -
15 ;; a la `pop-to-buffer' - plus a keybinding. Together, they enable you to:
17 ;; * Get to the input point from wherever you are in a shell buffer,
18 ;; ... or to any of your shell buffers, from elsewhere inside emacs.
20 ;; * Use universal arguments to launch and choose among alternate shell buffers,
21 ;; * ... and change which is the current default.
23 ;; * Easily restart disconnected shells, or shells from prior sessions
24 ;; * ... the latter from Emacs builtin savehist minibuf history persistence
26 ;; * Append a path to a new shell name to launch a shell in that directory,
27 ;; * ... and use a path with Emacs tramp syntax to launch a remote shell -
30 ;; * `/ssh:example.net:/` for a shell buffer in / on example.net.
31 ;; The buffer will be named "*example.net*".
33 ;; * `#ex/ssh:example.net|sudo:root@example.net:/etc` for a root shell
34 ;; starting in /etc on example.net named "*#ex*".
36 ;; * '\#intrn/ssh:corp.com|ssh:intern.corp.com|sudo:root@intern.corp.com:/etc'
37 ;; to go via corp.com to intern.corp.com, sudood to root, in /etc. Whee! (-:
38 ;; The buffer will be named "*#intrn*".
40 ;; * File visits will all be under the auspices of the account, and relative to
41 ;; the current directory, on the remote host.
43 ;; See the `multishell-pop-to-shell` docstring for details.
45 ;; Customize-group `multishell' to select and activate a keybinding and set
46 ;; various behaviors. Customize-group `savehist' to preserve buffer
47 ;; names/paths across emacs sessions.
50 ;; [the multishell repository](https://github.com/kenmanheimer/EmacsMultishell)
51 ;; issue tracker to report problems, suggestions, etc.
53 ;; (NOTE - tramp sometimes has a problem opening a remote shell pointed at
54 ;; a homedir, eg `/ssh:example.net:` or `/ssh:example.net:~`. When it
55 ;; fails, it won't work for the rest of the session. Non-homedir remote
56 ;; access isn't disrupted. Until this is fixed, you may need to start
57 ;; remote shells with an explicit path, then cd ~.)
61 ;; * 2016-01-16 1.0.5 Ken Manheimer:
62 ;; - History now includes paths, when designated
63 ;; - Actively track current directory in history entries that have a path.
64 ;; Custom control: multishell-history-entry-tracks-current-directory
65 ;; - Offer to remove shell's history entry when buffer is killed.
66 ;; (Currently the only UI mechanism to remove history entries.)
67 ;; - Fix - prevent duplicate entries for same name but different paths
68 ;; - Fix - recognize and respect tramp path syntax to start in home dir
69 ;; - But tramp bug, remote w/empty path (homedir) often fails, gets wedged.
70 ;; - Simplify history var name, migrate existing history if any from old name
71 ;; * 2016-01-04 1.0.4 Ken Manheimer - Released to ELPA
72 ;; * 2016-01-02 Ken Manheimer - working on this in public, but not yet released.
76 ;; * Isolate tramp sporadic failure to connect to remote+homedir (empty path)
78 ;; (eg, /ssh:xyz.com|sudo:root@xyz.com: or /ssh:xyz.com|sudo:root@xyz.com:~)
79 ;; * Find suitable, internally consistent ways to sort tidy completions, eg:
80 ;; - first list completions for active shells, then present but inactive,
82 ;; - some way for user to toggle between presenting just buffer names vs
84 ;; - without cutting user off from easy editing of path
85 ;; * Find proper method for setting field boundary at beginning of tramp path
86 ;; in the minibuffer, in order to see whether the field boundary magically
87 ;; enables tramp completion of the path.
88 ;; * Assess whether option to delete history entry on kill-buffer is
96 (defvar multishell-version "1.0.5")
98 (defgroup multishell nil
99 "Allout extension that highlights outline structure graphically.
101 Customize `allout-widgets-auto-activation' to activate allout-widgets
105 (defcustom multishell-command-key "\M- "
106 "The key to use if `multishell-activate-command-key' is true.
108 You can instead manually bind `multishell-pop-to-shell` using emacs
109 lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
113 (defvar multishell--responsible-for-command-key nil
114 "Coordination for multishell key assignment.")
115 (defun multishell-activate-command-key-setter (symbol setting)
116 "Implement `multishell-activate-command-key' choice."
117 (set-default 'multishell-activate-command-key setting)
118 (when (or setting multishell--responsible-for-command-key)
119 (multishell-implement-command-key-choice (not setting))))
120 (defun multishell-implement-command-key-choice (&optional unbind)
121 "If settings dicate, implement binding of multishell command key.
123 If optional UNBIND is true, globally unbind the key.
125 * `multishell-activate-command-key' - Set this to get the binding or not.
126 * `multishell-command-key' - The key to use for the binding, if appropriate."
128 (when (and (boundp 'multishell-command-key) multishell-command-key)
129 (global-unset-key multishell-command-key)))
130 ((not (and (boundp 'multishell-activate-command-key)
131 (boundp 'multishell-command-key)))
133 ((and multishell-activate-command-key multishell-command-key)
134 (setq multishell--responsible-for-command-key t)
135 (global-set-key multishell-command-key 'multishell-pop-to-shell))))
137 (defcustom multishell-activate-command-key nil
138 "Set this to impose the `multishell-command-key' binding.
140 You can instead manually bind `multishell-pop-to-shell` using emacs
141 lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
143 :set 'multishell-activate-command-key-setter
146 ;; Assert the customizations whenever the package is loaded:
147 (with-eval-after-load "multishell"
148 (multishell-implement-command-key-choice))
150 (defcustom multishell-pop-to-frame nil
151 "*If non-nil, jump to a frame already showing the shell, if another is.
153 Otherwise, disregard already-open windows on the shell if they're
154 in another frame, and open a new window on the shell in the
157 \(Use `pop-up-windows' to change multishell other-buffer vs
158 current-buffer behavior.)"
162 (defcustom multishell-history-entry-tracks-current-directory t
163 "Modify shell buffer's multishell entry to track the current directory.
165 When set, the path part of the name/path entry for each shell
166 will track the current directory of the shell with emacs. If
167 `savehist' is active, the directory tracking will extend across
172 (defvar multishell-history nil
173 "Name/path entries, most recent first.")
174 (when (and (not multishell-history)
175 (boundp 'multishell-buffer-name-history)
176 multishell-buffer-name-history)
177 ;; Migrate few users who had old var to new.
178 (setq multishell-history multishell-buffer-name-history)
181 (defvar multishell-primary-name "*shell*"
182 "Shell name to use for un-modified multishell-pop-to-shell buffer target.")
184 ;; Multiple entries happen because completion also adds name to history.
185 (defun multishell-register-name-to-path (name path)
186 "Add or replace entry associating NAME with PATH in `multishell-history'.
188 If NAME already had a PATH and new PATH is empty, retain the prior one.
190 Promote added/changed entry to the front of the list."
191 ;; Add or promote to the front, tracking path changes in the process.
192 (let* ((entries (multishell-history-entries name))
194 (dolist (entry entries)
195 (when (string= path "")
196 ;; Retain explicit established path.
197 (setq path (cadr (multishell-split-entry-name-and-tramp entry))))
198 (setq multishell-history (delete entry multishell-history)))
199 (setq multishell-history (push (concat name path)
200 multishell-history))))
202 (defun multishell-history-entries (name)
203 "Return `multishell-history' entry that starts with NAME, or nil if none."
204 (let ((match-expr (concat "^" name "\\\(/.*$\\\)?"))
206 (dolist (entry multishell-history)
207 (when (and (string-match match-expr entry)
208 (not (member entry got)))
209 (setq got (cons entry got))))
212 (defun multishell-pop-to-shell (&optional arg)
213 "Easily navigate to and within multiple shell buffers, local and remote.
215 Use universal arguments to launch and choose between alternate
216 shell buffers and to select which is default. Append a path to
217 a new shell name to launch a shell in that directory, and use
218 Emacs tramp syntax to launch a remote shell.
220 Customize-group `multishell' to set up a key binding and tweak behaviors.
222 ==== Basic operation:
224 - If the current buffer is shell-mode (or shell-mode derived)
225 buffer then focus is moved to the process input point.
227 \(You can use a universal argument go to a different shell
228 buffer when already in a buffer that has a process - see
231 - If not in a shell buffer (or with universal argument), go to a
232 window that is already showing the (a) shell buffer, if any.
234 In this case, the cursor is left in its prior position in the
235 shell buffer. Repeating the command will then go to the
236 process input point, per the first item in this list.
238 We respect `pop-up-windows', so you can adjust it to set the
239 other-buffer/same-buffer behavior.
241 - Otherwise, start a new shell buffer, using the current
242 directory as the working directory.
244 If a buffer with the resulting name exists and its shell process
245 was disconnected or otherwise stopped, it's resumed.
247 ===== Universal arg to start and select between named shell buffers:
249 You can name alternate shell buffers to create or return to using
250 single or doubled universal arguments:
252 - With a single universal argument, prompt for the buffer name
253 to use (without the asterisks that shell mode will put around
254 the name), defaulting to 'shell'.
256 Completion is available.
258 This combination makes it easy to start and switch between
259 multiple shell buffers.
261 - A double universal argument will prompt for the name *and* set
262 the default to that name, so the target shell becomes the
265 ===== Select starting directory and remote host:
267 The shell buffer name you give to the prompt for a universal arg
268 can include an appended path. That will be used for the startup
269 directory. You can use tramp remote syntax to specify a remote
270 shell. If there is an element after a final '/', that's used for
271 the buffer name. Otherwise, the host, domain, or path is used.
275 * Use '/ssh:example.net:/home/myaccount' for a shell buffer in
276 /home/myaccount on example.net; the buffer will be named
278 * '\#ex/ssh:example.net|sudo:root@example.net:/etc' for a root
279 shell in /etc on example.net named \"*#ex*\".
280 * '\#in/ssh:corp.com|ssh:internal.corp.com|sudo:root@internal.corp.com:/etc'
281 for a root shell name \"*in*\" in /etc on internal.corp.com, via host
284 \(NOTE that there is a problem with specifying a remote homedir using
285 tramp syntax, eg '/ssh:example.net:'. That sometimes fails on an obscure
286 bug - particularly for remote with empty path (homedir) syntax. Until fixed,
287 you may need to start remote shells with an explicit path, then cd ~.)
289 You can change the startup path for a shell buffer by editing it
290 at the completion prompt. The new path will be preserved in
291 history but will not take effect for an already-running shell.
293 To remove a shell buffer's history entry, kill the buffer and
294 affirm removal of the entry when prompted.
296 ===== Activate savehist to retain shell buffer names and paths across Emacs sessions:
298 To have emacs maintain your history of shell buffer names and paths,
299 customize the savehist group to activate savehist."
303 (let* ((from-buffer (current-buffer))
304 (from-buffer-is-shell (derived-mode-p 'shell-mode))
305 (doublearg (equal arg '(16)))
306 (target-name-and-path
307 (multishell-derive-target-name-and-path
309 (multishell-read-bare-shell-buffer-name
310 (format "Shell buffer name [%s]%s "
311 (substring-no-properties
312 multishell-primary-name
313 1 (- (length multishell-primary-name) 1))
314 (if doublearg " <==" ":"))
315 multishell-primary-name)
316 multishell-primary-name)))
317 (use-default-dir (cadr target-name-and-path))
318 (target-shell-buffer-name (car target-name-and-path))
319 (curr-buff-proc (get-buffer-process from-buffer))
320 (target-buffer (if from-buffer-is-shell
322 (get-buffer target-shell-buffer-name)))
326 ;; Register early so the entry is pushed to the front:
327 (multishell-register-name-to-path (multishell-unbracket-asterisks
328 target-shell-buffer-name)
332 (setq multishell-primary-name target-shell-buffer-name))
338 ((and (or curr-buff-proc from-buffer-is-shell)
340 (eq from-buffer target-buffer)
341 (not (eq target-shell-buffer-name (buffer-name from-buffer))))
342 ;; In a shell buffer, but not named - stay in buffer, but go to end.
343 (setq already-there t))
345 ((string= (buffer-name) target-shell-buffer-name)
346 ;; Already in the specified shell buffer:
347 (setq already-there t))
349 ((or (not target-buffer)
351 (multishell-get-visible-window-for-buffer target-buffer))))
352 ;; No preexisting shell buffer, or not in a visible window:
353 (pop-to-buffer target-shell-buffer-name pop-up-windows))
355 ;; Buffer exists and already has a window - jump to it:
356 (t (if (and multishell-pop-to-frame
358 (not (equal (window-frame (selected-window))
359 (window-frame inwin))))
360 (select-frame-set-input-focus (window-frame inwin)))
361 (if (not (string= (buffer-name (current-buffer))
362 target-shell-buffer-name))
363 (pop-to-buffer target-shell-buffer-name t))))
365 ;; We're in the buffer. Activate:
367 (if (not (comint-check-proc (current-buffer)))
368 (multishell-start-shell-in-buffer (buffer-name (current-buffer))
371 ;; If the destination buffer has a stopped process, resume it:
372 (let ((process (get-buffer-process (current-buffer))))
373 (if (and process (equal 'stop (process-status process)))
374 (continue-process process)))
376 (when (or already-there
377 (equal (current-buffer) from-buffer))
378 (goto-char (point-max))
379 (and (get-buffer-process from-buffer)
380 (goto-char (process-mark (get-buffer-process from-buffer)))))))
382 (defun multishell-kill-buffer-query-function ()
383 "Offer to remove multishell-history entry for buffer."
384 ;; Removal choice is crucial, so users can, eg, kill and a runaway shell
385 ;; and keep the history entry to easily restart it.
387 ;; We use kill-buffer-query-functions instead of kill-buffer-hook because:
389 ;; 1. It enables the user to remove the history without killing the buffer,
390 ;; by cancelling the kill-buffer process after affirming history removal.
391 ;; 2. kill-buffer-hooks often fails to run when killing shell buffers!
392 ;; I've failed to resolve that, and like the first reason well enough.
394 ;; (Use condition-case to avoid inadvertant disruption of kill-buffer
395 ;; activity. kill-buffer happens behind the scenes a whole lot.)
396 (condition-case anyerr
397 (let ((entries (and (derived-mode-p 'shell-mode)
398 (multishell-history-entries
399 (multishell-unbracket-asterisks (buffer-name))))))
400 (dolist (entry entries)
402 (y-or-n-p (format "Remove multishell history entry `%s'? "
404 (setq multishell-history
405 (delete entry multishell-history)))))
408 (add-hook 'kill-buffer-query-functions 'multishell-kill-buffer-query-function)
410 (defun multishell-get-visible-window-for-buffer (buffer)
411 "Return visible window containing buffer."
414 (function (lambda (win)
415 (if (and (eq (window-buffer win) buffer)
416 (equal (frame-parameter
417 (selected-frame) 'display)
419 (window-frame win) 'display)))
420 (throw 'got-a-vis win))))
424 (defun multishell-read-bare-shell-buffer-name (prompt default)
425 "PROMPT for shell buffer name, sans asterisks.
427 Return the supplied name bracketed with the asterisks, or specified DEFAULT
431 ;; Plain shell buffer names appended with names from name/path hist:
433 (mapcar (lambda (buffer)
434 (let* ((name (multishell-unbracket-asterisks
435 (buffer-name buffer))))
436 (and (buffer-live-p buffer)
437 (with-current-buffer buffer
438 ;; Shell mode buffers.
439 (derived-mode-p 'shell-mode))
440 (not (multishell-history-entries name))
444 (got (completing-read prompt
454 'multishell-history)))
455 (if (not (string= got ""))
456 (multishell-bracket-asterisks got)
459 (defun multishell-derive-target-name-and-path (path-ish)
460 "Give tramp-style PATH-ISH, determine target name and default directory.
462 The name is the part of the string before the initial '/' slash,
463 if any. Otherwise, it's either the host-name, domain-name, final
464 directory name, or local host name. The path is everything
465 besides the string before the initial '/' slash.
467 Return them as a list (name dir), with dir nil if none given."
468 (let (name (path "") dir)
469 (cond ((string= path-ish "") (setq dir multishell-primary-name))
470 ((string-match "^\\*\\([^/]*\\)\\(/.*\\)\\*" path-ish)
471 ;; We have a path, use it
472 (let ((overt-name (match-string 1 path-ish)))
473 (setq path (match-string 2 path-ish))
474 (if (string= overt-name "") (setq overt-name nil))
475 (if (string= path "") (setq path nil))
477 (multishell-bracket-asterisks
479 (if (file-remote-p path)
480 (let ((vec (tramp-dissect-file-name path)))
481 (or (tramp-file-name-host vec)
482 (tramp-file-name-domain vec)
483 (tramp-file-name-localname vec)
485 (multishell-unbracket-asterisks
486 multishell-primary-name)))))))
487 (t (setq name (multishell-bracket-asterisks path-ish))))
490 (defun multishell-bracket-asterisks (name)
491 "Return a copy of name, ensuring it has an asterisk at the beginning and end."
492 (if (not (string= (substring name 0 1) "*"))
493 (setq name (concat "*" name)))
494 (if (not (string= (substring name -1) "*"))
495 (setq name (concat name "*")))
497 (defun multishell-unbracket-asterisks (name)
498 "Return a copy of name, removing asterisks, if any, at beginning and end."
499 (if (string= (substring name 0 1) "*")
500 (setq name (substring name 1)))
501 (if (string= (substring name -1) "*")
502 (setq name (substring name 0 -1)))
505 (defun multishell-start-shell-in-buffer (buffer-name path)
506 "Ensure a shell is started, with name NAME and PATH."
507 ;; We work around shell-mode's bracketing of the buffer name, and do
508 ;; some tramp-mode hygiene for remote connections.
510 (let* ((buffer buffer-name)
511 (prog (or explicit-shell-file-name
515 (name (file-name-nondirectory prog))
516 (startfile (concat "~/.emacs_" name))
517 (xargs-name (intern-soft (concat "explicit-" name "-args")))
519 (set-buffer buffer-name)
520 (if (and path (not (string= path "")))
521 (setq default-directory path))
522 (setq is-remote (file-remote-p default-directory))
524 (derived-mode-p 'shell-mode)
525 (not (comint-check-proc (current-buffer))))
526 ;; We're returning to an already established but disconnected remote
528 (tramp-cleanup-connection
529 (tramp-dissect-file-name default-directory 'noexpand)
530 'keep-debug 'keep-password))
531 ;; (cd default-directory) will connect if remote:
533 (message "Connecting to %s" default-directory))
535 (cd default-directory)
537 ;; Aargh. Need to isolate this tramp bug.
538 (if (and (stringp (cadr err))
539 (string-equal (cadr err)
540 "Selecting deleted buffer"))
543 (format "%s, %s (\"%s\")"
544 "Tramp shell can fail on empty (homedir) path"
545 "please try again with an explicit path"
547 (signal (car err)(cdr err)))))
548 (setq buffer (set-buffer (apply 'make-comint
549 (multishell-unbracket-asterisks buffer-name)
551 (if (file-exists-p startfile)
555 (symbol-value xargs-name)
559 (defun multishell-track-dirchange (name newpath)
560 "Change multishell history entry to track current directory."
561 (let* ((entries (multishell-history-entries name)))
562 (dolist (entry entries)
563 (let* ((name-path (multishell-split-entry-name-and-tramp entry))
564 (name (car name-path))
565 (path (cadr name-path)))
567 (let* ((is-remote (file-remote-p path))
568 (vec (and is-remote (tramp-dissect-file-name path nil)))
569 (localname (if is-remote
570 (tramp-file-name-localname vec)
573 (replace-regexp-in-string (if (string= localname "")
575 (regexp-quote localname))
585 (newpath (if is-remote
586 (tramp-make-tramp-file-name (aref vec 0)
592 (newentry (concat name newpath))
593 (membership (member entry multishell-history)))
595 (setcar membership newentry))))))))
596 (defvar multishell-was-default-directory ()
597 "Provide for tracking directory changes.")
598 (make-variable-buffer-local 'multishell-was-default-directory)
599 (defun multishell-post-command-business ()
600 "Do multishell bookkeeping."
601 ;; Update multishell-history with dir changes.
603 (when (and multishell-history-entry-tracks-current-directory
604 (derived-mode-p 'shell-mode))
605 (let ((curdir (if (file-remote-p default-directory)
606 (tramp-file-name-localname
607 (tramp-dissect-file-name default-directory))
609 (when (and multishell-was-default-directory
610 (not (string= curdir multishell-was-default-directory)))
611 (multishell-track-dirchange (multishell-unbracket-asterisks
614 (setq multishell-was-default-directory curdir)))
615 ;; To avoid disruption as a pervasive hook function, swallow all errors:
617 (add-hook 'post-command-hook 'multishell-post-command-business)
619 (defun multishell-split-entry-name-and-tramp (entry)
620 "Given multishell name/path ENTRY, return the separated name and path pair.
622 Returns nil for empty parts, rather than the empty string."
623 (string-match "^\\([^/]*\\)\\(/?.*\\)?" entry)
624 (let ((name (match-string 1 entry))
625 (path (match-string 2 entry)))
626 (and (string= name "") (setq name nil))
627 (and (string= path "") (setq path nil))
630 (provide 'multishell)
632 ;;; multishell.el ends here