code.delx.au - gnu-emacs-elpa/blob - packages/multishell/multishell.el

   1 ;;; multishell.el --- facilitate multiple local and remote shell buffers
   2
   3 ;; Copyright (C) 1999-2016 Free Software Foundation, Inc. and Ken Manheimer
   4
   5 ;; Author: Ken Manheimer <ken.manheimer@gmail.com>
   6 ;; Version: 1.0.7
   7 ;; Created: 1999 -- first public availability
   8 ;; Keywords: processes
   9 ;; URL: https://github.com/kenmanheimer/EmacsMultishell
  10 ;;
  11 ;;; Commentary:
  12 ;;
  13 ;; Easily use and navigate multiple shell buffers, including remote shells.
  14 ;; Fundamentally, multishell is the function `multishell-pop-to-shell' -
  15 ;; a la `pop-to-buffer' - plus a keybinding. Together, they enable you to:
  16 ;;
  17 ;; * Get to the input point from wherever you are in a shell buffer,
  18 ;;   ... or to any of your shell buffers, from anywhere inside emacs.
  19 ;;
  20 ;; * Use universal arguments to launch and choose among alternate shell buffers,
  21 ;;   ... and change which is the current default.
  22 ;;
  23 ;; * Easily restart disconnected shells, or shells from prior sessions
  24 ;;   ... the latter from Emacs builtin savehist minibuf history persistence
  25 ;;
  26 ;; * Append a path to a new shell name to launch a shell in that directory,
  27 ;;   ... and use a path with Emacs tramp syntax to launch a remote shell -
  28 ;;   for example:
  29 ;;
  30 ;;   * `#root/sudo:root@localhost:/etc` for a buffer named "#root" with a
  31 ;;     root shell starting in /etc.
  32 ;;
  33 ;;   * `/ssh:example.net:/` for a shell buffer in / on example.net.
  34 ;;     The buffer will be named "*example.net*".
  35 ;;
  36 ;;   * `#ex/ssh:example.net|sudo:root@example.net:/etc` for a root shell
  37 ;;     starting in /etc on example.net named "*#ex*".
  38 ;;
  39 ;;   * 'interior/ssh:gateway.corp.com|ssh:interior.corp.com:' to go via
  40 ;;     gateway.corp.com to your homedir on interior.corp.com.  The buffer
  41 ;;     will be named "*interior*". You could append a sudo hop, and so on.
  42 ;;
  43 ;; * Thanks to tramp, file visits from the shell will seamlessly be in
  44 ;;   the auspices of the target account, and relative to the current
  45 ;;   directory, on the host where the shell is running.
  46 ;;
  47 ;; See the `multishell-pop-to-shell` docstring for details.
  48 ;;
  49 ;; Customize-group `multishell' to select and activate a keybinding and set
  50 ;; various behaviors. Customize-group `savehist' to preserve buffer
  51 ;; names/paths across emacs restarts.
  52 ;;
  53 ;; Please use
  54 ;; [the multishell repository](https://github.com/kenmanheimer/EmacsMultishell)
  55 ;; issue tracker to report problems, suggestions, etc.
  56 ;;
  57 ;; Change Log:
  58 ;;
  59 ;; * 2016-01-23 1.0.7 Ken Manheimer:
  60 ;;   - Remove notes about tramp remote+sudo+homedir problem. Apparently it's
  61 ;;     due to something in my local site configuration (happens with -q but
  62 ;;     not -Q).
  63 ;; * 2016-01-22 1.0.6 Ken Manheimer:
  64 ;;   - Add multishell-version function.
  65 ;;   - Tweak commentary/comments/docstrings.
  66 ;;   - Null old multishell-buffer-name-history var, if present.
  67 ;; * 2016-01-16 1.0.5 Ken Manheimer:
  68 ;;   - History now includes paths, when designated.
  69 ;;   - Actively track current directory in history entries that have a path.
  70 ;;     Custom control: multishell-history-entry-tracks-current-directory
  71 ;;   - Offer to remove shell's history entry when buffer is killed.
  72 ;;     (Currently the only UI mechanism to remove history entries.)
  73 ;;   - Fix - prevent duplicate entries for same name but different paths
  74 ;;   - Fix - recognize and respect tramp path syntax to start in home dir
  75 ;;   - Simplify history var name, migrate existing history if any from old name
  76 ;; * 2016-01-04 1.0.4 Ken Manheimer - Released to ELPA
  77 ;; * 2016-01-02 Ken Manheimer - working on this in public, but not yet released.
  78 ;;
  79 ;; TODO:
  80 ;;
  81 ;; * Find suitable, internally consistent ways to tidy completions, eg:
  82 ;;   - first list completions for active shells, then present but inactive,
  83 ;;     then historical
  84 ;;   - some way for user to toggle between presenting just buffer names vs
  85 ;;     full buffer/path
  86 ;;     - without cutting user off from easy editing of path
  87 ;; * Try minibuffer field boundary at beginning of tramp path, to see whether
  88 ;;   the field boundary magically enables tramp path completion.
  89 ;; * Assess whether deletion of history entry via kill-buffer is sufficient.
  90
  91 ;;; Code:
  92
  93 (require 'comint)
  94 (require 'shell)
  95 (require 'savehist)
  96
  97 (defvar multishell-version "1.0.7")
  98 (defun multishell-version (&optional here)
  99   "Return string describing the loaded multishell version."
 100   (interactive "P")
 101   (let ((msg (concat "Multishell " multishell-version)))
 102     (if here (insert msg)
 103       (if (called-interactively-p 'interactive)
 104           (message "%s" msg)
 105         msg))))
 106
 107 (defgroup multishell nil
 108   "Allout extension that highlights outline structure graphically.
 109
 110 Customize `allout-widgets-auto-activation' to activate allout-widgets
 111 with allout-mode."
 112   :group 'shell)
 113
 114 (defcustom multishell-command-key "\M- "
 115   "The key to use if `multishell-activate-command-key' is true.
 116
 117 You can instead manually bind `multishell-pop-to-shell` using emacs
 118 lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
 119   :type 'key-sequence
 120   :group 'multishell)
 121
 122 (defvar multishell--responsible-for-command-key nil
 123   "Coordination for multishell key assignment.")
 124 (defun multishell-activate-command-key-setter (symbol setting)
 125   "Implement `multishell-activate-command-key' choice."
 126   (set-default 'multishell-activate-command-key setting)
 127   (when (or setting multishell--responsible-for-command-key)
 128     (multishell-implement-command-key-choice (not setting))))
 129 (defun multishell-implement-command-key-choice (&optional unbind)
 130   "If settings dicate, implement binding of multishell command key.
 131
 132 If optional UNBIND is true, globally unbind the key.
 133
 134 * `multishell-activate-command-key' - Set this to get the binding or not.
 135 * `multishell-command-key' - The key to use for the binding, if appropriate."
 136   (cond (unbind
 137          (when (and (boundp 'multishell-command-key) multishell-command-key)
 138            (global-unset-key multishell-command-key)))
 139         ((not (and (boundp 'multishell-activate-command-key)
 140                    (boundp 'multishell-command-key)))
 141          nil)
 142         ((and multishell-activate-command-key multishell-command-key)
 143          (setq multishell--responsible-for-command-key t)
 144          (global-set-key multishell-command-key 'multishell-pop-to-shell))))
 145
 146 (defcustom multishell-activate-command-key nil
 147   "Set this to impose the `multishell-command-key' binding.
 148
 149 You can instead manually bind `multishell-pop-to-shell` using emacs
 150 lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
 151   :type 'boolean
 152   :set 'multishell-activate-command-key-setter
 153   :group 'multishell)
 154
 155 ;; Implement the key customization whenever the package is loaded:
 156 (with-eval-after-load "multishell"
 157   (multishell-implement-command-key-choice))
 158
 159 (defcustom multishell-pop-to-frame nil
 160   "*If non-nil, jump to a frame already showing the shell, if another one is.
 161
 162 Otherwise, disregard already-open windows on the shell if they're
 163 in another frame, and open a new window on the shell in the
 164 current frame.
 165
 166 \(Use `pop-up-windows' to change multishell other-window vs
 167 current-window behavior.)"
 168   :type 'boolean
 169   :group 'multishell)
 170
 171 (defcustom multishell-history-entry-tracks-current-directory t
 172   "Maintain shell's current directory in its multishell history entry.
 173
 174 When set, the history entry for shells started with explicit
 175 paths will track the shell's current working directory. (Explicit
 176 paths will not be added to local shells started without one,
 177 however.)
 178
 179 If `savehist-save-minibuffer-history' is enabled, the current
 180 working directory of shells \(that were started with an explicit
 181 path) will be conveyed between emacs sessions."
 182  :type 'boolean
 183  :group 'multishell)
 184
 185 (defvar multishell-history nil
 186   "Name/path entries, most recent first.")
 187 ;; Migrate the few pre 1.0.5 users to changed history var:
 188 (when (and (not multishell-history)
 189            (boundp 'multishell-buffer-name-history)
 190            multishell-buffer-name-history)
 191   (setq multishell-history multishell-buffer-name-history
 192         multishell-buffer-name-history nil))
 193
 194 (defvar multishell-primary-name "*shell*"
 195   "Default shell name for un-modified multishell-pop-to-shell buffer target.
 196
 197 This is adjusted by `multishell-pop-to-shell' when it is
 198 invoked (with doubled universal argument) to set the default.
 199
 200 To preserve changes to this setting across emacs restarts, add it
 201 to `savehist-additional-variables' by customizing the latter.")
 202
 203 ;;; Can't just add multishell-primary-name to savehist-additional-variables
 204 ;;; - it'll be lost any time the user runs emacs without loading
 205 ;;; multishell.  So instead, inform the user that they can customize
 206 ;;; savehist-additional-variables.
 207 ;;;
 208 ;;; I suspect that including savehist-additional-variables *on*
 209 ;;; savehist-additional-variables could avoid this problem, as long as it
 210 ;;; doesn't conflict with user customizations. However, even if that works,
 211 ;;; doing so from multishell would change a behavior (for the better, but)
 212 ;;; beyond multishell's scope, making the change hard to track down.
 213
 214 ;; (when (not (member 'multishell-primary-name
 215 ;;                    savehist-additional-variables))
 216 ;;   (setq savehist-additional-variables
 217 ;;         (cons 'multishell-primary-name savehist-additional-variables)))
 218
 219 ;; Multiple entries happen because completion also adds name to history.
 220 (defun multishell-register-name-to-path (name path)
 221   "Add or replace entry associating NAME with PATH in `multishell-history'.
 222
 223 If NAME already had a PATH and new PATH is empty, retain the prior one.
 224
 225 Promote added/changed entry to the front of the list."
 226   ;; Add or promote to the front, tracking path changes in the process.
 227   (let* ((entries (multishell-history-entries name))
 228          (path (or path "")))
 229     (dolist (entry entries)
 230       (when (string= path "")
 231         ;; Retain explicit established path.
 232         (setq path (cadr (multishell-split-entry entry))))
 233       (setq multishell-history (delete entry multishell-history)))
 234     (setq multishell-history (push (concat name path)
 235                                    multishell-history))))
 236
 237 (defun multishell-history-entries (name)
 238   "Return `multishell-history' entry that starts with NAME, or nil if none."
 239   (let ((match-expr (concat "^" name "\\\(/.*$\\\)?$"))
 240         got)
 241     (dolist (entry multishell-history)
 242       (when (and (string-match match-expr entry)
 243                  (not (member entry got)))
 244         (setq got (cons entry got))))
 245     got))
 246
 247 (defun multishell-pop-to-shell (&optional arg)
 248   "Easily navigate to and within multiple shell buffers, local and remote.
 249
 250 Use universal arguments to launch and choose between alternate
 251 shell buffers and to select which is default.  Append a path to
 252 a new shell name to launch a shell in that directory, and use
 253 Emacs tramp syntax to launch a remote shell.
 254
 255 Customize-group `multishell' to set up a key binding and tweak behaviors.
 256
 257 ==== Basic operation:
 258
 259  - If the current buffer is shell-mode (or shell-mode derived)
 260    buffer then focus is moved to the process input point.
 261
 262    \(You can use a universal argument go to a different shell
 263    buffer when already in a buffer that has a process - see
 264    below.)
 265
 266  - If not in a shell buffer (or with universal argument), go to a
 267    window that is already showing the (a) shell buffer, if any.
 268
 269    In this case, the cursor is left in its prior position in the
 270    shell buffer. Repeating the command will then go to the
 271    process input point, per the first item in this list.
 272
 273    We respect `pop-up-windows', so you can adjust it to set the
 274    other-buffer/same-buffer behavior.
 275
 276  - Otherwise, start a new shell buffer, using the current
 277    directory as the working directory.
 278
 279 If a buffer with the resulting name exists and its shell process
 280 was disconnected or otherwise stopped, it's resumed.
 281
 282 ===== Universal arg to start and select between named shell buffers:
 283
 284 You can name alternate shell buffers to create or return to using
 285 single or doubled universal arguments:
 286
 287  - With a single universal argument, prompt for the buffer name
 288    to use (without the asterisks that shell mode will put around
 289    the name), defaulting to 'shell'.
 290
 291    Completion is available.
 292
 293    This combination makes it easy to start and switch across
 294    multiple shell restarts.
 295
 296  - A double universal argument will prompt for the name *and* set
 297    the default to that name, so the target shell becomes the
 298    primary.
 299
 300    See `multishell-primary-name' for info about preserving the
 301    setting across emacs restarts.
 302
 303 ===== Select starting directory and remote host:
 304
 305 The shell buffer name you give to the prompt for a universal arg
 306 can include an appended path. That will be used for the startup
 307 directory. You can use tramp remote syntax to specify a remote
 308 shell. If there is an element after a final '/', that's used for
 309 the buffer name. Otherwise, the host, domain, or path is used.
 310
 311 For example:
 312
 313 * '#root/sudo:root@localhost:/etc' for a buffer named \"#root\" with a
 314   root shell starting in /etc.
 315
 316 * '/ssh:example.net:/' for a shell buffer in / on example.net; the buffer
 317   will be named \"*example.net*\".
 318
 319 * '#ex/ssh:example.net|sudo:root@example.net:/etc' for a root shell
 320   starting in /etc on example.net named \"*#ex*\".
 321
 322 * 'interior/ssh:gateway.corp.com|ssh:interior.corp.com:' to go
 323   via gateway.corp.com to your homedir on interior.corp.com.  The
 324   buffer will be named \"*interior*\". You could append a sudo
 325   hop to the path, combining the previous example, and so on.
 326
 327 Thanks to tramp, file visits from the shell, and many common
 328 emacs activities, like dired, will seamlessly be in the auspices
 329 of the target account, and relative to the current directory, on
 330 the host where the shell is running.
 331
 332 You can change the startup path for a shell buffer by editing it
 333 at the completion prompt. The new path will be preserved in
 334 history but will not take effect for an already-running shell.
 335
 336 To remove a shell buffer's history entry, kill the buffer and
 337 affirm removal of the entry when prompted.
 338
 339 ===== Activate savehist to retain shell buffer names and paths across Emacs restarts:
 340
 341 To have emacs maintain your history of shell buffer names and paths,
 342 customize the savehist group to activate savehist."
 343
 344   (interactive "P")
 345
 346   (let* ((from-buffer (current-buffer))
 347          (from-buffer-is-shell (derived-mode-p 'shell-mode))
 348          (doublearg (equal arg '(16)))
 349          (target-name-and-path (multishell-resolve-target-name-and-path
 350            (if arg
 351                (multishell-read-bare-shell-buffer-name
 352                 (format "Shell buffer name [%s]%s "
 353                         (substring-no-properties
 354                          multishell-primary-name
 355                          1 (- (length multishell-primary-name) 1))
 356                         (if doublearg " <==" ":"))
 357                 (multishell-unbracket-asterisks multishell-primary-name))
 358              (multishell-unbracket-asterisks multishell-primary-name))))
 359          (use-default-dir (cadr target-name-and-path))
 360          (target-shell-buffer-name (car target-name-and-path))
 361          (curr-buff-proc (get-buffer-process from-buffer))
 362          (target-buffer (if from-buffer-is-shell
 363                             from-buffer
 364                           (get-buffer target-shell-buffer-name)))
 365          inwin
 366          already-there)
 367
 368     ;; Register early so the entry is pushed to the front:
 369     (multishell-register-name-to-path (multishell-unbracket-asterisks
 370                                        target-shell-buffer-name)
 371                                       use-default-dir)
 372
 373     (when doublearg
 374       (setq multishell-primary-name target-shell-buffer-name))
 375
 376     ;; Situate:
 377
 378     (cond
 379
 380      ((and (or curr-buff-proc from-buffer-is-shell)
 381            (not arg)
 382            (eq from-buffer target-buffer)
 383            (not (eq target-shell-buffer-name (buffer-name from-buffer))))
 384       ;; In a shell buffer, but not named - stay in buffer, but go to end.
 385       (setq already-there t))
 386
 387      ((string= (buffer-name) target-shell-buffer-name)
 388       ;; Already in the specified shell buffer:
 389       (setq already-there t))
 390
 391      ((or (not target-buffer)
 392           (not (setq inwin
 393                      (multishell-get-visible-window-for-buffer target-buffer))))
 394       ;; No preexisting shell buffer, or not in a visible window:
 395       (pop-to-buffer target-shell-buffer-name pop-up-windows))
 396
 397        ;; Buffer exists and already has a window - jump to it:
 398      (t (if (and multishell-pop-to-frame
 399                  inwin
 400                  (not (equal (window-frame (selected-window))
 401                              (window-frame inwin))))
 402             (select-frame-set-input-focus (window-frame inwin)))
 403         (if (not (string= (buffer-name (current-buffer))
 404                           target-shell-buffer-name))
 405             (pop-to-buffer target-shell-buffer-name t))))
 406
 407     ;; We're in the buffer. Activate:
 408
 409     (if (not (comint-check-proc (current-buffer)))
 410         (multishell-start-shell-in-buffer (buffer-name (current-buffer))
 411                                           use-default-dir))
 412
 413     ;; If the destination buffer has a stopped process, resume it:
 414     (let ((process (get-buffer-process (current-buffer))))
 415       (if (and process (equal 'stop (process-status process)))
 416           (continue-process process)))
 417
 418     (when (or already-there
 419              (equal (current-buffer) from-buffer))
 420       (goto-char (point-max))
 421       (and (get-buffer-process from-buffer)
 422            (goto-char (process-mark (get-buffer-process from-buffer)))))))
 423
 424 (defun multishell-kill-buffer-query-function ()
 425   "Offer to remove multishell-history entry for buffer."
 426   ;; Removal choice is crucial, so users can, eg, kill a shell with huge
 427   ;; output backlog, while keeping the history entry to easily restart it.
 428   ;;
 429   ;; We use kill-buffer-query-functions instead of kill-buffer-hook because:
 430   ;;
 431   ;; 1. It enables the user to remove the history without actually killing a
 432   ;;    running buffer, by not confirming the subsequent running-proc query.
 433   ;; 2. kill-buffer-hooks often fails to run when killing shell buffers!
 434   ;;    It's probably due to failures in other hooks - beyond our control -
 435   ;;    and anyway, I like the first reason well enough.
 436
 437   ;; (Use condition-case to avoid inadvertant disruption of kill-buffer
 438   ;; activity.  kill-buffer happens behind the scenes a whole lot.)
 439   (condition-case err
 440         (dolist (entry (and (derived-mode-p 'shell-mode)
 441                           (multishell-history-entries
 442                            (multishell-unbracket-asterisks (buffer-name)))))
 443           (when (and entry
 444                      (y-or-n-p (format "Remove multishell history entry `%s'? "
 445                                        entry)))
 446             (setq multishell-history
 447                   (delete entry multishell-history))))
 448     (error
 449      (message "multishell-kill-buffer-query-function error: %s" err)))
 450   t)
 451 (add-hook 'kill-buffer-query-functions 'multishell-kill-buffer-query-function)
 452
 453 (defun multishell-get-visible-window-for-buffer (buffer)
 454   "Return visible window containing buffer."
 455   (catch 'got-a-vis
 456     (walk-windows
 457      (function (lambda (win)
 458                  (if (and (eq (window-buffer win) buffer)
 459                           (equal (frame-parameter
 460                                   (selected-frame) 'display)
 461                                  (frame-parameter
 462                                   (window-frame win) 'display)))
 463                      (throw 'got-a-vis win))))
 464      nil 'visible)
 465     nil))
 466
 467 (defun multishell-read-bare-shell-buffer-name (prompt default)
 468   "PROMPT for shell buffer name, sans asterisks.
 469
 470 Return the supplied name not bracketed with the asterisks, or specified
 471 DEFAULT on empty input."
 472   (let* ((candidates
 473           (append
 474            ;; Plain shell buffer names appended with names from name/path hist:
 475            (remq nil
 476                  (mapcar (lambda (buffer)
 477                            (let* ((name (multishell-unbracket-asterisks
 478                                          (buffer-name buffer))))
 479                              (and (buffer-live-p buffer)
 480                                   (with-current-buffer buffer
 481                                     ;; Shell mode buffers.
 482                                     (derived-mode-p 'shell-mode))
 483                                   (not (multishell-history-entries name))
 484                                   name)))
 485                          (buffer-list)))
 486            multishell-history))
 487          (got (completing-read prompt
 488                                ;; COLLECTION:
 489                                (reverse candidates)
 490                                ;; PREDICATE:
 491                                nil
 492                                ;; REQUIRE-MATCH:
 493                                'confirm
 494                                ;; INITIAL-INPUT
 495                                nil
 496                                ;; HIST:
 497                                'multishell-history)))
 498     (if (not (string= got ""))
 499         got
 500       default)))
 501
 502 (defun multishell-resolve-target-name-and-path (path-ish)
 503   "Given name/tramp-path PATH-ISH, resolve buffer name and initial directory.
 504
 505 The name is the part of the string up to the first '/' slash, if
 506 any. Missing pieces are filled in from remote path elements, if
 507 any, and multishell history. Given a path and no name, either the
 508 host-name, domain-name, final directory name, or local host name
 509 is used.
 510
 511 Return them as a list (name path), with name asterisk-bracketed
 512 and path nil if none resolved."
 513   (let* ((splat (multishell-split-entry path-ish))
 514          (name (car splat))
 515          (path (cadr splat)))
 516     (if path
 517         (if (not name)
 518             (setq name
 519                   (if (file-remote-p path)
 520                       (let ((vec (tramp-dissect-file-name path)))
 521                         (or (tramp-file-name-host vec)
 522                             (tramp-file-name-domain vec)
 523                             (tramp-file-name-localname vec)
 524                             system-name))
 525                     multishell-primary-name)))
 526       ;; No path - get one from history, if present.
 527       (when (not name)
 528         (setq name multishell-primary-name))
 529       (mapcar #'(lambda (entry)
 530                   (when (or (not path) (string= path ""))
 531                     (setq path (cadr (multishell-split-entry entry)))))
 532               (multishell-history-entries
 533                (multishell-unbracket-asterisks name))))
 534     (list (multishell-bracket-asterisks name) path)))
 535
 536 (defun multishell-bracket-asterisks (name)
 537   "Return a copy of name, ensuring it has an asterisk at the beginning and end."
 538   (if (not (string= (substring name 0 1) "*"))
 539       (setq name (concat "*" name)))
 540   (if (not (string= (substring name -1) "*"))
 541       (setq name (concat name "*")))
 542   name)
 543 (defun multishell-unbracket-asterisks (name)
 544   "Return a copy of name, removing asterisks, if any, at beginning and end."
 545   (if (string= (substring name 0 1) "*")
 546       (setq name (substring name 1)))
 547   (if (string= (substring name -1) "*")
 548       (setq name (substring name 0 -1)))
 549   name)
 550
 551 (defun multishell-start-shell-in-buffer (buffer-name path)
 552   "Ensure a shell is started, with name NAME and PATH."
 553   ;; We work around shell-mode's bracketing of the buffer name, and do
 554   ;; some tramp-mode hygiene for remote connections.
 555
 556   (let* ((buffer buffer-name)
 557          (prog (or explicit-shell-file-name
 558                    (getenv "ESHELL")
 559                    (getenv "SHELL")
 560                    "/bin/sh"))
 561          (name (file-name-nondirectory prog))
 562          (startfile (concat "~/.emacs_" name))
 563          (xargs-name (intern-soft (concat "explicit-" name "-args")))
 564          is-remote)
 565     (set-buffer buffer-name)
 566     (if (and path (not (string= path "")))
 567         (setq default-directory path))
 568     (setq is-remote (file-remote-p default-directory))
 569     (when (and is-remote
 570                (derived-mode-p 'shell-mode)
 571                (not (comint-check-proc (current-buffer))))
 572       ;; We're returning to an already established but disconnected remote
 573       ;; shell, tidy it:
 574       (tramp-cleanup-connection
 575        (tramp-dissect-file-name default-directory 'noexpand)
 576        'keep-debug 'keep-password))
 577     ;; (cd default-directory) will connect if remote:
 578     (when is-remote
 579       (message "Connecting to %s" default-directory))
 580     (condition-case err
 581         (cd default-directory)
 582       (error
 583        ;; Aargh. Need to isolate this tramp bug.
 584        (if (and (stringp (cadr err))
 585                 (string-equal (cadr err)
 586                               "Selecting deleted buffer"))
 587            (signal (car err)
 588                    (list
 589                     (format "%s, %s (\"%s\")"
 590                             "Tramp shell can fail on remote|sudo to homedir"
 591                             "please try again with an explicit path"
 592                             (cadr err))))
 593          (signal (car err)(cdr err)))))
 594     (setq buffer (set-buffer (apply 'make-comint
 595                                     (multishell-unbracket-asterisks buffer-name)
 596                                     prog
 597                                     (if (file-exists-p startfile)
 598                                         startfile)
 599                                     (if (and xargs-name
 600                                              (boundp xargs-name))
 601                                         (symbol-value xargs-name)
 602                                       '("-i")))))
 603     (shell-mode)))
 604
 605 (defun multishell-track-dirchange (name newpath)
 606   "Change multishell history entry to track current directory."
 607   (let* ((entries (multishell-history-entries name)))
 608     (dolist (entry entries)
 609       (let* ((name-path (multishell-split-entry entry))
 610              (name (car name-path))
 611              (path (cadr name-path)))
 612         (when path
 613           (let* ((is-remote (file-remote-p path))
 614                  (vec (and is-remote (tramp-dissect-file-name path nil)))
 615                  (localname (if is-remote
 616                                 (tramp-file-name-localname vec)
 617                               path))
 618                  (newlocalname
 619                   (replace-regexp-in-string (if (string= localname "")
 620                                                 "$"
 621                                               (regexp-quote localname))
 622                                             ;; REP
 623                                             newpath
 624                                             ;; STRING
 625                                             localname
 626                                             ;; FIXEDCASE
 627                                             t
 628                                             ;; LITERAL
 629                                             t
 630                                             ))
 631                  (newpath (if is-remote
 632                               (tramp-make-tramp-file-name (aref vec 0)
 633                                                           (aref vec 1)
 634                                                           (aref vec 2)
 635                                                           newlocalname
 636                                                           (aref vec 4))
 637                             newlocalname))
 638                  (newentry (concat name newpath))
 639                  (membership (member entry multishell-history)))
 640             (when membership
 641               (setcar membership newentry))))))))
 642 (defvar multishell-was-default-directory ()
 643   "Provide for tracking directory changes.")
 644 (make-variable-buffer-local 'multishell-was-default-directory)
 645 (defun multishell-post-command-business ()
 646   "Do multishell bookkeeping."
 647   ;; Update multishell-history with dir changes.
 648   (condition-case err
 649       (when (and multishell-history-entry-tracks-current-directory
 650                  (derived-mode-p 'shell-mode))
 651         (let ((curdir (if (file-remote-p default-directory)
 652                           (tramp-file-name-localname
 653                            (tramp-dissect-file-name default-directory))
 654                         default-directory)))
 655           (when (and multishell-was-default-directory
 656                      (not (string= curdir multishell-was-default-directory)))
 657             (multishell-track-dirchange (multishell-unbracket-asterisks
 658                                          (buffer-name))
 659                                         curdir))
 660           (setq multishell-was-default-directory curdir)))
 661     ;; To avoid disruption as a pervasive hook function, swallow all errors:
 662     (error
 663      (message "multishell-post-command-business error: %s" err))))
 664 (add-hook 'post-command-hook 'multishell-post-command-business)
 665
 666 (defun multishell-split-entry (entry)
 667   "Given multishell name/path ENTRY, return the separated name and path pair.
 668
 669 Returns nil for empty parts, rather than the empty string."
 670   (string-match "^\\([^/]*\\)\\(/?.*\\)?" entry)
 671   (let ((name (match-string 1 entry))
 672         (path (match-string 2 entry)))
 673     (and (string= name "") (setq name nil))
 674     (and (string= path "") (setq path nil))
 675     (list name path)))
 676
 677 (provide 'multishell)
 678
 679 ;;; multishell.el ends here