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