X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/e0cc6d48508299f04f092823f41c41809a785a1a..3e639bfbf6f22149abb8b828a4b35f688d45b4a6:/multishell.el diff --git a/multishell.el b/multishell.el index f32a9801b..7295aa1ea 100644 --- a/multishell.el +++ b/multishell.el @@ -1,4 +1,4 @@ -;;; 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 @@ -6,7 +6,7 @@ ;; Version: 1.0.5 ;; Created: 1999 -- first public availability ;; Keywords: processes -;; URL: https://github.com/kenmanheimer/EmacsUtils +;; URL: https://github.com/kenmanheimer/EmacsMultishell ;; ;;; Commentary: ;; @@ -15,44 +15,86 @@ ;; 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 a shell buffer if you're not currently in one. +;; ... or to any of your shell buffers, from elsewhere 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: +;; +;; * `/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*". ;; -;; Customize-group `multishell` to select and activate a keybinding and set -;; various behaviors. +;; * File visits will all be under the auspices of the account, and relative to +;; the current directory, on the remote host. +;; +;; See the `multishell-pop-to-shell` docstring for details. ;; -;; 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. ;; -;;; Change Log: +;; Please use +;; [the multishell repository](https://github.com/kenmanheimer/EmacsMultishell) +;; issue tracker to report problems, suggestions, etc. ;; -;; 2016-01-02 Ken Manheimer - working on this in public, but not yet released. +;; (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 ~.) ;; -;;; TODO: +;; Change Log: ;; -;; * Preserveable (savehist) history that associates names with paths -;; - Editible -;; - New shell prompts for confirmation -;; - Including path from history, if any -;; - which offers opportunity to entry -;; - ?completions list toggles between short and long? -;; - "Toggle short/long listing by immediately repeating completion key" -;; - History tracks buffer disposition -;; - Deleting buffer removes history entry -;; - Track buffer name change using buffer-list-update-hook -;; - Option to track last directory - multishell-remember-last-dir -;; - dig into tramp to find out where the actual remote+dir path is -;; - Include note about tramp not tracking remote dir changes well -;; - use `M-x shell-resync-dirs'; I bind to M-return -;; * Note in multishell doc to activate (customize) savehist to preserve history +;; * 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, 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: +;; - 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. ;;; Code: (require 'comint) (require 'shell) +(defvar multishell-version "1.0.5") + (defgroup multishell nil "Allout extension that highlights outline structure graphically. @@ -69,7 +111,7 @@ lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)." :group 'multishell) (defvar multishell--responsible-for-command-key nil - "Multishell internal.") + "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) @@ -117,13 +159,15 @@ current-buffer behavior.)" :type 'boolean :group 'multishell) -;; (defcustom multishell-persist-shell-names nil -;; "Remember shell name/path associations across sessions. Note well: -;; This will activate minibuffer history persistence, in general, if it's not -;; already active." -;; :type 'boolean -;; :set 'multishell-activate-persistence -;; :group 'shell) +(defcustom multishell-history-entry-tracks-current-directory t + "Modify shell buffer's multishell entry to track the current directory. + +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." + :type 'boolean + :group 'multishell) (defvar multishell-history nil "Name/path entries, most recent first.") @@ -137,21 +181,33 @@ current-buffer behavior.)" (defvar multishell-primary-name "*shell*" "Shell name to use for un-modified multishell-pop-to-shell buffer target.") +;; 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'." + "Add or replace entry associating NAME with PATH in `multishell-history'. + +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* ((entry (multishell-history-entry name)) - (becomes (concat name path))) - (when entry + (let* ((entries (multishell-history-entries name)) + (path (or path ""))) + (dolist (entry entries) + (when (string= path "") + ;; Retain explicit established path. + (setq path (cadr (multishell-split-entry-name-and-tramp entry)))) (setq multishell-history (delete entry multishell-history))) - (push becomes multishell-history))) + (setq multishell-history (push (concat name path) + multishell-history)))) -(defun multishell-history-entry (name) +(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 (string-match match-expr entry) - (return entry))))) + (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. @@ -216,10 +272,19 @@ the buffer name. Otherwise, the host, domain, or path is used. For example: -* Use '/ssh:example.net:/' for a shell buffer on example.net named - \"example.net\". -* '\#ex/ssh:example.net|sudo:root@example.net:/' for a root shell on - example.net named \"#ex\". +* 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. + +\(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 ~.) You can change the startup path for a shell buffer by editing it at the completion prompt. The new path will be preserved in @@ -228,9 +293,9 @@ 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 sessions: -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") @@ -258,6 +323,11 @@ customize the savehist group to activate savehist." 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-default-dir) + (when doublearg (setq multishell-primary-name target-shell-buffer-name)) @@ -294,19 +364,15 @@ customize the savehist group to activate savehist." ;; We're in the buffer. Activate: - (cond ((not (comint-check-proc (current-buffer))) - (multishell-start-shell-in-buffer (buffer-name (current-buffer)) - use-default-dir)) - (use-default-dir - (cd use-default-dir))) + (if (not (comint-check-proc (current-buffer))) + (multishell-start-shell-in-buffer (buffer-name (current-buffer)) + use-default-dir)) ;; 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)) @@ -328,14 +394,15 @@ 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 anyerr - (let ((entry (and (derived-mode-p 'shell-mode) - (multishell-history-entry - (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)))) + (let ((entries (and (derived-mode-p 'shell-mode) + (multishell-history-entries + (multishell-unbracket-asterisks (buffer-name)))))) + (dolist (entry entries) + (when (and entry + (y-or-n-p (format "Remove multishell history entry `%s'? " + entry))) + (setq multishell-history + (delete entry multishell-history))))) (error nil)) t) (add-hook 'kill-buffer-query-functions 'multishell-kill-buffer-query-function) @@ -366,10 +433,11 @@ on empty input." (mapcar (lambda (buffer) (let* ((name (multishell-unbracket-asterisks (buffer-name buffer)))) - (and (with-current-buffer buffer + (and (buffer-live-p buffer) + (with-current-buffer buffer ;; Shell mode buffers. (derived-mode-p 'shell-mode)) - (not (multishell-history-entry name)) + (not (multishell-history-entries name)) name))) (buffer-list))) multishell-history)) @@ -399,15 +467,12 @@ 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) + ((string-match "^\\*\\([^/]*\\)\\(/.*\\)\\*" path-ish) ;; We have a path, use it - (let ((overt-name (match-string 1 path-ish)) - (overt-path (match-string 2 path-ish)) - (trailing-name (match-string 3 path-ish))) + (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= overt-path "") (setq overt-path nil)) - (if (string= trailing-name "") (setq trailing-name nil)) - (setq path (concat overt-path trailing-name)) + (if (string= path "") (setq path nil)) (setq name (multishell-bracket-asterisks (or overt-name @@ -416,7 +481,6 @@ Return them as a list (name dir), with dir nil if none given." (or (tramp-file-name-host vec) (tramp-file-name-domain vec) (tramp-file-name-localname vec) - trailing-name system-name)) (multishell-unbracket-asterisks multishell-primary-name))))))) @@ -450,11 +514,13 @@ Return them as a list (name dir), with dir nil if none given." "/bin/sh")) (name (file-name-nondirectory prog)) (startfile (concat "~/.emacs_" name)) - (xargs-name (intern-soft (concat "explicit-" name "-args")))) + (xargs-name (intern-soft (concat "explicit-" name "-args"))) + is-remote) (set-buffer buffer-name) (if (and path (not (string= path ""))) (setq default-directory path)) - (when (and (file-remote-p default-directory) + (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 @@ -462,8 +528,23 @@ 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 reconnect a disconnected remote: - (cd default-directory) + ;; (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 empty (homedir) path" + "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 @@ -475,6 +556,77 @@ Return them as a list (name dir), with dir nil if none given." '("-i"))))) (shell-mode))) +(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)) + (name (car name-path)) + (path (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)) + (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) +(defun multishell-post-command-business () + "Do multishell bookkeeping." + ;; Update multishell-history with dir changes. + (condition-case err + (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)) + default-directory))) + (when (and multishell-was-default-directory + (not (string= curdir 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))) +(add-hook 'post-command-hook 'multishell-post-command-business) + +(defun multishell-split-entry-name-and-tramp (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))) + (provide 'multishell) ;;; multishell.el ends here