Merge commit '2c5d608ddfeb2dc1acc15d645d94cac087f001d4'

[gnu-emacs-elpa] / packages / multishell / multishell.el

diff --git a/packages/multishell/multishell.el b/packages/multishell/multishell.el
index fb37b2590d6307e8afbfa932d24c9776b0917754..e23813d25144073e0320ad4dd2e461cf2a4a21f0 100644 (file)
--- a/packages/multishell/multishell.el
+++ b/packages/multishell/multishell.el
@@ -1,55 +1,87 @@
-;;; 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
 
 ;; Author: Ken Manheimer <ken.manheimer@gmail.com>
 
 ;; Copyright (C) 1999-2016 Free Software Foundation, Inc. and Ken Manheimer
 
 ;; Author: Ken Manheimer <ken.manheimer@gmail.com>

-;; Version: 1.0.2
+;; Version: 1.0.5

 ;; Created: 1999 -- first public availability
 ;; Keywords: processes
 ;; Created: 1999 -- first public availability
 ;; Keywords: processes

-;; URL: https://github.com/kenmanheimer/EmacsUtils
+;; URL: https://github.com/kenmanheimer/EmacsMultishell

 ;;
 ;;; Commentary:
 ;;
 ;;
 ;;; 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,
 ;;
 ;; * 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 one of your shell buffers if you're not currently in one.

 ;; * Use universal arguments to launch and choose among alternate shell buffers,
 ;; * ... and select which is default.
 ;; * 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,
+;; * 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.
 ;;

-;; Customize-group `multishell` to select and activate a keybinding and set
-;; various behaviors.
+;;   For example:

 ;;
 ;;

-;; See the pop-to-shell docstring for details.
+;;   * `/ssh:example.net:/` for a shell buffer in / on
+;;     example.net; the buffer will be named "*example.net*".

 ;;
 ;;

-;;; Change Log:
+;;   * `#ex/ssh:example.net|sudo:root@example.net:/etc` for a root shell
+;;     starting in /etc on example.net named "*#ex*".

 ;;
 ;;

-;; 2016-01-02 Ken Manheimer - initial release
+;; (NOTE - there's a sporadic problem when opening a shell pointed at a
+;; remote homedir, eg `/ssh:example.net:` or `/ssh:example.net:~`. It
+;; sometimes fails, particularly for remotes with empty fs path syntax. Until
+;; fixed, you may need to start remote shells with an explicit path, then
+;; cd ~. If you set up `multishell`s persistent dir-tracking history,
+;; you'll be able to use completion to start that shell in the right place,
+;; in your subsequent sessions.)

 ;;
 ;;

-;;; TODO:
+;; See the `multishell-pop-to-shell` docstring for details.

 ;;
 ;;

-;; * 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
+;; Customize-group `multishell' to select and activate a keybinding and set
+;; various behaviors. Customize-group `savehist' to preserve buffer
+;; names/paths across emacs sessions.
+;;
+;; See the `multishell-pop-to-shell' docstring for details.
+;;
+;; Please use [the repository](https://github.com/kenmanheimer/EmacsMultishell)
+;; issue tracker to report problems, suggestions, etc.
+;;
+;; Change Log:
+;;
+;; * 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
+;;     - But tramp bug, remote w/empty path (homedir) often fails, gets wedged.
+;;   - 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:
+;;
+;; * Isolate tramp sporadic failure to connect to remote+homedir (empty path)
+;;   syntax
+;;   (eg, /ssh:xyz.com|sudo:root@xyz.com: or /ssh:xyz.com|sudo:root@xyz.com:~)
+;; * Find suitable, internally consistent ways to sort tidy completions, eg:
+;;   - first list completions for active shells, then present but inactive,
+;;     then historical
+;;   - some way for user to toggle between presenting just buffer names vs
+;;     full buffer/path
+;;     - without cutting user off from easy editing of path
+;; * Find proper method for setting field boundary at beginning of tramp path
+;;   in the minibuffer, in order to see whether the field boundary magically
+;;   enables tramp completion of the path.
+;; * Assess whether option to delete history entry on kill-buffer is
+;;   sufficient.

 
 ;;; Code:
 
 
 ;;; Code:
 

-(defvar non-interactive-process-buffers '("*compilation*" "*grep*"))
-

 (require 'comint)
 (require 'shell)
 
 (require 'comint)
 (require 'shell)
 


@@ -60,86 +92,119 @@ Customize `allout-widgets-auto-activation' to activate allout-widgets
 with allout-mode."
   :group 'shell)
 
 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.
+(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)."
+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
   :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)
