code.delx.au - gnu-emacs-elpa/blob - packages/multishell/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: 0
   7 ;; Created: 1999 -- first public availability
   8 ;; Keywords: processes
   9 ;; URL: https://github.com/kenmanheimer/EmacsUtils
  10 ;;
  11 ;;; Commentary:
  12 ;;
  13 ;; Easily use and manage multiple shell buffers, including remote shells.
  14 ;; Fundamentally, multishell is the function `multishell-pop-to-shell' -
  15 ;; akin to `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 a shell buffer if you're not currently in one.
  19 ;; * Use universal arguments to launch and choose among alternate shell buffers,
  20 ;; * ... and select which is default.
  21 ;; * Prepend a path to a new shell name to launch a shell in that directory,
  22 ;; * ... and use a path with Emacs tramp syntax to launch a remote shell.
  23 ;;
  24 ;; Customize-group `multishell` to select and activate a keybinding and set
  25 ;; various behaviors.
  26 ;;
  27 ;; See the multishell-pop-to-shell docstring for details.
  28 ;;
  29 ;;; Change Log:
  30 ;;
  31 ;; 2016-01-02 Ken Manheimer - initial release
  32 ;;
  33 ;;; TODO:
  34 ;;
  35 ;; * Preserveable (savehist) history that associates names with paths
  36 ;;   - Using an association list between names and paths
  37 ;;   - Searched for search backwards/forwards on isearch-like M-r/M-s bindings
  38 ;;     - *Not* searched for regular completion
  39 ;;   - Editible
  40 ;;     - Using isearch keybinding M-e
  41 ;;     - Edits path
  42 ;;     - New association overrides previous
  43 ;;     - Deleting path removes association and history entry
  44 ;; * Customize activation of savehist
  45 ;;   - Customize entry has warning about activating savehist
  46 ;;   - Adds the name/path association list to savehist-additional-variables
  47 ;;   - Activates savehist, if inactive
  48
  49 ;;; Code:
  50
  51 (defvar non-interactive-process-buffers '("*compilation*" "*grep*"))
  52
  53 (require 'comint)
  54 (require 'shell)
  55
  56 (defgroup multishell nil
  57   "Allout extension that highlights outline structure graphically.
  58
  59 Customize `allout-widgets-auto-activation' to activate allout-widgets
  60 with allout-mode."
  61   :group 'shell)
  62
  63 (defcustom multishell-non-interactive-process-buffers
  64   '("*compilation*" "*grep*")
  65   "Names of buffers that have processes but are not for interaction.
  66 Identify buffers that you don't want to be multishell-pop-to-shell \"sticky\"."
  67   :type '(repeat string)
  68   :group 'multishell)
  69 (defcustom multishell-command-key "\M- "
  70   "The key to use if `multishell-activate-command-key' is true.
  71
  72 You can instead bind `multishell-pop-to-shell` to your preferred key using
  73 emacs lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
  74   :type 'key-sequence
  75   :group 'multishell)
  76
  77 (defvar multishell-responsible-for-command-key nil
  78   "Multishell internal.")
  79 (defun multishell-activate-command-key-setter (symbol setting)
  80   "Implement `multishell-activate-command-key' choice."
  81   (set-default 'multishell-activate-command-key setting)
  82   (when (or setting multishell-responsible-for-command-key)
  83     (multishell-implement-command-key-choice (not setting))))
  84 (defun multishell-implement-command-key-choice (&optional unbind)
  85   "If settings dicate, implement binding of multishell command key.
  86
  87 If optional UNBIND is true, globally unbind the key.
  88
  89 * `multishell-activate-command-key' - Set this to get the binding or not.
  90 * `multishell-command-key' - The key to use for the binding, if appropriate."
  91   (cond (unbind
  92          (when (and (boundp 'multishell-command-key) multishell-command-key)
  93            (global-unset-key multishell-command-key)))
  94         ((not (and (boundp 'multishell-activate-command-key)
  95                    (boundp 'multishell-command-key)))
  96          nil)
  97         ((and multishell-activate-command-key multishell-command-key)
  98          (setq multishell-responsible-for-command-key t)
  99          (global-set-key multishell-command-key 'multishell-pop-to-shell))))
 100
 101 (defcustom multishell-activate-command-key nil
 102   "Set this to impose the `multishell-command-key' binding.
 103
 104 You can instead bind `multishell-pop-to-shell` to your preferred key using
 105 emacs lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
 106   :type 'boolean
 107   :set 'multishell-activate-command-key-setter
 108   :group 'multishell)
 109
 110 ;; Assert the customizations whenever the package is loaded:
 111 (with-eval-after-load "multishell"
 112   (multishell-implement-command-key-choice))
 113
 114 (defcustom multishell-pop-to-frame nil
 115   "*If non-nil, jump to a frame already showing the shell, if another is.
 116
 117 Otherwise, open a new window in the current frame.
 118
 119 \(Adjust `pop-up-windows' to change other-buffer vs current-buffer behavior.)"
 120   :type 'boolean
 121   :group 'multishell)
 122
 123 ;; (defcustom multishell-persist-shell-names nil
 124 ;;   "Remember shell name/path associations across sessions. Note well:
 125 ;; This will activate minibuffer history persistence, in general, if it's not
 126 ;; already active."
 127 ;;   :type 'boolean
 128 ;;  :group 'shell)
 129
 130 (defvar multishell-name-path-assoc nil
 131   "Assoc list from name to path")
 132
 133 (defvar multishell-primary-name "*shell*"
 134   "Shell name to use for un-modified `multishell-pop-to-shell' buffer target.")
 135 (defvar multishell-buffer-name-history nil
 136   "Distinct `multishell-pop-to-shell' completion history container.")
 137
 138 (defun multishell-pop-to-shell (&optional arg)
 139   "Easily navigate to and within multiple shell buffers, local and remote.
 140
 141 Use universal arguments to launch and choose between alternate
 142 shell buffers and to select which is default.  Prepend a path to
 143 a new shell name to launch a shell in that directory, and use
 144 Emacs tramp syntax to launch a remote shell.
 145
 146 Customize-group `multishell' to set up a key binding and tweak behaviors.
 147
 148 ==== Basic operation:
 149
 150  - If the current buffer is associated with a subprocess (that is
 151    not among those named on `non-interactive-process-buffers'),
 152    then focus is moved to the process input point.
 153
 154    \(You can use a universal argument go to a different shell
 155    buffer when already in a buffer that has a process - see
 156    below.)
 157
 158  - If not in a shell buffer (or with universal argument), go to a
 159    window that is already showing the (a) shell buffer, if any.
 160
 161    In this case, the cursor is left in its prior position in the
 162    shell buffer. Repeating the command will then go to the
 163    process input point, per the first item in this list.
 164
 165    We respect `pop-up-windows', so you can adjust it to set the
 166    other-buffer/same-buffer behavior.
 167
 168  - Otherwise, start a new shell buffer, using the current
 169    directory as the working directory.
 170
 171 If a buffer with the resulting name exists and its shell process
 172 was disconnected or otherwise stopped, it's resumed.
 173
 174 ===== Universal arg to start and select between named shell buffers:
 175
 176 You can name alternate shell buffers to create or return to using
 177 single or doubled universal arguments:
 178
 179  - With a single universal argument, prompt for the buffer name
 180    to use (without the asterisks that shell mode will put around
 181    the name), defaulting to 'shell'.
 182
 183    Completion is available.
 184
 185    This combination makes it easy to start and switch between
 186    multiple shell buffers.
 187
 188  - A double universal argument will prompt for the name *and* set
 189    the default to that name, so the target shell becomes the
 190    primary.
 191
 192 ===== Select starting directory and remote host:
 193
 194 The shell buffer name you give to the prompt for a universal arg
 195 can include a preceding path. That will be used for the startup
 196 directory. You can use tramp remote syntax to specify a remote
 197 shell. If there is an element after a final '/', that's used for
 198 the buffer name. Otherwise, the host, domain, or path is used.
 199
 200 For example:
 201
 202 * Use '/ssh:example.net:/' for a shell buffer on example.net named
 203   \"example.net\".
 204 * '/ssh:example.net|sudo:root@example.net:/\#ex' for a root shell on
 205   example.net named \"#ex\"."
 206
 207 ;; I'm leaving the following out of the docstring for now because just
 208 ;; saving the buffer names, and not the paths, yields sometimes unwanted
 209 ;; behavior.
 210
 211 ;; ===== Persisting your alternate shell buffer names and paths:
 212
 213 ;; You can use emacs builtin SaveHist to preserve your alternate
 214 ;; shell buffer names and paths across emacs sessions. To do so,
 215 ;; customize the `savehist' group, and:
 216
 217 ;; 1. Add `multishell-pop-to-shell-buffer-name-history' to Savehist Additional
 218 ;;    Variables.
 219 ;; 2. Activate Savehist Mode, if not already activated.
 220 ;; 3. Save.
 221
 222   (interactive "P")
 223
 224   (let* ((from-buffer (current-buffer))
 225          (from-buffer-is-shell (eq major-mode 'shell-mode))
 226          (doublearg (equal arg '(16)))
 227          (temp (if arg
 228                    (multishell-read-bare-shell-buffer-name
 229                     (format "Shell buffer name [%s]%s "
 230                             (substring-no-properties
 231                              multishell-primary-name
 232                              1 (- (length multishell-primary-name) 1))
 233                             (if doublearg " <==" ":"))
 234                     multishell-primary-name)
 235                  multishell-primary-name))
 236          use-default-dir
 237          (target-shell-buffer-name
 238           ;; Derive target name, and default-dir if any, from temp.
 239           (cond ((string= temp "") multishell-primary-name)
 240                 ((string-match "^\\*\\(/.*/\\)\\(.*\\)\\*" temp)
 241                  (setq use-default-dir (match-string 1 temp))
 242                  (multishell-bracket-asterisks
 243                   (if (string= (match-string 2 temp) "")
 244                       (let ((v (tramp-dissect-file-name
 245                                 use-default-dir)))
 246                         (or (tramp-file-name-host v)
 247                             (tramp-file-name-domain v)
 248                             (tramp-file-name-localname v)
 249                             use-default-dir))
 250                     (match-string 2 temp))))
 251                 (t (multishell-bracket-asterisks temp))))
 252          (curr-buff-proc (get-buffer-process from-buffer))
 253          (target-buffer (if (and (or curr-buff-proc from-buffer-is-shell)
 254                                  (not (member (buffer-name from-buffer)
 255                                               non-interactive-process-buffers)))
 256                             from-buffer
 257                           (get-buffer target-shell-buffer-name)))
 258          inwin
 259          already-there)
 260
 261     (when doublearg
 262       (setq multishell-primary-name target-shell-buffer-name))
 263
 264     ;; Situate:
 265
 266     (cond
 267
 268      ((and (or curr-buff-proc from-buffer-is-shell)
 269            (not arg)
 270            (eq from-buffer target-buffer)
 271            (not (eq target-shell-buffer-name (buffer-name from-buffer))))
 272       ;; In a shell buffer, but not named - stay in buffer, but go to end.
 273       (setq already-there t))
 274
 275      ((string= (buffer-name) target-shell-buffer-name)
 276       ;; Already in the specified shell buffer:
 277       (setq already-there t))
 278
 279      ((or (not target-buffer)
 280           (not (setq inwin
 281                      (multishell-get-visible-window-for-buffer target-buffer))))
 282       ;; No preexisting shell buffer, or not in a visible window:
 283       (pop-to-buffer target-shell-buffer-name pop-up-windows))
 284
 285        ;; Buffer exists and already has a window - jump to it:
 286      (t (if (and multishell-pop-to-frame
 287                  inwin
 288                  (not (equal (window-frame (selected-window))
 289                              (window-frame inwin))))
 290             (select-frame-set-input-focus (window-frame inwin)))
 291         (if (not (string= (buffer-name (current-buffer))
 292                           target-shell-buffer-name))
 293             (pop-to-buffer target-shell-buffer-name t))))
 294
 295     ;; We're in the buffer. Activate:
 296
 297     (cond ((not (comint-check-proc (current-buffer)))
 298            (multishell-start-shell-in-buffer (buffer-name (current-buffer))
 299                                              use-default-dir))
 300           (use-default-dir
 301            (cd use-default-dir)))
 302
 303     ;; If the destination buffer has a stopped process, resume it:
 304     (let ((process (get-buffer-process (current-buffer))))
 305       (if (and process (equal 'stop (process-status process)))
 306           (continue-process process)))
 307     (when (or already-there
 308              (equal (current-buffer) from-buffer))
 309       (goto-char (point-max))
 310       (and (get-buffer-process from-buffer)
 311            (goto-char (process-mark (get-buffer-process from-buffer)))))))
 312
 313 (defun multishell-get-visible-window-for-buffer (buffer)
 314   "Return visible window containing buffer."
 315   (catch 'got-a-vis
 316     (walk-windows
 317      (function (lambda (win)
 318                  (if (and (eq (window-buffer win) buffer)
 319                           (equal (frame-parameter
 320                                   (selected-frame) 'display)
 321                                  (frame-parameter
 322                                   (window-frame win) 'display)))
 323                      (throw 'got-a-vis win))))
 324      nil 'visible)
 325     nil))
 326
 327 (defun multishell-read-bare-shell-buffer-name (prompt default)
 328   "PROMPT for shell buffer name, sans asterisks.
 329
 330 Return the supplied name bracketed with the asterisks, or specified DEFAULT
 331 on empty input."
 332   (let* ((candidates (append
 333                       (remq nil
 334                             (mapcar (lambda (buffer)
 335                                       (let ((name (buffer-name buffer)))
 336                                         (if (with-current-buffer buffer
 337                                               (eq major-mode 'shell-mode))
 338                                             ;; Shell mode buffers.
 339                                             (if (> (length name) 2)
 340                                                 ;; Strip asterisks.
 341                                                 (substring name 1
 342                                                            (1- (length name)))
 343                                               name))))
 344                                     (buffer-list)))))
 345          (got (completing-read prompt
 346                                candidates ; COLLECTION
 347                                nil        ; PREDICATE
 348                                'confirm   ; REQUIRE-MATCH
 349                                nil        ; INITIAL-INPUT
 350                                'multishell-buffer-name-history ; HIST
 351                                )))
 352     (if (not (string= got "")) (multishell-bracket-asterisks got) default)))
 353
 354 (defun multishell-bracket-asterisks (name)
 355   "Return a copy of name, ensuring it has an asterisk at the beginning and end."
 356   (if (not (string= (substring name 0 1) "*"))
 357       (setq name (concat "*" name)))
 358   (if (not (string= (substring name -1) "*"))
 359       (setq name (concat name "*")))
 360   name)
 361 (defun multishell-unbracket-asterisks (name)
 362   "Return a copy of name, removing asterisks, if any, at beginning and end."
 363   (if (string= (substring name 0 1) "*")
 364       (setq name (substring name 1)))
 365   (if (string= (substring name -1) "*")
 366       (setq name (substring name 0 -1)))
 367   name)
 368 (defun multishell-start-shell-in-buffer (buffer-name dir)
 369   "Ensure a shell is started, using whatever name we're passed."
 370   ;; We work around shell-mode's bracketing of the buffer name, and do
 371   ;; some tramp-mode hygiene for remote connections.
 372
 373   (let* ((buffer buffer-name)
 374          (prog (or explicit-shell-file-name
 375                    (getenv "ESHELL")
 376                    (getenv "SHELL")
 377                    "/bin/sh"))
 378          (name (file-name-nondirectory prog))
 379          (startfile (concat "~/.emacs_" name))
 380          (xargs-name (intern-soft (concat "explicit-" name "-args"))))
 381     (set-buffer buffer-name)
 382     (when (and (file-remote-p default-directory)
 383                (eq major-mode 'shell-mode)
 384                (not (comint-check-proc (current-buffer))))
 385       ;; We're returning to an already established but disconnected remote
 386       ;; shell, tidy it:
 387       (tramp-cleanup-connection
 388        (tramp-dissect-file-name default-directory 'noexpand)
 389        'keep-debug 'keep-password))
 390     (if dir
 391         (cd dir))
 392     (setq buffer (set-buffer (apply 'make-comint
 393                                     (multishell-unbracket-asterisks buffer-name)
 394                                     prog
 395                                     (if (file-exists-p startfile)
 396                                         startfile)
 397                                     (if (and xargs-name
 398                                              (boundp xargs-name))
 399                                         (symbol-value xargs-name)
 400                                       '("-i")))))
 401     (shell-mode)))
 402
 403 (provide 'multishell)
 404
 405 ;;; multishell.el ends here