X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/9611c98636eeb84b933d237218716f7809915847..7e7d7bbea8bbe625bb38e29502c47b42245fcbd7:/packages/multishell/multishell.el

diff --git a/packages/multishell/multishell.el b/packages/multishell/multishell.el
index e5ae0b7eb..e23813d25 100644
--- a/packages/multishell/multishell.el
+++ b/packages/multishell/multishell.el
@@ -1,55 +1,84 @@
-;;; 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>
-;; Version: 1.0.4
+;; Version: 1.0.5
 ;; 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.
+;; 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 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.
 ;; * 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.
 ;;
-;; Customize-group `multishell` to select and activate a keybinding and set
-;; various behaviors.
+;;   For example:
 ;;
-;; See the multishell-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 - working on this in public, but not yet released.
+;; (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.
 ;;
-;; * 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
+;; 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:
 
@@ -72,7 +101,7 @@ lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
   :group 'multishell)
 
 (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)
@@ -120,23 +149,56 @@ 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)
-
-(defvar multishell-name-path-assoc nil
-  "Assoc list from name to path")
+(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.")
-(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.")
+
+;; 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.
@@ -201,25 +263,28 @@ 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\".
-* '\#ex/ssh:example.net|sudo:root@example.net:/' 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*\".
+
+\(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 ~.)
 
-;; 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 be preserved in
+history but 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 persisting your shell buffer names and paths:
 
-;; 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")
 
@@ -242,7 +307,11 @@ For example:
          (curr-buff-proc (get-buffer-process from-buffer))
          (target-buffer (if from-buffer-is-shell
                             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)
 
@@ -282,22 +351,51 @@ For example:
 
     ;; 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)))
+    (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)))))))
 
+(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
@@ -317,27 +415,36 @@ For example:
 
 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
-                                              (derived-mode-p '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
-                               candidates ; COLLECTION
-                               nil        ; PREDICATE
-                               'confirm   ; REQUIRE-MATCH
-                               nil        ; INITIAL-INPUT
-                               'multishell-buffer-name-history ; HIST
-                               )))
-    (if (not (string= got "")) (multishell-bracket-asterisks got) default)))
+                               ;; 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.
 
@@ -349,15 +456,12 @@ 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)
+          ((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)))
+           (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= overt-path "") (setq overt-path nil))
-             (if (string= trailing-name "") (setq trailing-name nil))
-             (setq path (concat overt-path trailing-name))
+             (if (string= path "") (setq path nil))
              (setq name
                    (multishell-bracket-asterisks
                     (or overt-name
@@ -366,7 +470,6 @@ Return them as a list (name dir), with dir nil if none given."
                               (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)))))))
@@ -400,11 +503,13 @@ Return them as a list (name dir), with dir nil if none given."
                    "/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)
     (if (and path (not (string= path "")))
         (setq default-directory path))
-    (when (and (file-remote-p default-directory)
+    (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
@@ -412,8 +517,22 @@ Return them as a list (name dir), with dir nil if none given."
       (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)
+    ;; (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
                                     (multishell-unbracket-asterisks buffer-name)
                                     prog
@@ -425,6 +544,77 @@ Return them as a list (name dir), with dir nil if none given."
                                       '("-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