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.4
   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' -
  15 ;; a la `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 (require 'comint)
  57 (require 'shell)
  58
  59 (defgroup multishell nil
  60   "Allout extension that highlights outline structure graphically.
  61
  62 Customize `allout-widgets-auto-activation' to activate allout-widgets
  63 with allout-mode."
  64   :group 'shell)
  65
  66 (defcustom multishell-command-key "\M- "
  67   "The key to use if `multishell-activate-command-key' is true.
  68
  69 You can instead manually bind `multishell-pop-to-shell` using emacs
  70 lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
  71   :type 'key-sequence
  72   :group 'multishell)
  73
  74 (defvar multishell--responsible-for-command-key nil
  75   "Multishell internal.")
  76 (defun multishell-activate-command-key-setter (symbol setting)
  77   "Implement `multishell-activate-command-key' choice."
  78   (set-default 'multishell-activate-command-key setting)
  79   (when (or setting multishell--responsible-for-command-key)
  80     (multishell-implement-command-key-choice (not setting))))
  81 (defun multishell-implement-command-key-choice (&optional unbind)
  82   "If settings dicate, implement binding of multishell command key.
  83
  84 If optional UNBIND is true, globally unbind the key.
  85
  86 * `multishell-activate-command-key' - Set this to get the binding or not.
  87 * `multishell-command-key' - The key to use for the binding, if appropriate."
  88   (cond (unbind
  89          (when (and (boundp 'multishell-command-key) multishell-command-key)
  90            (global-unset-key multishell-command-key)))
  91         ((not (and (boundp 'multishell-activate-command-key)
  92                    (boundp 'multishell-command-key)))
  93          nil)
  94         ((and multishell-activate-command-key multishell-command-key)
  95          (setq multishell--responsible-for-command-key t)
  96          (global-set-key multishell-command-key 'multishell-pop-to-shell))))
  97
  98 (defcustom multishell-activate-command-key nil
  99   "Set this to impose the `multishell-command-key' binding.
 100
 101 You can instead manually bind `multishell-pop-to-shell` using emacs
 102 lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
 103   :type 'boolean
 104   :set 'multishell-activate-command-key-setter
 105   :group 'multishell)
 106
 107 ;; Assert the customizations whenever the package is loaded:
 108 (with-eval-after-load "multishell"
 109   (multishell-implement-command-key-choice))
 110
 111 (defcustom multishell-pop-to-frame nil
 112   "*If non-nil, jump to a frame already showing the shell, if another is.
 113
 114 Otherwise, disregard already-open windows on the shell if they're
 115 in another frame, and open a new window on the shell in the
 116 current frame.
 117
 118 \(Use `pop-up-windows' to change multishell other-buffer vs
 119 current-buffer behavior.)"
 120   :type 'boolean
 121   :group 'multishell)
 122
 123 ;; (defcustom multishell-persist-shell-names nil
 124 ;;   "Remember shell name/path associations across sessions. Note well:
 125 ;; This will activate minibuffer history persistence, in general, if it's not
 126 ;; already active."
 127 ;;   :type 'boolean
 128 ;;  :group 'shell)
 129
 130 (defvar multishell-name-path-assoc nil
 131   "Assoc list from name to path")
 132
 133 (defvar multishell-primary-name "*shell*"
 134   "Shell name to use for un-modified multishell-pop-to-shell buffer target.")
 135 (defvar multishell-buffer-name-history nil
 136   "Distinct multishell-pop-to-shell completion history container.")
 137 (defvar multishell-buffer-name-path-history nil
 138   "Another multishell-pop-to-shell completion history container,
 139 including paths.")
 140
 141 (defun multishell-pop-to-shell (&optional arg)
 142   "Easily navigate to and within multiple shell buffers, local and remote.
 143
 144 Use universal arguments to launch and choose between alternate
 145 shell buffers and to select which is default.  Append a path to
 146 a new shell name to launch a shell in that directory, and use
 147 Emacs tramp syntax to launch a remote shell.
 148
 149 Customize-group `multishell' to set up a key binding and tweak behaviors.
 150
 151 ==== Basic operation:
 152
 153  - If the current buffer is shell-mode (or shell-mode derived)
 154    buffer then focus is moved to the process input point.
 155
 156    \(You can use a universal argument go to a different shell
 157    buffer when already in a buffer that has a process - see
 158    below.)
 159
 160  - If not in a shell buffer (or with universal argument), go to a
 161    window that is already showing the (a) shell buffer, if any.
 162
 163    In this case, the cursor is left in its prior position in the
 164    shell buffer. Repeating the command will then go to the
 165    process input point, per the first item in this list.
 166
 167    We respect `pop-up-windows', so you can adjust it to set the
 168    other-buffer/same-buffer behavior.
 169
 170  - Otherwise, start a new shell buffer, using the current
 171    directory as the working directory.
 172
 173 If a buffer with the resulting name exists and its shell process
 174 was disconnected or otherwise stopped, it's resumed.
 175
 176 ===== Universal arg to start and select between named shell buffers:
 177
 178 You can name alternate shell buffers to create or return to using
 179 single or doubled universal arguments:
 180
 181  - With a single universal argument, prompt for the buffer name
 182    to use (without the asterisks that shell mode will put around
 183    the name), defaulting to 'shell'.
 184
 185    Completion is available.
 186
 187    This combination makes it easy to start and switch between
 188    multiple shell buffers.
 189
 190  - A double universal argument will prompt for the name *and* set
 191    the default to that name, so the target shell becomes the
 192    primary.
 193
 194 ===== Select starting directory and remote host:
 195
 196 The shell buffer name you give to the prompt for a universal arg
 197 can include an appended path. That will be used for the startup
 198 directory. You can use tramp remote syntax to specify a remote
 199 shell. If there is an element after a final '/', that's used for
 200 the buffer name. Otherwise, the host, domain, or path is used.
 201
 202 For example:
 203
 204 * Use '/ssh:example.net:/' for a shell buffer on example.net named
 205   \"example.net\".
 206 * '\#ex/ssh:example.net|sudo:root@example.net:/' for a root shell on
 207   example.net named \"#ex\"."
 208
 209 ;; I'm leaving the following out of the docstring for now because just
 210 ;; saving the buffer names, and not the paths, yields sometimes unwanted
 211 ;; behavior.
 212
 213 ;; ===== Persisting your alternate shell buffer names and paths:
 214
 215 ;; You can use emacs builtin SaveHist to preserve your alternate
 216 ;; shell buffer names and paths across emacs sessions. To do so,
 217 ;; customize the `savehist' group, and:
 218
 219 ;; 1. Add `multishell-pop-to-shell-buffer-name-history' to Savehist Additional
 220 ;;    Variables.
 221 ;; 2. Activate Savehist Mode, if not already activated.
 222 ;; 3. Save.
 223
 224   (interactive "P")
 225
 226   (let* ((from-buffer (current-buffer))
 227          (from-buffer-is-shell (derived-mode-p 'shell-mode))
 228          (doublearg (equal arg '(16)))
 229          (target-name-and-path
 230           (multishell-derive-target-name-and-path
 231            (if arg
 232                (multishell-read-bare-shell-buffer-name
 233                 (format "Shell buffer name [%s]%s "
 234                         (substring-no-properties
 235                          multishell-primary-name
 236                          1 (- (length multishell-primary-name) 1))
 237                         (if doublearg " <==" ":"))
 238                 multishell-primary-name)
 239              multishell-primary-name)))
 240          (use-default-dir (cadr target-name-and-path))
 241          (target-shell-buffer-name (car target-name-and-path))
 242          (curr-buff-proc (get-buffer-process from-buffer))
 243          (target-buffer (if from-buffer-is-shell
 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. Activate:
 284
 285     (cond ((not (comint-check-proc (current-buffer)))
 286            (multishell-start-shell-in-buffer (buffer-name (current-buffer))
 287                                              use-default-dir))
 288           (use-default-dir
 289            (cd use-default-dir)))
 290
 291     ;; If the destination buffer has a stopped process, resume it:
 292     (let ((process (get-buffer-process (current-buffer))))
 293       (if (and process (equal 'stop (process-status process)))
 294           (continue-process process)))
 295     (when (or already-there
 296              (equal (current-buffer) from-buffer))
 297       (goto-char (point-max))
 298       (and (get-buffer-process from-buffer)
 299            (goto-char (process-mark (get-buffer-process from-buffer)))))))
 300
 301 (defun multishell-get-visible-window-for-buffer (buffer)
 302   "Return visible window containing buffer."
 303   (catch 'got-a-vis
 304     (walk-windows
 305      (function (lambda (win)
 306                  (if (and (eq (window-buffer win) buffer)
 307                           (equal (frame-parameter
 308                                   (selected-frame) 'display)
 309                                  (frame-parameter
 310                                   (window-frame win) 'display)))
 311                      (throw 'got-a-vis win))))
 312      nil 'visible)
 313     nil))
 314
 315 (defun multishell-read-bare-shell-buffer-name (prompt default)
 316   "PROMPT for shell buffer name, sans asterisks.
 317
 318 Return the supplied name bracketed with the asterisks, or specified DEFAULT
 319 on empty input."
 320   (let* ((candidates (append
 321                       (remq nil
 322                             (mapcar (lambda (buffer)
 323                                       (let ((name (buffer-name buffer)))
 324                                         (if (with-current-buffer buffer
 325                                               (derived-mode-p 'shell-mode))
 326                                             ;; Shell mode buffers.
 327                                             (if (> (length name) 2)
 328                                                 ;; Strip asterisks.
 329                                                 (substring name 1
 330                                                            (1- (length name)))
 331                                               name))))
 332                                     (buffer-list)))))
 333          (got (completing-read prompt
 334                                candidates ; COLLECTION
 335                                nil        ; PREDICATE
 336                                'confirm   ; REQUIRE-MATCH
 337                                nil        ; INITIAL-INPUT
 338                                'multishell-buffer-name-history ; HIST
 339                                )))
 340     (if (not (string= got "")) (multishell-bracket-asterisks got) default)))
 341 (defun multishell-derive-target-name-and-path (path-ish)
 342   "Give tramp-style PATH-ISH, determine target name and default directory.
 343
 344 The name is the part of the string before the initial '/' slash,
 345 if any. Otherwise, it's either the host-name, domain-name, final
 346 directory name, or local host name. The path is everything
 347 besides the string before the initial '/' slash.
 348
 349 Return them as a list (name dir), with dir nil if none given."
 350   (let (name (path "") dir)
 351     (cond ((string= path-ish "") (setq dir multishell-primary-name))
 352           ((string-match "^\\*\\([^/]*\\)\\(/.*/\\)\\(.*\\)\\*" path-ish)
 353            ;; We have a path, use it
 354            (let ((overt-name (match-string 1 path-ish))
 355                  (overt-path (match-string 2 path-ish))
 356                  (trailing-name (match-string 3 path-ish)))
 357              (if (string= overt-name "") (setq overt-name nil))
 358              (if (string= overt-path "") (setq overt-path nil))
 359              (if (string= trailing-name "") (setq trailing-name nil))
 360              (setq path (concat overt-path trailing-name))
 361              (setq name
 362                    (multishell-bracket-asterisks
 363                     (or overt-name
 364                         (if (file-remote-p path)
 365                             (let ((vec (tramp-dissect-file-name path)))
 366                               (or (tramp-file-name-host vec)
 367                                   (tramp-file-name-domain vec)
 368                                   (tramp-file-name-localname vec)
 369                                   trailing-name
 370                                   system-name))
 371                           (multishell-unbracket-asterisks
 372                            multishell-primary-name)))))))
 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
 391 (defun multishell-start-shell-in-buffer (buffer-name path)
 392   "Ensure a shell is started, with name NAME and PATH."
 393   ;; We work around shell-mode's bracketing of the buffer name, and do
 394   ;; some tramp-mode hygiene for remote connections.
 395
 396   (let* ((buffer buffer-name)
 397          (prog (or explicit-shell-file-name
 398                    (getenv "ESHELL")
 399                    (getenv "SHELL")
 400                    "/bin/sh"))
 401          (name (file-name-nondirectory prog))
 402          (startfile (concat "~/.emacs_" name))
 403          (xargs-name (intern-soft (concat "explicit-" name "-args"))))
 404     (set-buffer buffer-name)
 405     (if (and path (not (string= path "")))
 406         (setq default-directory path))
 407     (when (and (file-remote-p default-directory)
 408                (derived-mode-p 'shell-mode)
 409                (not (comint-check-proc (current-buffer))))
 410       ;; We're returning to an already established but disconnected remote
 411       ;; shell, tidy it:
 412       (tramp-cleanup-connection
 413        (tramp-dissect-file-name default-directory 'noexpand)
 414        'keep-debug 'keep-password))
 415     ;; (cd default-directory) will reconnect a disconnected remote:
 416     (cd default-directory)
 417     (setq buffer (set-buffer (apply 'make-comint
 418                                     (multishell-unbracket-asterisks buffer-name)
 419                                     prog
 420                                     (if (file-exists-p startfile)
 421                                         startfile)
 422                                     (if (and xargs-name
 423                                              (boundp xargs-name))
 424                                         (symbol-value xargs-name)
 425                                       '("-i")))))
 426     (shell-mode)))
 427
 428 (provide 'multishell)
 429
 430 ;;; multishell.el ends here