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