X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/500f08cf9edde5448a4c7b22a21ba6ebe9d8f8b2..d33fb5489c4cc6c9111d7f485376699516896e72:/packages/multishell/multishell.el diff --git a/packages/multishell/multishell.el b/packages/multishell/multishell.el index d859f98eb..f746c5757 100644 --- a/packages/multishell/multishell.el +++ b/packages/multishell/multishell.el @@ -1,58 +1,169 @@ -;;; multishell.el --- manage interaction with multiple local and remote shells +;;; multishell.el --- facilitate multiple local and remote shell buffers -;; Copyright (C) 1999-2016 Free Software Foundation, Inc. and Ken Manheimer +;; Copyright (C) 1999-2016 Free Software Foundation, Inc. -;; Author: Ken Manheimer -;; Version: 1.0.0 -;; Maintainer: Ken Manheimer +;; Author: Ken Manheimer +;; Version: 1.1.2 ;; 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. -;; * Prepend 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 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 - +;; 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. +;; +;; * Manage your list of shells, current and past, as a collection. +;; +;; See the `multishell-pop-to-shell` docstring for details. ;; -;; Customize-group `multishell` to select and activate a keybinding and set -;; various behaviors. +;; Customize-group `multishell' to select and activate a keybinding and set +;; various behaviors. Customize-group `savehist' to preserve buffer +;; names/paths across emacs restarts. ;; -;; See the pop-to-shell docstring for details. +;; 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. ;; -;;; Change Log: +;; Change Log: ;; -;; 2016-01-02 Ken Manheimer - initial release +;; * 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: +;; TODO and Known Issues: ;; -;; * 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 -;; - Using isearch keybinding M-e -;; - Edits path -;; - New association overrides previous -;; - Deleting path removes association and history entry -;; * 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 +;; * 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.2") +(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. @@ -61,96 +172,161 @@ Customize `allout-widgets-auto-activation' to activate allout-widgets with allout-mode." :group 'shell) -(defcustom multishell:non-interactive-process-buffers - '("*compilation*" "*grep*") - "Names of buffers that have processes but are not for interaction. -Add names of buffers that you don't want pop-to-shell to stick around in." - :type '(repeat string) - :group 'multishell) -(defcustom multishell:command-key "\M- " - "The key to use if `multishell:activate-command-key' is true. - -You can instead bind `pop-to-shell` to your preferred key using emacs -lisp, eg: (global-set-key \"\\M- \" 'pop-to-shell)." - :type 'key-sequence - :group 'multishell) - -(defvar multishell:responsible-for-command-key nil - "Multishell internal.") -(defun multishell:activate-command-key-setter (symbol setting) - "Implement `multishell:activate-command-key' choice." - (set-default 'multishell:activate-command-key setting) - (when (or setting multishell:responsible-for-command-key) - (multishell:implement-command-key-choice (not setting)))) -(defun multishell:implement-command-key-choice (&optional unbind) +(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) + +(defvar multishell--responsible-for-command-key nil + "Coordination for multishell key assignment.") +(defun multishell-activate-command-key-setter (symbol setting) + "Implement `multishell-activate-command-key' choice." + (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) "If settings dicate, implement binding of multishell command key. If optional UNBIND is true, globally unbind the key. -* `multishell:activate-command-key' - Set this to get the binding or not. -* `multishell:command-key' - The key to use for the binding, if appropriate." +* `multishell-activate-command-key' - Set this to get the binding or not. +* `multishell-command-key' - The key to use for the binding, if appropriate." (cond (unbind - (when (and (boundp 'multishell:command-key) multishell:command-key) - (global-unset-key multishell:command-key))) - ((not (and (boundp 'multishell:activate-command-key) - (boundp 'multishell:command-key))) + (when (and (boundp 'multishell-command-key) multishell-command-key) + (global-unset-key multishell-command-key))) + ((not (and (boundp 'multishell-activate-command-key) + (boundp 'multishell-command-key))) nil) - ((and multishell:activate-command-key multishell:command-key) - (setq multishell:responsible-for-command-key t) - (global-set-key multishell:command-key 'pop-to-shell)))) + ((and multishell-activate-command-key multishell-command-key) + (setq multishell--responsible-for-command-key t) + (global-set-key multishell-command-key 'multishell-pop-to-shell)))) -(defcustom multishell:activate-command-key nil - "Set this to impose the `multishell:command-key' binding. +(defcustom multishell-activate-command-key nil + "Set this to impose the `multishell-command-key' binding. -You can instead bind `pop-to-shell` to your preferred key using emacs -lisp, eg: (global-set-key \"\\M- \" 'pop-to-shell)." +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) - -;; Assert the customizations whenever the package is loaded: -(with-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. - -Otherwise, open a new window in the current frame. - -\(Adjust `pop-up-windows' to change other-buffer vs current-buffer behavior.)" - :type 'boolean - :group 'multishell) - -;; (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) + :set 'multishell-activate-command-key-setter) + +;; 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 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-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. + +When set, the history entry for shells started with explicit +paths will track the shell's current working directory. + +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*" + "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'.") + +;; 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. -(defvar multishell:name-path-assoc nil - "Assoc list from name to path") +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. -(defvar multishell:primary-name "*shell*" - "Shell name to use for un-modified pop-to-shell buffer target.") -(defvar multishell:buffer-name-history nil - "Distinct pop-to-shell completion history container.") +Customize-group `multishell' to set up a key binding and tweak behaviors. -(defun pop-to-shell (&optional arg) - "Easily navigate to and within multiple shell buffers, local and remote. +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: -Use universal arguments to launch and choose between alternate -shell buffers and to select which is default. Prepend a path to -a new shell name to launch a shell in that directory, and use -Emacs tramp syntax to launch a remote shell. + \\[universal-argument] \\[multishell-pop-to-shell] \\[multishell-pop-to-shell] -Customize-group `multishell' to set up a key binding and tweak behaviors. +\(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 @@ -174,8 +350,9 @@ was disconnected or otherwise stopped, it's resumed. ===== 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 @@ -183,84 +360,107 @@ single or doubled universal arguments: 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 -can include a preceding path. That will be used for the startup +can include an appended path. That will be used for the startup directory. You can use tramp remote syntax to specify a remote shell. If there is an element after a final '/', that's used for the buffer name. Otherwise, the host, domain, or path is used. For example: -* Use '/ssh:example.net:/' for a shell buffer on example.net named - \"example.net\". -* '/ssh:example.net|sudo:root@example.net:/\#ex' 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*\". + +* '#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 to the path, combining the previous example, and so on. + +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. -;; 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. +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. -;; ===== Persisting your alternate shell buffer names and paths: +To remove a shell buffer's history entry, kill the buffer and +affirm removal of the entry when prompted. -;; 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: +===== Activate savehist to retain shell buffer names and paths across Emacs restarts: -;; 1. Add `multishell:pop-to-shell-buffer-name-history' to Savehist Additional -;; Variables. -;; 2. Activate Savehist Mode, if not already activated. -;; 3. Save. +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-do-list token) + (if (equal token + (catch 'multishell-do-list + (multishell-pop-to-shell-worker arg name here))) + (multishell-list))))) + +(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))) - (temp (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 - (target-shell-buffer-name - ;; Derive target name, and default-dir if any, from temp. - (cond ((string= temp "") multishell:primary-name) - ((string-match "^\\*\\(/.*/\\)\\(.*\\)\\*" temp) - (setq use-default-dir (match-string 1 temp)) - (multishell:bracket-asterisks - (if (string= (match-string 2 temp) "") - (let ((v (tramp-dissect-file-name - use-default-dir))) - (or (tramp-file-name-host v) - (tramp-file-name-domain v) - (tramp-file-name-localname v) - use-default-dir)) - (match-string 2 temp)))) - (t (multishell:bracket-asterisks temp)))) + (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)) + (setq multishell-primary-name target-shell-buffer-name)) ;; Situate: @@ -279,42 +479,83 @@ For example: ((or (not target-buffer) (not (setq inwin - (multishell:get-visible-window-for-buffer target-buffer)))) + (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)) - - ;; Buffer exists and already has a window - jump to it: - (t (if (and multishell:pop-to-frame + (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: + (t (if (and multishell-pop-to-frame inwin (not (equal (window-frame (selected-window)) (window-frame inwin)))) (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)))) - - ;; We're in the buffer. - - ;; If we have a use-default-dir, impose it: - (when use-default-dir - (cd use-default-dir)) + (if here + (switch-to-buffer target-shell-buffer-name) + (pop-to-buffer target-shell-buffer-name t))))) - ;; Activate: + ;; We're in the buffer. Activate: (if (not (comint-check-proc (current-buffer))) - (multishell:start-shell-in-buffer (buffer-name (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:get-visible-window-for-buffer (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 (walk-windows @@ -328,82 +569,215 @@ For example: 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))))) +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)) (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:bracket-asterisks (name) + ;; 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 - tidy up: + (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))) (if (string= (substring name -1) "*") (setq name (substring name 0 -1))) name) -(defun multishell:start-shell-in-buffer (buffer-name) - "Ensure a shell is started, using whatever name we're passed." - ;; We work around shell-mode's bracketing of the buffer name, and do - ;; some tramp-mode hygiene for remote connections. - - (require 'comint) - (require 'shell) - - (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) - (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)) - (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)