From: Ken Manheimer Date: Mon, 18 Jan 2016 00:30:43 +0000 (-0500) Subject: Merge branch 'master' of github.com:kenmanheimer/EmacsMultishell X-Git-Url: https://code.delx.au/gnu-emacs-elpa/commitdiff_plain/3428b25c9018f5df46d5934c858ba1162996cbab?hp=7956bdacdba9fb0e3f36c53f3448c51a4e1fbb9e Merge branch 'master' of github.com:kenmanheimer/EmacsMultishell --- diff --git a/.gitignore b/.gitignore new file mode 100644 index 000000000..1c1754987 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +# Compiled +*.elc diff --git a/LICENSE b/LICENSE index 9cecc1d46..ef7e7efc0 100644 --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ - GNU GENERAL PUBLIC LICENSE +GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 Copyright (C) 2007 Free Software Foundation, Inc. diff --git a/README.md b/README.md new file mode 100644 index 000000000..be5e78de0 --- /dev/null +++ b/README.md @@ -0,0 +1,36 @@ +multishell.el +============= + +Facilitate interaction with multiple local and remote Emacs shell buffers. + +I use the emacs shell a *lot*. On top of emacs' powerful shell and tramp +facilities, multishell.el turns emacs into a versatile tool for conducting +operations and development across numerous hosts. + +Using the include customization binding, you can use a keystroke 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. +* Use universal arguments to launch and choose among alternate shell buffers, +* ... and select which is default. +* 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. + + 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*". + +(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 ~.) + +Customize-group `multishell` to select and activate a keybinding and set +various behaviors. Customize-group `savehist` to preserve buffer +names/paths across emacs sessions. + +See the `multishell-pop-to-shell` docstring for details. diff --git a/aside/pdbtrack.el b/aside/pdbtrack.el new file mode 100644 index 000000000..a61546f07 --- /dev/null +++ b/aside/pdbtrack.el @@ -0,0 +1,135 @@ +;;; pdbtrack - Track source file lines as you run python/pdb in an emacs shell. + +;;; Standalone Python PDB dynamic file tracking. + +;;; CRAP. This was extracted from python.el, which lacks some crucial +;;; features of my original pdbtrack code. python-mode.el (available via +;;; marmalade, melpa) has a much more faithful version, including seeking +;;; an existing buffer for a function if the indicated file can't be found +;;; - crucial for doing remote debugging, eg via rpdb. +;;; +;;; I'm going to retire this code, for the moment, until I can recover +;;; pdbtrack (plus whatever improvements may have been developed) from +;;; python-mode.el. + +(define-minor-mode pdbtrack-minor-mode + "Show lines in source file when Python PDB debugger steps through them." + nil ":PDBtrack" :require 'pdbtrack :version "2.1" + + (add-hook 'comint-output-filter-functions + 'pdbtrack-comint-output-filter-function) + (make-local-variable 'pdbtrack-buffers-to-kill) + (make-local-variable 'pdbtrack-tracked-buffer) +) + +(defcustom pdbtrack-stacktrace-info-regexp + "> \\([^\"(<]+\\)(\\([0-9]+\\))\\([?a-zA-Z0-9_<>]+\\)()" + "Regular Expression matching stacktrace information. +Used to extract the current line and module being inspected." + :type 'string + :group 'python + :safe 'stringp) + +(defvar pdbtrack-tracked-buffer nil + "Variable containing the value of the current tracked buffer. +Never set this variable directly, use +`pdbtrack-set-tracked-buffer' instead.") + +(defcustom pdbtrack-remove-new-buffers-after-tracking t + "Remove buffers visited for the sake of tracking, on pdb session conclusion." + :type 'boolean + :group 'python) +(defvar pdbtrack-buffers-to-kill nil + "List of buffers to be deleted after tracking finishes.") + +(defun pdbtrack-set-tracked-buffer (file-name) + "Set the buffer for FILE-NAME as the tracked buffer. +Internally it uses the `pdbtrack-tracked-buffer' variable. +Returns the tracked buffer." + (let ((file-buffer (get-file-buffer + (concat (file-remote-p default-directory) + file-name)))) + (if file-buffer + (setq pdbtrack-tracked-buffer file-buffer) + (setq file-buffer (find-file-noselect file-name)) + (when (not (member file-buffer pdbtrack-buffers-to-kill)) + (add-to-list 'pdbtrack-buffers-to-kill file-buffer))) + file-buffer)) + +(defun pdbtrack-comint-output-filter-function (output) + "Move overlay arrow to current pdb line in tracked buffer. +Argument OUTPUT is a string with the output from the comint process." + (when (and pdbtrack-minor-mode (not (string= output ""))) + (let* ((full-output (ansi-color-filter-apply + (buffer-substring comint-last-input-end (point-max)))) + (line-number) + (file-name + (with-temp-buffer + (insert full-output) + ;; When the debugger encounters a pdb.set_trace() + ;; command, it prints a single stack frame. Sometimes + ;; it prints a bit of extra information about the + ;; arguments of the present function. When ipdb + ;; encounters an exception, it prints the _entire_ stack + ;; trace. To handle all of these cases, we want to find + ;; the _last_ stack frame printed in the most recent + ;; batch of output, then jump to the corresponding + ;; file/line number. + (goto-char (point-max)) + (when (re-search-backward pdbtrack-stacktrace-info-regexp nil t) + (setq line-number (string-to-number + (match-string-no-properties 2))) + (match-string-no-properties 1))))) + (if (and file-name line-number) + (let* ((tracked-buffer + (pdbtrack-set-tracked-buffer file-name)) + (shell-buffer (current-buffer)) + (tracked-buffer-window (get-buffer-window tracked-buffer)) + (tracked-buffer-line-pos)) + (with-current-buffer tracked-buffer + (set (make-local-variable 'overlay-arrow-string) "=>") + (set (make-local-variable 'overlay-arrow-position) (make-marker)) + (setq tracked-buffer-line-pos (progn + (goto-char (point-min)) + (forward-line (1- line-number)) + (point-marker))) + (when tracked-buffer-window + (set-window-point + tracked-buffer-window tracked-buffer-line-pos)) + (set-marker overlay-arrow-position tracked-buffer-line-pos)) + (pop-to-buffer tracked-buffer) + (switch-to-buffer-other-window shell-buffer)) + (when pdbtrack-tracked-buffer + (with-current-buffer pdbtrack-tracked-buffer + (set-marker overlay-arrow-position nil)) + (when (not pdbtrack-remove-new-buffers-after-tracking) + (mapc #'(lambda (buffer) + (ignore-errors (kill-buffer buffer))) + pdbtrack-buffers-to-kill)) + (setq pdbtrack-tracked-buffer nil + pdbtrack-buffers-to-kill nil))))) + output) + +(defun pdbtrack-cherry-pick-buffer (funcname lineno) + "Find most recent buffer having name or having function named FUNCNAME. +We walk the buffer-list history for python-mode buffers that are +named for funcname or define a function funcname." + (let ((buffers (buffer-list)) + buf + got) + (while (and buffers (not got)) + (setq buf (car buffers) + buffers (cdr buffers)) + (if (and (save-excursion (set-buffer buf) + (string= major-mode "python-mode")) + (or (string-match funcname (buffer-name buf)) + (string-match (concat "^\\s-*\\(def\\|class\\)\\s-+" + funcname "\\s-*(") + (save-excursion + (set-buffer buf) + (buffer-substring (point-min) + (point-max)))))) + (setq got buf))) + got)) + +(provide 'pdbtrack) diff --git a/multishell.el b/multishell.el new file mode 100644 index 000000000..b5d6cc02e --- /dev/null +++ b/multishell.el @@ -0,0 +1,593 @@ +;;; multishell.el --- manage interaction with multiple local and remote shells + +;; Copyright (C) 1999-2016 Free Software Foundation, Inc. and Ken Manheimer + +;; Author: Ken Manheimer +;; Version: 1.0.5 +;; Created: 1999 -- first public availability +;; Keywords: processes +;; URL: https://github.com/kenmanheimer/EmacsUtils +;; +;;; Commentary: +;; +;; Easily use and navigate multiple shell buffers, including remote shells. +;; Fundamentally, multishell is the function `multishell-pop-to-shell' - +;; 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. +;; * Use universal arguments to launch and choose among alternate shell buffers, +;; * ... and select which is default. +;; * 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. +;; +;; 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*". +;; +;; (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 ~.) +;; +;; Customize-group `multishell' to select and activate a keybinding and set +;; various behaviors. Customize-group `savehist' to preserve buffer +;; names/paths across emacs sessions. +;; +;; See the `multishell-pop-to-shell' docstring for details. +;; +;;; 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 +;; - 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. +;; +;;; TODO: +;; +;; * 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 + +;;; Code: + +(require 'comint) +(require 'shell) + +(defgroup multishell nil + "Allout extension that highlights outline structure graphically. + +Customize `allout-widgets-auto-activation' to activate allout-widgets +with allout-mode." + :group 'shell) + +(defcustom multishell-command-key "\M- " + "The key to use if `multishell-activate-command-key' is true. + +You can instead manually bind `multishell-pop-to-shell` using emacs +lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)." + :type 'key-sequence + :group 'multishell) + +(defvar multishell--responsible-for-command-key nil + "Coordination for multishell key assignment.") +(defun multishell-activate-command-key-setter (symbol setting) + "Implement `multishell-activate-command-key' choice." + (set-default 'multishell-activate-command-key setting) + (when (or setting multishell--responsible-for-command-key) + (multishell-implement-command-key-choice (not setting)))) +(defun multishell-implement-command-key-choice (&optional unbind) + "If settings dicate, implement binding of multishell command key. + +If optional UNBIND is true, globally unbind the key. + +* `multishell-activate-command-key' - Set this to get the binding or not. +* `multishell-command-key' - The key to use for the binding, if appropriate." + (cond (unbind + (when (and (boundp 'multishell-command-key) multishell-command-key) + (global-unset-key multishell-command-key))) + ((not (and (boundp 'multishell-activate-command-key) + (boundp 'multishell-command-key))) + nil) + ((and multishell-activate-command-key multishell-command-key) + (setq multishell--responsible-for-command-key t) + (global-set-key multishell-command-key 'multishell-pop-to-shell)))) + +(defcustom multishell-activate-command-key nil + "Set this to impose the `multishell-command-key' binding. + +You can instead manually bind `multishell-pop-to-shell` using emacs +lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)." + :type 'boolean + :set 'multishell-activate-command-key-setter + :group 'multishell) + +;; Assert the customizations 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. + +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.)" + :type 'boolean + :group 'multishell) + +(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.") +(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) + ) + +(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. +(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." + ;; Add or promote to the front, tracking path changes in the process. + (let* ((entries (multishell-history-entries name)) + (becomes (concat name path))) + (dolist (entry entries) + (setq multishell-history (delete entry multishell-history))) + (setq multishell-history (push becomes 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)) + +(defun multishell-pop-to-shell (&optional arg) + "Easily navigate to and within multiple shell buffers, local and remote. + +Use universal arguments to launch and choose between alternate +shell buffers and to select which is default. Append a path to +a new shell name to launch a shell in that directory, and use +Emacs tramp syntax to launch a remote shell. + +Customize-group `multishell' to set up a key binding and tweak behaviors. + +==== Basic operation: + + - If the current buffer is shell-mode (or shell-mode derived) + buffer then focus is moved to the process input point. + + \(You can use a universal argument go to a different shell + buffer when already in a buffer that has a process - see + below.) + + - If not in a shell buffer (or with universal argument), go to a + window that is already showing the (a) shell buffer, if any. + + In this case, the cursor is left in its prior position in the + shell buffer. Repeating the command will then go to the + process input point, per the first item in this list. + + We respect `pop-up-windows', so you can adjust it to set the + other-buffer/same-buffer behavior. + + - Otherwise, start a new shell buffer, using the current + directory as the working directory. + +If a buffer with the resulting name exists and its shell process +was disconnected or otherwise stopped, it's resumed. + +===== Universal arg to start and select between named shell buffers: + +You can name alternate shell buffers to create or return to using +single or doubled universal arguments: + + - With a single universal argument, prompt for the buffer name + to use (without the asterisks that shell mode will put around + the name), defaulting to 'shell'. + + Completion is available. + + This combination makes it easy to start and switch between + multiple shell buffers. + + - A double universal argument will prompt for the name *and* set + the default to that name, so the target shell becomes the + primary. + +===== Select starting directory and remote host: + +The shell buffer name you give to the prompt for a universal arg +can include an appended path. That will be used for the startup +directory. You can use tramp remote syntax to specify a remote +shell. If there is an element after a final '/', that's used for +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*\". + +\(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 ~.) + +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. + +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: + +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)) + (doublearg (equal arg '(16))) + (target-name-and-path + (multishell-derive-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)) + (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))))) + inwin + already-there) + + (when doublearg + (setq multishell-primary-name target-shell-buffer-name)) + + ;; Situate: + + (cond + + ((and (or curr-buff-proc from-buffer-is-shell) + (not arg) + (eq from-buffer target-buffer) + (not (eq target-shell-buffer-name (buffer-name from-buffer)))) + ;; In a shell buffer, but not named - stay in buffer, but go to end. + (setq already-there t)) + + ((string= (buffer-name) target-shell-buffer-name) + ;; Already in the specified shell buffer: + (setq already-there t)) + + ((or (not target-buffer) + (not (setq inwin + (multishell-get-visible-window-for-buffer target-buffer)))) + ;; No preexisting shell buffer, or not in a visible window: + (pop-to-buffer target-shell-buffer-name pop-up-windows)) + + ;; Buffer exists and already has a window - jump to it: + (t (if (and multishell-pop-to-frame + inwin + (not (equal (window-frame (selected-window)) + (window-frame inwin)))) + (select-frame-set-input-focus (window-frame inwin))) + (if (not (string= (buffer-name (current-buffer)) + target-shell-buffer-name)) + (pop-to-buffer target-shell-buffer-name t)))) + + ;; We're in the buffer. Activate: + + (if (not (comint-check-proc (current-buffer))) + (multishell-start-shell-in-buffer (buffer-name (current-buffer)) + use-default-dir)) + + ;; 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)) + (and (get-buffer-process from-buffer) + (goto-char (process-mark (get-buffer-process from-buffer))))))) + +(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. + ;; + ;; 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. + ;; 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. + + ;; (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) + (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) + +(defun multishell-get-visible-window-for-buffer (buffer) + "Return visible window containing buffer." + (catch 'got-a-vis + (walk-windows + (function (lambda (win) + (if (and (eq (window-buffer win) buffer) + (equal (frame-parameter + (selected-frame) 'display) + (frame-parameter + (window-frame win) 'display))) + (throw 'got-a-vis win)))) + nil 'visible) + nil)) + +(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." + (let* ((candidates + (append + ;; Plain shell buffer names appended with names from name/path hist: + (remq nil + (mapcar (lambda (buffer) + (let* ((name (multishell-unbracket-asterisks + (buffer-name buffer)))) + (and (buffer-live-p buffer) + (with-current-buffer buffer + ;; Shell mode buffers. + (derived-mode-p 'shell-mode)) + (not (multishell-history-entries name)) + name))) + (buffer-list))) + multishell-history)) + (got (completing-read prompt + ;; COLLECTION: + (reverse candidates) + ;; PREDICATE: + nil + ;; REQUIRE-MATCH: + 'confirm + ;; INITIAL-INPUT + nil + ;; 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) + +(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))) + +(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