Merge multishell 1.1.2.

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

diff --git a/packages/multishell/multishell.el b/packages/multishell/multishell.el
index 283be374a6b20522af1817781073df2e3f1c24d6..5342cfc6a931d9541a9b072327aa88242d81a86b 100644 (file)
--- a/packages/multishell/multishell.el
+++ b/packages/multishell/multishell.el
@@ -1,9 +1,9 @@
 ;;; multishell.el --- facilitate multiple local and remote shell buffers
 
 ;;; 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>
 
 ;; 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
 ;; Created: 1999 -- first public availability
 ;; Keywords: processes
 ;; URL: https://github.com/kenmanheimer/EmacsMultishell


@@ -59,6 +59,15 @@
 ;;
 ;; Change Log:
 ;;
 ;;
 ;; 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.
 ;; * 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)
 
 (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")
 (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)."
 
 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."
 
 (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)
   (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
 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"
 
 ;; 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.
 
 (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.)"
 
 \(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.
 
 (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."
 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.")
 
 (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))))
 
     (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)))
 (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
     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
 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:
 
 
 ==== 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
                   (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))
                       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)))
     ;; 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))))
 
     ;; 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:
 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)
     (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)
             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))))
                     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)))
 
     (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 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."
 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)
          (got (completing-read prompt
                                ;; COLLECTION:
                                (reverse candidates)


@@ -592,31 +619,33 @@ Return what's provided, if anything, else nil."
                                initial
                                ;; HIST:
                                'multishell-history)))
                                initial
                                ;; HIST:
                                'multishell-history)))

+    (when no-record
+      (setq multishell-history was-multishell-history))

     (if (not (string= got ""))
         got
       nil)))
 
     (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
 
 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.
          (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)
     (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)
            (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))))))
 
             (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))
 
     (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))
         (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))
 
       (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."
 
 (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
              (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))))))))
                  (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)
 (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)
       (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))
                         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))))
     ;; 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.
 
 (defun multishell-split-entry (entry)
   "Given multishell name/path ENTRY, return the separated name and path pair.