X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/822d6284b0dc757a7537df2d1ed46e8a9187a9e2..b19288e6ef625e22bf4dda36578eebe157662ad5:/packages/multishell/multishell.el diff --git a/packages/multishell/multishell.el b/packages/multishell/multishell.el index 8c16f16d2..8056669c0 100644 --- 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 --- Easily use multiple shell buffers, local and remote. -;; Copyright (C) 1999-2016 Free Software Foundation, Inc. and Ken Manheimer +;; Copyright (C) 1999-2016 Free Software Foundation, Inc. ;; Author: Ken Manheimer -;; Version: 1.0.7 +;; Version: 1.1.4 ;; Created: 1999 -- first public availability ;; Keywords: processes ;; URL: https://github.com/kenmanheimer/EmacsMultishell @@ -27,14 +27,14 @@ ;; ... and use a path with Emacs tramp syntax to launch a remote shell - ;; for example: ;; -;; * `#root/sudo:root@localhost:/etc` for a buffer named "#root" with a +;; * `#root/sudo:root@localhost:/etc` for a buffer named "*#root*" with a ;; root shell starting in /etc. ;; -;; * `/ssh:example.net:/` for a shell buffer in / on example.net. +;; * `/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 -;; starting in /etc on example.net named "*#ex*". +;; * `#ex/ssh:example.net|sudo:root@example.net:/var/log` for a root shell +;; starting in /var/log on example.net named "*#ex*". ;; ;; * 'interior/ssh:gateway.corp.com|ssh:interior.corp.com:' to go via ;; gateway.corp.com to your homedir on interior.corp.com. The buffer @@ -43,7 +43,9 @@ ;; * Thanks to tramp, file visits from the shell will seamlessly be in ;; the auspices of the target account, and relative to the current ;; directory, on the host where the shell is running. -;; +;; +;; * Manage your list of shells, current and past, as a collection. +;; ;; See the `multishell-pop-to-shell` docstring for details. ;; ;; Customize-group `multishell' to select and activate a keybinding and set @@ -52,10 +54,68 @@ ;; ;; Please use ;; [the multishell repository](https://github.com/kenmanheimer/EmacsMultishell) -;; issue tracker to report problems, suggestions, etc. +;; issue tracker to report problems, suggestions, etc, and see that +;; repository for a bit more documentation. ;; ;; Change Log: ;; +;; * 2016-02-11 1.1.4 Ken Manheimer: +;; - hookup multishell-list as completion help buffer. +;; Mouse and keyboard selections from help listing properly exits +;; minibuffer. +;; * 2016-02-09 1.1.3 Ken Manheimer: +;; multishell-list: +;; - add some handy operations, like cloning new entry from existing +;; - add optional behaviors to existing operations for returning to +;; stopped shells without restarting them. +;; - solidify maintaining focus on current entry +;; - fix miscellaneous. +;; * 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 unnecessary multishell-list-revert-buffer-kludge. +;; - Rectify byte compiler offenses, and other fixes - thanks to Stefan +;; Monnier for pointing out many of the corrections. +;; - Avoid directly calling tramp functions unnecessarily. +;; * 2016-01-30 1.1.1 Ken Manheimer: +;; - shake out initial multishell-list glitches: +;; - (Offer to) delete shell buffer, if present, when deleting entry. +;; - Set recency (numeric rank) as initial sort field +;; - Recompute list on most operations that affect the order, and try to +;; preserve stability. (Kludgy solution, needs work.) +;; - Set version to 1.1.1 - multishell-list addition should have been 1.1.0. +;; * 2016-01-30 1.0.9 Ken Manheimer: +;; - Add multishell-list for managing the collection of current and +;; history-registered shells: edit, delete, and switch/pop to entries. +;; Easy access by invoking `multishell-pop-to-shell' from in the +;; `multishell-pop-to-shell' universal arg prompts. +;; - Duplicate existing shell buffer names in completions, for distinction. +;; - Add paths to buffers started without one, when multishell history dir +;; tracking is enabled. +;; - Major code cleanup: +;; - Simplify multishell-start-shell-in-buffer, in particular using +;; shell function, rather than unnecessarily going underneath it. +;; - Establish multishell-name-from-entry as canonical name resolver. +;; - Fallback to eval-after-load in emacs versions that lack +;; with-eval-after-load (eg, emacs 23). +;; - save-match-data, where match-string is used +;; - resituate some helpers +;; * 2016-01-24 1.0.8 Ken Manheimer: +;; - Work around the shell/tramp mishandling of remote+sudo+homedir problem! +;; The work around is clean and simple, basically using high-level `cd' +;; API and not messing with the low-level default-directory setting. +;; (Turns out the problem was not in my local config. Good riddance to the +;; awkward failure handler!) +;; - Clean up code resolving the destination shell, starting to document the +;; decision tree in the process. See getting-to-a-shell.md in the +;; multishell repository, https://github.com/kenmanheimer/EmacsMultishell +;; - There may be some shake-out on resolving the destination shell, but +;; this release gets the fundamental functionality soundly in place. ;; * 2016-01-23 1.0.7 Ken Manheimer: ;; - Remove notes about tramp remote+sudo+homedir problem. Apparently it's ;; due to something in my local site configuration (happens with -q but @@ -76,25 +136,27 @@ ;; * 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 and Known Issues: ;; -;; * Find suitable, internally consistent ways to 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 +;; * Add custom shell launch prep actions +;; - for, eg, port knocking, interface activations +;; - shell commands to execute when shell name or path matches a regexp +;; - list of (regexp, which - name, path, or both, command) +;; * Investigate whether we can recognize and provide for failed hops. +;; - Tramp doesn't provide useful reactions for any hop but the first +;; - Might be stuff we can do to detect and convey failures? +;; - Might be no recourse but to seek tramp changes. ;; * Try minibuffer field boundary at beginning of tramp path, to see whether ;; the field boundary magically enables tramp path completion. -;; * Assess whether deletion of history entry via kill-buffer is sufficient. ;;; Code: (require 'comint) (require 'shell) (require 'savehist) +(require 'multishell-list) -(defvar multishell-version "1.0.7") +(defvar multishell-version "1.1.3") (defun multishell-version (&optional here) "Return string describing the loaded multishell version." (interactive "P") @@ -116,14 +178,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) @@ -149,12 +210,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: -(with-eval-after-load "multishell" - (multishell-implement-command-key-choice)) +(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))) (defcustom multishell-pop-to-frame nil "*If non-nil, jump to a frame already showing the shell, if another one is. @@ -165,22 +228,18 @@ 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. When set, the history entry for shells started with explicit -paths will track the shell's current working directory. (Explicit -paths will not be added to local shells started without one, -however.) +paths will track the shell's current working directory. 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) +working directory of shells will be conveyed between emacs +sessions." + :type 'boolean) (defvar multishell-history nil "Name/path entries, most recent first.") @@ -194,27 +253,17 @@ path) will be conveyed between emacs sessions." (defvar multishell-primary-name "*shell*" "Default shell name for un-modified multishell-pop-to-shell buffer target. -This is adjusted by `multishell-pop-to-shell' when it is -invoked (with doubled universal argument) to set the default. +This is set by `multishell-pop-to-shell' as the current default, +when invoked with doubled universal argument. -To preserve changes to this setting across emacs restarts, add it -to `savehist-additional-variables' by customizing the latter.") +If you want the designated primary that you have at the end of +one emacs session to be resumed at the next, customize +`savehist-additional-variables' to include the +`multishell-primary-name'.") -;;; Can't just add multishell-primary-name to savehist-additional-variables -;;; - it'll be lost any time the user runs emacs without loading -;;; multishell. So instead, inform the user that they can customize -;;; savehist-additional-variables. -;;; -;;; I suspect that including savehist-additional-variables *on* -;;; savehist-additional-variables could avoid this problem, as long as it -;;; doesn't conflict with user customizations. However, even if that works, -;;; doing so from multishell would change a behavior (for the better, but) -;;; beyond multishell's scope, making the change hard to track down. - -;; (when (not (member 'multishell-primary-name -;; savehist-additional-variables)) -;; (setq savehist-additional-variables -;; (cons 'multishell-primary-name savehist-additional-variables))) +(defvar multishell-completing-read nil + "Internal use, conveying whether or not we're in the midst of a multishell +completing-read.") ;; Multiple entries happen because completion also adds name to history. (defun multishell-register-name-to-path (name path) @@ -234,26 +283,51 @@ 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 ((match-expr (concat "^" name "\\\(/.*$\\\)?$")) - got) + (let (got) (dolist (entry multishell-history) - (when (and (string-match match-expr entry) + (when (and (string-equal name (multishell-name-from-entry entry)) (not (member entry got))) - (setq got (cons entry got)))) + (push entry got))) got)) -(defun multishell-pop-to-shell (&optional arg) +;;;###autoload +(defun multishell-pop-to-shell (&optional arg name here) "Easily navigate to and within multiple shell buffers, local and remote. -Use universal arguments to launch and choose between alternate -shell buffers and to select which is default. Append a path to -a new shell name to launch a shell in that directory, and use -Emacs tramp syntax to launch a remote shell. +Use a single `universal-argument' (\\[universal-argument]) to launch and choose between +nalternate shell buffers, and a doubled universal argument to also set your +choice as the ongoing default. Append a path to a new shell name to launch +a shell in that directory, and use Emacs tramp syntax to launch a remote +shell. There is a shortcut to manage your list of current and +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 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: - If the current buffer is shell-mode (or shell-mode derived) @@ -281,8 +355,9 @@ was disconnected or otherwise stopped, it's resumed. ===== Universal arg to start and select between named shell buffers: -You can name alternate shell buffers to create or return to using -single or doubled universal arguments: +You can name alternate shell buffers to create or return to, by +prefixing your \\[multishell-pop-to-shell] invocation with single or double +`universal-argument', \\[universal-argument]: - With a single universal argument, prompt for the buffer name to use (without the asterisks that shell mode will put around @@ -300,6 +375,12 @@ single or doubled universal arguments: See `multishell-primary-name' for info about preserving the setting across emacs restarts. + - 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. + ===== Select starting directory and remote host: The shell buffer name you give to the prompt for a universal arg @@ -310,28 +391,28 @@ the buffer name. Otherwise, the host, domain, or path is used. For example: -* '#root/sudo:root@localhost:/etc' for a buffer named \"#root\" with a +* '#root/sudo:root@localhost:/etc' for a buffer named \"*#root*\" with a root shell starting in /etc. -* '/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 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 - starting in /etc on example.net named \"*#ex*\". +* '#ex/ssh:example.net|sudo:root@example.net:/var/log' for a root shell + starting in /var/log on example.net named \"*#ex*\". * 'interior/ssh:gateway.corp.com|ssh:interior.corp.com:' to go via gateway.corp.com to your homedir on interior.corp.com. The buffer will be named \"*interior*\". You could append a sudo hop to the path, combining the previous example, and so on. -Thanks to tramp, file visits from the shell, and many common -emacs activities, like dired, will seamlessly be in the auspices -of the target account, and relative to the current directory, on -the host where the shell is running. +File visits from the shell, and many common emacs activities like +dired, will be on the host where the shell is running, in the +auspices of the target account, and relative to the current +directory. 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. +at the completion prompt. The new path 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. @@ -343,32 +424,53 @@ customize the savehist group to activate savehist." (interactive "P") + (let ((token '(token))) + (if (window-minibuffer-p) + (throw 'multishell-minibuffer-exit token) + (let ((got (catch 'multishell-minibuffer-exit + (multishell-pop-to-shell-worker arg name here)))) + ;; Handle catch or plain fall-through - see cond comments for protocol. + (cond + ;; Caught token from recursive invocation in minibuffer: + ((equal token got) (multishell-list)) + ;; Caught specifaction of multishell args, eg from multishell-list: + ((listp got) (multishell-pop-to-shell-worker (nth 2 got) + (nth 0 got) + (nth 1 got))) + ;; Regular fallthrough - just relay the result: + (t got)))))) + +(defun multishell-pop-to-shell-worker (&optional arg name here) + "Do real work of `multishell-pop-to-shell', which see." (let* ((from-buffer (current-buffer)) (from-buffer-is-shell (derived-mode-p 'shell-mode)) + (primary-name-unbracketed (multishell-unbracket + multishell-primary-name)) + (fallthrough-name (if from-buffer-is-shell + (buffer-name from-buffer) + primary-name-unbracketed)) (doublearg (equal arg '(16))) - (target-name-and-path (multishell-resolve-target-name-and-path - (if arg - (multishell-read-bare-shell-buffer-name - (format "Shell buffer name [%s]%s " - (substring-no-properties - multishell-primary-name - 1 (- (length multishell-primary-name) 1)) - (if doublearg " <==" ":")) - (multishell-unbracket-asterisks multishell-primary-name)) - (multishell-unbracket-asterisks multishell-primary-name)))) - (use-default-dir (cadr target-name-and-path)) + (target-name-and-path + (multishell-resolve-target-name-and-path + (cond (name name) + (arg + (or (multishell-read-unbracketed-entry + (format "Shell buffer name [%s]%s " + primary-name-unbracketed + (if doublearg " <==" ":"))) + primary-name-unbracketed)) + (t fallthrough-name)))) + (use-path (cadr target-name-and-path)) (target-shell-buffer-name (car target-name-and-path)) + (target-buffer (get-buffer target-shell-buffer-name)) (curr-buff-proc (get-buffer-process from-buffer)) - (target-buffer (if from-buffer-is-shell - from-buffer - (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 + (multishell-register-name-to-path (multishell-unbracket target-shell-buffer-name) - use-default-dir) + use-path) (when doublearg (setq multishell-primary-name target-shell-buffer-name)) @@ -392,9 +494,13 @@ customize the savehist group to activate savehist." (not (setq inwin (multishell-get-visible-window-for-buffer target-buffer)))) ;; No preexisting shell buffer, or not in a visible window: - (pop-to-buffer target-shell-buffer-name pop-up-windows)) + (when (not (get-buffer target-shell-buffer-name)) + (message "Creating new shell buffer '%s'" target-shell-buffer-name)) + (if here + (switch-to-buffer target-shell-buffer-name) + (pop-to-buffer target-shell-buffer-name pop-up-windows))) - ;; Buffer exists and already has a window - jump to it: + ;; Buffer exists and already has a window - jump to it: (t (if (and multishell-pop-to-frame inwin (not (equal (window-frame (selected-window)) @@ -402,13 +508,14 @@ customize the savehist group to activate savehist." (select-frame-set-input-focus (window-frame inwin))) (if (not (string= (buffer-name (current-buffer)) target-shell-buffer-name)) - (pop-to-buffer target-shell-buffer-name t)))) + (if here + (switch-to-buffer target-shell-buffer-name) + (pop-to-buffer target-shell-buffer-name t))))) ;; We're in the buffer. Activate: (if (not (comint-check-proc (current-buffer))) - (multishell-start-shell-in-buffer (buffer-name (current-buffer)) - use-default-dir)) + (multishell-start-shell-in-buffer use-path)) ;; If the destination buffer has a stopped process, resume it: (let ((process (get-buffer-process (current-buffer)))) @@ -421,6 +528,21 @@ customize the savehist group to activate savehist." (and (get-buffer-process from-buffer) (goto-char (process-mark (get-buffer-process from-buffer))))))) +(defun multishell-delete-history-name (name &optional ask) + "Remove all multishell history entries for NAME. + +if optional ask is non-nil (default nil), ask before each deletion. + +Return the last entry deleted." + (let (got) + (dolist (entry (multishell-history-entries name) got) + (when (and entry + (or (not ask) + (y-or-n-p (format "Remove multishell history entry `%s'? " + entry)))) + (setq got entry + multishell-history (delete entry multishell-history)))))) + (defun multishell-kill-buffer-query-function () "Offer to remove multishell-history entry for buffer." ;; Removal choice is crucial, so users can, eg, kill a shell with huge @@ -437,14 +559,10 @@ customize the savehist group to activate savehist." ;; (Use condition-case to avoid inadvertant disruption of kill-buffer ;; activity. kill-buffer happens behind the scenes a whole lot.) (condition-case err - (dolist (entry (and (derived-mode-p 'shell-mode) - (multishell-history-entries - (multishell-unbracket-asterisks (buffer-name))))) - (when (and entry - (y-or-n-p (format "Remove multishell history entry `%s'? " - entry))) - (setq multishell-history - (delete entry multishell-history)))) + (and (derived-mode-p 'shell-mode) + (multishell-delete-history-name + (multishell-unbracket (buffer-name)) + t)) (error (message "multishell-kill-buffer-query-function error: %s" err))) t) @@ -464,27 +582,54 @@ customize the savehist group to activate savehist." nil 'visible) nil)) -(defun multishell-read-bare-shell-buffer-name (prompt default) +(defun multishell-all-entries (&optional active-duplicated) + "Return multishell history, with active buffers listed first. + +Optional ACTIVE-DUPLICATED will return a copy of +`multishell-history' with unbracketed names of active buffers, +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 buffer) + (dolist (entry multishell-history) + (setq splat (multishell-split-entry entry) + name (car splat) + buffer (and name (get-buffer (multishell-bracket name)))) + (if (buffer-live-p buffer) + (if (comint-check-proc buffer) + (setq active-entries (push entry active-entries) + active-names (push name active-names)) + (setq present (push entry present))) + (setq past (push entry 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 &optional initial no-record) "PROMPT for shell buffer name, sans asterisks. -Return the supplied name not bracketed with the asterisks, or specified -DEFAULT on empty input." - (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 +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* ((was-multishell-history multishell-history) + (candidates (multishell-all-entries 'active-duplicated)) + (multishell-completing-read t) + (got + ;; Use `cl-letf' to dynamically bind multishell-list to + ;; display-completion-list, so multishell-list is used when doing + ;; minibuffer-completion-help. + (cl-letf (((symbol-function 'display-completion-list) + #'multishell-list)) + (completing-read prompt ;; COLLECTION: (reverse candidates) ;; PREDICATE: @@ -492,115 +637,96 @@ DEFAULT on empty input." ;; REQUIRE-MATCH: 'confirm ;; INITIAL-INPUT - nil + initial ;; HIST: - 'multishell-history))) + 'multishell-history)))) + (when no-record + (setq multishell-history was-multishell-history)) (if (not (string= got "")) got - default))) + 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. - -Return them as a list (name path), with name asterisk-bracketed -and path nil if none resolved." - (let* ((splat (multishell-split-entry path-ish)) - (name (car splat)) - (path (cadr splat))) - (if path - (if (not name) - (setq 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)) - multishell-primary-name))) - ;; No path - get one from history, if present. - (when (not name) - (setq name multishell-primary-name)) - (mapcar #'(lambda (entry) - (when (or (not path) (string= path "")) - (setq path (cadr (multishell-split-entry entry))))) - (multishell-history-entries - (multishell-unbracket-asterisks name)))) - (list (multishell-bracket-asterisks name) path))) - -(defun multishell-bracket-asterisks (name) - "Return a copy of name, ensuring it has an asterisk at the beginning and end." - (if (not (string= (substring name 0 1) "*")) - (setq name (concat "*" name))) - (if (not (string= (substring name -1) "*")) - (setq name (concat name "*"))) - name) -(defun multishell-unbracket-asterisks (name) - "Return a copy of name, removing asterisks, if any, at beginning and end." - (if (string= (substring name 0 1) "*") - (setq name (substring name 1))) - (if (string= (substring name -1) "*") - (setq name (substring name 0 -1))) - name) - -(defun multishell-start-shell-in-buffer (buffer-name path) - "Ensure a shell is started, with name NAME and PATH." - ;; We work around shell-mode's bracketing of the buffer name, and do - ;; some tramp-mode hygiene for remote connections. - - (let* ((buffer buffer-name) - (prog (or explicit-shell-file-name - (getenv "ESHELL") - (getenv "SHELL") - "/bin/sh")) - (name (file-name-nondirectory prog)) - (startfile (concat "~/.emacs_" name)) - (xargs-name (intern-soft (concat "explicit-" name "-args"))) - is-remote) - (set-buffer buffer-name) - (if (and path (not (string= path ""))) - (setq default-directory path)) - (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 - ;; shell, tidy it: - (tramp-cleanup-connection - (tramp-dissect-file-name default-directory 'noexpand) - 'keep-debug 'keep-password)) - ;; (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. - (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 remote|sudo to homedir" - "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 - (if (file-exists-p startfile) - startfile) - (if (and xargs-name - (boundp xargs-name)) - (symbol-value xargs-name) - '("-i"))))) - (shell-mode))) +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 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. + (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) + "Derive a name for a shell buffer according to ENTRY." + (if (not entry) + (multishell-unbracket multishell-primary-name) + (let* ((splat (multishell-split-entry entry)) + (name (car splat)) + (path (cadr splat))) + (or name + (if (file-remote-p path) + (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)))))) + +(declare-function tramp-dissect-file-name "tramp") +(declare-function tramp-cleanup-connection "tramp") + +(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. + ;; Without this cleanup, occasionally restarting a disconnected + ;; remote session, particularly one that includes sudo, results in + ;; an untraceable "Args out of range" error. That never happens if + ;; we precedeed connection attempts with this cleanup - + ;; prophylactic. + (tramp-cleanup-connection + (tramp-dissect-file-name default-directory 'noexpand) + 'keep-debug 'keep-password)) + + (when (file-remote-p path) (message "Connecting to %s" path)) + (cd path)) + + (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." @@ -608,37 +734,29 @@ and path nil if none resolved." (dolist (entry entries) (let* ((name-path (multishell-split-entry entry)) (name (car name-path)) - (path (cadr 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)) - newlocalname)) - (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) @@ -649,30 +767,42 @@ 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 (and multishell-was-default-directory - (not (string= curdir multishell-was-default-directory))) - (multishell-track-dirchange (multishell-unbracket-asterisks - (buffer-name)) + (when (not (string= curdir (or multishell-was-default-directory ""))) + (multishell-track-dirchange (multishell-unbracket (buffer-name)) curdir)) (setq multishell-was-default-directory curdir))) ;; 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. 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))) + (save-match-data + (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)))) +(defun multishell-bracket (name) + "Return a copy of name, ensuring it has an asterisk at the beginning and end." + (if (not (string= (substring name 0 1) "*")) + (setq name (concat "*" name))) + (if (not (string= (substring name -1) "*")) + (setq name (concat name "*"))) + name) +(defun multishell-unbracket (name) + "Return a copy of name, removing asterisks, if any, at beginning and end." + (if (string= (substring name 0 1) "*") + (setq name (substring name 1))) + (if (string= (substring name -1) "*") + (setq name (substring name 0 -1))) + name) (provide 'multishell)