X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/3715fb26fbc10426eccd9df529d8b7fe280bfa91..9df64fc64f09c459c22894c8bfa88dce054afbe0:/packages/multishell/multishell.el

diff --git a/packages/multishell/multishell.el b/packages/multishell/multishell.el
index 283be374a..5342cfc6a 100644
--- a/packages/multishell/multishell.el
+++ b/packages/multishell/multishell.el
@@ -1,9 +1,9 @@
 ;;; multishell.el --- facilitate multiple local and remote shell buffers
 
-;; Copyright (C) 1999-2016 Free Software Foundation, Inc. and Ken Manheimer
+;; Copyright (C) 1999-2016 Free Software Foundation, Inc.
 
 ;; Author: Ken Manheimer <ken.manheimer@gmail.com>
-;; Version: 1.1.1
+;; Version: 1.1.2
 ;; Created: 1999 -- first public availability
 ;; Keywords: processes
 ;; URL: https://github.com/kenmanheimer/EmacsMultishell
@@ -59,6 +59,15 @@
 ;;
 ;; Change Log:
 ;;
+;; * 2016-01-31 1.1.2 Ken Manheimer:
+;;   - Settle puzzling instability of multishell-all-entries
+;;     - The accumulations was putting items going from more to less active
+;;       categories to be put at the end, not beginning.
+;;     - Also, using history for prompting changes history - implement
+;;       no-record option to avoid this when needed.
+;;   - Implement simple edit-in-place multishell-replace-entry and use in
+;;     multishell-list-edit-entry.
+;;   - Remove now (hopefully) unnecessary multishell-list-revert-buffer-kludge.
 ;; * 2016-01-30 1.1.1 Ken Manheimer:
 ;;   - shake out initial multishell-list glitches:
 ;;     - (Offer to) delete shell buffer, if present, when deleting entry.
@@ -143,7 +152,7 @@
 (require 'savehist)
 (require 'multishell-list)
 
-(defvar multishell-version "1.1.1")
+(defvar multishell-version "1.1.2")
 (defun multishell-version (&optional here)
   "Return string describing the loaded multishell version."
   (interactive "P")
@@ -165,14 +174,13 @@ with allout-mode."
 
 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)
 
 (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)
+  (set-default symbol setting)
   (when (or setting multishell--responsible-for-command-key)
     (multishell-implement-command-key-choice (not setting))))
 (defun multishell-implement-command-key-choice (&optional unbind)
@@ -198,15 +206,14 @@ If optional UNBIND is true, globally unbind the key.
 You can instead manually bind `multishell-pop-to-shell` using emacs
 lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
   :type 'boolean
-  :set 'multishell-activate-command-key-setter
-  :group 'multishell)
+  :set 'multishell-activate-command-key-setter)
 
 ;; Implement the key customization whenever the package is loaded:
 (if (fboundp 'with-eval-after-load)
     (with-eval-after-load "multishell"
 			  (multishell-implement-command-key-choice))
   (eval-after-load "multishell"
-    (multishell-implement-command-key-choice)))
+    '(multishell-implement-command-key-choice)))
 
 (defcustom multishell-pop-to-frame nil
   "*If non-nil, jump to a frame already showing the shell, if another one is.
@@ -217,8 +224,7 @@ current frame.
 
 \(Use `pop-up-windows' to change multishell other-window vs
 current-window behavior.)"
-  :type 'boolean
-  :group 'multishell)
+  :type 'boolean)
 
 (defcustom multishell-history-entry-tracks-current-directory t
   "Maintain shell's current directory in its multishell history entry.
@@ -231,8 +237,7 @@ however.)
 If `savehist-save-minibuffer-history' is enabled, the current
 working directory of shells \(that were started with an explicit
 path) will be conveyed between emacs sessions."
- :type 'boolean
- :group 'multishell)
+ :type 'boolean)
 
 (defvar multishell-history nil
   "Name/path entries, most recent first.")
@@ -272,13 +277,27 @@ Promote added/changed entry to the front of the list."
     (setq multishell-history (push (concat name path)
                                    multishell-history))))
 
+(defun multishell-replace-entry (entry revised)
+  "Replace every instance of ENTRY in `multishell-history' with REVISED.
+
+Revised entry is situated where former one was.
+
+Returns non-nil iff any changes were made."
+  (let ((candidates multishell-history)
+        did-revisions)
+    (while (setq candidates (member entry candidates))
+      (setcar candidates revised)
+      (setq candidates (cdr candidates)
+            did-revisions t))
+    did-revisions))
+
 (defun multishell-history-entries (name)
   "Return `multishell-history' entry that starts with NAME, or nil if none."
   (let (got)
     (dolist (entry multishell-history)
       (when (and (string-equal name (multishell-name-from-entry entry))
                  (not (member entry got)))
-        (setq got (cons entry got))))
+        (push entry got)))
     got))
 
 ;;;###autoload
@@ -295,9 +314,13 @@ historical shells, collectively, using `multishell-list' - see below.
 Customize-group `multishell' to set up a key binding and tweak behaviors.
 
 Manage your collection of current and historical shells by
-recursively invoking \\[multishell-pop-to-shell] at either of the
-`multishell-pop-to-shell' universal argument prompts, or at any time via
-\\[multishell-list]. Hit ? in the listing buffer for editing commands.
+recursively invoking \\[multishell-pop-to-shell] at the
+`multishell-pop-to-shell' universal argument prompts, eg:
+
+  \\[universal-argument] \\[multishell-pop-to-shell] \\[multishell-pop-to-shell]
+
+\(That will be just a few keys if you do the above
+customization.) Hit ? in the listing buffer for editing commands.
 
 ==== Basic operation:
 
@@ -420,8 +443,7 @@ customize the savehist group to activate savehist."
                   (or (multishell-read-unbracketed-entry
                        (format "Shell buffer name [%s]%s "
                                primary-name-unbracketed
-                               (if doublearg " <==" ":"))
-                       primary-name-unbracketed)
+                               (if doublearg " <==" ":")))
                       primary-name-unbracketed))
                  (t fallthrough-name))))
          (use-path (cadr target-name-and-path))