+(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 '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)

   "If settings dicate, implement binding of multishell command key.
 
 If optional UNBIND is true, globally unbind the key.
 
   "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
   (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)
          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
   :type 'boolean

-  :set 'multishell:activate-command-key-setter
+  :set 'multishell-activate-command-key-setter

   :group 'multishell)
 
 ;; Assert the customizations whenever the package is loaded:
 (with-eval-after-load "multishell"
   :group 'multishell)
 
 ;; Assert the customizations whenever the package is loaded:
 (with-eval-after-load "multishell"

-  (multishell:implement-command-key-choice))
+  (multishell-implement-command-key-choice))

 
 

-(defcustom multishell:pop-to-frame nil
+(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 is.
 

-Otherwise, open a new window in the current frame.
+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.

 
 

-\(Adjust `pop-up-windows' to change other-buffer vs current-buffer behavior.)"
+\(Use `pop-up-windows' to change multishell other-buffer vs
+current-buffer behavior.)"

   :type 'boolean
   :group 'multishell)
 
   :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)
-
-(defvar multishell:name-path-assoc nil
-  "Assoc list from name to path")
-
-(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.")
-
-(defun pop-to-shell (&optional arg)
+(defcustom multishell-history-entry-tracks-current-directory t
+  "Modify shell buffer's multishell entry to track the current directory.
+
+When set, the path part of the name/path entry for each shell
+will track the current directory of the shell with emacs. If
+`savehist' is active, the directory tracking will extend across
+emacs sessions."
+ :type 'boolean
+ :group 'multishell)
+
+(defvar multishell-history nil
+  "Name/path entries, most recent first.")
+(when (and (not multishell-history)
+           (boundp 'multishell-buffer-name-history)
+           multishell-buffer-name-history)
+  ;; Migrate few users who had old var to new.
+  (setq multishell-history multishell-buffer-name-history)
+ )
+
+(defvar multishell-primary-name "*shell*"
+  "Shell name to use for un-modified multishell-pop-to-shell buffer target.")
+
+;; There is usually only one entry per name, but disruptions happen.
+(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 old 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))
+         (becomes (concat name path))
+         oldpath)
+    (dolist (entry entries)
+      (when (or (not path) (string= path ""))
+        ;; Retain explicit established path.
+        (setq path (cadr (multishell-split-entry-name-and-tramp entry))
+              becomes (concat name path)))
+      (setq multishell-history (delete entry multishell-history)))
+    (setq multishell-history (push becomes multishell-history))))
+
+(defun multishell-history-entries (name)
+  "Return `multishell-history' entry that starts with NAME, or nil if none."
+  (let ((match-expr (concat "^" name "\\\(/.*$\\\)?"))
+        got)
+    (dolist (entry multishell-history)
+      (when (and (string-match match-expr entry)
+                 (not (member entry got)))
+        (setq got (cons entry got))))
+    got))
+
+(defun multishell-pop-to-shell (&optional arg)

   "Easily navigate to and within multiple shell buffers, local and remote.
 
 Use universal arguments to launch and choose between alternate
   "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.  Prepend a path to
+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.
 
 a new shell name to launch a shell in that directory, and use
 Emacs tramp syntax to launch a remote shell.
 


@@ -147,9 +212,8 @@ Customize-group `multishell' to set up a key binding and tweak behaviors.
 
 ==== Basic operation:
 
 
 ==== 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
 
    \(You can use a universal argument go to a different shell
    buffer when already in a buffer that has a process - see


@@ -192,74 +256,67 @@ single or doubled universal arguments:
 ===== Select starting directory and remote host:
 
 The shell buffer name you give to the prompt for a universal arg
 ===== 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:
 
 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\"."
+* Use '/ssh:example.net:/home/myaccount' for a shell buffer in
+  /home/myaccount on example.net; the buffer will be named
+  \"*example.net*\". 
+* '\#ex/ssh:example.net|sudo:root@example.net:/etc' for a root
+  shell in /etc on example.net named \"*#ex*\".

 
 

-;; 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.
+\(NOTE that there is a problem with specifying a remote homedir using
+tramp syntax, eg '/ssh:example.net:'. That sometimes fails on an obscure
+bug - particularly for remote with empty path (homedir) syntax. Until fixed,
+you may need to start remote shells with an explicit path, then cd ~.)

 
 

-;; ===== Persisting your alternate shell buffer names and paths:
+You can change the startup path for a shell buffer by editing it
+at the completion prompt. The new path will be preserved in
+history but will not take effect for an already-running shell.

 
 

-;; 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:
+To remove a shell buffer's history entry, kill the buffer and
+affirm removal of the entry when prompted.

 
 

-;; 1. Add `multishell:pop-to-shell-buffer-name-history' to Savehist Additional
-;;    Variables.
-;; 2. Activate Savehist Mode, if not already activated.
-;; 3. Save.
+===== Activate savehist to persisting your shell buffer names and paths:
+
+To have emacs maintain your history of shell buffer names and paths, 
+customize the savehist group to activate savehist."

 
   (interactive "P")
 
   (let* ((from-buffer (current-buffer))
 
   (interactive "P")
 
   (let* ((from-buffer (current-buffer))

-         (from-buffer-is-shell (eq major-mode 'shell-mode))
+         (from-buffer-is-shell (derived-mode-p 'shell-mode))

          (doublearg (equal arg '(16)))
          (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-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))
+         (target-shell-buffer-name (car target-name-and-path))

          (curr-buff-proc (get-buffer-process from-buffer))
          (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)))
+         (target-buffer (if from-buffer-is-shell

                             from-buffer
                             from-buffer

-                          (get-buffer target-shell-buffer-name)))
+                          (let ((got (get-buffer target-shell-buffer-name)))
+                            (if (buffer-live-p got)
+                                got
+                              (kill-buffer got)
+                              (get-buffer target-shell-buffer-name)))))

          inwin
          already-there)
 
     (when doublearg
          inwin
          already-there)
 
     (when doublearg

-      (setq multishell:primary-name target-shell-buffer-name))
+      (setq multishell-primary-name target-shell-buffer-name))

 
     ;; Situate:
 
 
     ;; Situate:
 


@@ -278,12 +335,12 @@ For example:
 
      ((or (not target-buffer)
           (not (setq inwin
 
      ((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:
       ;; 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
+     (t (if (and multishell-pop-to-frame

                  inwin
                  (not (equal (window-frame (selected-window))
                              (window-frame inwin))))
                  inwin
                  (not (equal (window-frame (selected-window))
                              (window-frame inwin))))


@@ -294,23 +351,52 @@ For example:
 
     ;; We're in the buffer. Activate:
 
 
     ;; 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 (buffer-name (current-buffer))
+                                          use-default-dir))

 
     ;; 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)))
 
     ;; 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)))

+    (multishell-register-name-to-path (multishell-unbracket-asterisks
+                                       target-shell-buffer-name)
+                                      use-default-dir)

     (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)))))))
 
     (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-kill-buffer-query-function ()
+  "Offer to remove multishell-history entry for buffer."
+  ;; Removal choice is crucial, so users can, eg, kill and a runaway shell
+  ;; and keep 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 killing the buffer,
+  ;;    by cancelling the kill-buffer process after affirming history removal.
+  ;; 2. kill-buffer-hooks often fails to run when killing shell buffers!
+  ;;    I've failed to resolve that, and 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 anyerr
+      (let ((entries (and (derived-mode-p 'shell-mode)
+                          (multishell-history-entries
+                           (multishell-unbracket-asterisks (buffer-name))))))
+        (dolist (entry entries)
+          (when (and entry
+                     (y-or-n-p (format "Remove multishell history entry `%s'? "
+                                       entry)))
+            (setq multishell-history
+                  (delete entry multishell-history)))))
+    (error nil))
+  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
   "Return visible window containing buffer."
   (catch 'got-a-vis
     (walk-windows


@@ -324,49 +410,89 @@ For example:
      nil 'visible)
     nil))
 
      nil 'visible)
     nil))
 

