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