1 ;;; poptoshell.el --- easily manage interaction with multiple shells
3 ;; Copyright (C) 1999-2011 Free Software Foundation, Inc. and Ken Manheimer
5 ;; Author: Ken Manheimer <ken dot manheimer at gmail...>
6 ;; Maintainer: Ken Manheimer <ken dot manheimer at gmail...>
7 ;; Created: 1999 -- first public release
9 ;; Website: https://github.com/kenmanheimer/EmacsUtils
13 ;; See the pop-to-shell docstring for details.
14 ;; I bind to M-<space>, via eg: (global-set-key "\M- " 'pop-to-shell)
17 ;; * Change name to multishell.
18 ;; - Most functions will be prefixed, eg multishell:pop-to-shell
19 ;; * Preservable (savehist) history that associates names with paths
20 ;; - Using an association list between names and paths
21 ;; - Searched for search backwards/forwards on isearch-like M-r/M-s bindings
22 ;; - *Not* searched for regular completion
24 ;; - Using isearch keybinding M-e
26 ;; - New association overrides previous
27 ;; - Deleting path removes association and history entry
28 ;; * Customize provision for activating the saves
29 ;; - Customize entry has warning about activating savehist
30 ;; - Adds the name/path association list to savehist-additional-variables
31 ;; - Activates savehist, if inactive
32 ;; * Customize provision for keybinding
33 ;; - See allout.el allout-command-prefix for dynamic customization example.
35 (defvar non-interactive-process-buffers '("*compilation*" "*grep*"))
40 (defgroup multishell nil
41 "Allout extension that highlights outline structure graphically.
43 Customize `allout-widgets-auto-activation' to activate allout-widgets
47 (defcustom multishell:non-interactive-process-buffers
48 '("*compilation*" "*grep*")
49 "Buffers with processes but not for interaction."
50 :type '(repeat string)
52 (defcustom multishell:command-key "\M- "
53 "Choose a key to use for "
56 (defun multishell:assert-command-key-or-not (&optional force)
57 "Activate multishell command key if customizations dictate.
59 If optional FORCE is true and customizations dictate, globally
62 * `multishell:assert-command-key' - Establish or keep the binding if true
63 * `multishell:command-key' - Which key to use."
64 (if (boundp 'multishell:assert-command-key)
65 (cond ((and multishell:assert-command-key multishell:command-key)
66 (global-set-key multishell:command-key 'pop-to-shell))
67 ((and force (not multishell:assert-command-key))
68 (global-unset-key multishell:command-key)))
71 (defun multishell:do-assert-command-key (option-name option-value)
72 "If `multishell:assert-command-key', globally bind pop-to-shell.
74 Use keybinding identified by `multishell:command-key'."
75 (multishell:assert-command-key-or-not (not option-value))
77 (defcustom multishell:assert-command-key nil
78 "Set this to impose the `multishell-command-key binding."
80 :set 'multishell:do-assert-command-key
83 (defcustom multishell:pop-to-frame nil
84 "*If non-nil, jump to a frame already showing the shell, if any.
86 Otherwise, open a new window in the current frame."
90 (defcustom pop-to-shell-persist-shell-names nil
91 "Remember shell name/path associations across sessions. Note well:
92 This will activate minibuffer history persistence, in general, if it's not
97 (defvar multishell:name-path-assoc nil
98 "Assoc list from name to path")
100 (defvar pop-to-shell-primary-name "*shell*"
101 "Shell name to use for un-modified pop-to-shell buffer target.")
102 (defvar multishell:buffer-name-history nil
103 "Distinct pop-to-shell completion history container.")
105 (defun pop-to-shell (&optional arg)
107 "Navigate to or within local and remote shell buffers.
109 Use universal arguments to launch and choose between alternate
110 shell buffers and to select which is default. Prepend a path to
111 a new shell name to launch a shell in that directory, and use
112 Emacs tramp syntax to launch a remote shell.
114 ==== Basic operation:
116 - If the current buffer is associated with a subprocess (that is
117 not among those named on `non-interactive-process-buffers'),
118 then focus is moved to the process input point.
120 \(You can use a universal argument go to a different shell
121 buffer when already in a buffer that has a process - see
124 - If not in a shell buffer (or with universal argument), go to a
125 window that is already showing the (a) shell buffer, if any.
127 In this case, the cursor is left in its prior position in the
128 shell buffer. (Repeating the command will then go to the
129 process input point, by the previous behavior.)
131 - Otherwise, start a new shell buffer, using the current
132 directory as the working directory..
134 If the resulting buffer exists and its shell process was
135 disconnected or otherwise stopped, it's resumed.
137 ===== Universal arg to start and select between named shell buffers:
139 You can name alternate shell buffers to create or return to using
140 single or doubled universal arguments:
142 - With a single universal argument, prompt for the buffer name
143 to use (without the asterisks that shell mode will put around
144 the name), defaulting to 'shell'.
146 Completion is available.
148 This combination makes it easy to start and switch between
149 multiple shell buffers.
151 - A double universal argument will prompt for the name *and* set
152 the default to that name, so the target shell becomes the
155 ===== Select starting directory and remote host:
157 The shell buffer name you give to the prompt for a universal arg
158 can include a preceding path. That will be used for the startup
159 directory - and can include tramp remote syntax to specify a
160 remote shell. If there is an element after a final '/', that's used for the buffer name. Otherwise, the host, domain, or path is used.
162 For example: '/ssh:myriadicity.net:/' or
163 '/ssh:myriadicity.net|sudo:root@myriadicity.net:/\#myr', etc.
164 The stuff between the '/' slashes will be used for
165 starting the remote shell, and the stuff after the second
166 slash will be used for the shell name.
168 ===== Persisting your alternate shell buffer names and paths:
170 You can use emacs builtin SaveHist to preserve your alternate
171 shell buffer names and paths across emacs sessions. To do so,
172 customize the `savehist' group, and:
174 1. Add `pop-to-shell-buffer-name-history' to Savehist Additional Variables.
175 2. Activate Savehist Mode, if not already activated.
180 (if (not (boundp 'shell-buffer-name))
181 (setq shell-buffer-name "*shell*"))
183 (let* ((from-buffer (current-buffer))
184 (doublearg (equal arg '(16)))
186 (multishell:read-bare-shell-buffer-name
187 (format "Shell buffer name [%s]%s "
188 (substring-no-properties
189 pop-to-shell-primary-name
190 1 (- (length pop-to-shell-primary-name) 1))
191 (if doublearg " <==" ":"))
192 pop-to-shell-primary-name)
193 pop-to-shell-primary-name))
194 ;; Make sure it is bracketed with asterisks; silly.
196 (target-shell-buffer-name
197 ;; Derive target name, and default-dir if any, from temp.
198 (cond ((string= temp "") pop-to-shell-primary-name)
199 ((string-match "^\\*\\(/.*/\\)\\(.*\\)\\*" temp)
200 (setq use-default-dir (match-string 1 temp))
202 (if (string= (match-string 2 temp) "")
203 (let ((v (tramp-dissect-file-name
205 (or (tramp-file-name-host v)
206 (tramp-file-name-domain v)
207 (tramp-file-name-localname v)
209 (match-string 2 temp))))
210 (t (bracket-asterisks temp))))
211 (curr-buff-proc (get-buffer-process from-buffer))
212 (target-buffer (if (and curr-buff-proc
213 (not (member (buffer-name from-buffer)
214 non-interactive-process-buffers)))
216 (get-buffer target-shell-buffer-name)))
221 (setq pop-to-shell-primary-name target-shell-buffer-name))
229 (eq from-buffer target-buffer)
230 (not (eq target-shell-buffer-name (buffer-name from-buffer))))
231 ;; In a shell buffer, but not named - stay in buffer, but go to end.
232 (setq already-there t))
234 ((string= (buffer-name) target-shell-buffer-name)
235 ;; Already in the specified shell buffer:
236 (setq already-there t))
238 ((or (not target-buffer)
239 (not (setq inwin (get-visible-win-for-buffer target-buffer))))
240 ;; No preexisting shell buffer, or not in a visible window:
241 (pop-to-buffer target-shell-buffer-name pop-up-windows))
243 ;; Buffer exists and already has a window - jump to it:
244 (t (if (and multishell:pop-to-frame
246 (not (equal (window-frame (selected-window))
247 (window-frame inwin))))
248 (select-frame-set-input-focus (window-frame inwin)))
249 (if (not (string= (buffer-name (current-buffer))
250 target-shell-buffer-name))
251 (pop-to-buffer target-shell-buffer-name t))))
253 ;; We're in the buffer.
255 ;; If we have a use-default-dir, impose it:
256 (when use-default-dir
257 (cd use-default-dir))
261 (if (not (comint-check-proc (current-buffer)))
262 (start-shell-in-buffer (buffer-name (current-buffer))))
264 ;; If the destination buffer has a stopped process, resume it:
265 (let ((process (get-buffer-process (current-buffer))))
266 (if (and process (equal 'stop (process-status process)))
267 (continue-process process)))
268 (if (and (not already-there)
269 (not (equal (current-buffer) from-buffer)))
271 (goto-char (point-max))
272 (and (get-buffer-process from-buffer)
273 (goto-char (process-mark (get-buffer-process from-buffer)))))
277 (defun get-visible-win-for-buffer (buffer)
278 "Return visible window containing buffer."
281 (function (lambda (win)
282 (if (and (eq (window-buffer win) buffer)
283 (equal (frame-parameter
284 (selected-frame) 'display)
286 (window-frame win) 'display)))
287 (throw 'got-a-vis win))))
291 (defun multishell:read-bare-shell-buffer-name (prompt default)
292 "PROMPT for shell buffer name, sans asterisks.
294 Return the supplied name bracketed with the asterisks, or specified DEFAULT
296 (let* ((candidates (append
298 (mapcar (lambda (buffer)
299 (let ((name (buffer-name buffer)))
300 (if (with-current-buffer buffer
301 (eq major-mode 'shell-mode))
302 ;; Shell mode buffers.
303 (if (> (length name) 2)
309 (got (completing-read prompt
310 candidates ; COLLECTION
312 'confirm ; REQUIRE-MATCH
314 'multishell:buffer-name-history ; HIST
316 (if (not (string= got "")) (bracket-asterisks got) default)))
318 (defun bracket-asterisks (name)
319 "Return a copy of name, ensuring it has an asterisk at the beginning and end."
320 (if (not (string= (substring name 0 1) "*"))
321 (setq name (concat "*" name)))
322 (if (not (string= (substring name -1) "*"))
323 (setq name (concat name "*")))
325 (defun unbracket-asterisks (name)
326 "Return a copy of name, removing asterisks, if any, at beginning and end."
327 (if (string= (substring name 0 1) "*")
328 (setq name (substring name 1)))
329 (if (string= (substring name -1) "*")
330 (setq name (substring name 0 -1)))
332 (defun start-shell-in-buffer (buffer-name)
333 ;; Damn comint requires buffer name be bracketed by "*" asterisks.
337 (let* ((buffer buffer-name)
338 (prog (or explicit-shell-file-name
342 (name (file-name-nondirectory prog))
343 (startfile (concat "~/.emacs_" name))
344 (xargs-name (intern-soft (concat "explicit-" name "-args"))))
345 (setq buffer (set-buffer (apply 'make-comint
346 (unbracket-asterisks buffer-name)
348 (if (file-exists-p startfile)
352 (symbol-value xargs-name)
354 (set-buffer buffer-name)
356 (when (and (file-remote-p default-directory)
357 (not (comint-check-proc (current-buffer))))
358 (message "(Re)connection failed, doing a cleanup then retry...")
360 (tramp-cleanup-this-connection)
363 (provide 'poptoshell)