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