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