]> code.delx.au - gnu-emacs-elpa/blobdiff - multishell.el
Merge branch 'master' of github.com:kenmanheimer/EmacsMultishell
[gnu-emacs-elpa] / multishell.el
index a7b1d3b5e1864198b66a6a0ba0146e5f8f25cefe..b5d6cc02e85151e92320e62cb8a608853e40ef9d 100644 (file)
 ;; 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,
+;; * ... with just a keystroke.
 ;; * 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*".
+;;
+;;       * '#ex/ssh:example.net|sudo:root@example.net:/etc' for a root shell
+;;         starting 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+sudo with homedir syntax. Until fixed, you
+;; may need to start remote+sudo shells with an explicit path, then cd ~.)
+;;
+;; 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.
 ;;
 ;;; Change Log:
 ;;
+;; 2016-01-16 1.0.5 Ken Manheimer:
+;;   - History now includes paths, when specified.
+;;   - Actively track current directory in history entry, if it has a path
+;;     Customize: multishell-history-entry-tracks-current-directory
+;;   - Offer to user to remove shell's history entry when buffer is killed
+;;   - 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, sudo hops to a home dir often fails.
+;;   - Simplify history var name, migrate existing history if any from old name
+;; 2016-01-06 Ken Manheimer - Released
 ;; 2016-01-02 Ken Manheimer - working on this in public, but not yet released.
 ;;
 ;;; TODO:
 ;;
-;; * Preserveable (savehist) history that associates names with paths
-;;   - Editible
-;;     - New shell prompts for confirmation
-;;       - Including path from history, if any
-;;       - which offers opportunity to entry
-;;       - ?completions list toggles between short and long?
-;;         - "Toggle short/long listing by immediately repeating completion key"
-;;   - History tracks buffer disposition
-;;     - Deleting buffer removes history entry
-;;     - Track buffer name change using buffer-list-update-hook
-;;   - Option to track last directory - multishell-remember-last-dir
-;;     - dig into tramp to find out where the actual remote+dir path is
-;;     - Include note about tramp not tracking remote dir changes well
-;;       - use `M-x shell-resync-dirs'; I bind to M-return
-;; * Note in multishell doc to activate (customize) savehist to preserve history
+;; * Isolate frequent failure with remote tramp home-dir syntax (`/host.dom:')
+;; * Find suitable modes for brief and elaborate name/path exposures,
+;;   e.g. toggle for completions to show just name or name+path
 
 ;;; Code:
 
@@ -69,7 +82,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)
@@ -117,13 +130,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.")
@@ -137,8 +152,11 @@ current-buffer behavior.)"
 (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'."
+  "Add or replace entry associating NAME with PATH in `multishell-history'.
+
+Promote to 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)))
@@ -151,7 +169,8 @@ current-buffer behavior.)"
   (let ((match-expr (concat "^" name "\\\(/.*$\\\)?"))
         got)
     (dolist (entry multishell-history)
-      (when (string-match match-expr entry)
+      (when (and (string-match match-expr entry)
+                 (not (member entry got)))
         (setq got (cons entry got))))
     got))
 
@@ -218,10 +237,16 @@ the buffer name. Otherwise, the host, domain, or path is used.
 
 For example:
 
-* Use '/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:/etc' for a root shell 
-  in /etc 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+sudo with homedir syntax. Until fixed, you
+may need to start remote+sudo 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
@@ -256,7 +281,11 @@ customize the savehist group to activate savehist."
          (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)
 
@@ -296,11 +325,9 @@ 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))))
@@ -369,7 +396,8 @@ on empty input."
                  (mapcar (lambda (buffer)
                            (let* ((name (multishell-unbracket-asterisks
                                          (buffer-name buffer))))
-                             (and (with-current-buffer buffer
+                             (and (buffer-live-p buffer)
+                                  (with-current-buffer buffer
                                     ;; Shell mode buffers.
                                     (derived-mode-p 'shell-mode))
                                   (not (multishell-history-entries name))
@@ -449,11 +477,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
@@ -461,8 +491,21 @@ 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 "Tramp shell can fail on homedir paths, %s (\"%s\")"
+                          "please try with an explicit path"
+                          (cadr err)))))))
     (setq buffer (set-buffer (apply 'make-comint
                                     (multishell-unbracket-asterisks buffer-name)
                                     prog
@@ -474,6 +517,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