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