-;;; multishell.el --- manage interaction with multiple local and remote shells
+;;; multishell.el --- Easily use multiple shell buffers, local and remote.
-;; Copyright (C) 1999-2016 Free Software Foundation, Inc. and Ken Manheimer
+;; Copyright (C) 1999-2016 Free Software Foundation, Inc.
;; Author: Ken Manheimer <ken.manheimer@gmail.com>
-;; Version: 1.0.3
+;; Version: 1.1.4
;; Created: 1999 -- first public availability
;; Keywords: processes
-;; URL: https://github.com/kenmanheimer/EmacsUtils
+;; URL: https://github.com/kenmanheimer/EmacsMultishell
;;
;;; Commentary:
;;
-;; Easily use and manage multiple shell buffers, including remote shells.
-;; Fundamentally, multishell is the function `multishell-pop-to-shell - like
-;; pop-to-buffer - plus a keybinding. Together, they enable you to:
+;; Easily use and navigate multiple shell buffers, including remote shells.
+;; Fundamentally, multishell is the function `multishell-pop-to-shell' -
+;; a la `pop-to-buffer' - plus a keybinding. Together, they enable you to:
;;
;; * Get to the input point from wherever you are in a shell buffer,
-;; * ... or to a shell buffer if you're not currently in one.
+;; ... or to any of your shell buffers, from anywhere inside emacs.
+;;
;; * Use universal arguments to launch and choose among alternate shell buffers,
-;; * ... and select which is default.
+;; ... and change which is the current default.
+;;
+;; * Easily restart disconnected shells, or shells from prior sessions
+;; ... the latter from Emacs builtin savehist minibuf history persistence
+;;
;; * Append a path to a new shell name to launch a shell in that directory,
-;; * ... and use a path with Emacs tramp syntax to launch a remote shell.
+;; ... and use a path with Emacs tramp syntax to launch a remote shell -
+;; for example:
+;;
+;; * `#root/sudo:root@localhost:/etc` for a buffer named "*#root*" with a
+;; root shell starting in /etc.
+;;
+;; * `/ssh:example.net:` for a shell buffer in your homedir on example.net.
+;; The buffer will be named "*example.net*".
+;;
+;; * `#ex/ssh:example.net|sudo:root@example.net:/var/log` for a root shell
+;; starting in /var/log on example.net named "*#ex*".
+;;
+;; * 'interior/ssh:gateway.corp.com|ssh:interior.corp.com:' to go via
+;; gateway.corp.com to your homedir on interior.corp.com. The buffer
+;; will be named "*interior*". You could append a sudo hop, and so on.
+;;
+;; * Thanks to tramp, file visits from the shell will seamlessly be in
+;; the auspices of the target account, and relative to the current
+;; directory, on the host where the shell is running.
;;
-;; Customize-group `multishell` to select and activate a keybinding and set
-;; various behaviors.
+;; * Manage your list of shells, current and past, as a collection.
;;
-;; See the multishell-pop-to-shell docstring for details.
+;; See the `multishell-pop-to-shell` docstring for details.
;;
-;;; Change Log:
+;; Customize-group `multishell' to select and activate a keybinding and set
+;; various behaviors. Customize-group `savehist' to preserve buffer
+;; names/paths across emacs restarts.
;;
-;; 2016-01-02 Ken Manheimer - working on this in public, but not yet released.
+;; Please use
+;; [the multishell repository](https://github.com/kenmanheimer/EmacsMultishell)
+;; issue tracker to report problems, suggestions, etc, and see that
+;; repository for a bit more documentation.
;;
-;;; TODO:
+;; Change Log:
;;
-;; * Fix operation given local path without specified name
-;; * Preserveable (savehist) history that associates names with paths
-;; - Using an association list between names and paths
-;; - Searched for search backwards/forwards on isearch-like M-r/M-s bindings
-;; - *Not* searched for regular completion
-;; - Editible
-;; - During confirmation for new buffers - to use historical one
-;; - Or with minibuffer setup created key binding (isearch-like) M-e
-;; - M-e in empty initial provides completion on historicals
-;; - User can edit the entire path, changing the association
-;; - New association overrides previous
-;; - Deleting path removes association and history entry
-;; - Tracks buffer name changes
-;; - Using buffer-list-update-hook
-;; * Customize activation of savehist
-;; - Customize entry has warning about activating savehist
-;; - Adds the name/path association list to savehist-additional-variables
-;; - Activates savehist, if inactive
+;; * 2016-02-10 1.1.4 Ken Manheimer:
+;; - hookup multishell-list as completion help buffer.
+;; * 2016-02-09 1.1.3 Ken Manheimer:
+;; multishell-list:
+;; - add some handy operations, like cloning new entry from existing
+;; - add optional behaviors to existing operations for returning to
+;; stopped shells without restarting them.
+;; - solidify maintaining focus on current entry
+;; - fix miscellaneous.
+;; * 2016-01-31 1.1.2 Ken Manheimer:
+;; - Settle puzzling instability of multishell-all-entries
+;; - The accumulations was putting items going from more to less active
+;; categories to be put at the end, not beginning.
+;; - Also, using history for prompting changes history - implement
+;; no-record option to avoid this when needed.
+;; - Implement simple edit-in-place multishell-replace-entry and use in
+;; multishell-list-edit-entry.
+;; - Remove now unnecessary multishell-list-revert-buffer-kludge.
+;; - Rectify byte compiler offenses, and other fixes - thanks to Stefan
+;; Monnier for pointing out many of the corrections.
+;; - Avoid directly calling tramp functions unnecessarily.
+;; * 2016-01-30 1.1.1 Ken Manheimer:
+;; - shake out initial multishell-list glitches:
+;; - (Offer to) delete shell buffer, if present, when deleting entry.
+;; - Set recency (numeric rank) as initial sort field
+;; - Recompute list on most operations that affect the order, and try to
+;; preserve stability. (Kludgy solution, needs work.)
+;; - Set version to 1.1.1 - multishell-list addition should have been 1.1.0.
+;; * 2016-01-30 1.0.9 Ken Manheimer:
+;; - Add multishell-list for managing the collection of current and
+;; history-registered shells: edit, delete, and switch/pop to entries.
+;; Easy access by invoking `multishell-pop-to-shell' from in the
+;; `multishell-pop-to-shell' universal arg prompts.
+;; - Duplicate existing shell buffer names in completions, for distinction.
+;; - Add paths to buffers started without one, when multishell history dir
+;; tracking is enabled.
+;; - Major code cleanup:
+;; - Simplify multishell-start-shell-in-buffer, in particular using
+;; shell function, rather than unnecessarily going underneath it.
+;; - Establish multishell-name-from-entry as canonical name resolver.
+;; - Fallback to eval-after-load in emacs versions that lack
+;; with-eval-after-load (eg, emacs 23).
+;; - save-match-data, where match-string is used
+;; - resituate some helpers
+;; * 2016-01-24 1.0.8 Ken Manheimer:
+;; - Work around the shell/tramp mishandling of remote+sudo+homedir problem!
+;; The work around is clean and simple, basically using high-level `cd'
+;; API and not messing with the low-level default-directory setting.
+;; (Turns out the problem was not in my local config. Good riddance to the
+;; awkward failure handler!)
+;; - Clean up code resolving the destination shell, starting to document the
+;; decision tree in the process. See getting-to-a-shell.md in the
+;; multishell repository, https://github.com/kenmanheimer/EmacsMultishell
+;; - There may be some shake-out on resolving the destination shell, but
+;; this release gets the fundamental functionality soundly in place.
+;; * 2016-01-23 1.0.7 Ken Manheimer:
+;; - Remove notes about tramp remote+sudo+homedir problem. Apparently it's
+;; due to something in my local site configuration (happens with -q but
+;; not -Q).
+;; * 2016-01-22 1.0.6 Ken Manheimer:
+;; - Add multishell-version function.
+;; - Tweak commentary/comments/docstrings.
+;; - Null old multishell-buffer-name-history var, if present.
+;; * 2016-01-16 1.0.5 Ken Manheimer:
+;; - History now includes paths, when designated.
+;; - Actively track current directory in history entries that have a path.
+;; Custom control: multishell-history-entry-tracks-current-directory
+;; - Offer to remove shell's history entry when buffer is killed.
+;; (Currently the only UI mechanism to remove history entries.)
+;; - Fix - prevent duplicate entries for same name but different paths
+;; - Fix - recognize and respect tramp path syntax to start in home dir
+;; - Simplify history var name, migrate existing history if any from old name
+;; * 2016-01-04 1.0.4 Ken Manheimer - Released to ELPA
+;; * 2016-01-02 Ken Manheimer - working on this in public, but not yet released.
+;;
+;; TODO and Known Issues:
+;;
+;; * Add mouse actions - buttons - to multishell-list entries
+;; - see buf-menu.el, eg Buffer-menu-mouse-select
+;; * Resolve multishell-list sort glitches:
+;; - Fix config so multishell-list-revert-buffer-kludge is not needed
+;; - Make multishell-list-edit-entry in-place, so changed entries recency
+;; doesn't change.
+;; - Fill in kill-buffer prompting gaps, eg if default live-process
+;; prompts are inhibited.
+;; * Add custom shell launch prep actions
+;; - for, eg, port knocking, interface activations
+;; - shell commands to execute when shell name or path matches a regexp
+;; - list of (regexp, which - name, path, or both, command)
+;; * Adapt multishell-list facilities for all-completions
+;; - See info on minibuffer-completion-help, display-completion-list
+;; * Investigate whether we can recognize and provide for failed hops.
+;; - Tramp doesn't provide useful reactions for any hop but the first
+;; - Might be stuff we can do to detect and convey failures?
+;; - Might be no recourse but to seek tramp changes.
+;; * Try minibuffer field boundary at beginning of tramp path, to see whether
+;; the field boundary magically enables tramp path completion.
;;; Code:
-(defvar non-interactive-process-buffers '("*compilation*" "*grep*"))
-
(require 'comint)
(require 'shell)
+(require 'savehist)
+(require 'multishell-list)
+
+(defvar multishell-version "1.1.3")
+(defun multishell-version (&optional here)
+ "Return string describing the loaded multishell version."
+ (interactive "P")
+ (let ((msg (concat "Multishell " multishell-version)))
+ (if here (insert msg)
+ (if (called-interactively-p 'interactive)
+ (message "%s" msg)
+ msg))))
(defgroup multishell nil
"Allout extension that highlights outline structure graphically.
with allout-mode."
:group 'shell)
-(defcustom multishell-non-interactive-process-buffers
- '("*compilation*" "*grep*")
- "Names of buffers that have processes but are not for interaction.
-Identify which buffers you don't want to be multishell-pop-to-shell \"sticky\"."
- :type '(repeat string)
- :group 'multishell)
(defcustom multishell-command-key "\M- "
"The key to use if `multishell-activate-command-key' is true.
You can instead manually bind `multishell-pop-to-shell` using emacs
lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
- :type 'key-sequence
- :group 'multishell)
+ :type 'key-sequence)
(defvar multishell--responsible-for-command-key nil
- "Multishell internal.")
+ "Coordination for multishell key assignment.")
(defun multishell-activate-command-key-setter (symbol setting)
"Implement `multishell-activate-command-key' choice."
- (set-default 'multishell-activate-command-key setting)
+ (set-default symbol setting)
(when (or setting multishell--responsible-for-command-key)
(multishell-implement-command-key-choice (not setting))))
(defun multishell-implement-command-key-choice (&optional unbind)
You can instead manually bind `multishell-pop-to-shell` using emacs
lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
:type 'boolean
- :set 'multishell-activate-command-key-setter
- :group 'multishell)
+ :set 'multishell-activate-command-key-setter)
-;; Assert the customizations whenever the package is loaded:
-(with-eval-after-load "multishell"
- (multishell-implement-command-key-choice))
+;; Implement the key customization whenever the package is loaded:
+(if (fboundp 'with-eval-after-load)
+ (with-eval-after-load "multishell"
+ (multishell-implement-command-key-choice))
+ (eval-after-load "multishell"
+ '(multishell-implement-command-key-choice)))
(defcustom multishell-pop-to-frame nil
- "*If non-nil, jump to a frame already showing the shell, if another is.
+ "*If non-nil, jump to a frame already showing the shell, if another one is.
Otherwise, disregard already-open windows on the shell if they're
in another frame, and open a new window on the shell in the
current frame.
-\(Use `pop-up-windows' to change multishell other-buffer vs
-current-buffer behavior.)"
- :type 'boolean
- :group 'multishell)
+\(Use `pop-up-windows' to change multishell other-window vs
+current-window behavior.)"
+ :type 'boolean)
+
+(defcustom multishell-history-entry-tracks-current-directory t
+ "Maintain shell's current directory in its multishell history entry.
-;; (defcustom multishell-persist-shell-names nil
-;; "Remember shell name/path associations across sessions. Note well:
-;; This will activate minibuffer history persistence, in general, if it's not
-;; already active."
-;; :type 'boolean
-;; :group 'shell)
+When set, the history entry for shells started with explicit
+paths will track the shell's current working directory.
-(defvar multishell-name-path-assoc nil
- "Assoc list from name to path")
+If `savehist-save-minibuffer-history' is enabled, the current
+working directory of shells will be conveyed between emacs
+sessions."
+ :type 'boolean)
+
+(defvar multishell-history nil
+ "Name/path entries, most recent first.")
+;; Migrate the few pre 1.0.5 users to changed history var:
+(when (and (not multishell-history)
+ (boundp 'multishell-buffer-name-history)
+ multishell-buffer-name-history)
+ (setq multishell-history multishell-buffer-name-history
+ multishell-buffer-name-history nil))
(defvar multishell-primary-name "*shell*"
- "Shell name to use for un-modified multishell-pop-to-shell buffer target.")
-(defvar multishell-buffer-name-history nil
- "Distinct multishell-pop-to-shell completion history container.")
-(defvar multishell-buffer-name-path-history nil
- "Another multishell-pop-to-shell completion history container,
-including paths.")
-
-(defun multishell-pop-to-shell (&optional arg)
+ "Default shell name for un-modified multishell-pop-to-shell buffer target.
+
+This is set by `multishell-pop-to-shell' as the current default,
+when invoked with doubled universal argument.
+
+If you want the designated primary that you have at the end of
+one emacs session to be resumed at the next, customize
+`savehist-additional-variables' to include the
+`multishell-primary-name'.")
+
+(defvar multishell-completing-read nil
+ "Internal use, conveying whether or not we're in the midst of a multishell
+completing-read.")
+
+;; Multiple entries happen because completion also adds name to history.
+(defun multishell-register-name-to-path (name path)
+ "Add or replace entry associating NAME with PATH in `multishell-history'.
+
+If NAME already had a PATH and new PATH is empty, retain the prior one.
+
+Promote added/changed entry to the front of the list."
+ ;; Add or promote to the front, tracking path changes in the process.
+ (let* ((entries (multishell-history-entries name))
+ (path (or path "")))
+ (dolist (entry entries)
+ (when (string= path "")
+ ;; Retain explicit established path.
+ (setq path (cadr (multishell-split-entry entry))))
+ (setq multishell-history (delete entry multishell-history)))
+ (setq multishell-history (push (concat name path)
+ multishell-history))))
+
+(defun multishell-replace-entry (entry revised)
+ "Replace every instance of ENTRY in `multishell-history' with REVISED.
+
+Revised entry is situated where former one was.
+
+Returns non-nil iff any changes were made."
+ (let ((candidates multishell-history)
+ did-revisions)
+ (while (setq candidates (member entry candidates))
+ (setcar candidates revised)
+ (setq candidates (cdr candidates)
+ did-revisions t))
+ did-revisions))
+
+(defun multishell-history-entries (name)
+ "Return `multishell-history' entry that starts with NAME, or nil if none."
+ (let (got)
+ (dolist (entry multishell-history)
+ (when (and (string-equal name (multishell-name-from-entry entry))
+ (not (member entry got)))
+ (push entry got)))
+ got))
+
+;;;###autoload
+(defun multishell-pop-to-shell (&optional arg name here)
"Easily navigate to and within multiple shell buffers, local and remote.
-Use universal arguments to launch and choose between alternate
-shell buffers and to select which is default. Append a path to
-a new shell name to launch a shell in that directory, and use
-Emacs tramp syntax to launch a remote shell.
+Use a single `universal-argument' (\\[universal-argument]) to launch and choose between
+nalternate shell buffers, and a doubled universal argument to also set your
+choice as the ongoing default. Append a path to a new shell name to launch
+a shell in that directory, and use Emacs tramp syntax to launch a remote
+shell. There is a shortcut to manage your list of current and
+historical shells, collectively, using `multishell-list' - see below.
Customize-group `multishell' to set up a key binding and tweak behaviors.
+Manage your collection of current and historical shells by
+recursively invoking \\[multishell-pop-to-shell] at the
+`multishell-pop-to-shell' universal argument prompts, eg:
+
+ \\[universal-argument] \\[multishell-pop-to-shell] \\[multishell-pop-to-shell]
+
+\(That will be just a few keys if you do the above
+customization.) Hit ? in the listing buffer for editing commands.
+
==== Basic operation:
- - If the current buffer is associated with a subprocess (that is
- not among those named on `non-interactive-process-buffers'),
- then focus is moved to the process input point.
+ - If the current buffer is shell-mode (or shell-mode derived)
+ buffer then focus is moved to the process input point.
\(You can use a universal argument go to a different shell
buffer when already in a buffer that has a process - see
===== Universal arg to start and select between named shell buffers:
-You can name alternate shell buffers to create or return to using
-single or doubled universal arguments:
+You can name alternate shell buffers to create or return to, by
+prefixing your \\[multishell-pop-to-shell] invocation with single or double
+`universal-argument', \\[universal-argument]:
- With a single universal argument, prompt for the buffer name
to use (without the asterisks that shell mode will put around
Completion is available.
- This combination makes it easy to start and switch between
- multiple shell buffers.
+ This combination makes it easy to start and switch across
+ multiple shell restarts.
- A double universal argument will prompt for the name *and* set
the default to that name, so the target shell becomes the
primary.
+ See `multishell-primary-name' for info about preserving the
+ setting across emacs restarts.
+
+ - Manage your collection of current and historical shells by
+ recursively invoking \\[multishell-pop-to-shell] at either of the
+ `multishell-pop-to-shell' universal argument prompts, or at any
+ time via \\[multishell-list]. Hit ? in the listing buffer for
+ editing commands.
+
===== Select starting directory and remote host:
The shell buffer name you give to the prompt for a universal arg
For example:
-* Use '/ssh:example.net:/' for a shell buffer on example.net named
- \"example.net\".
-* '\#ex/ssh:example.net|sudo:root@example.net:/' for a root shell on
- example.net named \"#ex\"."
+* '#root/sudo:root@localhost:/etc' for a buffer named \"*#root*\" with a
+ root shell starting in /etc.
+
+* '/ssh:example.net:' for a shell buffer in your homedir on example.net.
+ The buffer will be named \"*example.net*\".
-;; I'm leaving the following out of the docstring for now because just
-;; saving the buffer names, and not the paths, yields sometimes unwanted
-;; behavior.
+* '#ex/ssh:example.net|sudo:root@example.net:/var/log' for a root shell
+ starting in /var/log on example.net named \"*#ex*\".
-;; ===== Persisting your alternate shell buffer names and paths:
+* 'interior/ssh:gateway.corp.com|ssh:interior.corp.com:' to go
+ via gateway.corp.com to your homedir on interior.corp.com. The
+ buffer will be named \"*interior*\". You could append a sudo
+ hop to the path, combining the previous example, and so on.
-;; You can use emacs builtin SaveHist to preserve your alternate
-;; shell buffer names and paths across emacs sessions. To do so,
-;; customize the `savehist' group, and:
+File visits from the shell, and many common emacs activities like
+dired, will be on the host where the shell is running, in the
+auspices of the target account, and relative to the current
+directory.
-;; 1. Add `multishell-pop-to-shell-buffer-name-history' to Savehist Additional
-;; Variables.
-;; 2. Activate Savehist Mode, if not already activated.
-;; 3. Save.
+You can change the startup path for a shell buffer by editing it
+at the completion prompt. The new path will not take effect for
+an already-running shell.
+
+To remove a shell buffer's history entry, kill the buffer and
+affirm removal of the entry when prompted.
+
+===== Activate savehist to retain shell buffer names and paths across Emacs restarts:
+
+To have emacs maintain your history of shell buffer names and paths,
+customize the savehist group to activate savehist."
(interactive "P")
+ (let ((token '(token)))
+ (if (window-minibuffer-p)
+ (throw 'multishell-minibuffer-exit token)
+ (let ((got (catch 'multishell-minibuffer-exit
+ (multishell-pop-to-shell-worker arg name here))))
+ ;; Handle catch or plain fall-through - see cond comments for protocol.
+ (cond
+ ;; Caught token from recursive invocation in minibuffer:
+ ((equal token got) (multishell-list))
+ ;; Caught specifaction of multishell args, eg from multishell-list:
+ ((listp got) (multishell-pop-to-shell-worker (nth 2 got)
+ (nth 0 got)
+ (nth 1 got)))
+ ;; Regular fallthrough - just relay the result:
+ (t got))))))
+
+(defun multishell-pop-to-shell-worker (&optional arg name here)
+ "Do real work of `multishell-pop-to-shell', which see."
(let* ((from-buffer (current-buffer))
- (from-buffer-is-shell (eq major-mode 'shell-mode))
+ (from-buffer-is-shell (derived-mode-p 'shell-mode))
+ (primary-name-unbracketed (multishell-unbracket
+ multishell-primary-name))
+ (fallthrough-name (if from-buffer-is-shell
+ (buffer-name from-buffer)
+ primary-name-unbracketed))
(doublearg (equal arg '(16)))
(target-name-and-path
- (multishell-derive-target-name-and-path
- (if arg
- (multishell-read-bare-shell-buffer-name
- (format "Shell buffer name [%s]%s "
- (substring-no-properties
- multishell-primary-name
- 1 (- (length multishell-primary-name) 1))
- (if doublearg " <==" ":"))
- multishell-primary-name)
- multishell-primary-name)))
- (use-default-dir (cadr target-name-and-path))
+ (multishell-resolve-target-name-and-path
+ (cond (name name)
+ (arg
+ (or (multishell-read-unbracketed-entry
+ (format "Shell buffer name [%s]%s "
+ primary-name-unbracketed
+ (if doublearg " <==" ":")))
+ primary-name-unbracketed))
+ (t fallthrough-name))))
+ (use-path (cadr target-name-and-path))
(target-shell-buffer-name (car target-name-and-path))
+ (target-buffer (get-buffer target-shell-buffer-name))
(curr-buff-proc (get-buffer-process from-buffer))
- (target-buffer (if (and (or curr-buff-proc from-buffer-is-shell)
- (not (member (buffer-name from-buffer)
- non-interactive-process-buffers)))
- from-buffer
- (get-buffer target-shell-buffer-name)))
inwin
already-there)
+ ;; Register early so the entry is pushed to the front:
+ (multishell-register-name-to-path (multishell-unbracket
+ target-shell-buffer-name)
+ use-path)
+
(when doublearg
(setq multishell-primary-name target-shell-buffer-name))
(not (setq inwin
(multishell-get-visible-window-for-buffer target-buffer))))
;; No preexisting shell buffer, or not in a visible window:
- (pop-to-buffer target-shell-buffer-name pop-up-windows))
+ (when (not (get-buffer target-shell-buffer-name))
+ (message "Creating new shell buffer '%s'" target-shell-buffer-name))
+ (if here
+ (switch-to-buffer target-shell-buffer-name)
+ (pop-to-buffer target-shell-buffer-name pop-up-windows)))
- ;; Buffer exists and already has a window - jump to it:
+ ;; Buffer exists and already has a window - jump to it:
(t (if (and multishell-pop-to-frame
inwin
(not (equal (window-frame (selected-window))
(select-frame-set-input-focus (window-frame inwin)))
(if (not (string= (buffer-name (current-buffer))
target-shell-buffer-name))
- (pop-to-buffer target-shell-buffer-name t))))
+ (if here
+ (switch-to-buffer target-shell-buffer-name)
+ (pop-to-buffer target-shell-buffer-name t)))))
;; We're in the buffer. Activate:
- (cond ((not (comint-check-proc (current-buffer)))
- (multishell-start-shell-in-buffer (buffer-name (current-buffer))
- use-default-dir))
- (use-default-dir
- (cd use-default-dir)))
+ (if (not (comint-check-proc (current-buffer)))
+ (multishell-start-shell-in-buffer use-path))
;; If the destination buffer has a stopped process, resume it:
(let ((process (get-buffer-process (current-buffer))))
(if (and process (equal 'stop (process-status process)))
(continue-process process)))
+
(when (or already-there
(equal (current-buffer) from-buffer))
(goto-char (point-max))
(and (get-buffer-process from-buffer)
(goto-char (process-mark (get-buffer-process from-buffer)))))))
+(defun multishell-delete-history-name (name &optional ask)
+ "Remove all multishell history entries for NAME.
+
+if optional ask is non-nil (default nil), ask before each deletion.
+
+Return the last entry deleted."
+ (let (got)
+ (dolist (entry (multishell-history-entries name) got)
+ (when (and entry
+ (or (not ask)
+ (y-or-n-p (format "Remove multishell history entry `%s'? "
+ entry))))
+ (setq got entry
+ multishell-history (delete entry multishell-history))))))
+
+(defun multishell-kill-buffer-query-function ()
+ "Offer to remove multishell-history entry for buffer."
+ ;; Removal choice is crucial, so users can, eg, kill a shell with huge
+ ;; output backlog, while keeping the history entry to easily restart it.
+ ;;
+ ;; We use kill-buffer-query-functions instead of kill-buffer-hook because:
+ ;;
+ ;; 1. It enables the user to remove the history without actually killing a
+ ;; running buffer, by not confirming the subsequent running-proc query.
+ ;; 2. kill-buffer-hooks often fails to run when killing shell buffers!
+ ;; It's probably due to failures in other hooks - beyond our control -
+ ;; and anyway, I like the first reason well enough.
+
+ ;; (Use condition-case to avoid inadvertant disruption of kill-buffer
+ ;; activity. kill-buffer happens behind the scenes a whole lot.)
+ (condition-case err
+ (and (derived-mode-p 'shell-mode)
+ (multishell-delete-history-name
+ (multishell-unbracket (buffer-name))
+ t))
+ (error
+ (message "multishell-kill-buffer-query-function error: %s" err)))
+ t)
+(add-hook 'kill-buffer-query-functions 'multishell-kill-buffer-query-function)
+
(defun multishell-get-visible-window-for-buffer (buffer)
"Return visible window containing buffer."
(catch 'got-a-vis
nil 'visible)
nil))
-(defun multishell-read-bare-shell-buffer-name (prompt default)
+(defun multishell-all-entries (&optional active-duplicated)
+ "Return multishell history, with active buffers listed first.
+
+Optional ACTIVE-DUPLICATED will return a copy of
+`multishell-history' with unbracketed names of active buffers,
+sans paths, appended to the list, so they have short and long
+completions."
+ ;; Reorder so active lead present lead historical entries:
+ (let (active-entries active-names present past splat name buffer)
+ (dolist (entry multishell-history)
+ (setq splat (multishell-split-entry entry)
+ name (car splat)
+ buffer (and name (get-buffer (multishell-bracket name))))
+ (if (buffer-live-p buffer)
+ (if (comint-check-proc buffer)
+ (setq active-entries (push entry active-entries)
+ active-names (push name active-names))
+ (setq present (push entry present)))
+ (setq past (push entry past))))
+ ;; Reverse present and past lists
+ (setq multishell-history (append (reverse active-entries)
+ (reverse present)
+ (reverse past)))
+ (if active-duplicated
+ (append multishell-history active-names)
+ multishell-history)))
+
+(defun multishell-read-unbracketed-entry (prompt &optional initial no-record)
"PROMPT for shell buffer name, sans asterisks.
-Return the supplied name bracketed with the asterisks, or specified DEFAULT
-on empty input."
- (let* ((candidates (append
- (remq nil
- (mapcar (lambda (buffer)
- (let ((name (buffer-name buffer)))
- (if (with-current-buffer buffer
- (eq major-mode 'shell-mode))
- ;; Shell mode buffers.
- (if (> (length name) 2)
- ;; Strip asterisks.
- (substring name 1
- (1- (length name)))
- name))))
- (buffer-list)))))
- (got (completing-read prompt
- candidates ; COLLECTION
- nil ; PREDICATE
- 'confirm ; REQUIRE-MATCH
- nil ; INITIAL-INPUT
- 'multishell-buffer-name-history ; HIST
- )))
- (if (not (string= got "")) (multishell-bracket-asterisks got) default)))
-(defun multishell-derive-target-name-and-path (path-ish)
- "Give tramp-style PATH-ISH, determine target name and default directory.
-
-The name is the part of the string before the initial '/' slash,
-if any. Otherwise, it's either the host-name, domain-name, final
-directory name, or local host name. The path is everything
-besides the string before the initial '/' slash.
-
-Return them as a list (name dir), with dir nil if none given."
- (let (name (path "") dir)
- (cond ((string= path-ish "") (setq dir multishell-primary-name))
- ((string-match "^\\*\\([^/]*\\)\\(/.*/\\)\\(.*\\)\\*" path-ish)
- ;; We have a path, use it
- (let ((overt-name (match-string 1 path-ish))
- (overt-path (match-string 2 path-ish))
- (trailing-name (match-string 3 path-ish)))
- (if (string= overt-name "") (setq overt-name nil))
- (if (string= overt-path "") (setq overt-path nil))
- (if (string= trailing-name "") (setq trailing-name nil))
- (setq path (concat overt-path trailing-name))
- (setq name
- (multishell-bracket-asterisks
- (or overt-name
- (if (file-remote-p path)
- (let ((vec (tramp-dissect-file-name path)))
- (or (tramp-file-name-host vec)
- (tramp-file-name-domain vec)
- (tramp-file-name-localname vec)
- trailing-name
- system-name))
- (multishell-unbracket-asterisks
- multishell-primary-name)))))))
- (t (setq name (multishell-bracket-asterisks path-ish))))
- (list name path)))
-
-(defun multishell-bracket-asterisks (name)
+Optional INITIAL is preliminary value to be edited.
+
+Optional NO-RECORD prevents changes to `multishell-history'
+across the activity.
+
+Input and completion can include associated path, if any.
+
+Return what's provided, if anything, else nil."
+ (let* ((was-multishell-history multishell-history)
+ (candidates (multishell-all-entries 'active-duplicated))
+ (multishell-completing-read t)
+ (got
+ ;; Use `cl-letf' to dynamically bind multishell-list to
+ ;; display-completion-list, so multishell-list is used when doing
+ ;; minibuffer-completion-help.
+ (cl-letf (((symbol-function 'display-completion-list)
+ #'multishell-list))
+ (completing-read prompt
+ ;; COLLECTION:
+ (reverse candidates)
+ ;; PREDICATE:
+ nil
+ ;; REQUIRE-MATCH:
+ 'confirm
+ ;; INITIAL-INPUT
+ initial
+ ;; HIST:
+ 'multishell-history))))
+ (when no-record
+ (setq multishell-history was-multishell-history))
+ (if (not (string= got ""))
+ got
+ nil)))
+
+(defun multishell-resolve-target-name-and-path (shell-spec)
+ "Given name/tramp-style address shell spec, resolve buffer name and directory.
+
+The name is the part of the string up to the first '/' slash, if
+any. Missing pieces are filled in from remote path elements, if
+any, and multishell history. Given a tramp-style remote address
+and no name part, either the user@host is used for the buffer
+name, if a user is specified, or just the host.
+
+Return them as a list: (name path), with name asterisk-bracketed
+and path nil if none is resolved."
+ (let* ((splat (multishell-split-entry (or shell-spec "")))
+ (path (cadr splat))
+ (name (or (car splat) (multishell-name-from-entry path))))
+ (when (not path)
+ ;; Get path from history, if present.
+ (dolist (entry
+ (multishell-history-entries
+ (multishell-unbracket name)))
+ (when (or (not path) (string= path ""))
+ (setq path (cadr (multishell-split-entry entry))))))
+ (list (multishell-bracket name) path)))
+
+(defun multishell-name-from-entry (entry)
+ "Derive a name for a shell buffer according to ENTRY."
+ (if (not entry)
+ (multishell-unbracket multishell-primary-name)
+ (let* ((splat (multishell-split-entry entry))
+ (name (car splat))
+ (path (cadr splat)))
+ (or name
+ (if (file-remote-p path)
+ (let ((host (file-remote-p path 'host))
+ (user (file-remote-p path 'user)))
+ (cond ((and host user)
+ (format "%s@%s" user host))
+ (host host)
+ (user user)
+ ((system-name))))
+ (multishell-unbracket multishell-primary-name))))))
+
+(declare-function tramp-dissect-file-name "tramp")
+(declare-function tramp-cleanup-connection "tramp")
+
+(defun multishell-start-shell-in-buffer (path)
+ "Start, restart, or continue a shell in BUFFER-NAME on PATH."
+ (let* ((is-active (comint-check-proc (current-buffer))))
+
+ (when (and path (not is-active))
+
+ (when (and (derived-mode-p 'shell-mode) (file-remote-p path))
+ ;; Returning to disconnected remote shell - do some tidying.
+ ;; Prevents an "Args out of range" failure when reconnecting.
+ (tramp-cleanup-connection
+ (tramp-dissect-file-name default-directory 'noexpand)
+ 'keep-debug 'keep-password))
+
+ (when (file-remote-p path) (message "Connecting to %s" path))
+ (cd path))
+
+ (shell (current-buffer))))
+
+(defun multishell-homedir-shorthand-p (dirpath)
+ "t if dirpath is an unexpanded remote homedir spec."
+ ;; Workaround to recognize tramp-style homedir shorthand, "...:" and "...:~".
+ (let ((localname (file-remote-p dirpath 'localname)))
+ (and localname
+ (or
+ ;; No directory path and no connection to expand homedir:
+ (string= localname "")
+ ;; Original path doesn't equal expanded homedir:
+ (save-match-data
+ (not (string-match (concat (regexp-quote localname) "/?$")
+ dirpath)))))))
+;; (assert (multishell-homedir-shorthand-p "/ssh:myhost.net:")
+;; (assert (not (multishell-homedir-shorthand-p "/home/klm")))
+;; (assert (not (multishell-homedir-shorthand-p "/ssh:myhost.net:/home/me")))
+
+(defun multishell-track-dirchange (name newpath)
+ "Change multishell history entry to track current directory."
+ (let* ((entries (multishell-history-entries name)))
+ (dolist (entry entries)
+ (let* ((name-path (multishell-split-entry entry))
+ (name (car name-path))
+ (path (or (cadr name-path) "")))
+ (when path
+ (let* ((old-localname (or (file-remote-p path 'localname)
+ path))
+ (newentry
+ (if (multishell-homedir-shorthand-p path)
+ (concat entry newpath)
+ (replace-regexp-in-string (concat (regexp-quote
+ old-localname)
+ "$")
+ ;; REPLACEMENT
+ newpath
+ ;; STRING
+ entry
+ ;; FIXEDCASE
+ t
+ ;; LITERAL
+ t
+ )))
+ (membership (member entry multishell-history)))
+ (when membership
+ (setcar membership newentry))))))))
+
+(defvar multishell-was-default-directory ()
+ "Provide for tracking directory changes.")
+(make-variable-buffer-local 'multishell-was-default-directory)
+(defun multishell-post-command-business ()
+ "Do multishell bookkeeping."
+ ;; Update multishell-history with dir changes.
+ (condition-case err
+ (when (and multishell-history-entry-tracks-current-directory
+ (derived-mode-p 'shell-mode))
+ (let ((curdir (if (file-remote-p default-directory)
+ (file-remote-p default-directory 'localname)
+ default-directory)))
+ (when (not (string= curdir (or multishell-was-default-directory "")))
+ (multishell-track-dirchange (multishell-unbracket (buffer-name))
+ curdir))
+ (setq multishell-was-default-directory curdir)))
+ ;; To avoid disruption as a pervasive hook function, swallow all errors:
+ (error
+ (message "multishell-post-command-business error: %s" err))))
+(add-hook 'post-command-hook #'multishell-post-command-business)
+
+(defun multishell-split-entry (entry)
+ "Given multishell name/path ENTRY, return the separated name and path pair.
+
+Returns nil for empty parts, rather than the empty string."
+ (save-match-data
+ (string-match "^\\([^/]*\\)\\(/?.*\\)?" entry)
+ (let ((name (match-string 1 entry))
+ (path (match-string 2 entry)))
+ (and (string= name "") (setq name nil))
+ (and (string= path "") (setq path nil))
+ (list name path))))
+(defun multishell-bracket (name)
"Return a copy of name, ensuring it has an asterisk at the beginning and end."
(if (not (string= (substring name 0 1) "*"))
(setq name (concat "*" name)))
(if (not (string= (substring name -1) "*"))
(setq name (concat name "*")))
name)
-(defun multishell-unbracket-asterisks (name)
+(defun multishell-unbracket (name)
"Return a copy of name, removing asterisks, if any, at beginning and end."
(if (string= (substring name 0 1) "*")
(setq name (substring name 1)))
(setq name (substring name 0 -1)))
name)
-(defun multishell-start-shell-in-buffer (buffer-name path)
- "Ensure a shell is started, with name NAME and PATH."
- ;; We work around shell-mode's bracketing of the buffer name, and do
- ;; some tramp-mode hygiene for remote connections.
-
- (let* ((buffer buffer-name)
- (prog (or explicit-shell-file-name
- (getenv "ESHELL")
- (getenv "SHELL")
- "/bin/sh"))
- (name (file-name-nondirectory prog))
- (startfile (concat "~/.emacs_" name))
- (xargs-name (intern-soft (concat "explicit-" name "-args"))))
- (set-buffer buffer-name)
- (if (and path (not (string= path "")))
- (setq default-directory path))
- (when (and (file-remote-p default-directory)
- (eq major-mode 'shell-mode)
- (not (comint-check-proc (current-buffer))))
- ;; We're returning to an already established but disconnected remote
- ;; shell, tidy it:
- (tramp-cleanup-connection
- (tramp-dissect-file-name default-directory 'noexpand)
- 'keep-debug 'keep-password))
- ;; (cd default-directory) will reconnect a disconnected remote:
- (cd default-directory)
- (setq buffer (set-buffer (apply 'make-comint
- (multishell-unbracket-asterisks buffer-name)
- prog
- (if (file-exists-p startfile)
- startfile)
- (if (and xargs-name
- (boundp xargs-name))
- (symbol-value xargs-name)
- '("-i")))))
- (shell-mode)))
-
(provide 'multishell)
;;; multishell.el ends here