]> code.delx.au - gnu-emacs-elpa/blob - multishell.el
0ea7bfab4a34818c3229bc5e77ba37b75ee4c331
[gnu-emacs-elpa] / multishell.el
1 ;;; multishell.el --- facilitate multiple local and remote shell buffers
2
3 ;; Copyright (C) 1999-2016 Free Software Foundation, Inc. and Ken Manheimer
4
5 ;; Author: Ken Manheimer <ken.manheimer@gmail.com>
6 ;; Version: 1.0.10
7 ;; Created: 1999 -- first public availability
8 ;; Keywords: processes
9 ;; URL: https://github.com/kenmanheimer/EmacsMultishell
10 ;;
11 ;;; Commentary:
12 ;;
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:
16 ;;
17 ;; * Get to the input point from wherever you are in a shell buffer,
18 ;; ... or to any of your shell buffers, from anywhere inside emacs.
19 ;;
20 ;; * Use universal arguments to launch and choose among alternate shell buffers,
21 ;; ... and change which is the current default.
22 ;;
23 ;; * Easily restart disconnected shells, or shells from prior sessions
24 ;; ... the latter from Emacs builtin savehist minibuf history persistence
25 ;;
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 -
28 ;; for example:
29 ;;
30 ;; * `#root/sudo:root@localhost:/etc` for a buffer named "*#root*" with a
31 ;; root shell starting in /etc.
32 ;;
33 ;; * `/ssh:example.net:` for a shell buffer in your homedir on example.net.
34 ;; The buffer will be named "*example.net*".
35 ;;
36 ;; * `#ex/ssh:example.net|sudo:root@example.net:/var/log` for a root shell
37 ;; starting in /var/log on example.net named "*#ex*".
38 ;;
39 ;; * 'interior/ssh:gateway.corp.com|ssh:interior.corp.com:' to go via
40 ;; gateway.corp.com to your homedir on interior.corp.com. The buffer
41 ;; will be named "*interior*". You could append a sudo hop, and so on.
42 ;;
43 ;; * Thanks to tramp, file visits from the shell will seamlessly be in
44 ;; the auspices of the target account, and relative to the current
45 ;; directory, on the host where the shell is running.
46 ;;
47 ;; * Manage your list of shells, current and past, as a collection.
48 ;;
49 ;; See the `multishell-pop-to-shell` docstring for details.
50 ;;
51 ;; Customize-group `multishell' to select and activate a keybinding and set
52 ;; various behaviors. Customize-group `savehist' to preserve buffer
53 ;; names/paths across emacs restarts.
54 ;;
55 ;; Please use
56 ;; [the multishell repository](https://github.com/kenmanheimer/EmacsMultishell)
57 ;; issue tracker to report problems, suggestions, etc, and see that
58 ;; repository for a bit more documentation.
59 ;;
60 ;; Change Log:
61 ;;
62 ;; * 2016-01-30 1.0.10 Ken Manheimer:
63 ;; - shake out some initial multishell-list glitches:
64 ;; - Delete shell buffer, if present, when deleting an entry.
65 ;; (Offer to) delete shell buffer, if present, when deleting an
66 ;; entry. Rely on the default active-shell deletion prompting
67 ;; for confirmation, supplementing with our own confirmation
68 ;; for inactive shell buffers.
69 ;; - Set recency (numeric rank) as initial sort field
70 ;; - Recompute list on any operation that affects it, and try to
71 ;; preserve stability. (Still needs work.)
72 ;; * 2016-01-30 1.0.9 Ken Manheimer:
73 ;; - Add multishell-list for managing the collection of current and
74 ;; history-registered shells: edit, delete, and switch/pop to entries.
75 ;; Easy access by invoking `multishell-pop-to-shell' from in the
76 ;; `multishell-pop-to-shell' universal arg prompts.
77 ;; - Duplicate existing shell buffer names in completions, for distinction.
78 ;; - Add paths to buffers started without one, when multishell history dir
79 ;; tracking is enabled.
80 ;; - Major code cleanup:
81 ;; - Simplify multishell-start-shell-in-buffer, in particular using
82 ;; shell function, rather than unnecessarily going underneath it.
83 ;; - Establish multishell-name-from-entry as canonical name resolver.
84 ;; - Fallback to eval-after-load in emacs versions that lack
85 ;; with-eval-after-load (eg, emacs 23).
86 ;; - save-match-data, where match-string is used
87 ;; - resituate some helpers
88 ;; * 2016-01-24 1.0.8 Ken Manheimer:
89 ;; - Work around the shell/tramp mishandling of remote+sudo+homedir problem!
90 ;; The work around is clean and simple, basically using high-level `cd'
91 ;; API and not messing with the low-level default-directory setting.
92 ;; (Turns out the problem was not in my local config. Good riddance to the
93 ;; awkward failure handler!)
94 ;; - Clean up code resolving the destination shell, starting to document the
95 ;; decision tree in the process. See getting-to-a-shell.md in the
96 ;; multishell repository, https://github.com/kenmanheimer/EmacsMultishell
97 ;; - There may be some shake-out on resolving the destination shell, but
98 ;; this release gets the fundamental functionality soundly in place.
99 ;; * 2016-01-23 1.0.7 Ken Manheimer:
100 ;; - Remove notes about tramp remote+sudo+homedir problem. Apparently it's
101 ;; due to something in my local site configuration (happens with -q but
102 ;; not -Q).
103 ;; * 2016-01-22 1.0.6 Ken Manheimer:
104 ;; - Add multishell-version function.
105 ;; - Tweak commentary/comments/docstrings.
106 ;; - Null old multishell-buffer-name-history var, if present.
107 ;; * 2016-01-16 1.0.5 Ken Manheimer:
108 ;; - History now includes paths, when designated.
109 ;; - Actively track current directory in history entries that have a path.
110 ;; Custom control: multishell-history-entry-tracks-current-directory
111 ;; - Offer to remove shell's history entry when buffer is killed.
112 ;; (Currently the only UI mechanism to remove history entries.)
113 ;; - Fix - prevent duplicate entries for same name but different paths
114 ;; - Fix - recognize and respect tramp path syntax to start in home dir
115 ;; - Simplify history var name, migrate existing history if any from old name
116 ;; * 2016-01-04 1.0.4 Ken Manheimer - Released to ELPA
117 ;; * 2016-01-02 Ken Manheimer - working on this in public, but not yet released.
118 ;;
119 ;; TODO and Known Issues:
120 ;;
121 ;; * Resolve multishell-list sort glitches:
122 ;; - Fix config so multishell-list-revert-buffer-kludge is not needed
123 ;; - Make multishell-list-edit-entry in-place, so changed entries recency
124 ;; doesn't change.
125 ;; - Fill in kill-buffer prompting gaps, eg if default live-process
126 ;; prompts are inhibited.
127 ;; * Add custom shell launch prep actions
128 ;; - for, eg, port knocking, interface activations
129 ;; - shell commands to execute when shell name or path matches a regexp
130 ;; - list of (regexp, which - name, path, or both, command)
131 ;; * Adapt multishell-list facilities for all-completions
132 ;; - See info on minibuffer-completion-help, display-completion-list
133 ;; - implement markup for mouse selection
134 ;; * Investigate whether we can recognize and provide for failed hops.
135 ;; - Tramp doesn't provide useful reactions for any hop but the first
136 ;; - Might be stuff we can do to detect and convey failures?
137 ;; - Might be no recourse but to seek tramp changes.
138 ;; * Try minibuffer field boundary at beginning of tramp path, to see whether
139 ;; the field boundary magically enables tramp path completion.
140
141 ;;; Code:
142
143 (require 'comint)
144 (require 'shell)
145 (require 'savehist)
146 (require 'multishell-list)
147
148 (defvar multishell-version "1.0.10")
149 (defun multishell-version (&optional here)
150 "Return string describing the loaded multishell version."
151 (interactive "P")
152 (let ((msg (concat "Multishell " multishell-version)))
153 (if here (insert msg)
154 (if (called-interactively-p 'interactive)
155 (message "%s" msg)
156 msg))))
157
158 (defgroup multishell nil
159 "Allout extension that highlights outline structure graphically.
160
161 Customize `allout-widgets-auto-activation' to activate allout-widgets
162 with allout-mode."
163 :group 'shell)
164
165 (defcustom multishell-command-key "\M- "
166 "The key to use if `multishell-activate-command-key' is true.
167
168 You can instead manually bind `multishell-pop-to-shell` using emacs
169 lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
170 :type 'key-sequence
171 :group 'multishell)
172
173 (defvar multishell--responsible-for-command-key nil
174 "Coordination for multishell key assignment.")
175 (defun multishell-activate-command-key-setter (symbol setting)
176 "Implement `multishell-activate-command-key' choice."
177 (set-default 'multishell-activate-command-key setting)
178 (when (or setting multishell--responsible-for-command-key)
179 (multishell-implement-command-key-choice (not setting))))
180 (defun multishell-implement-command-key-choice (&optional unbind)
181 "If settings dicate, implement binding of multishell command key.
182
183 If optional UNBIND is true, globally unbind the key.
184
185 * `multishell-activate-command-key' - Set this to get the binding or not.
186 * `multishell-command-key' - The key to use for the binding, if appropriate."
187 (cond (unbind
188 (when (and (boundp 'multishell-command-key) multishell-command-key)
189 (global-unset-key multishell-command-key)))
190 ((not (and (boundp 'multishell-activate-command-key)
191 (boundp 'multishell-command-key)))
192 nil)
193 ((and multishell-activate-command-key multishell-command-key)
194 (setq multishell--responsible-for-command-key t)
195 (global-set-key multishell-command-key 'multishell-pop-to-shell))))
196
197 (defcustom multishell-activate-command-key nil
198 "Set this to impose the `multishell-command-key' binding.
199
200 You can instead manually bind `multishell-pop-to-shell` using emacs
201 lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
202 :type 'boolean
203 :set 'multishell-activate-command-key-setter
204 :group 'multishell)
205
206 ;; Implement the key customization whenever the package is loaded:
207 (if (fboundp 'with-eval-after-load)
208 (with-eval-after-load "multishell"
209 (multishell-implement-command-key-choice))
210 (eval-after-load "multishell"
211 (multishell-implement-command-key-choice)))
212
213 (defcustom multishell-pop-to-frame nil
214 "*If non-nil, jump to a frame already showing the shell, if another one is.
215
216 Otherwise, disregard already-open windows on the shell if they're
217 in another frame, and open a new window on the shell in the
218 current frame.
219
220 \(Use `pop-up-windows' to change multishell other-window vs
221 current-window behavior.)"
222 :type 'boolean
223 :group 'multishell)
224
225 (defcustom multishell-history-entry-tracks-current-directory t
226 "Maintain shell's current directory in its multishell history entry.
227
228 When set, the history entry for shells started with explicit
229 paths will track the shell's current working directory. (Explicit
230 paths will not be added to local shells started without one,
231 however.)
232
233 If `savehist-save-minibuffer-history' is enabled, the current
234 working directory of shells \(that were started with an explicit
235 path) will be conveyed between emacs sessions."
236 :type 'boolean
237 :group 'multishell)
238
239 (defvar multishell-history nil
240 "Name/path entries, most recent first.")
241 ;; Migrate the few pre 1.0.5 users to changed history var:
242 (when (and (not multishell-history)
243 (boundp 'multishell-buffer-name-history)
244 multishell-buffer-name-history)
245 (setq multishell-history multishell-buffer-name-history
246 multishell-buffer-name-history nil))
247
248 (defvar multishell-primary-name "*shell*"
249 "Default shell name for un-modified multishell-pop-to-shell buffer target.
250
251 This is set by `multishell-pop-to-shell' as the current default,
252 when invoked with doubled universal argument.
253
254 If you want the designated primary that you have at the end of
255 one emacs session to be resumed at the next, customize
256 `savehist-additional-variables' to include the
257 `multishell-primary-name'.")
258
259 ;; Multiple entries happen because completion also adds name to history.
260 (defun multishell-register-name-to-path (name path)
261 "Add or replace entry associating NAME with PATH in `multishell-history'.
262
263 If NAME already had a PATH and new PATH is empty, retain the prior one.
264
265 Promote added/changed entry to the front of the list."
266 ;; Add or promote to the front, tracking path changes in the process.
267 (let* ((entries (multishell-history-entries name))
268 (path (or path "")))
269 (dolist (entry entries)
270 (when (string= path "")
271 ;; Retain explicit established path.
272 (setq path (cadr (multishell-split-entry entry))))
273 (setq multishell-history (delete entry multishell-history)))
274 (setq multishell-history (push (concat name path)
275 multishell-history))))
276
277 (defun multishell-history-entries (name)
278 "Return `multishell-history' entry that starts with NAME, or nil if none."
279 (let (got)
280 (dolist (entry multishell-history)
281 (when (and (string-equal name (multishell-name-from-entry entry))
282 (not (member entry got)))
283 (setq got (cons entry got))))
284 got))
285
286 ;;;###autoload
287 (defun multishell-pop-to-shell (&optional arg name here)
288 "Easily navigate to and within multiple shell buffers, local and remote.
289
290 Use a single `universal-argument' (\\[universal-argument]) to launch and choose between
291 nalternate shell buffers, and a doubled universal argument to also set your
292 choice as the ongoing default. Append a path to a new shell name to launch
293 a shell in that directory, and use Emacs tramp syntax to launch a remote
294 shell. There is a shortcut to manage your list of current and
295 historical shells, collectively, using `multishell-list' - see below.
296
297 Customize-group `multishell' to set up a key binding and tweak behaviors.
298
299 Manage your collection of current and historical shells by
300 recursively invoking \\[multishell-pop-to-shell] at either of the
301 `multishell-pop-to-shell' universal argument prompts, or at any time via
302 \\[multishell-list]. Hit ? in the listing buffer for editing commands.
303
304 ==== Basic operation:
305
306 - If the current buffer is shell-mode (or shell-mode derived)
307 buffer then focus is moved to the process input point.
308
309 \(You can use a universal argument go to a different shell
310 buffer when already in a buffer that has a process - see
311 below.)
312
313 - If not in a shell buffer (or with universal argument), go to a
314 window that is already showing the (a) shell buffer, if any.
315
316 In this case, the cursor is left in its prior position in the
317 shell buffer. Repeating the command will then go to the
318 process input point, per the first item in this list.
319
320 We respect `pop-up-windows', so you can adjust it to set the
321 other-buffer/same-buffer behavior.
322
323 - Otherwise, start a new shell buffer, using the current
324 directory as the working directory.
325
326 If a buffer with the resulting name exists and its shell process
327 was disconnected or otherwise stopped, it's resumed.
328
329 ===== Universal arg to start and select between named shell buffers:
330
331 You can name alternate shell buffers to create or return to, by
332 prefixing your \\[multishell-pop-to-shell] invocation with single or double
333 `universal-argument', \\[universal-argument]:
334
335 - With a single universal argument, prompt for the buffer name
336 to use (without the asterisks that shell mode will put around
337 the name), defaulting to 'shell'.
338
339 Completion is available.
340
341 This combination makes it easy to start and switch across
342 multiple shell restarts.
343
344 - A double universal argument will prompt for the name *and* set
345 the default to that name, so the target shell becomes the
346 primary.
347
348 See `multishell-primary-name' for info about preserving the
349 setting across emacs restarts.
350
351 - Manage your collection of current and historical shells by
352 recursively invoking \\[multishell-pop-to-shell] at either of the
353 `multishell-pop-to-shell' universal argument prompts, or at any
354 time via \\[multishell-list]. Hit ? in the listing buffer for
355 editing commands.
356
357 ===== Select starting directory and remote host:
358
359 The shell buffer name you give to the prompt for a universal arg
360 can include an appended path. That will be used for the startup
361 directory. You can use tramp remote syntax to specify a remote
362 shell. If there is an element after a final '/', that's used for
363 the buffer name. Otherwise, the host, domain, or path is used.
364
365 For example:
366
367 * '#root/sudo:root@localhost:/etc' for a buffer named \"*#root*\" with a
368 root shell starting in /etc.
369
370 * '/ssh:example.net:' for a shell buffer in your homedir on example.net.
371 The buffer will be named \"*example.net*\".
372
373 * '#ex/ssh:example.net|sudo:root@example.net:/var/log' for a root shell
374 starting in /var/log on example.net named \"*#ex*\".
375
376 * 'interior/ssh:gateway.corp.com|ssh:interior.corp.com:' to go
377 via gateway.corp.com to your homedir on interior.corp.com. The
378 buffer will be named \"*interior*\". You could append a sudo
379 hop to the path, combining the previous example, and so on.
380
381 File visits from the shell, and many common emacs activities like
382 dired, will be on the host where the shell is running, in the
383 auspices of the target account, and relative to the current
384 directory.
385
386 You can change the startup path for a shell buffer by editing it
387 at the completion prompt. The new path will not take effect for
388 an already-running shell.
389
390 To remove a shell buffer's history entry, kill the buffer and
391 affirm removal of the entry when prompted.
392
393 ===== Activate savehist to retain shell buffer names and paths across Emacs restarts:
394
395 To have emacs maintain your history of shell buffer names and paths,
396 customize the savehist group to activate savehist."
397
398 (interactive "P")
399
400 (let ((token '(token)))
401 (if (window-minibuffer-p)
402 (throw 'multishell-do-list token)
403 (if (equal token
404 (catch 'multishell-do-list
405 (multishell-pop-to-shell-worker arg name here)))
406 (multishell-list)))))
407
408 (defun multishell-pop-to-shell-worker (&optional arg name here)
409 "Do real work of `multishell-pop-to-shell', which see."
410 (let* ((from-buffer (current-buffer))
411 (from-buffer-is-shell (derived-mode-p 'shell-mode))
412 (primary-name-unbracketed (multishell-unbracket
413 multishell-primary-name))
414 (fallthrough-name (if from-buffer-is-shell
415 (buffer-name from-buffer)
416 primary-name-unbracketed))
417 (doublearg (equal arg '(16)))
418 (target-name-and-path
419 (multishell-resolve-target-name-and-path
420 (cond (name name)
421 (arg
422 (or (multishell-read-unbracketed-entry
423 (format "Shell buffer name [%s]%s "
424 primary-name-unbracketed
425 (if doublearg " <==" ":"))
426 primary-name-unbracketed)
427 primary-name-unbracketed))
428 (t fallthrough-name))))
429 (use-path (cadr target-name-and-path))
430 (target-shell-buffer-name (car target-name-and-path))
431 (target-buffer (get-buffer target-shell-buffer-name))
432 (curr-buff-proc (get-buffer-process from-buffer))
433 inwin
434 already-there)
435
436 ;; Register early so the entry is pushed to the front:
437 (multishell-register-name-to-path (multishell-unbracket
438 target-shell-buffer-name)
439 use-path)
440
441 (when doublearg
442 (setq multishell-primary-name target-shell-buffer-name))
443
444 ;; Situate:
445
446 (cond
447
448 ((and (or curr-buff-proc from-buffer-is-shell)
449 (not arg)
450 (eq from-buffer target-buffer)
451 (not (eq target-shell-buffer-name (buffer-name from-buffer))))
452 ;; In a shell buffer, but not named - stay in buffer, but go to end.
453 (setq already-there t))
454
455 ((string= (buffer-name) target-shell-buffer-name)
456 ;; Already in the specified shell buffer:
457 (setq already-there t))
458
459 ((or (not target-buffer)
460 (not (setq inwin
461 (multishell-get-visible-window-for-buffer target-buffer))))
462 ;; No preexisting shell buffer, or not in a visible window:
463 (when (not (get-buffer target-shell-buffer-name))
464 (message "Creating new shell buffer '%s'" target-shell-buffer-name))
465 (if here
466 (switch-to-buffer target-shell-buffer-name)
467 (pop-to-buffer target-shell-buffer-name pop-up-windows)))
468
469 ;; Buffer exists and already has a window - jump to it:
470 (t (if (and multishell-pop-to-frame
471 inwin
472 (not (equal (window-frame (selected-window))
473 (window-frame inwin))))
474 (select-frame-set-input-focus (window-frame inwin)))
475 (if (not (string= (buffer-name (current-buffer))
476 target-shell-buffer-name))
477 (if here
478 (switch-to-buffer target-shell-buffer-name)
479 (pop-to-buffer target-shell-buffer-name t)))))
480
481 ;; We're in the buffer. Activate:
482
483 (if (not (comint-check-proc (current-buffer)))
484 (multishell-start-shell-in-buffer (buffer-name (current-buffer))
485 use-path))
486
487 ;; If the destination buffer has a stopped process, resume it:
488 (let ((process (get-buffer-process (current-buffer))))
489 (if (and process (equal 'stop (process-status process)))
490 (continue-process process)))
491
492 (when (or already-there
493 (equal (current-buffer) from-buffer))
494 (goto-char (point-max))
495 (and (get-buffer-process from-buffer)
496 (goto-char (process-mark (get-buffer-process from-buffer)))))))
497
498 (defun multishell-delete-history-name (name &optional ask)
499 "Remove all multishell history entries for NAME.
500
501 if optional ask is non-nil (default nil), ask before each deletion.
502
503 Return the last entry deleted."
504 (let (got)
505 (dolist (entry (multishell-history-entries name) got)
506 (when (and entry
507 (or (not ask)
508 (y-or-n-p (format "Remove multishell history entry `%s'? "
509 entry))))
510 (setq got entry
511 multishell-history (delete entry multishell-history))))))
512
513 (defun multishell-kill-buffer-query-function ()
514 "Offer to remove multishell-history entry for buffer."
515 ;; Removal choice is crucial, so users can, eg, kill a shell with huge
516 ;; output backlog, while keeping the history entry to easily restart it.
517 ;;
518 ;; We use kill-buffer-query-functions instead of kill-buffer-hook because:
519 ;;
520 ;; 1. It enables the user to remove the history without actually killing a
521 ;; running buffer, by not confirming the subsequent running-proc query.
522 ;; 2. kill-buffer-hooks often fails to run when killing shell buffers!
523 ;; It's probably due to failures in other hooks - beyond our control -
524 ;; and anyway, I like the first reason well enough.
525
526 ;; (Use condition-case to avoid inadvertant disruption of kill-buffer
527 ;; activity. kill-buffer happens behind the scenes a whole lot.)
528 (condition-case err
529 (and (derived-mode-p 'shell-mode)
530 (multishell-delete-history-name
531 (multishell-unbracket (buffer-name))
532 t))
533 (error
534 (message "multishell-kill-buffer-query-function error: %s" err)))
535 t)
536 (add-hook 'kill-buffer-query-functions 'multishell-kill-buffer-query-function)
537
538 (defun multishell-get-visible-window-for-buffer (buffer)
539 "Return visible window containing buffer."
540 (catch 'got-a-vis
541 (walk-windows
542 (function (lambda (win)
543 (if (and (eq (window-buffer win) buffer)
544 (equal (frame-parameter
545 (selected-frame) 'display)
546 (frame-parameter
547 (window-frame win) 'display)))
548 (throw 'got-a-vis win))))
549 nil 'visible)
550 nil))
551
552 (defun multishell-all-entries (&optional active-duplicated)
553 "Return multishell history, with active buffers listed first.
554
555 Optional ACTIVE-DUPLICATED will return a copy of
556 `multishell-history' with unbracketed names of active buffers,
557 sans paths, appended to the list, so they have short and long
558 completions."
559 ;; Reorder so active lead present lead historical entries:
560 (let (active-entries active-names present past splat name path buffer)
561 (dolist (entry multishell-history)
562 (setq splat (multishell-split-entry entry)
563 name (car splat)
564 path (cadr splat)
565 buffer (and name (get-buffer (multishell-bracket name))))
566 (if (buffer-live-p buffer)
567 (if (comint-check-proc buffer)
568 (setq active-entries (push entry active-entries)
569 active-names (push name active-names))
570 (setq present (push entry present)))
571 (setq past (push entry past))))
572 (setq multishell-history (append active-entries present past))
573 (if active-duplicated
574 (append multishell-history active-names)
575 multishell-history)))
576
577 (defun multishell-read-unbracketed-entry (prompt default &optional initial)
578 "PROMPT for shell buffer name, sans asterisks. Indicate DEFAULT in prompt.
579
580 Optional INITIAL is preliminary value to be edited.
581
582 Input and completion can include associated path, if any.
583
584 Return what's provided, if anything, else nil."
585 (let* ((candidates (multishell-all-entries 'active-duplicated))
586 (got (completing-read prompt
587 ;; COLLECTION:
588 (reverse candidates)
589 ;; PREDICATE:
590 nil
591 ;; REQUIRE-MATCH:
592 'confirm
593 ;; INITIAL-INPUT
594 initial
595 ;; HIST:
596 'multishell-history)))
597 (if (not (string= got ""))
598 got
599 nil)))
600
601 (defun multishell-resolve-target-name-and-path (path-ish)
602 "Given name/tramp-path PATH-ISH, resolve buffer name and initial directory.
603
604 The name is the part of the string up to the first '/' slash, if
605 any. Missing pieces are filled in from remote path elements, if
606 any, and multishell history. Given a path and no name, either the
607 host-name, domain-name, final directory name, or local host name
608 is used.
609
610 Return them as a list (name path), with name asterisk-bracketed
611 and path nil if none resolved."
612 (let* ((splat (multishell-split-entry (or path-ish "")))
613 (path (cadr splat))
614 (name (or (car splat) (multishell-name-from-entry path))))
615 (when (not path)
616 ;; Get path from history, if present.
617 (mapcar #'(lambda (entry)
618 (when (or (not path) (string= path ""))
619 (setq path (cadr (multishell-split-entry entry)))))
620 (multishell-history-entries
621 (multishell-unbracket name))))
622 (list (multishell-bracket name) path)))
623
624 (defun multishell-name-from-entry (entry)
625 "Derive a name for a shell buffer according to ENTRY."
626 (if (not entry)
627 (multishell-unbracket multishell-primary-name)
628 (let* ((splat (multishell-split-entry entry))
629 (name (car splat))
630 (path (cadr splat)))
631 (or name
632 (if (file-remote-p path)
633 (let ((vec (tramp-dissect-file-name path)))
634 (or (tramp-file-name-host vec)
635 (tramp-file-name-domain vec)
636 (tramp-file-name-localname vec)
637 system-name))
638 (multishell-unbracket multishell-primary-name))))))
639
640 (defun multishell-start-shell-in-buffer (buffer-name path)
641 "Start, restart, or continue a shell in BUFFER-NAME on PATH."
642 (let* ((buffer (get-buffer buffer-name))
643 is-active)
644
645 (set-buffer buffer)
646 (setq is-active (comint-check-proc buffer))
647
648 (when (and path (not is-active))
649
650 (when (and (derived-mode-p 'shell-mode) (file-remote-p path))
651 ;; Returning to disconnected remote shell - do some tidying:
652 (tramp-cleanup-connection
653 (tramp-dissect-file-name default-directory 'noexpand)
654 'keep-debug 'keep-password))
655
656 (when (file-remote-p path) (message "Connecting to %s" path))
657 (cd path))
658
659 (shell buffer)))
660
661 (defun multishell-track-dirchange (name newpath)
662 "Change multishell history entry to track current directory."
663 (let* ((entries (multishell-history-entries name)))
664 (dolist (entry entries)
665 (let* ((name-path (multishell-split-entry entry))
666 (name (car name-path))
667 (path (or (cadr name-path) "")))
668 (when path
669 (let* ((is-remote (file-remote-p path))
670 (vec (and is-remote (tramp-dissect-file-name path nil)))
671 (localname (if is-remote
672 (tramp-file-name-localname vec)
673 path))
674 (newlocalname
675 (replace-regexp-in-string (if (string= localname "")
676 "$"
677 (regexp-quote localname))
678 ;; REP
679 newpath
680 ;; STRING
681 localname
682 ;; FIXEDCASE
683 t
684 ;; LITERAL
685 t
686 ))
687 (newpath (if is-remote
688 (tramp-make-tramp-file-name (aref vec 0)
689 (aref vec 1)
690 (aref vec 2)
691 newlocalname
692 (aref vec 4))
693 newpath))
694 (newentry (concat name newpath))
695 (membership (member entry multishell-history)))
696 (when membership
697 (setcar membership newentry))))))))
698 (defvar multishell-was-default-directory ()
699 "Provide for tracking directory changes.")
700 (make-variable-buffer-local 'multishell-was-default-directory)
701 (defun multishell-post-command-business ()
702 "Do multishell bookkeeping."
703 ;; Update multishell-history with dir changes.
704 (condition-case err
705 (when (and multishell-history-entry-tracks-current-directory
706 (derived-mode-p 'shell-mode))
707 (let ((curdir (if (file-remote-p default-directory)
708 (tramp-file-name-localname
709 (tramp-dissect-file-name default-directory))
710 default-directory)))
711 (when (not (string= curdir (or multishell-was-default-directory "")))
712 (multishell-track-dirchange (multishell-unbracket (buffer-name))
713 curdir))
714 (setq multishell-was-default-directory curdir)))
715 ;; To avoid disruption as a pervasive hook function, swallow all errors:
716 (error
717 (message "multishell-post-command-business error: %s" err))))
718 (add-hook 'post-command-hook 'multishell-post-command-business)
719
720 (defun multishell-split-entry (entry)
721 "Given multishell name/path ENTRY, return the separated name and path pair.
722
723 Returns nil for empty parts, rather than the empty string."
724 (save-match-data
725 (string-match "^\\([^/]*\\)\\(/?.*\\)?" entry)
726 (let ((name (match-string 1 entry))
727 (path (match-string 2 entry)))
728 (and (string= name "") (setq name nil))
729 (and (string= path "") (setq path nil))
730 (list name path))))
731 (defun multishell-bracket (name)
732 "Return a copy of name, ensuring it has an asterisk at the beginning and end."
733 (if (not (string= (substring name 0 1) "*"))
734 (setq name (concat "*" name)))
735 (if (not (string= (substring name -1) "*"))
736 (setq name (concat name "*")))
737 name)
738 (defun multishell-unbracket (name)
739 "Return a copy of name, removing asterisks, if any, at beginning and end."
740 (if (string= (substring name 0 1) "*")
741 (setq name (substring name 1)))
742 (if (string= (substring name -1) "*")
743 (setq name (substring name 0 -1)))
744 name)
745
746 (provide 'multishell)
747
748 ;;; multishell.el ends here