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