-(defun multishell:read-bare-shell-buffer-name (prompt default)
+(defun multishell-read-bare-shell-buffer-name (prompt default)

   "PROMPT for shell buffer name, sans asterisks.
 
 Return the supplied name bracketed with the asterisks, or specified DEFAULT
 on empty input."
   "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)))))
+  (let* ((candidates
+          (append
+           ;; Plain shell buffer names appended with names from name/path hist:
+           (remq nil
+                 (mapcar (lambda (buffer)
+                           (let* ((name (multishell-unbracket-asterisks
+                                         (buffer-name buffer))))
+                             (and (buffer-live-p buffer)
+                                  (with-current-buffer buffer
+                                    ;; Shell mode buffers.
+                                    (derived-mode-p 'shell-mode))
+                                  (not (multishell-history-entries name))
+                                  name)))
+                         (buffer-list)))
+           multishell-history))

          (got (completing-read prompt
          (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
+                               nil
+                               ;; HIST:
+                               'multishell-history)))
+    (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)))
+             (setq path (match-string 2 path-ish))
+             (if (string= overt-name "") (setq overt-name nil))
+             (if (string= path "") (setq path nil))
+             (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)
+                                  system-name))
+                          (multishell-unbracket-asterisks
+                           multishell-primary-name)))))))
+          (t (setq name (multishell-bracket-asterisks path-ish))))
+    (list name path)))
+
+(defun multishell-bracket-asterisks (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)
   "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-asterisks (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)
   "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 dir)
-  "Ensure a shell is started, using whatever name we're passed."
+
+(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.
 
   ;; We work around shell-mode's bracketing of the buffer name, and do
   ;; some tramp-mode hygiene for remote connections.
 


@@ -377,20 +503,38 @@ on empty input."
                    "/bin/sh"))
          (name (file-name-nondirectory prog))
          (startfile (concat "~/.emacs_" name))
                    "/bin/sh"))
          (name (file-name-nondirectory prog))
          (startfile (concat "~/.emacs_" name))

