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