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