X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/79796f98dc67f236e51eb3a1d4773d344f1f643e..77c698c621d5972e501558742d8107b1c8f2a6d5:/multishell.el diff --git a/multishell.el b/multishell.el index b5d6cc02e..dc979f015 100644 --- a/multishell.el +++ b/multishell.el @@ -1,12 +1,12 @@ -;;; multishell.el --- manage interaction with multiple local and remote shells +;;; multishell.el --- facilitate multiple local and remote shell buffers ;; 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/EmacsUtils +;; URL: https://github.com/kenmanheimer/EmacsMultishell ;; ;;; Commentary: ;; @@ -15,56 +15,140 @@ ;; 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, -;; * ... with just a keystroke. +;; ... 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: +;; +;; * `#root/sudo:root@localhost:/etc` for a buffer named "*#root*" with a +;; root shell starting in /etc. ;; -;; For example: +;; * `/ssh:example.net:` for a shell buffer in your homedir 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:/var/log` for a root shell +;; starting in /var/log on example.net named "*#ex*". ;; -;; * '#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, and so on. ;; -;; (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+sudo with homedir syntax. Until fixed, you -;; may need to start remote+sudo shells with an explicit path, then cd ~.) +;; * 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 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: +;; Change Log: ;; -;; 2016-01-16 1.0.5 Ken Manheimer: -;; - History now includes paths, when specified. -;; - Actively track current directory in history entry, if it has a path -;; Customize: multishell-history-entry-tracks-current-directory -;; - Offer to user to remove shell's history entry when buffer is killed +;; * XXX 1.0.9 Ken Manheimer: +;; - Allow existing shell buffers names as completions, even though they +;; duplicate the names with paths. The different behavior for entries +;; with existing buffers is actually useful. And in accord with actual +;; behavior, where changing path for existing shells doesn't, actually. +;; - Add paths to buffers started without one, if multishell history dir +;; tracking is enabled. +;; - Substantial code cleanup: +;; - simplify multishell-start-shell-in-buffer, in particular using +;; shell function, rather than unnecessarily going underneath it. +;; - fallback to eval-after-load in emacs, 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 +;; 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. +;; - 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, sudo hops to a home dir often fails. ;; - Simplify history var name, migrate existing history if any from old name -;; 2016-01-06 Ken Manheimer - Released -;; 2016-01-02 Ken Manheimer - working on this in public, but not yet released. +;; * 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: ;; -;; * Isolate frequent failure with remote tramp home-dir syntax (`/host.dom:') -;; * Find suitable modes for brief and elaborate name/path exposures, -;; e.g. toggle for completions to show just name or name+path +;; * 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 +;; - maybe use keybindings that wrap minibuffer completion keys +;; - minibuffer-local-completion-map, minibuffer-local-must-match-map +;; - setup minibuffer with these vars just before doing completions +;; - minibuffer exit reverts these vars, if necessary +;; - toggles between name and name/path if repeat count provided +;; - and an instruction about toggling in the completion buffer +;; - eventually? "multishell-list-all", based on tabulated-list-mode +;; - list-environment package is small, tidy, may be an easy template? +;; - sort based on existing vs just historical +;; - launch +;; - rename, change path, and remove history entries +;; - could we use it as the transient completions help window? +;; * 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. +;; * Add custom shell launch prep actions +;; - shell commands to execute when shell name or path matches a regexp +;; - list of [regexp, which (name, path, or both), command] +;; - for, eg, knock commands or interface activations, whatever +;; * 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. @@ -114,65 +198,87 @@ 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: -(with-eval-after-load "multishell" - (multishell-implement-command-key-choice)) +;; 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))) (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. -;; There is usually only one entry per name, but disruptions happen. +This is set by `multishell-pop-to-shell' as the current default, +when invoked with doubled universal argument. + +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'.") + +;; 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'. -Promote to added/changed entry to the front of the list." +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))) + (path (or path ""))) (dolist (entry entries) + (when (string= path "") + ;; Retain explicit established 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 "\\\(/.*$\\\)?")) - got) - (dolist (entry multishell-history) - (when (and (string-match match-expr entry) - (not (member entry got))) - (setq got (cons entry got)))) - got)) + (save-match-data + (let ((match-expr (concat "^" name "\\\(/.*$\\\)?$")) + got) + (dolist (entry multishell-history) + (when (and (string-match match-expr entry) + (not (member entry got))) + (setq got (cons entry got)))) + got))) (defun multishell-pop-to-shell (&optional arg) "Easily navigate to and within multiple shell buffers, local and remote. @@ -220,13 +326,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 @@ -237,58 +346,69 @@ 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 your homedir on example.net. + The buffer will be named \"*example.net*\". + +* '#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. -\(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+sudo with homedir syntax. Until fixed, you -may need to start remote+sudo shells with an explicit path, then cd ~.) +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. -===== 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)) @@ -311,9 +431,11 @@ 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: + (when (not (get-buffer target-shell-buffer-name)) + (message "Creating new shell buffer '%s'" 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)) @@ -327,15 +449,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)) @@ -344,29 +464,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) @@ -385,10 +506,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: @@ -400,7 +520,9 @@ on empty input." (with-current-buffer buffer ;; Shell mode buffers. (derived-mode-p 'shell-mode)) - (not (multishell-history-entries name)) + ;; Allow duplicates, as sign of buffers that + ;; currently exist vs historical entries. + ;;(not (multishell-history-entries name)) name))) (buffer-list))) multishell-history)) @@ -416,114 +538,71 @@ 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))) - -(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) + 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-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. - (when (and (stringp (cadr err)) - (string-equal (cadr err) - "Selecting deleted buffer")) - (signal (car err) - (list - (format "Tramp shell can fail on homedir paths, %s (\"%s\")" - "please try with an explicit path" - (cadr 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))) + "Start, restart, or continue a shell in BUFFER-NAME on PATH." + (let* ((buffer (get-buffer buffer-name)) + is-remote is-active) + + (set-buffer buffer) + (setq is-active (comint-check-proc 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: + (tramp-cleanup-connection + (tramp-dissect-file-name default-directory 'noexpand) + 'keep-debug 'keep-password)) + + (message "Connecting to %s" path) + (cd path)) + + (shell buffer))) (defun multishell-track-dirchange (name newpath) "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))) + (path (or (cadr name-path) ""))) (when path (let* ((is-remote (file-remote-p path)) (vec (and is-remote (tramp-dissect-file-name path nil))) @@ -549,7 +628,7 @@ Return them as a list (name dir), with dir nil if none given." (aref vec 2) newlocalname (aref vec 4)) - newlocalname)) + newpath)) (newentry (concat name newpath)) (membership (member entry multishell-history))) (when membership @@ -567,26 +646,41 @@ Return them as a list (name dir), with dir nil if none given." (tramp-file-name-localname (tramp-dissect-file-name default-directory)) default-directory))) - (when (and multishell-was-default-directory - (not (string= curdir multishell-was-default-directory))) + (when (not (string= curdir (or multishell-was-default-directory ""))) (multishell-track-dirchange (multishell-unbracket-asterisks (buffer-name)) 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." - (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-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) (provide 'multishell)