]> code.delx.au - gnu-emacs-elpa/blob - multishell.el
multishell - add multishell-list, solidify facilities
[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.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 active and historically registered shells, as a
48 ;; collection.
49 ;;
50 ;; See the `multishell-pop-to-shell` docstring for details.
51 ;;
52 ;; Customize-group `multishell' to select and activate a keybinding and set
53 ;; various behaviors. Customize-group `savehist' to preserve buffer
54 ;; names/paths across emacs restarts.
55 ;;
56 ;; Please use
57 ;; [the multishell repository](https://github.com/kenmanheimer/EmacsMultishell)
58 ;; issue tracker to report problems, suggestions, etc, and see that
59 ;; repository for a bit more documentation.
60 ;;
61 ;; Change Log:
62 ;;
63 ;; * 2016-01-30 1.0.9 Ken Manheimer:
64 ;; - Add multishell-list for managing the collection of current and
65 ;; history-registered shells: edit, delete, and switch/pop to entries.
66 ;; Easy access by invoking `multishell-pop-to-shell' from in the
67 ;; `multishell-pop-to-shell' universal arg prompts.
68 ;; - Duplicate existing shell buffer names in completions, for distinction.
69 ;; - Add paths to buffers started without one, when multishell history dir
70 ;; tracking is enabled.
71 ;; - Major code cleanup:
72 ;; - Simplify multishell-start-shell-in-buffer, in particular using
73 ;; shell function, rather than unnecessarily going underneath it.
74 ;; - Establish multishell-name-from-entry as canonical name resolver.
75 ;; - Fallback to eval-after-load in emacs versions that lack
76 ;; with-eval-after-load (eg, emacs 23).
77 ;; - save-match-data, where match-string is used
78 ;; - resituate some helpers
79 ;; * 2016-01-24 1.0.8 Ken Manheimer:
80 ;; - Work around the shell/tramp mishandling of remote+sudo+homedir problem!
81 ;; The work around is clean and simple, basically using high-level `cd'
82 ;; API and not messing with the low-level default-directory setting.
83 ;; (Turns out the problem was not in my local config. Good riddance to the
84 ;; awkward failure handler!)
85 ;; - Clean up code resolving the destination shell, starting to document the
86 ;; decision tree in the process. See getting-to-a-shell.md in the
87 ;; multishell repository, https://github.com/kenmanheimer/EmacsMultishell
88 ;; - There may be some shake-out on resolving the destination shell, but
89 ;; this release gets the fundamental functionality soundly in place.
90 ;; * 2016-01-23 1.0.7 Ken Manheimer:
91 ;; - Remove notes about tramp remote+sudo+homedir problem. Apparently it's
92 ;; due to something in my local site configuration (happens with -q but
93 ;; not -Q).
94 ;; * 2016-01-22 1.0.6 Ken Manheimer:
95 ;; - Add multishell-version function.
96 ;; - Tweak commentary/comments/docstrings.
97 ;; - Null old multishell-buffer-name-history var, if present.
98 ;; * 2016-01-16 1.0.5 Ken Manheimer:
99 ;; - History now includes paths, when designated.
100 ;; - Actively track current directory in history entries that have a path.
101 ;; Custom control: multishell-history-entry-tracks-current-directory
102 ;; - Offer to remove shell's history entry when buffer is killed.
103 ;; (Currently the only UI mechanism to remove history entries.)
104 ;; - Fix - prevent duplicate entries for same name but different paths
105 ;; - Fix - recognize and respect tramp path syntax to start in home dir
106 ;; - Simplify history var name, migrate existing history if any from old name
107 ;; * 2016-01-04 1.0.4 Ken Manheimer - Released to ELPA
108 ;; * 2016-01-02 Ken Manheimer - working on this in public, but not yet released.
109 ;;
110 ;; TODO and Known Issues:
111 ;;
112 ;; * Add custom shell launch prep actions
113 ;; - for, eg, port knocking, interface activations
114 ;; - shell commands to execute when shell name or path matches a regexp
115 ;; - list of (regexp, which - name, path, or both, command)
116 ;; * Adapt multishell-list facilities for all-completions
117 ;; - See info on minibuffer-completion-help, display-completion-list
118 ;; - implement markup for mouse selection
119 ;; * Investigate whether we can recognize and provide for failed hops.
120 ;; - Tramp doesn't provide useful reactions for any hop but the first
121 ;; - Might be stuff we can do to detect and convey failures?
122 ;; - Might be no recourse but to seek tramp changes.
123 ;; * Try minibuffer field boundary at beginning of tramp path, to see whether
124 ;; the field boundary magically enables tramp path completion.
125
126 ;;; Code:
127
128 (require 'comint)
129 (require 'shell)
130 (require 'savehist)
131 (require 'multishell-list)
132
133 (defvar multishell-version "1.0.9")
134 (defun multishell-version (&optional here)
135 "Return string describing the loaded multishell version."
136 (interactive "P")
137 (let ((msg (concat "Multishell " multishell-version)))
138 (if here (insert msg)
139 (if (called-interactively-p 'interactive)
140 (message "%s" msg)
141 msg))))
142
143 (defgroup multishell nil
144 "Allout extension that highlights outline structure graphically.
145
146 Customize `allout-widgets-auto-activation' to activate allout-widgets
147 with allout-mode."
148 :group 'shell)
149
150 (defcustom multishell-command-key "\M- "
151 "The key to use if `multishell-activate-command-key' is true.
152
153 You can instead manually bind `multishell-pop-to-shell` using emacs
154 lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
155 :type 'key-sequence
156 :group 'multishell)
157
158 (defvar multishell--responsible-for-command-key nil
159 "Coordination for multishell key assignment.")
160 (defun multishell-activate-command-key-setter (symbol setting)
161 "Implement `multishell-activate-command-key' choice."
162 (set-default 'multishell-activate-command-key setting)
163 (when (or setting multishell--responsible-for-command-key)
164 (multishell-implement-command-key-choice (not setting))))
165 (defun multishell-implement-command-key-choice (&optional unbind)
166 "If settings dicate, implement binding of multishell command key.
167
168 If optional UNBIND is true, globally unbind the key.
169
170 * `multishell-activate-command-key' - Set this to get the binding or not.
171 * `multishell-command-key' - The key to use for the binding, if appropriate."
172 (cond (unbind
173 (when (and (boundp 'multishell-command-key) multishell-command-key)
174 (global-unset-key multishell-command-key)))
175 ((not (and (boundp 'multishell-activate-command-key)
176 (boundp 'multishell-command-key)))
177 nil)
178 ((and multishell-activate-command-key multishell-command-key)
179 (setq multishell--responsible-for-command-key t)
180 (global-set-key multishell-command-key 'multishell-pop-to-shell))))
181
182 (defcustom multishell-activate-command-key nil
183 "Set this to impose the `multishell-command-key' binding.
184
185 You can instead manually bind `multishell-pop-to-shell` using emacs
186 lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
187 :type 'boolean
188 :set 'multishell-activate-command-key-setter
189 :group 'multishell)
190
191 ;; Implement the key customization whenever the package is loaded:
192 (if (fboundp 'with-eval-after-load)
193 (with-eval-after-load "multishell"
194 (multishell-implement-command-key-choice))
195 (eval-after-load "multishell"
196 (multishell-implement-command-key-choice)))
197
198 (defcustom multishell-pop-to-frame nil
199 "*If non-nil, jump to a frame already showing the shell, if another one is.
200
201 Otherwise, disregard already-open windows on the shell if they're
202 in another frame, and open a new window on the shell in the
203 current frame.
204
205 \(Use `pop-up-windows' to change multishell other-window vs
206 current-window behavior.)"
207 :type 'boolean
208 :group 'multishell)
209
210 (defcustom multishell-history-entry-tracks-current-directory t
211 "Maintain shell's current directory in its multishell history entry.
212
213 When set, the history entry for shells started with explicit
214 paths will track the shell's current working directory. (Explicit
215 paths will not be added to local shells started without one,
216 however.)
217
218 If `savehist-save-minibuffer-history' is enabled, the current
219 working directory of shells \(that were started with an explicit
220 path) will be conveyed between emacs sessions."
221 :type 'boolean
222 :group 'multishell)
223
224 (defvar multishell-history nil
225 "Name/path entries, most recent first.")
226 ;; Migrate the few pre 1.0.5 users to changed history var:
227 (when (and (not multishell-history)
228 (boundp 'multishell-buffer-name-history)
229 multishell-buffer-name-history)
230 (setq multishell-history multishell-buffer-name-history
231 multishell-buffer-name-history nil))
232
233 (defvar multishell-primary-name "*shell*"
234 "Default shell name for un-modified multishell-pop-to-shell buffer target.
235
236 This is set by `multishell-pop-to-shell' as the current default,
237 when invoked with doubled universal argument.
238
239 If you want the designated primary that you have at the end of
240 one emacs session to be resumed at the next, customize
241 `savehist-additional-variables' to include the
242 `multishell-primary-name'.")
243
244 ;; Multiple entries happen because completion also adds name to history.
245 (defun multishell-register-name-to-path (name path)
246 "Add or replace entry associating NAME with PATH in `multishell-history'.
247
248 If NAME already had a PATH and new PATH is empty, retain the prior one.
249
250 Promote added/changed entry to the front of the list."
251 ;; Add or promote to the front, tracking path changes in the process.
252 (let* ((entries (multishell-history-entries name))
253 (path (or path "")))
254 (dolist (entry entries)
255 (when (string= path "")
256 ;; Retain explicit established path.
257 (setq path (cadr (multishell-split-entry entry))))
258 (setq multishell-history (delete entry multishell-history)))
259 (setq multishell-history (push (concat name path)
260 multishell-history))))
261
262 (defun multishell-history-entries (name)
263 "Return `multishell-history' entry that starts with NAME, or nil if none."
264 (let (got)
265 (dolist (entry multishell-history)
266 (when (and (string-equal name (multishell-name-from-entry entry))
267 (not (member entry got)))
268 (setq got (cons entry got))))
269 got))
270
271 ;;;###autoload
272 (defun multishell-pop-to-shell (&optional arg name here)
273 "Easily navigate to and within multiple shell buffers, local and remote.
274
275 Use a single `universal-argument' (\\[universal-argument]) to launch and choose between
276 nalternate shell buffers, and a doubled universal argument to also set your
277 choice as the ongoing default. Append a path to a new shell name to launch
278 a shell in that directory, and use Emacs tramp syntax to launch a remote
279 shell. There is a shortcut to manage your list of current and
280 historical shells, collectively, using `multishell-list' - see below.
281
282 Customize-group `multishell' to set up a key binding and tweak behaviors.
283
284 Manage your collection of current and historical shells by
285 recursively invoking \\[multishell-pop-to-shell] at either of the
286 `multishell-pop-to-shell' universal argument prompts, or at any time via
287 \\[multishell-list]. Hit ? in the listing buffer for editing commands.
288
289 ==== Basic operation:
290
291 - If the current buffer is shell-mode (or shell-mode derived)
292 buffer then focus is moved to the process input point.
293
294 \(You can use a universal argument go to a different shell
295 buffer when already in a buffer that has a process - see
296 below.)
297
298 - If not in a shell buffer (or with universal argument), go to a
299 window that is already showing the (a) shell buffer, if any.
300
301 In this case, the cursor is left in its prior position in the
302 shell buffer. Repeating the command will then go to the
303 process input point, per the first item in this list.
304
305 We respect `pop-up-windows', so you can adjust it to set the
306 other-buffer/same-buffer behavior.
307
308 - Otherwise, start a new shell buffer, using the current
309 directory as the working directory.
310
311 If a buffer with the resulting name exists and its shell process
312 was disconnected or otherwise stopped, it's resumed.
313
314 ===== Universal arg to start and select between named shell buffers:
315
316 You can name alternate shell buffers to create or return to, by
317 prefixing your \\[multishell-pop-to-shell] invocation with single or double
318 `universal-argument', \\[universal-argument]:
319
320 - With a single universal argument, prompt for the buffer name
321 to use (without the asterisks that shell mode will put around
322 the name), defaulting to 'shell'.
323
324 Completion is available.
325
326 This combination makes it easy to start and switch across
327 multiple shell restarts.
328
329 - A double universal argument will prompt for the name *and* set
330 the default to that name, so the target shell becomes the
331 primary.
332
333 See `multishell-primary-name' for info about preserving the
334 setting across emacs restarts.
335
336 - Manage your collection of current and historical shells by
337 recursively invoking \\[multishell-pop-to-shell] at either of the
338 `multishell-pop-to-shell' universal argument prompts, or at any
339 time via \\[multishell-list]. Hit ? in the listing buffer for
340 editing commands.
341
342 ===== Select starting directory and remote host:
343
344 The shell buffer name you give to the prompt for a universal arg
345 can include an appended path. That will be used for the startup
346 directory. You can use tramp remote syntax to specify a remote
347 shell. If there is an element after a final '/', that's used for
348 the buffer name. Otherwise, the host, domain, or path is used.
349
350 For example:
351
352 * '#root/sudo:root@localhost:/etc' for a buffer named \"*#root*\" with a
353 root shell starting in /etc.
354
355 * '/ssh:example.net:' for a shell buffer in your homedir on example.net.
356 The buffer will be named \"*example.net*\".
357
358 * '#ex/ssh:example.net|sudo:root@example.net:/var/log' for a root shell
359 starting in /var/log on example.net named \"*#ex*\".
360
361 * 'interior/ssh:gateway.corp.com|ssh:interior.corp.com:' to go
362 via gateway.corp.com to your homedir on interior.corp.com. The
363 buffer will be named \"*interior*\". You could append a sudo
364 hop to the path, combining the previous example, and so on.
365
366 File visits from the shell, and many common emacs activities like
367 dired, will be on the host where the shell is running, in the
368 auspices of the target account, and relative to the current
369 directory.
370
371 You can change the startup path for a shell buffer by editing it
372 at the completion prompt. The new path will not take effect for
373 an already-running shell.
374
375 To remove a shell buffer's history entry, kill the buffer and
376 affirm removal of the entry when prompted.
377
378 ===== Activate savehist to retain shell buffer names and paths across Emacs restarts:
379
380 To have emacs maintain your history of shell buffer names and paths,
381 customize the savehist group to activate savehist."
382
383 (interactive "P")
384
385 (let ((token '(token)))
386 (if (window-minibuffer-p)
387 (throw 'multishell-do-list token)
388 (if (equal token
389 (catch 'multishell-do-list
390 (multishell-pop-to-shell-worker arg name here)))
391 (multishell-list)))))
392
393 (defun multishell-pop-to-shell-worker (&optional arg name here)
394 "Do real work of `multishell-pop-to-shell', which see."
395 (let* ((from-buffer (current-buffer))
396 (from-buffer-is-shell (derived-mode-p 'shell-mode))
397 (primary-name-unbracketed (multishell-unbracket
398 multishell-primary-name))
399 (fallthrough-name (if from-buffer-is-shell
400 (buffer-name from-buffer)
401 primary-name-unbracketed))
402 (doublearg (equal arg '(16)))
403 (target-name-and-path
404 (multishell-resolve-target-name-and-path
405 (cond (name name)
406 (arg
407 (or (multishell-read-unbracketed-entry
408 (format "Shell buffer name [%s]%s "
409 primary-name-unbracketed
410 (if doublearg " <==" ":"))
411 primary-name-unbracketed)
412 primary-name-unbracketed))
413 (t fallthrough-name))))
414 (use-path (cadr target-name-and-path))
415 (target-shell-buffer-name (car target-name-and-path))
416 (target-buffer (get-buffer target-shell-buffer-name))
417 (curr-buff-proc (get-buffer-process from-buffer))
418 inwin
419 already-there)
420
421 ;; Register early so the entry is pushed to the front:
422 (multishell-register-name-to-path (multishell-unbracket
423 target-shell-buffer-name)
424 use-path)
425
426 (when doublearg
427 (setq multishell-primary-name target-shell-buffer-name))
428
429 ;; Situate:
430
431 (cond
432
433 ((and (or curr-buff-proc from-buffer-is-shell)
434 (not arg)
435 (eq from-buffer target-buffer)
436 (not (eq target-shell-buffer-name (buffer-name from-buffer))))
437 ;; In a shell buffer, but not named - stay in buffer, but go to end.
438 (setq already-there t))
439
440 ((string= (buffer-name) target-shell-buffer-name)
441 ;; Already in the specified shell buffer:
442 (setq already-there t))
443
444 ((or (not target-buffer)
445 (not (setq inwin
446 (multishell-get-visible-window-for-buffer target-buffer))))
447 ;; No preexisting shell buffer, or not in a visible window:
448 (when (not (get-buffer target-shell-buffer-name))
449 (message "Creating new shell buffer '%s'" target-shell-buffer-name))
450 (if here
451 (switch-to-buffer target-shell-buffer-name)
452 (pop-to-buffer target-shell-buffer-name pop-up-windows)))
453
454 ;; Buffer exists and already has a window - jump to it:
455 (t (if (and multishell-pop-to-frame
456 inwin
457 (not (equal (window-frame (selected-window))
458 (window-frame inwin))))
459 (select-frame-set-input-focus (window-frame inwin)))
460 (if (not (string= (buffer-name (current-buffer))
461 target-shell-buffer-name))
462 (if here
463 (switch-to-buffer target-shell-buffer-name)
464 (pop-to-buffer target-shell-buffer-name t)))))
465
466 ;; We're in the buffer. Activate:
467
468 (if (not (comint-check-proc (current-buffer)))
469 (multishell-start-shell-in-buffer (buffer-name (current-buffer))
470 use-path))
471
472 ;; If the destination buffer has a stopped process, resume it:
473 (let ((process (get-buffer-process (current-buffer))))
474 (if (and process (equal 'stop (process-status process)))
475 (continue-process process)))
476
477 (when (or already-there
478 (equal (current-buffer) from-buffer))
479 (goto-char (point-max))
480 (and (get-buffer-process from-buffer)
481 (goto-char (process-mark (get-buffer-process from-buffer)))))))
482
483 (defun multishell-delete-history-name (name &optional ask)
484 "Remove all multishell history entries for NAME.
485
486 if optional ask is non-nil (default nil), ask before each deletion.
487
488 Return the last entry deleted."
489 (let (got)
490 (dolist (entry (multishell-history-entries name) got)
491 (when (and entry
492 (or (not ask)
493 (y-or-n-p (format "Remove multishell history entry `%s'? "
494 entry))))
495 (setq got entry
496 multishell-history (delete entry multishell-history))))))
497
498 (defun multishell-kill-buffer-query-function ()
499 "Offer to remove multishell-history entry for buffer."
500 ;; Removal choice is crucial, so users can, eg, kill a shell with huge
501 ;; output backlog, while keeping the history entry to easily restart it.
502 ;;
503 ;; We use kill-buffer-query-functions instead of kill-buffer-hook because:
504 ;;
505 ;; 1. It enables the user to remove the history without actually killing a
506 ;; running buffer, by not confirming the subsequent running-proc query.
507 ;; 2. kill-buffer-hooks often fails to run when killing shell buffers!
508 ;; It's probably due to failures in other hooks - beyond our control -
509 ;; and anyway, I like the first reason well enough.
510
511 ;; (Use condition-case to avoid inadvertant disruption of kill-buffer
512 ;; activity. kill-buffer happens behind the scenes a whole lot.)
513 (condition-case err
514 (and (derived-mode-p 'shell-mode)
515 (multishell-delete-history-name
516 (multishell-unbracket (buffer-name))
517 t))
518 (error
519 (message "multishell-kill-buffer-query-function error: %s" err)))
520 t)
521 (add-hook 'kill-buffer-query-functions 'multishell-kill-buffer-query-function)
522
523 (defun multishell-get-visible-window-for-buffer (buffer)
524 "Return visible window containing buffer."
525 (catch 'got-a-vis
526 (walk-windows
527 (function (lambda (win)
528 (if (and (eq (window-buffer win) buffer)
529 (equal (frame-parameter
530 (selected-frame) 'display)
531 (frame-parameter
532 (window-frame win) 'display)))
533 (throw 'got-a-vis win))))
534 nil 'visible)
535 nil))
536
537 (defun multishell-all-entries (&optional active-duplicated)
538 "Return multishell history, with active buffers listed first.
539
540 Optional ACTIVE-DUPLICATED will return a copy of
541 `multishell-history' with unbracketed names of active buffers,
542 sans paths, appended to the list, so they have short and long
543 completions."
544 ;; Reorder so active buffers are listed first:
545 (let (active-entries active-names historicals splat name path buffer)
546 (dolist (entry multishell-history)
547 (setq splat (multishell-split-entry entry)
548 name (car splat)
549 path (cadr splat)
550 buffer (and name (get-buffer (multishell-bracket name))))
551 (if (and (buffer-live-p buffer)
552 (comint-check-proc buffer))
553 (setq active-entries (push entry active-entries)
554 active-names (push name active-names))
555 (setq historicals (push entry historicals))))
556 (setq multishell-history (append active-entries historicals))
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