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