@@ -479,8 +501,7 @@ customize the savehist group to activate savehist."
     ;; We're in the buffer. Activate:
 
     (if (not (comint-check-proc (current-buffer)))
-        (multishell-start-shell-in-buffer (buffer-name (current-buffer))
-                                          use-path))
+        (multishell-start-shell-in-buffer use-path))
 
     ;; If the destination buffer has a stopped process, resume it:
     (let ((process (get-buffer-process (current-buffer))))
@@ -555,11 +576,10 @@ Optional ACTIVE-DUPLICATED will return a copy of
 sans paths, appended to the list, so they have short and long
 completions."
   ;; Reorder so active lead present lead historical entries:
-  (let (active-entries active-names present past splat name path buffer)
+  (let (active-entries active-names present past splat name buffer)
     (dolist (entry multishell-history)
       (setq splat (multishell-split-entry entry)
             name (car splat)
-            path (cadr splat)
             buffer (and name (get-buffer (multishell-bracket name))))
       (if (buffer-live-p buffer)
           (if (comint-check-proc buffer)
@@ -567,20 +587,27 @@ completions."
                     active-names (push name active-names))
             (setq present (push entry present)))
         (setq past (push entry past))))
-    (setq multishell-history (append active-entries present past))
+    ;; Reverse present and past lists
+    (setq multishell-history (append (reverse active-entries)
+                                     (reverse present)
+                                     (reverse past)))
     (if active-duplicated
         (append multishell-history active-names)
       multishell-history)))
 
