X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/44207eadd7f8eb9192e128a0108efeb5e7f88009..4300eaeea7120e40693a8873d98b40272035c2a8:/packages/multishell/multishell.el diff --git a/packages/multishell/multishell.el b/packages/multishell/multishell.el index 62c9d3e85..65afc4c47 100644 --- a/packages/multishell/multishell.el +++ b/packages/multishell/multishell.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1999-2016 Free Software Foundation, Inc. and Ken Manheimer ;; Author: Ken Manheimer -;; Version: 1.0.5 +;; Version: 1.0.6 ;; Created: 1999 -- first public availability ;; Keywords: processes ;; URL: https://github.com/kenmanheimer/EmacsMultishell @@ -15,85 +15,102 @@ ;; 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 any of your shell buffers, from elsewhere inside emacs. +;; ... or to any of your shell buffers, from anywhere inside emacs. ;; ;; * Use universal arguments to launch and choose among alternate shell buffers, -;; * ... and change which is the current default. +;; ... and change which is the current default. ;; ;; * Easily restart disconnected shells, or shells from prior sessions -;; * ... the latter from Emacs builtin savehist minibuf history persistence +;; ... the latter from Emacs builtin savehist minibuf history persistence ;; ;; * Append a path to a new shell name to launch a shell in that directory, -;; * ... and use a path with Emacs tramp syntax to launch a remote shell - +;; ... and use a path with Emacs tramp syntax to launch a remote shell - ;; for example: ;; +;; * `#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*". ;; ;; * `#ex/ssh:example.net|sudo:root@example.net:/etc` for a root shell ;; starting in /etc on example.net named "*#ex*". ;; -;; * '\#intrn/ssh:corp.com|ssh:intern.corp.com|sudo:root@intern.corp.com:/etc' -;; to go via corp.com to intern.corp.com, sudood to root, in /etc. Whee! (-: -;; The buffer will be named "*#intrn*". +;; * '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, and so on. ;; -;; * File visits will all be under the auspices of the account, and relative to -;; the current directory, on the remote host. +;; * 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. ;; ;; See the `multishell-pop-to-shell` docstring for details. ;; ;; Customize-group `multishell' to select and activate a keybinding and set ;; various behaviors. Customize-group `savehist' to preserve buffer -;; names/paths across emacs sessions. +;; names/paths across emacs restarts. ;; ;; Please use ;; [the multishell repository](https://github.com/kenmanheimer/EmacsMultishell) ;; issue tracker to report problems, suggestions, etc. ;; -;; (NOTE - tramp sometimes has a problem opening a remote shell pointed at -;; a homedir, eg `/ssh:example.net:` or `/ssh:example.net:~`. When it -;; fails, it won't work for the rest of the session. Non-homedir remote -;; access isn't disrupted. Until this is fixed, you may need to start -;; remote shells with an explicit path, then cd ~.) +;; (NOTE - tramp sometimes fails to open specifically a remote shell to +;; sudo to a homedir, eg `/ssh:example.net|sudo:root:` or +;; `/ssh:example.net|sudo:root:~`. Once it fails for a specific path, that +;; path won't work for the rest of the session. Non-homedir remote access +;; isn't disrupted. You can always work around this by switching to an +;; explicit, non-homedir remote path when the problem occurs, and then +;; cd'ing to wherever, including your homedir, in the remote shell.) ;; ;; Change Log: ;; +;; * 2016-01-22 1.0.6 Ken Manheimer: +;; - Add multishell-version function. +;; - Tweak commentary/comments/docstrings. +;; - Null old multishell-buffer-name-history var, if present. ;; * 2016-01-16 1.0.5 Ken Manheimer: -;; - History now includes paths, when designated +;; - History now includes paths, when designated. ;; - Actively track current directory in history entries that have a path. ;; Custom control: multishell-history-entry-tracks-current-directory ;; - Offer to remove shell's history entry when buffer is killed. ;; (Currently the only UI mechanism to remove history entries.) ;; - Fix - prevent duplicate entries for same name but different paths ;; - Fix - recognize and respect tramp path syntax to start in home dir -;; - But tramp bug, remote w/empty path (homedir) often fails, gets wedged. +;; - But tramp bug, remote|sudo to homedir, often fails, gets wedged. ;; - Simplify history var name, migrate existing history if any from old name ;; * 2016-01-04 1.0.4 Ken Manheimer - Released to ELPA ;; * 2016-01-02 Ken Manheimer - working on this in public, but not yet released. ;; ;; TODO: ;; -;; * Isolate tramp sporadic failure to connect to remote+homedir (empty path) +;; * Isolate tramp's sporadic failure to connect to remote|sudo+homedir ;; syntax ;; (eg, /ssh:xyz.com|sudo:root@xyz.com: or /ssh:xyz.com|sudo:root@xyz.com:~) -;; * Find suitable, internally consistent ways to sort tidy completions, eg: +;; * 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 -;; * Find proper method for setting field boundary at beginning of tramp path -;; in the minibuffer, in order to see whether the field boundary magically -;; enables tramp completion of the path. -;; * Assess whether option to delete history entry on kill-buffer is -;; sufficient. +;; * 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) -(defvar multishell-version "1.0.5") +(defvar multishell-version "1.0.6") +(defun multishell-version (&optional here) + "Return string describing the loaded multishell version." + (interactive "P") + (let ((msg (concat "Multishell " multishell-version))) + (if here (insert msg) + (if (called-interactively-p 'interactive) + (message "%s" msg) + msg)))) (defgroup multishell nil "Allout extension that highlights outline structure graphically. @@ -143,43 +160,69 @@ lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)." :set 'multishell-activate-command-key-setter :group 'multishell) -;; Assert the customizations whenever the package is loaded: +;; Implement the key customization whenever the package is loaded: (with-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 is. + "*If non-nil, jump to a frame already showing the shell, if another one is. Otherwise, disregard already-open windows on the shell if they're in another frame, and open a new window on the shell in the current frame. -\(Use `pop-up-windows' to change multishell other-buffer vs -current-buffer behavior.)" +\(Use `pop-up-windows' to change multishell other-window vs +current-window behavior.)" :type 'boolean :group 'multishell) (defcustom multishell-history-entry-tracks-current-directory t - "Modify shell buffer's multishell entry to track the current directory. + "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.) -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." +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) (defvar multishell-history nil "Name/path entries, most recent first.") +;; Migrate the few pre 1.0.5 users to changed history var: (when (and (not multishell-history) (boundp 'multishell-buffer-name-history) multishell-buffer-name-history) - ;; Migrate few users who had old var to new. - (setq multishell-history multishell-buffer-name-history) - ) + (setq multishell-history multishell-buffer-name-history + multishell-buffer-name-history nil)) (defvar multishell-primary-name "*shell*" - "Shell name to use for un-modified multishell-pop-to-shell buffer target.") + "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. + +To preserve changes to this setting across emacs restarts, add it +to `savehist-additional-variables' by customizing the latter.") + +;;; 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))) ;; Multiple entries happen because completion also adds name to history. (defun multishell-register-name-to-path (name path) @@ -194,14 +237,14 @@ Promote added/changed entry to the front of the list." (dolist (entry entries) (when (string= path "") ;; Retain explicit established path. - (setq path (cadr (multishell-split-entry-name-and-tramp entry)))) + (setq path (cadr (multishell-split-entry entry)))) (setq multishell-history (delete entry multishell-history))) (setq multishell-history (push (concat name path) multishell-history)))) (defun multishell-history-entries (name) "Return `multishell-history' entry that starts with NAME, or nil if none." - (let ((match-expr (concat "^" name "\\\(/.*$\\\)?")) + (let ((match-expr (concat "^" name "\\\(/.*$\\\)?$")) got) (dolist (entry multishell-history) (when (and (string-match match-expr entry) @@ -255,13 +298,16 @@ single or doubled universal arguments: Completion is available. - This combination makes it easy to start and switch between - multiple shell buffers. + This combination makes it easy to start and switch across + multiple shell restarts. - A double universal argument will prompt for the name *and* set the default to that name, so the target shell becomes the primary. + See `multishell-primary-name' for info about preserving the + setting across emacs restarts. + ===== Select starting directory and remote host: The shell buffer name you give to the prompt for a universal arg @@ -272,19 +318,34 @@ the buffer name. Otherwise, the host, domain, or path is used. For example: -* 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*\". -* '\#in/ssh:corp.com|ssh:internal.corp.com|sudo:root@internal.corp.com:/etc' - for a root shell name \"*in*\" in /etc on internal.corp.com, via host - corp.com. +* '#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*\". -\(NOTE that there is a problem with specifying a remote homedir using -tramp syntax, eg '/ssh:example.net:'. That sometimes fails on an obscure -bug - particularly for remote with empty path (homedir) syntax. Until fixed, -you may need to start remote shells with an explicit path, then cd ~.) +* '#ex/ssh:example.net|sudo:root@example.net:/etc' for a root shell + starting in /etc 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. + +\(NOTE - tramp sometimes fails to open specifically a remote shell +to sudo to a homedir, eg `/ssh:example.net|sudo:root:` or +`/ssh:example.net|sudo:root:~`. Once it fails for a specific +path, that path won't work for the rest of the +session. Non-homedir remote access isn't disrupted. You can +always work around this by switching to an explicit, non-homedir +remote path when the problem occurs, and then cd'ing to wherever, +including your homedir, in the remote shell. Non-homedir initial +paths aren't disrupted.) You can change the startup path for a shell buffer by editing it at the completion prompt. The new path will be preserved in @@ -293,7 +354,7 @@ history but will not take effect for an already-running shell. To remove a shell buffer's history entry, kill the buffer and affirm removal of the entry when prompted. -===== Activate savehist to retain shell buffer names and paths across Emacs sessions: +===== Activate savehist to retain shell buffer names and paths across Emacs restarts: To have emacs maintain your history of shell buffer names and paths, customize the savehist group to activate savehist." @@ -303,8 +364,7 @@ customize the savehist group to activate savehist." (let* ((from-buffer (current-buffer)) (from-buffer-is-shell (derived-mode-p 'shell-mode)) (doublearg (equal arg '(16))) - (target-name-and-path - (multishell-derive-target-name-and-path + (target-name-and-path (multishell-resolve-target-name-and-path (if arg (multishell-read-bare-shell-buffer-name (format "Shell buffer name [%s]%s " @@ -312,18 +372,14 @@ customize the savehist group to activate savehist." multishell-primary-name 1 (- (length multishell-primary-name) 1)) (if doublearg " <==" ":")) - multishell-primary-name) - multishell-primary-name))) + (multishell-unbracket-asterisks multishell-primary-name)) + (multishell-unbracket-asterisks multishell-primary-name)))) (use-default-dir (cadr target-name-and-path)) (target-shell-buffer-name (car target-name-and-path)) (curr-buff-proc (get-buffer-process from-buffer)) (target-buffer (if from-buffer-is-shell from-buffer - (let ((got (get-buffer target-shell-buffer-name))) - (if (buffer-live-p got) - got - (kill-buffer got) - (get-buffer target-shell-buffer-name))))) + (get-buffer target-shell-buffer-name))) inwin already-there) @@ -385,29 +441,30 @@ customize the savehist group to activate savehist." (defun multishell-kill-buffer-query-function () "Offer to remove multishell-history entry for buffer." - ;; Removal choice is crucial, so users can, eg, kill and a runaway shell - ;; and keep the history entry to easily restart it. + ;; Removal choice is crucial, so users can, eg, kill a shell with huge + ;; output backlog, while keeping the history entry to easily restart it. ;; ;; We use kill-buffer-query-functions instead of kill-buffer-hook because: ;; - ;; 1. It enables the user to remove the history without killing the buffer, - ;; by cancelling the kill-buffer process after affirming history removal. + ;; 1. It enables the user to remove the history without actually killing a + ;; running buffer, by not confirming the subsequent running-proc query. ;; 2. kill-buffer-hooks often fails to run when killing shell buffers! - ;; I've failed to resolve that, and like the first reason well enough. + ;; It's probably due to failures in other hooks - beyond our control - + ;; and anyway, I like the first reason well enough. ;; (Use condition-case to avoid inadvertant disruption of kill-buffer ;; activity. kill-buffer happens behind the scenes a whole lot.) - (condition-case anyerr - (let ((entries (and (derived-mode-p 'shell-mode) + (condition-case err + (dolist (entry (and (derived-mode-p 'shell-mode) (multishell-history-entries - (multishell-unbracket-asterisks (buffer-name)))))) - (dolist (entry 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))))) - (error nil)) + (delete entry multishell-history)))) + (error + (message "multishell-kill-buffer-query-function error: %s" err))) t) (add-hook 'kill-buffer-query-functions 'multishell-kill-buffer-query-function) @@ -428,8 +485,8 @@ customize the savehist group to activate savehist." (defun multishell-read-bare-shell-buffer-name (prompt default) "PROMPT for shell buffer name, sans asterisks. -Return the supplied name bracketed with the asterisks, or specified DEFAULT -on empty input." +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: @@ -457,39 +514,42 @@ on empty input." ;; HIST: 'multishell-history))) (if (not (string= got "")) - (multishell-bracket-asterisks got) + got default))) -(defun multishell-derive-target-name-and-path (path-ish) - "Give tramp-style PATH-ISH, determine target name and default directory. - -The name is the part of the string before the initial '/' slash, -if any. Otherwise, it's either the host-name, domain-name, final -directory name, or local host name. The path is everything -besides the string before the initial '/' slash. - -Return them as a list (name dir), with dir nil if none given." - (let (name (path "") dir) - (cond ((string= path-ish "") (setq dir multishell-primary-name)) - ((string-match "^\\*\\([^/]*\\)\\(/.*\\)\\*" path-ish) - ;; We have a path, use it - (let ((overt-name (match-string 1 path-ish))) - (setq path (match-string 2 path-ish)) - (if (string= overt-name "") (setq overt-name nil)) - (if (string= path "") (setq path nil)) - (setq name - (multishell-bracket-asterisks - (or overt-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-unbracket-asterisks - multishell-primary-name))))))) - (t (setq name (multishell-bracket-asterisks path-ish)))) - (list name path))) +(defun multishell-resolve-target-name-and-path (path-ish) + "Given name/tramp-path PATH-ISH, resolve buffer name and initial 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." @@ -539,15 +599,16 @@ Return them as a list (name dir), with dir nil if none given." (cd default-directory) (error ;; Aargh. Need to isolate this tramp bug. - (when (and (stringp (cadr err)) - (string-equal (cadr err) - "Selecting deleted buffer")) - (signal (car err) - (list - (format "%s, %s (\"%s\")" - "Tramp shell can fail on empty (homedir) path" - "please try again with an explicit path" - (cadr err))))))) + (if (and (stringp (cadr err)) + (string-equal (cadr err) + "Selecting deleted buffer")) + (signal (car err) + (list + (format "%s, %s (\"%s\")" + "Tramp shell can fail on 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 @@ -563,7 +624,7 @@ Return them as a list (name dir), with dir nil if none given." "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)) + (let* ((name-path (multishell-split-entry entry)) (name (car name-path)) (path (cadr name-path))) (when path @@ -616,10 +677,11 @@ Return them as a list (name dir), with dir nil if none given." curdir)) (setq multishell-was-default-directory curdir))) ;; To avoid disruption as a pervasive hook function, swallow all errors: - (error nil))) + (error + (message "multishell-post-command-business error: %s" err)))) (add-hook 'post-command-hook 'multishell-post-command-business) -(defun multishell-split-entry-name-and-tramp (entry) +(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."