X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/7e7d7bbea8bbe625bb38e29502c47b42245fcbd7..91905b6de42dd519770186436c6f9a6c92921677:/packages/multishell/multishell.el diff --git a/packages/multishell/multishell.el b/packages/multishell/multishell.el index e23813d25..c19ba29a6 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.8 ;; Created: 1999 -- first public availability ;; Keywords: processes ;; URL: https://github.com/kenmanheimer/EmacsMultishell @@ -15,75 +15,106 @@ ;; 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 one of your shell buffers if you're not currently in one. +;; ... or to any of your shell buffers, from anywhere inside emacs. +;; ;; * Use universal arguments to launch and choose among alternate shell buffers, -;; * ... and select which is 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 +;; ;; * 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: ;; -;; 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*". +;; * `/ssh:example.net:/` for a shell buffer in / on example.net. +;; The buffer will be named "*example.net*". ;; ;; * `#ex/ssh:example.net|sudo:root@example.net:/etc` for a root shell ;; starting in /etc on example.net named "*#ex*". ;; -;; (NOTE - there's a sporadic problem when opening a shell pointed at a -;; remote homedir, eg `/ssh:example.net:` or `/ssh:example.net:~`. It -;; sometimes fails, particularly for remotes with empty fs path syntax. Until -;; fixed, you may need to start remote shells with an explicit path, then -;; cd ~. If you set up `multishell`s persistent dir-tracking history, -;; you'll be able to use completion to start that shell in the right place, -;; in your subsequent sessions.) +;; * '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. ;; +;; * 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. ;; -;; See the `multishell-pop-to-shell' docstring for details. -;; -;; Please use [the repository](https://github.com/kenmanheimer/EmacsMultishell) -;; issue tracker to report problems, suggestions, etc. +;; Please use +;; [the multishell repository](https://github.com/kenmanheimer/EmacsMultishell) +;; issue tracker to report problems, suggestions, etc, and see that +;; repository for a bit more documentation. ;; ;; Change Log: ;; +;; * 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 +;; not -Q). +;; * 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. ;; - 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) -;; 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.8") +(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. @@ -133,66 +164,91 @@ 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 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." +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.) + +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.") - -;; There is usually only one entry per name, but disruptions happen. + "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) "Add or replace entry associating NAME with PATH in `multishell-history'. -If NAME already had a PATH and new PATH is empty, retain old one. +If NAME already had a PATH and new PATH is empty, retain the prior one. Promote added/changed entry to the front of the list." ;; Add or promote to the front, tracking path changes in the process. (let* ((entries (multishell-history-entries name)) - (becomes (concat name path)) - oldpath) + (path (or path ""))) (dolist (entry entries) - (when (or (not path) (string= path "")) + (when (string= path "") ;; Retain explicit established path. - (setq path (cadr (multishell-split-entry-name-and-tramp entry)) - becomes (concat name path))) + (setq path (cadr (multishell-split-entry entry)))) (setq multishell-history (delete entry multishell-history))) - (setq multishell-history (push becomes 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) @@ -246,13 +302,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 @@ -263,16 +322,24 @@ 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*\". +* '#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*\". -\(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 ~.) +* '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. You can change the startup path for a shell buffer by editing it at the completion prompt. The new path will be preserved in @@ -281,40 +348,43 @@ 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 persisting your shell buffer names and paths: +===== Activate savehist to retain shell buffer names and paths across Emacs restarts: -To have emacs maintain your history of shell buffer names and paths, +To have emacs maintain your history of shell buffer names and paths, customize the savehist group to activate savehist." (interactive "P") (let* ((from-buffer (current-buffer)) (from-buffer-is-shell (derived-mode-p 'shell-mode)) + (primary-name-unbracketed (multishell-unbracket-asterisks + 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-derive-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-primary-name) - multishell-primary-name))) - (use-default-dir (cadr target-name-and-path)) + (or (multishell-read-bare-shell-buffer-name + (format "Shell buffer name [%s]%s " + primary-name-unbracketed + (if doublearg " <==" ":")) + primary-name-unbracketed) + primary-name-unbracketed) + 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 - (let ((got (get-buffer target-shell-buffer-name))) - (if (buffer-live-p got) - got - (kill-buffer got) - (get-buffer target-shell-buffer-name))))) inwin already-there) + ;; Register early so the entry is pushed to the front: + (multishell-register-name-to-path (multishell-unbracket-asterisks + target-shell-buffer-name) + use-path) + (when doublearg (setq multishell-primary-name target-shell-buffer-name)) @@ -353,15 +423,13 @@ customize the savehist group to activate savehist." (if (not (comint-check-proc (current-buffer))) (multishell-start-shell-in-buffer (buffer-name (current-buffer)) - use-default-dir)) + use-path)) ;; If the destination buffer has a stopped process, resume it: (let ((process (get-buffer-process (current-buffer)))) (if (and process (equal 'stop (process-status process))) (continue-process process))) - (multishell-register-name-to-path (multishell-unbracket-asterisks - target-shell-buffer-name) - use-default-dir) + (when (or already-there (equal (current-buffer) from-buffer)) (goto-char (point-max)) @@ -370,29 +438,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) @@ -411,10 +480,9 @@ customize the savehist group to activate savehist." nil)) (defun multishell-read-bare-shell-buffer-name (prompt default) - "PROMPT for shell buffer name, sans asterisks. + "PROMPT for shell buffer name, sans asterisks. Indicate DEFAULT in prompt. -Return the supplied name bracketed with the asterisks, or specified DEFAULT -on empty input." +Return the supplied name, if provided, else return nil." (let* ((candidates (append ;; Plain shell buffer names appended with names from name/path hist: @@ -442,39 +510,42 @@ on empty input." ;; HIST: 'multishell-history))) (if (not (string= got "")) - (multishell-bracket-asterisks 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))) + got + nil))) + +(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 (or 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." @@ -506,9 +577,7 @@ Return them as a list (name dir), with dir nil if none given." (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)) + (setq is-remote (and path (file-remote-p path))) (when (and is-remote (derived-mode-p 'shell-mode) (not (comint-check-proc (current-buffer)))) @@ -517,22 +586,10 @@ Return them as a list (name dir), with dir nil if none given." (tramp-cleanup-connection (tramp-dissect-file-name default-directory 'noexpand) 'keep-debug 'keep-password)) - ;; (cd default-directory) will connect if remote: (when is-remote - (message "Connecting to %s" default-directory)) - (condition-case err - (cd default-directory) - (error - ;; Aargh. Need to isolate this tramp bug. - (when (and (stringp (cadr err)) - (string-equal (cadr err) - "Selecting deleted buffer")) - (signal (car err) - (list - (format "%s, %s (\"%s\")" - "Tramp shell can fail on empty (homedir) path" - "please try again with an explicit path" - (cadr err))))))) + (message "Connecting to %s" path)) + (if (and path (not (string= path ""))) + (cd path)) (setq buffer (set-buffer (apply 'make-comint (multishell-unbracket-asterisks buffer-name) prog @@ -548,7 +605,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 @@ -601,10 +658,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."