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