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