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

   1 ;;; multishell.el --- manage interaction with multiple local and remote shells
   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.5
   7 ;; Created: 1999 -- first public availability
   8 ;; Keywords: processes
   9 ;; URL: https://github.com/kenmanheimer/EmacsUtils
  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 one of your shell buffers if you're not currently in one,
  19 ;; * ... with just a keystroke.
  20 ;; * Use universal arguments to launch and choose among alternate shell buffers,
  21 ;; * ... and select which is default.
  22 ;; * Append a path to a new shell name to launch a shell in that directory,
  23 ;; * ... and use a path with Emacs tramp syntax to launch a remote shell.
  24 ;;
  25 ;;       For example:
  26 ;;
  27 ;;       * '/ssh:example.net:/' for a shell buffer in / on
  28 ;;         example.net; the buffer will be named "*example.net*".
  29 ;;
  30 ;;       * '#ex/ssh:example.net|sudo:root@example.net:/etc' for a root shell
  31 ;;         starting in /etc on example.net named "*#ex*".
  32 ;;
  33 ;; (NOTE that you can try to use, eg, '/ssh:example.net:' to get to your
  34 ;; home dir on example.net (if you had one), but that generally fails on an
  35 ;; obscure bug. Until emacs versions where that's solved, you need to use
  36 ;; an explicit path.)
  37 ;;
  38 ;; Customize-group `multishell' to select and activate a keybinding and set
  39 ;; various behaviors. Customize-group `savehist' to preserve buffer
  40 ;; names/paths across emacs sessions.
  41 ;;
  42 ;; See the `multishell-pop-to-shell' docstring for details.
  43 ;;
  44 ;;; Change Log:
  45 ;;
  46 ;; 2016-01-16 1.0.5 Ken Manheimer:
  47 ;;   - Fix - recognize and respect tramp path syntax to start in home dir
  48 ;;   - Offer to user to remove shell's history entry when buffer is killed
  49 ;;   - Fix - prevent duplicate entries for same name but different paths
  50 ;;   - Simplify history var name, migrate existing history from old name if any
  51 ;; 2016-01-06 Ken Manheimer - Released
  52 ;; 2016-01-02 Ken Manheimer - working on this in public, but not yet released.
  53 ;;
  54 ;;; TODO:
  55 ;;
  56 ;; * Isolate frequent failure with remote tramp home-dir syntax (`/host.dom:')
  57 ;; * Track the current directory in each buffer's history entry.
  58 ;; * Provide toggle to see completions buffer with just buffer names or + paths
  59
  60 ;;; Code:
  61
  62 (require 'comint)
  63 (require 'shell)
  64
  65 (defgroup multishell nil
  66   "Allout extension that highlights outline structure graphically.
  67
  68 Customize `allout-widgets-auto-activation' to activate allout-widgets
  69 with allout-mode."
  70   :group 'shell)
  71
  72 (defcustom multishell-command-key "\M- "
  73   "The key to use if `multishell-activate-command-key' is true.
  74
  75 You can instead manually bind `multishell-pop-to-shell` using emacs
  76 lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
  77   :type 'key-sequence
  78   :group 'multishell)
  79
  80 (defvar multishell--responsible-for-command-key nil
  81   "Multishell internal.")
  82 (defun multishell-activate-command-key-setter (symbol setting)
  83   "Implement `multishell-activate-command-key' choice."
  84   (set-default 'multishell-activate-command-key setting)
  85   (when (or setting multishell--responsible-for-command-key)
  86     (multishell-implement-command-key-choice (not setting))))
  87 (defun multishell-implement-command-key-choice (&optional unbind)
  88   "If settings dicate, implement binding of multishell command key.
  89
  90 If optional UNBIND is true, globally unbind the key.
  91
  92 * `multishell-activate-command-key' - Set this to get the binding or not.
  93 * `multishell-command-key' - The key to use for the binding, if appropriate."
  94   (cond (unbind
  95          (when (and (boundp 'multishell-command-key) multishell-command-key)
  96            (global-unset-key multishell-command-key)))
  97         ((not (and (boundp 'multishell-activate-command-key)
  98                    (boundp 'multishell-command-key)))
  99          nil)
 100         ((and multishell-activate-command-key multishell-command-key)
 101          (setq multishell--responsible-for-command-key t)
 102          (global-set-key multishell-command-key 'multishell-pop-to-shell))))
 103
 104 (defcustom multishell-activate-command-key nil
 105   "Set this to impose the `multishell-command-key' binding.
 106
 107 You can instead manually bind `multishell-pop-to-shell` using emacs
 108 lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
 109   :type 'boolean
 110   :set 'multishell-activate-command-key-setter
 111   :group 'multishell)
 112
 113 ;; Assert the customizations whenever the package is loaded:
 114 (with-eval-after-load "multishell"
 115   (multishell-implement-command-key-choice))
 116
 117 (defcustom multishell-pop-to-frame nil
 118   "*If non-nil, jump to a frame already showing the shell, if another is.
 119
 120 Otherwise, disregard already-open windows on the shell if they're
 121 in another frame, and open a new window on the shell in the
 122 current frame.
 123
 124 \(Use `pop-up-windows' to change multishell other-buffer vs
 125 current-buffer behavior.)"
 126   :type 'boolean
 127   :group 'multishell)
 128
 129 ;; (defcustom multishell-persist-shell-names nil
 130 ;;   "Remember shell name/path associations across sessions. Note well:
 131 ;; This will activate minibuffer history persistence, in general, if it's not
 132 ;; already active."
 133 ;;  :type 'boolean
 134 ;;  :set 'multishell-activate-persistence
 135 ;;  :group 'shell)
 136
 137 (defvar multishell-history nil
 138   "Name/path entries, most recent first.")
 139 (when (and (not multishell-history)
 140            (boundp 'multishell-buffer-name-history)
 141            multishell-buffer-name-history)
 142   ;; Migrate few users who had old var to new.
 143   (setq multishell-history multishell-buffer-name-history)
 144  )
 145
 146 (defvar multishell-primary-name "*shell*"
 147   "Shell name to use for un-modified multishell-pop-to-shell buffer target.")
 148
 149 (defun multishell-register-name-to-path (name path)
 150   "Add or replace entry associating NAME with PATH in `multishell-history'."
 151   ;; Add or promote to the front, tracking path changes in the process.
 152   (let* ((entries (multishell-history-entries name))
 153          (becomes (concat name path)))
 154     (dolist (entry entries)
 155       (setq multishell-history (delete entry multishell-history)))
 156     (setq multishell-history (push becomes multishell-history))))
 157
 158 (defun multishell-history-entries (name)
 159   "Return `multishell-history' entry that starts with NAME, or nil if none."
 160   (let ((match-expr (concat "^" name "\\\(/.*$\\\)?"))
 161         got)
 162     (dolist (entry multishell-history)
 163       (when (and (string-match match-expr entry)
 164                  (not (member entry got)))
 165         (setq got (cons entry got))))
 166     got))
 167
 168 (defun multishell-pop-to-shell (&optional arg)
 169   "Easily navigate to and within multiple shell buffers, local and remote.
 170
 171 Use universal arguments to launch and choose between alternate
 172 shell buffers and to select which is default.  Append a path to
 173 a new shell name to launch a shell in that directory, and use
 174 Emacs tramp syntax to launch a remote shell.
 175
 176 Customize-group `multishell' to set up a key binding and tweak behaviors.
 177
 178 ==== Basic operation:
 179
 180  - If the current buffer is shell-mode (or shell-mode derived)
 181    buffer then focus is moved to the process input point.
 182
 183    \(You can use a universal argument go to a different shell
 184    buffer when already in a buffer that has a process - see
 185    below.)
 186
 187  - If not in a shell buffer (or with universal argument), go to a
 188    window that is already showing the (a) shell buffer, if any.
 189
 190    In this case, the cursor is left in its prior position in the
 191    shell buffer. Repeating the command will then go to the
 192    process input point, per the first item in this list.
 193
 194    We respect `pop-up-windows', so you can adjust it to set the
 195    other-buffer/same-buffer behavior.
 196
 197  - Otherwise, start a new shell buffer, using the current
 198    directory as the working directory.
 199
 200 If a buffer with the resulting name exists and its shell process
 201 was disconnected or otherwise stopped, it's resumed.
 202
 203 ===== Universal arg to start and select between named shell buffers:
 204
 205 You can name alternate shell buffers to create or return to using
 206 single or doubled universal arguments:
 207
 208  - With a single universal argument, prompt for the buffer name
 209    to use (without the asterisks that shell mode will put around
 210    the name), defaulting to 'shell'.
 211
 212    Completion is available.
 213
 214    This combination makes it easy to start and switch between
 215    multiple shell buffers.
 216
 217  - A double universal argument will prompt for the name *and* set
 218    the default to that name, so the target shell becomes the
 219    primary.
 220
 221 ===== Select starting directory and remote host:
 222
 223 The shell buffer name you give to the prompt for a universal arg
 224 can include an appended path. That will be used for the startup
 225 directory. You can use tramp remote syntax to specify a remote
 226 shell. If there is an element after a final '/', that's used for
 227 the buffer name. Otherwise, the host, domain, or path is used.
 228
 229 For example:
 230
 231 * Use '/ssh:example.net:/home/myaccount' for a shell buffer in
 232   /home/myaccount on example.net; the buffer will be named
 233   \"*example.net*\".
 234 * '\#ex/ssh:example.net|sudo:root@example.net:/etc' for a root
 235   shell in /etc on example.net named \"*#ex*\".
 236
 237 \(NOTE that you can specify a remote homedir using tramp syntax,
 238 eg '/ssh:example.net:'. However that generally fails on an
 239 obscure bug. Until emacs versions where that's solved, you avoid
 240 that by using an explicit path.)
 241
 242 You can change the startup path for a shell buffer by editing it
 243 at the completion prompt. The new path will be preserved in
 244 history but will not take effect for an already-running shell.
 245
 246 To remove a shell buffer's history entry, kill the buffer and
 247 affirm removal of the entry when prompted.
 248
 249 ===== Activate savehist to persisting your shell buffer names and paths:
 250
 251 To have emacs maintain your history of shell buffer names and paths,
 252 customize the savehist group to activate savehist."
 253
 254   (interactive "P")
 255
 256   (let* ((from-buffer (current-buffer))
 257          (from-buffer-is-shell (derived-mode-p 'shell-mode))
 258          (doublearg (equal arg '(16)))
 259          (target-name-and-path
 260           (multishell-derive-target-name-and-path
 261            (if arg
 262                (multishell-read-bare-shell-buffer-name
 263                 (format "Shell buffer name [%s]%s "
 264                         (substring-no-properties
 265                          multishell-primary-name
 266                          1 (- (length multishell-primary-name) 1))
 267                         (if doublearg " <==" ":"))
 268                 multishell-primary-name)
 269              multishell-primary-name)))
 270          (use-default-dir (cadr target-name-and-path))
 271          (target-shell-buffer-name (car target-name-and-path))
 272          (curr-buff-proc (get-buffer-process from-buffer))
 273          (target-buffer (if from-buffer-is-shell
 274                             from-buffer
 275                           (let ((got (get-buffer target-shell-buffer-name)))
 276                             (if (buffer-live-p got)
 277                                 got
 278                               (kill-buffer got)
 279                               (get-buffer target-shell-buffer-name)))))
 280          inwin
 281          already-there)
 282
 283     (when doublearg
 284       (setq multishell-primary-name target-shell-buffer-name))
 285
 286     ;; Situate:
 287
 288     (cond
 289
 290      ((and (or curr-buff-proc from-buffer-is-shell)
 291            (not arg)
 292            (eq from-buffer target-buffer)
 293            (not (eq target-shell-buffer-name (buffer-name from-buffer))))
 294       ;; In a shell buffer, but not named - stay in buffer, but go to end.
 295       (setq already-there t))
 296
 297      ((string= (buffer-name) target-shell-buffer-name)
 298       ;; Already in the specified shell buffer:
 299       (setq already-there t))
 300
 301      ((or (not target-buffer)
 302           (not (setq inwin
 303                      (multishell-get-visible-window-for-buffer target-buffer))))
 304       ;; No preexisting shell buffer, or not in a visible window:
 305       (pop-to-buffer target-shell-buffer-name pop-up-windows))
 306
 307        ;; Buffer exists and already has a window - jump to it:
 308      (t (if (and multishell-pop-to-frame
 309                  inwin
 310                  (not (equal (window-frame (selected-window))
 311                              (window-frame inwin))))
 312             (select-frame-set-input-focus (window-frame inwin)))
 313         (if (not (string= (buffer-name (current-buffer))
 314                           target-shell-buffer-name))
 315             (pop-to-buffer target-shell-buffer-name t))))
 316
 317     ;; We're in the buffer. Activate:
 318
 319     (cond ((not (comint-check-proc (current-buffer)))
 320            (multishell-start-shell-in-buffer (buffer-name (current-buffer))
 321                                              use-default-dir))
 322           (use-default-dir
 323            (cd use-default-dir)))
 324
 325     ;; If the destination buffer has a stopped process, resume it:
 326     (let ((process (get-buffer-process (current-buffer))))
 327       (if (and process (equal 'stop (process-status process)))
 328           (continue-process process)))
 329     (multishell-register-name-to-path (multishell-unbracket-asterisks
 330                                        target-shell-buffer-name)
 331                                       use-default-dir)
 332     (when (or already-there
 333              (equal (current-buffer) from-buffer))
 334       (goto-char (point-max))
 335       (and (get-buffer-process from-buffer)
 336            (goto-char (process-mark (get-buffer-process from-buffer)))))))
 337
 338 (defun multishell-kill-buffer-query-function ()
 339   "Offer to remove multishell-history entry for buffer."
 340   ;; Removal choice is crucial, so users can, eg, kill and a runaway shell
 341   ;; and keep the history entry to easily restart it.
 342   ;;
 343   ;; We use kill-buffer-query-functions instead of kill-buffer-hook because:
 344   ;;
 345   ;; 1. It enables the user to remove the history without killing the buffer,
 346   ;;    by cancelling the kill-buffer process after affirming history removal.
 347   ;; 2. kill-buffer-hooks often fails to run when killing shell buffers!
 348   ;;    I've failed to resolve that, and like the first reason well enough.
 349
 350   ;; (Use condition-case to avoid inadvertant disruption of kill-buffer
 351   ;; activity.  kill-buffer happens behind the scenes a whole lot.)
 352   (condition-case anyerr
 353       (let ((entries (and (derived-mode-p 'shell-mode)
 354                           (multishell-history-entries
 355                            (multishell-unbracket-asterisks (buffer-name))))))
 356         (dolist (entry entries)
 357           (when (and entry
 358                      (y-or-n-p (format "Remove multishell history entry `%s'? "
 359                                        entry)))
 360             (setq multishell-history
 361                   (delete entry multishell-history)))))
 362     (error nil))
 363   t)
 364 (add-hook 'kill-buffer-query-functions 'multishell-kill-buffer-query-function)
 365
 366 (defun multishell-get-visible-window-for-buffer (buffer)
 367   "Return visible window containing buffer."
 368   (catch 'got-a-vis
 369     (walk-windows
 370      (function (lambda (win)
 371                  (if (and (eq (window-buffer win) buffer)
 372                           (equal (frame-parameter
 373                                   (selected-frame) 'display)
 374                                  (frame-parameter
 375                                   (window-frame win) 'display)))
 376                      (throw 'got-a-vis win))))
 377      nil 'visible)
 378     nil))
 379
 380 (defun multishell-read-bare-shell-buffer-name (prompt default)
 381   "PROMPT for shell buffer name, sans asterisks.
 382
 383 Return the supplied name bracketed with the asterisks, or specified DEFAULT
 384 on empty input."
 385   (let* ((candidates
 386           (append
 387            ;; Plain shell buffer names appended with names from name/path hist:
 388            (remq nil
 389                  (mapcar (lambda (buffer)
 390                            (let* ((name (multishell-unbracket-asterisks
 391                                          (buffer-name buffer))))
 392                              (and (buffer-live-p buffer)
 393                                   (with-current-buffer buffer
 394                                     ;; Shell mode buffers.
 395                                     (derived-mode-p 'shell-mode))
 396                                   (not (multishell-history-entries name))
 397                                   name)))
 398                          (buffer-list)))
 399            multishell-history))
 400          (got (completing-read prompt
 401                                ;; COLLECTION:
 402                                (reverse candidates)
 403                                ;; PREDICATE:
 404                                nil
 405                                ;; REQUIRE-MATCH:
 406                                'confirm
 407                                ;; INITIAL-INPUT
 408                                nil
 409                                ;; HIST:
 410                                'multishell-history)))
 411     (if (not (string= got ""))
 412         (multishell-bracket-asterisks got)
 413       default)))
 414
 415 (defun multishell-derive-target-name-and-path (path-ish)
 416   "Give tramp-style PATH-ISH, determine target name and default directory.
 417
 418 The name is the part of the string before the initial '/' slash,
 419 if any. Otherwise, it's either the host-name, domain-name, final
 420 directory name, or local host name. The path is everything
 421 besides the string before the initial '/' slash.
 422
 423 Return them as a list (name dir), with dir nil if none given."
 424   (let (name (path "") dir)
 425     (cond ((string= path-ish "") (setq dir multishell-primary-name))
 426           ((string-match "^\\*\\([^/]*\\)\\(/.*\\)\\*" path-ish)
 427            ;; We have a path, use it
 428            (let ((overt-name (match-string 1 path-ish)))
 429              (setq path (match-string 2 path-ish))
 430              (if (string= overt-name "") (setq overt-name nil))
 431              (if (string= path "") (setq path nil))
 432              (setq name
 433                    (multishell-bracket-asterisks
 434                     (or overt-name
 435                         (if (file-remote-p path)
 436                             (let ((vec (tramp-dissect-file-name path)))
 437                               (or (tramp-file-name-host vec)
 438                                   (tramp-file-name-domain vec)
 439                                   (tramp-file-name-localname vec)
 440                                   system-name))
 441                           (multishell-unbracket-asterisks
 442                            multishell-primary-name)))))))
 443           (t (setq name (multishell-bracket-asterisks path-ish))))
 444     (list name path)))
 445
 446 (defun multishell-bracket-asterisks (name)
 447   "Return a copy of name, ensuring it has an asterisk at the beginning and end."
 448   (if (not (string= (substring name 0 1) "*"))
 449       (setq name (concat "*" name)))
 450   (if (not (string= (substring name -1) "*"))
 451       (setq name (concat name "*")))
 452   name)
 453 (defun multishell-unbracket-asterisks (name)
 454   "Return a copy of name, removing asterisks, if any, at beginning and end."
 455   (if (string= (substring name 0 1) "*")
 456       (setq name (substring name 1)))
 457   (if (string= (substring name -1) "*")
 458       (setq name (substring name 0 -1)))
 459   name)
 460
 461 (defun multishell-start-shell-in-buffer (buffer-name path)
 462   "Ensure a shell is started, with name NAME and PATH."
 463   ;; We work around shell-mode's bracketing of the buffer name, and do
 464   ;; some tramp-mode hygiene for remote connections.
 465
 466   (let* ((buffer buffer-name)
 467          (prog (or explicit-shell-file-name
 468                    (getenv "ESHELL")
 469                    (getenv "SHELL")
 470                    "/bin/sh"))
 471          (name (file-name-nondirectory prog))
 472          (startfile (concat "~/.emacs_" name))
 473          (xargs-name (intern-soft (concat "explicit-" name "-args")))
 474          is-remote)
 475     (set-buffer buffer-name)
 476     (if (and path (not (string= path "")))
 477         (setq default-directory path))
 478     (setq is-remote (file-remote-p default-directory))
 479     (when (and is-remote
 480                (derived-mode-p 'shell-mode)
 481                (not (comint-check-proc (current-buffer))))
 482       ;; We're returning to an already established but disconnected remote
 483       ;; shell, tidy it:
 484       (tramp-cleanup-connection
 485        (tramp-dissect-file-name default-directory 'noexpand)
 486        'keep-debug 'keep-password))
 487     ;; (cd default-directory) will connect if remote:
 488     (when is-remote
 489       (message "Connecting to %s" default-directory))
 490     (condition-case err
 491         (cd default-directory)
 492       (error
 493        ;; Aargh. Need to isolate this tramp bug.
 494        (when (and (stringp (cadr err))
 495                   (string-equal (cadr err)
 496                                 "Selecting deleted buffer"))
 497          (signal (car err)
 498                  (list
 499                   (format "Tramp shell may fail with homedir paths, %s (\"%s\")"
 500                           "please try with an explicit path"
 501                           (cadr err)))))))
 502     (setq buffer (set-buffer (apply 'make-comint
 503                                     (multishell-unbracket-asterisks buffer-name)
 504                                     prog
 505                                     (if (file-exists-p startfile)
 506                                         startfile)
 507                                     (if (and xargs-name
 508                                              (boundp xargs-name))
 509                                         (symbol-value xargs-name)
 510                                       '("-i")))))
 511     (shell-mode)))
 512
 513 (provide 'multishell)
 514
 515 ;;; multishell.el ends here