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