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