]> code.delx.au - gnu-emacs-elpa/blobdiff - multishell.el
multishell - don't swallow connection errors besides tramp homedir prob
[gnu-emacs-elpa] / multishell.el
index 653eec94e65b512544c82bb5186904b4a7df91ea..7295aa1ea904dc60eb71e57fc0367aade177db51 100644 (file)
@@ -1,4 +1,4 @@
-;;; 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
 
@@ -6,7 +6,7 @@
 ;; Version: 1.0.5
 ;; Created: 1999 -- first public availability
 ;; Keywords: processes
-;; URL: https://github.com/kenmanheimer/EmacsUtils
+;; URL: https://github.com/kenmanheimer/EmacsMultishell
 ;;
 ;;; Commentary:
 ;;
 ;; 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 one of your shell buffers if you're not currently in one,
-;; * ... with just a keystroke.
+;;   ... or to any of your shell buffers, from elsewhere inside emacs.
+;;
 ;; * Use universal arguments to launch and choose among alternate shell buffers,
-;; * ... and select which is default.
+;; * ... and change which is the current default.
+;;
+;; * Easily restart disconnected shells, or shells from prior sessions
+;; * ... the latter from Emacs builtin savehist minibuf history persistence
+;;
 ;; * Append a path to a new shell name to launch a shell in that directory,
-;; * ... and use a path with Emacs tramp syntax to launch a remote shell.
+;; * ... and use a path with Emacs tramp syntax to launch a remote shell -
+;;   for example:
 ;;
-;;       For example: 
+;;   * `/ssh:example.net:/` for a shell buffer in / on example.net.
+;;     The buffer will be named "*example.net*".
 ;;
-;;       * '/ssh:example.net:/' for a shell buffer in / on
-;;         example.net; the buffer will be named "*example.net*".
+;;   * `#ex/ssh:example.net|sudo:root@example.net:/etc` for a root shell
+;;     starting in /etc on example.net named "*#ex*".
 ;;
-;;       * '#ex/ssh:example.net|sudo:root@example.net:/etc' for a root shell
-;;         starting in /etc on example.net named "*#ex*".
+;;   * '\#intrn/ssh:corp.com|ssh:intern.corp.com|sudo:root@intern.corp.com:/etc'
+;;     to go via corp.com to intern.corp.com, sudood to root, in /etc. Whee! (-:
+;;     The buffer will be named "*#intrn*".
 ;;
-;; (NOTE that you can try to use, eg, '/ssh:example.net:' to get to your
-;; home dir on example.net (if you had one), but that generally fails on an
-;; obscure bug. Until emacs versions where that's solved, you need to use
-;; an explicit path.)
+;; * File visits will all be under the auspices of the account, and relative to
+;;   the current directory, on the remote host.
+;; 
+;; See the `multishell-pop-to-shell` docstring for details.
 ;;
 ;; 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 multishell repository](https://github.com/kenmanheimer/EmacsMultishell)
+;; issue tracker to report problems, suggestions, etc.
 ;;
-;;; Change Log:
+;; (NOTE - tramp sometimes has a problem opening a remote shell pointed at
+;; a homedir, eg `/ssh:example.net:` or `/ssh:example.net:~`. When it
+;; fails, it won't work for the rest of the session. Non-homedir remote
+;; access isn't disrupted. Until this is fixed, you may need to start
+;; remote shells with an explicit path, then cd ~.)
 ;;
-;; 2016-01-16 1.0.5 Ken Manheimer:
-;;   - Fix - recognize and respect tramp path syntax to start in home dir
-;;   - Offer to user to remove shell's history entry when buffer is killed
+;; 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
-;;   - Simplify history var name, migrate existing history from old name if any
-;; 2016-01-06 Ken Manheimer - Released
-;; 2016-01-02 Ken Manheimer - working on this in public, but not yet released.
+;;   - 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:
+;; TODO:
 ;;
-;; * Isolate frequent failure with remote tramp home-dir syntax (`/host.dom:')
-;; * Track the current directory in each buffer's history entry.
-;; * Provide toggle to see completions buffer with just buffer names or + paths
+;; * 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:
 
 (require 'comint)
 (require 'shell)
 
+(defvar multishell-version "1.0.5")
+
 (defgroup multishell nil
   "Allout extension that highlights outline structure graphically.
 
@@ -78,7 +111,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)
@@ -126,13 +159,15 @@ 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
-;;  :set 'multishell-activate-persistence
-;;  :group 'shell)
+(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.")
@@ -146,14 +181,23 @@ current-buffer behavior.)"
 (defvar multishell-primary-name "*shell*"
   "Shell name to use for un-modified multishell-pop-to-shell buffer target.")
 
+;; 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'."
+  "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))
-         (becomes (concat name path)))
+         (path (or path "")))
     (dolist (entry entries)
+      (when (string= path "")
+        ;; Retain explicit established path.
+        (setq path (cadr (multishell-split-entry-name-and-tramp entry))))
       (setq multishell-history (delete entry multishell-history)))
-    (setq multishell-history (push becomes multishell-history))))
+    (setq multishell-history (push (concat name path)
+                                   multishell-history))))
 
 (defun multishell-history-entries (name)
   "Return `multishell-history' entry that starts with NAME, or nil if none."
@@ -233,11 +277,14 @@ For example:
   \"*example.net*\". 
 * '\#ex/ssh:example.net|sudo:root@example.net:/etc' for a root
   shell in /etc on example.net named \"*#ex*\".
+* '\#in/ssh:corp.com|ssh:internal.corp.com|sudo:root@internal.corp.com:/etc'
+  for a root shell name \"*in*\" in /etc on internal.corp.com, via host 
+  corp.com.
 
-\(NOTE that you can specify a remote homedir using tramp syntax,
-eg '/ssh:example.net:'. However that generally fails on an
-obscure bug. Until emacs versions where that's solved, you avoid
-that by using an explicit path.)
+\(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 ~.)
 
 You can change the startup path for a shell buffer by editing it
 at the completion prompt. The new path will be preserved in
@@ -246,9 +293,9 @@ history but will not take effect for an already-running shell.
 To remove a shell buffer's history entry, kill the buffer and
 affirm removal of the entry when prompted.
 
-===== Activate savehist to persisting your shell buffer names and paths:
+===== Activate savehist to retain shell buffer names and paths across Emacs sessions:
 
-To have emacs maintain your history of 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")
@@ -272,14 +319,15 @@ customize the savehist group to activate savehist."
          (curr-buff-proc (get-buffer-process from-buffer))
          (target-buffer (if from-buffer-is-shell
                             from-buffer
-                          (let ((got (get-buffer target-shell-buffer-name)))
-                            (if (buffer-live-p got)
-                                got
-                              (kill-buffer got)
-                              (get-buffer target-shell-buffer-name)))))
+                          (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-asterisks
+                                       target-shell-buffer-name)
+                                      use-default-dir)
+
     (when doublearg
       (setq multishell-primary-name target-shell-buffer-name))
 
@@ -316,19 +364,15 @@ customize the savehist group to activate savehist."
 
     ;; 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))
@@ -491,14 +535,16 @@ Return them as a list (name dir), with dir nil if none given."
         (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 "Tramp shell may fail with homedir paths, %s (\"%s\")"
-                          "please try with an explicit path"
-                          (cadr err)))))))
+       (if (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))))
+         (signal (car err)(cdr err)))))
     (setq buffer (set-buffer (apply 'make-comint
                                     (multishell-unbracket-asterisks buffer-name)
                                     prog
@@ -510,6 +556,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