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