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.3
   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 ;; * Append 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 - working on this in public, but not yet released.
  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 Identify which buffers you don't want to be multishell-pop-to-shell \"sticky\"."
  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 manually bind `multishell-pop-to-shell` using emacs
  78 lisp, eg: (global-set-key \"\\M- \" 'multishell-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 'multishell-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 manually bind `multishell-pop-to-shell` using emacs
 110 lisp, eg: (global-set-key \"\\M- \" 'multishell-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, disregard already-open windows on the shell if they're
 123 in another frame, and open a new window on the shell in the
 124 current frame.
 125
 126 \(Use `pop-up-windows' to change multishell other-buffer vs
 127 current-buffer behavior.)"
 128   :type 'boolean
 129   :group 'multishell)
 130
 131 ;; (defcustom multishell-persist-shell-names nil
 132 ;;   "Remember shell name/path associations across sessions. Note well:
 133 ;; This will activate minibuffer history persistence, in general, if it's not
 134 ;; already active."
 135 ;;   :type 'boolean
 136 ;;  :group 'shell)
 137
 138 (defvar multishell-name-path-assoc nil
 139   "Assoc list from name to path")
 140
 141 (defvar multishell-primary-name "*shell*"
 142   "Shell name to use for un-modified multishell-pop-to-shell buffer target.")
 143 (defvar multishell-buffer-name-history nil
 144   "Distinct multishell-pop-to-shell completion history container.")
 145 (defvar multishell-buffer-name-path-history nil
 146   "Another multishell-pop-to-shell completion history container,
 147 including paths.")
 148
 149 (defun multishell-pop-to-shell (&optional arg)
 150   "Easily navigate to and within multiple shell buffers, local and remote.
 151
 152 Use universal arguments to launch and choose between alternate
 153 shell buffers and to select which is default.  Append a path to
 154 a new shell name to launch a shell in that directory, and use
 155 Emacs tramp syntax to launch a remote shell.
 156
 157 Customize-group `multishell' to set up a key binding and tweak behaviors.
 158
 159 ==== Basic operation:
 160
 161  - If the current buffer is associated with a subprocess (that is
 162    not among those named on `non-interactive-process-buffers'),
 163    then focus is moved to the process input point.
 164
 165    \(You can use a universal argument go to a different shell
 166    buffer when already in a buffer that has a process - see
 167    below.)
 168
 169  - If not in a shell buffer (or with universal argument), go to a
 170    window that is already showing the (a) shell buffer, if any.
 171
 172    In this case, the cursor is left in its prior position in the
 173    shell buffer. Repeating the command will then go to the
 174    process input point, per the first item in this list.
 175
 176    We respect `pop-up-windows', so you can adjust it to set the
 177    other-buffer/same-buffer behavior.
 178
 179  - Otherwise, start a new shell buffer, using the current
 180    directory as the working directory.
 181
 182 If a buffer with the resulting name exists and its shell process
 183 was disconnected or otherwise stopped, it's resumed.
 184
 185 ===== Universal arg to start and select between named shell buffers:
 186
 187 You can name alternate shell buffers to create or return to using
 188 single or doubled universal arguments:
 189
 190  - With a single universal argument, prompt for the buffer name
 191    to use (without the asterisks that shell mode will put around
 192    the name), defaulting to 'shell'.
 193
 194    Completion is available.
 195
 196    This combination makes it easy to start and switch between
 197    multiple shell buffers.
 198
 199  - A double universal argument will prompt for the name *and* set
 200    the default to that name, so the target shell becomes the
 201    primary.
 202
 203 ===== Select starting directory and remote host:
 204
 205 The shell buffer name you give to the prompt for a universal arg
 206 can include an appended path. That will be used for the startup
 207 directory. You can use tramp remote syntax to specify a remote
 208 shell. If there is an element after a final '/', that's used for
 209 the buffer name. Otherwise, the host, domain, or path is used.
 210
 211 For example:
 212
 213 * Use '/ssh:example.net:/' for a shell buffer on example.net named
 214   \"example.net\".
 215 * '\#ex/ssh:example.net|sudo:root@example.net:/' for a root shell on
 216   example.net named \"#ex\"."
 217
 218 ;; I'm leaving the following out of the docstring for now because just
 219 ;; saving the buffer names, and not the paths, yields sometimes unwanted
 220 ;; behavior.
 221
 222 ;; ===== Persisting your alternate shell buffer names and paths:
 223
 224 ;; You can use emacs builtin SaveHist to preserve your alternate
 225 ;; shell buffer names and paths across emacs sessions. To do so,
 226 ;; customize the `savehist' group, and:
 227
 228 ;; 1. Add `multishell-pop-to-shell-buffer-name-history' to Savehist Additional
 229 ;;    Variables.
 230 ;; 2. Activate Savehist Mode, if not already activated.
 231 ;; 3. Save.
 232
 233   (interactive "P")
 234
 235   (let* ((from-buffer (current-buffer))
 236          (from-buffer-is-shell (eq major-mode 'shell-mode))
 237          (doublearg (equal arg '(16)))
 238          (target-name-and-path
 239           (multishell-derive-target-name-and-path
 240            (if arg
 241                (multishell-read-bare-shell-buffer-name
 242                 (format "Shell buffer name [%s]%s "
 243                         (substring-no-properties
 244                          multishell-primary-name
 245                          1 (- (length multishell-primary-name) 1))
 246                         (if doublearg " <==" ":"))
 247                 multishell-primary-name)
 248              multishell-primary-name)))
 249          (use-default-dir (cadr target-name-and-path))
 250          (target-shell-buffer-name (car target-name-and-path))
 251          (curr-buff-proc (get-buffer-process from-buffer))
 252          (target-buffer (if (and (or curr-buff-proc from-buffer-is-shell)
 253                                  (not (member (buffer-name from-buffer)
 254                                               non-interactive-process-buffers)))
 255                             from-buffer
 256                           (get-buffer target-shell-buffer-name)))
 257          inwin
 258          already-there)
 259
 260     (when doublearg
 261       (setq multishell-primary-name target-shell-buffer-name))
 262
 263     ;; Situate:
 264
 265     (cond
 266
 267      ((and (or curr-buff-proc from-buffer-is-shell)
 268            (not arg)
 269            (eq from-buffer target-buffer)
 270            (not (eq target-shell-buffer-name (buffer-name from-buffer))))
 271       ;; In a shell buffer, but not named - stay in buffer, but go to end.
 272       (setq already-there t))
 273
 274      ((string= (buffer-name) target-shell-buffer-name)
 275       ;; Already in the specified shell buffer:
 276       (setq already-there t))
 277
 278      ((or (not target-buffer)
 279           (not (setq inwin
 280                      (multishell-get-visible-window-for-buffer target-buffer))))
 281       ;; No preexisting shell buffer, or not in a visible window:
 282       (pop-to-buffer target-shell-buffer-name pop-up-windows))
 283
 284        ;; Buffer exists and already has a window - jump to it:
 285      (t (if (and multishell-pop-to-frame
 286                  inwin
 287                  (not (equal (window-frame (selected-window))
 288                              (window-frame inwin))))
 289             (select-frame-set-input-focus (window-frame inwin)))
 290         (if (not (string= (buffer-name (current-buffer))
 291                           target-shell-buffer-name))
 292             (pop-to-buffer target-shell-buffer-name t))))
 293
 294     ;; We're in the buffer. Activate:
 295
 296     (cond ((not (comint-check-proc (current-buffer)))
 297            (multishell-start-shell-in-buffer (buffer-name (current-buffer))
 298                                              use-default-dir))
 299           (use-default-dir
 300            (cd use-default-dir)))
 301
 302     ;; If the destination buffer has a stopped process, resume it:
 303     (let ((process (get-buffer-process (current-buffer))))
 304       (if (and process (equal 'stop (process-status process)))
 305           (continue-process process)))
 306     (when (or already-there
 307              (equal (current-buffer) from-buffer))
 308       (goto-char (point-max))
 309       (and (get-buffer-process from-buffer)
 310            (goto-char (process-mark (get-buffer-process from-buffer)))))))
 311
 312 (defun multishell-get-visible-window-for-buffer (buffer)
 313   "Return visible window containing buffer."
 314   (catch 'got-a-vis
 315     (walk-windows
 316      (function (lambda (win)
 317                  (if (and (eq (window-buffer win) buffer)
 318                           (equal (frame-parameter
 319                                   (selected-frame) 'display)
 320                                  (frame-parameter
 321                                   (window-frame win) 'display)))
 322                      (throw 'got-a-vis win))))
 323      nil 'visible)
 324     nil))
 325
 326 (defun multishell-read-bare-shell-buffer-name (prompt default)
 327   "PROMPT for shell buffer name, sans asterisks.
 328
 329 Return the supplied name bracketed with the asterisks, or specified DEFAULT
 330 on empty input."
 331   (let* ((candidates (append
 332                       (remq nil
 333                             (mapcar (lambda (buffer)
 334                                       (let ((name (buffer-name buffer)))
 335                                         (if (with-current-buffer buffer
 336                                               (eq major-mode 'shell-mode))
 337                                             ;; Shell mode buffers.
 338                                             (if (> (length name) 2)
 339                                                 ;; Strip asterisks.
 340                                                 (substring name 1
 341                                                            (1- (length name)))
 342                                               name))))
 343                                     (buffer-list)))))
 344          (got (completing-read prompt
 345                                candidates ; COLLECTION
 346                                nil        ; PREDICATE
 347                                'confirm   ; REQUIRE-MATCH
 348                                nil        ; INITIAL-INPUT
 349                                'multishell-buffer-name-history ; HIST
 350                                )))
 351     (if (not (string= got "")) (multishell-bracket-asterisks got) default)))
 352 (defun multishell-derive-target-name-and-path (path-ish)
 353   "Give tramp-style PATH-ISH, determine target name and default directory.
 354
 355 The name is the part of the string before the initial '/' slash,
 356 if any. Otherwise, it's either the host-name, domain-name, final
 357 directory name, or local host name. The path is everything
 358 besides the string before the initial '/' slash.
 359
 360 Return them as a list (name dir), with dir nil if none given."
 361   (let (name (path "") dir)
 362     (cond ((string= path-ish "") (setq dir multishell-primary-name))
 363           ((string-match "^\\*\\([^/]*\\)\\(/.*/\\)\\(.*\\)\\*" path-ish)
 364            ;; We have a path, use it
 365            (let ((overt-name (match-string 1 path-ish))
 366                  (overt-path (match-string 2 path-ish))
 367                  (trailing-name (match-string 3 path-ish)))
 368              (if (string= overt-name "") (setq overt-name nil))
 369              (if (string= overt-path "") (setq overt-path nil))
 370              (if (string= trailing-name "") (setq trailing-name nil))
 371              (setq path (concat overt-path trailing-name))
 372              (setq name
 373                    (multishell-bracket-asterisks
 374                     (or overt-name
 375                         (if (file-remote-p path)
 376                             (let ((vec (tramp-dissect-file-name path)))
 377                               (or (tramp-file-name-host vec)
 378                                   (tramp-file-name-domain vec)
 379                                   (tramp-file-name-localname vec)
 380                                   trailing-name
 381                                   system-name))
 382                           (multishell-unbracket-asterisks
 383                            multishell-primary-name)))))))
 384           (t (setq name (multishell-bracket-asterisks path-ish))))
 385     (list name path)))
 386
 387 (defun multishell-bracket-asterisks (name)
 388   "Return a copy of name, ensuring it has an asterisk at the beginning and end."
 389   (if (not (string= (substring name 0 1) "*"))
 390       (setq name (concat "*" name)))
 391   (if (not (string= (substring name -1) "*"))
 392       (setq name (concat name "*")))
 393   name)
 394 (defun multishell-unbracket-asterisks (name)
 395   "Return a copy of name, removing asterisks, if any, at beginning and end."
 396   (if (string= (substring name 0 1) "*")
 397       (setq name (substring name 1)))
 398   (if (string= (substring name -1) "*")
 399       (setq name (substring name 0 -1)))
 400   name)
 401
 402 (defun multishell-start-shell-in-buffer (buffer-name path)
 403   "Ensure a shell is started, with name NAME and PATH."
 404   ;; We work around shell-mode's bracketing of the buffer name, and do
 405   ;; some tramp-mode hygiene for remote connections.
 406
 407   (let* ((buffer buffer-name)
 408          (prog (or explicit-shell-file-name
 409                    (getenv "ESHELL")
 410                    (getenv "SHELL")
 411                    "/bin/sh"))
 412          (name (file-name-nondirectory prog))
 413          (startfile (concat "~/.emacs_" name))
 414          (xargs-name (intern-soft (concat "explicit-" name "-args"))))
 415     (set-buffer buffer-name)
 416     (if (and path (not (string= path "")))
 417         (setq default-directory path))
 418     (when (and (file-remote-p default-directory)
 419                (eq major-mode 'shell-mode)
 420                (not (comint-check-proc (current-buffer))))
 421       ;; We're returning to an already established but disconnected remote
 422       ;; shell, tidy it:
 423       (tramp-cleanup-connection
 424        (tramp-dissect-file-name default-directory 'noexpand)
 425        'keep-debug 'keep-password))
 426     ;; (cd default-directory) will reconnect a disconnected remote:
 427     (cd default-directory)
 428     (setq buffer (set-buffer (apply 'make-comint
 429                                     (multishell-unbracket-asterisks buffer-name)
 430                                     prog
 431                                     (if (file-exists-p startfile)
 432                                         startfile)
 433                                     (if (and xargs-name
 434                                              (boundp xargs-name))
 435                                         (symbol-value xargs-name)
 436                                       '("-i")))))
 437     (shell-mode)))
 438
 439 (provide 'multishell)
 440
 441 ;;; multishell.el ends here