-(defun multishell-read-unbracketed-entry (prompt default &optional initial)
-  "PROMPT for shell buffer name, sans asterisks. Indicate DEFAULT in prompt.
+(defun multishell-read-unbracketed-entry (prompt &optional initial no-record)
+  "PROMPT for shell buffer name, sans asterisks.
 
 Optional INITIAL is preliminary value to be edited.
 
+Optional NO-RECORD prevents changes to `multishell-history'
+across the activity.
+
 Input and completion can include associated path, if any.
 
 Return what's provided, if anything, else nil."
-  (let* ((candidates (multishell-all-entries 'active-duplicated))
+  (let* ((was-multishell-history multishell-history)
+         (candidates (multishell-all-entries 'active-duplicated))
          (got (completing-read prompt
                                ;; COLLECTION:
                                (reverse candidates)
@@ -592,31 +619,33 @@ Return what's provided, if anything, else nil."
                                initial
                                ;; HIST:
                                'multishell-history)))
+    (when no-record
+      (setq multishell-history was-multishell-history))
     (if (not (string= got ""))
         got
       nil)))
 
-(defun multishell-resolve-target-name-and-path (path-ish)
-  "Given name/tramp-path PATH-ISH, resolve buffer name and initial directory.
+(defun multishell-resolve-target-name-and-path (shell-spec)
+  "Given name/tramp-style address shell spec, resolve buffer name and directory.
 
 The name is the part of the string up to the first '/' slash, if
 any. Missing pieces are filled in from remote path elements, if
-any, and multishell history. Given a path and no name, either the
-host-name, domain-name, final directory name, or local host name
-is used.
+any, and multishell history. Given a tramp-style remote address
+and no name part, either the user@host is used for the buffer
+name, if a user is specified, or just the host.
 
-Return them as a list (name path), with name asterisk-bracketed
-and path nil if none resolved."
-  (let* ((splat (multishell-split-entry (or path-ish "")))
+Return them as a list: (name path), with name asterisk-bracketed
+and path nil if none is resolved."
+  (let* ((splat (multishell-split-entry (or shell-spec "")))
          (path (cadr splat))
          (name (or (car splat) (multishell-name-from-entry path))))
     (when (not path)
       ;; Get path from history, if present.
-      (mapcar #'(lambda (entry)
-                  (when (or (not path) (string= path ""))
-                    (setq path (cadr (multishell-split-entry entry)))))
-              (multishell-history-entries
-               (multishell-unbracket name))))
+      (dolist (entry
+               (multishell-history-entries
+                (multishell-unbracket name)))
+        (when (or (not path) (string= path ""))
+          (setq path (cadr (multishell-split-entry entry))))))
     (list (multishell-bracket name) path)))
 
 (defun multishell-name-from-entry (entry)
@@ -628,25 +657,26 @@ and path nil if none resolved."
            (path (cadr splat)))
       (or 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))
+              (let ((host (file-remote-p path 'host))
+                    (user (file-remote-p path 'user)))
+                (cond ((and host user)
+                       (format "%s@%s" user host))
+                      (host host)
+                      (user user)
+                      ((system-name))))
             (multishell-unbracket multishell-primary-name))))))
 
-(defun multishell-start-shell-in-buffer (buffer-name path)
-  "Start, restart, or continue a shell in BUFFER-NAME on PATH."
-  (let* ((buffer (get-buffer buffer-name))
-         is-active)
+(declare-function tramp-dissect-file-name "tramp")
+(declare-function tramp-cleanup-connection "tramp")
 
-    (set-buffer buffer)
-    (setq is-active (comint-check-proc buffer))
+(defun multishell-start-shell-in-buffer (path)
+  "Start, restart, or continue a shell in BUFFER-NAME on PATH."
+  (let* ((is-active (comint-check-proc (current-buffer))))
 
     (when (and path (not is-active))
 
       (when (and (derived-mode-p 'shell-mode) (file-remote-p path))
-        ;; Returning to disconnected remote shell - do some tidying:
+        ;; Returning to disconnected remote shell - tidy up:
         (tramp-cleanup-connection
          (tramp-dissect-file-name default-directory 'noexpand)
          'keep-debug 'keep-password))
@@ -654,7 +684,23 @@ and path nil if none resolved."
       (when (file-remote-p path) (message "Connecting to %s" path))
       (cd path))
 
-    (shell buffer)))
+    (shell (current-buffer))))
+
+(defun multishell-homedir-shorthand-p (dirpath)
+  "t if dirpath is an unexpanded remote homedir spec."
+  ;; Workaround to recognize tramp-style homedir shorthand, "...:" and "...:~".
+  (let ((localname (file-remote-p dirpath 'localname)))
+    (and localname
+         (or
+          ;; No directory path and no connection to expand homedir:
+          (string= localname "")
+          ;; Original path doesn't equal expanded homedir:
+          (save-match-data
+            (not (string-match (concat (regexp-quote localname) "/?$")
+                               dirpath)))))))
+;; (assert (multishell-homedir-shorthand-p "/ssh:myhost.net:")
+;; (assert (not (multishell-homedir-shorthand-p "/home/klm")))
+;; (assert (not (multishell-homedir-shorthand-p "/ssh:myhost.net:/home/me")))
 
 (defun multishell-track-dirchange (name newpath)
   "Change multishell history entry to track current directory."
@@ -664,35 +710,27 @@ and path nil if none resolved."
              (name (car name-path))
              (path (or (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))
-                            newpath))
-                 (newentry (concat name newpath))
+          (let* ((old-localname (or (file-remote-p path 'localname)
+                                    path))
+                 (newentry
+                  (if (multishell-homedir-shorthand-p path)
+                      (concat entry newpath)
+                    (replace-regexp-in-string (concat (regexp-quote
+                                                       old-localname)
+                                                      "$")
+                                              ;; REPLACEMENT
+                                              newpath
+                                              ;; STRING
+                                              entry
+                                              ;; FIXEDCASE
+                                              t
+                                              ;; LITERAL
+                                              t
+                                              )))
                  (membership (member entry multishell-history)))
             (when membership
               (setcar membership newentry))))))))
+
 (defvar multishell-was-default-directory ()
   "Provide for tracking directory changes.")
 (make-variable-buffer-local 'multishell-was-default-directory)
@@ -703,8 +741,7 @@ and path nil if none resolved."
       (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))
+                          (file-remote-p default-directory 'localname)
                         default-directory)))
           (when (not (string= curdir (or multishell-was-default-directory "")))
             (multishell-track-dirchange (multishell-unbracket (buffer-name))
@@ -713,7 +750,7 @@ and path nil if none resolved."
     ;; To avoid disruption as a pervasive hook function, swallow all errors:
     (error
      (message "multishell-post-command-business error: %s" err))))
-(add-hook 'post-command-hook 'multishell-post-command-business)
+(add-hook 'post-command-hook #'multishell-post-command-business)
 
 (defun multishell-split-entry (entry)
   "Given multishell name/path ENTRY, return the separated name and path pair.