-         (xargs-name (intern-soft (concat "explicit-" name "-args"))))
+         (xargs-name (intern-soft (concat "explicit-" name "-args")))
+         is-remote)

     (set-buffer buffer-name)
     (set-buffer buffer-name)

-    (when (and (file-remote-p default-directory)
-               (eq major-mode 'shell-mode)
+    (if (and path (not (string= path "")))
+        (setq default-directory path))
+    (setq is-remote (file-remote-p default-directory))
+    (when (and is-remote
+               (derived-mode-p '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))
                (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))

-    (if dir
-        (cd dir))
+    ;; (cd default-directory) will connect if remote:
+    (when is-remote
+      (message "Connecting to %s" default-directory))
+    (condition-case err
+        (cd default-directory)
+      (error
+       ;; Aargh. Need to isolate this tramp bug.
+       (when (and (stringp (cadr err))
+                  (string-equal (cadr err)
+                                "Selecting deleted buffer"))
+         (signal (car err)
+                 (list
+                  (format "%s, %s (\"%s\")"
+                          "Tramp shell can fail on empty (homedir) path"
+                          "please try again with an explicit path"
+                          (cadr err)))))))

     (setq buffer (set-buffer (apply 'make-comint
     (setq buffer (set-buffer (apply 'make-comint

-                                    (multishell:unbracket-asterisks buffer-name)
+                                    (multishell-unbracket-asterisks buffer-name)

                                     prog
                                     (if (file-exists-p startfile)
                                         startfile)
                                     prog
                                     (if (file-exists-p startfile)
                                         startfile)


@@ -400,6 +544,77 @@ on empty input."
                                       '("-i")))))
     (shell-mode)))
 
                                       '("-i")))))
     (shell-mode)))
 

+(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-name-and-tramp entry))
+             (name (car name-path))
+             (path (cadr name-path)))
+        (when path
+          (let* ((is-remote (file-remote-p path))
+                 (vec (and is-remote (tramp-dissect-file-name path nil)))
+                 (localname (if is-remote
+                                (tramp-file-name-localname vec)
+                              path))
+                 (newlocalname
+                  (replace-regexp-in-string (if (string= localname "")
+                                                "$"
+                                              (regexp-quote localname))
+                                            ;; REP
+                                            newpath
+                                            ;; STRING
+                                            localname
+                                            ;; FIXEDCASE
+                                            t
+                                            ;; LITERAL
+                                            t
+                                            ))
+                 (newpath (if is-remote
+                              (tramp-make-tramp-file-name (aref vec 0)
+                                                          (aref vec 1)
+                                                          (aref vec 2)
+                                                          newlocalname
+                                                          (aref vec 4))
+                            newlocalname))
+                 (newentry (concat name newpath))
+                 (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)
+                          (tramp-file-name-localname
+                           (tramp-dissect-file-name default-directory))
+                        default-directory)))
+          (when (and multishell-was-default-directory
+                     (not (string= curdir multishell-was-default-directory)))
+            (multishell-track-dirchange (multishell-unbracket-asterisks
+                                         (buffer-name))
+                                        curdir))
+          (setq multishell-was-default-directory curdir)))
+    ;; To avoid disruption as a pervasive hook function, swallow all errors:
+    (error nil)))
+(add-hook 'post-command-hook 'multishell-post-command-business)
+
+(defun multishell-split-entry-name-and-tramp (entry)
+  "Given multishell name/path ENTRY, return the separated name and path pair.
+
+Returns nil for empty parts, rather than the empty string."
+  (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)))
+

 (provide 'multishell)
 
 ;;; multishell.el ends here
 (provide 'multishell)
 
 ;;; multishell.el ends here