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 one of your shell buffers if you're not currently in one,
  19 ;; * ... with just a keystroke.
  20 ;; * Use universal arguments to launch and choose among alternate shell buffers,
  21 ;; * ... and select which is default.
  22 ;; * Append a path to a new shell name to launch a shell in that directory,
  23 ;; * ... and use a path with Emacs tramp syntax to launch a remote shell.
  24 ;;
  25 ;;       For example:
  26 ;;
  27 ;;       * '/ssh:example.net:/' for a shell buffer in / on
  28 ;;         example.net; the buffer will be named "*example.net*".
  29 ;;
  30 ;;       * '#ex/ssh:example.net|sudo:root@example.net:/etc' for a root shell
  31 ;;         starting in /etc on example.net named "*#ex*".
  32 ;;
  33 ;; (NOTE that you can try to use, eg, '/ssh:example.net:' to get to your
  34 ;; home dir on example.net (if you had one), but that sometimes fails -
  35 ;; particularly remote+sudo to homedir - on an obscure bug. Until that's
  36 ;; fixed, you may need to start remote+sudo shells with an explicit path,
  37 ;; then cd to the homedir.)
  38 ;;
  39 ;; Customize-group `multishell' to select and activate a keybinding and set
  40 ;; various behaviors. Customize-group `savehist' to preserve buffer
  41 ;; names/paths across emacs sessions.
  42 ;;
  43 ;; See the `multishell-pop-to-shell' docstring for details.
  44 ;;
  45 ;;; Change Log:
  46 ;;
  47 ;; 2016-01-16 1.0.5 Ken Manheimer:
  48 ;;   - Fix - recognize and respect tramp path syntax to start in home dir
  49 ;;   - Offer to user to remove shell's history entry when buffer is killed
  50 ;;   - Fix - prevent duplicate entries for same name but different paths
  51 ;;   - Simplify history var name, migrate existing history from old name if any
  52 ;; 2016-01-06 Ken Manheimer - Released
  53 ;; 2016-01-02 Ken Manheimer - working on this in public, but not yet released.
  54 ;;
  55 ;;; TODO:
  56 ;;
  57 ;; * Isolate frequent failure with remote tramp home-dir syntax (`/host.dom:')
  58 ;; * Track the current directory in each buffer's history entry.
  59 ;; * Provide toggle to see completions buffer with just buffer names or + paths
  60
  61 ;;; Code:
  62
  63 (require 'comint)
  64 (require 'shell)
  65
  66 (defgroup multishell nil
  67   "Allout extension that highlights outline structure graphically.
  68
  69 Customize `allout-widgets-auto-activation' to activate allout-widgets
  70 with allout-mode."
  71   :group 'shell)
  72
  73 (defcustom multishell-command-key "\M- "
  74   "The key to use if `multishell-activate-command-key' is true.
  75
  76 You can instead manually bind `multishell-pop-to-shell` using emacs
  77 lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
  78   :type 'key-sequence
  79   :group 'multishell)
  80
  81 (defvar multishell--responsible-for-command-key nil
  82   "Multishell internal.")
  83 (defun multishell-activate-command-key-setter (symbol setting)
  84   "Implement `multishell-activate-command-key' choice."
  85   (set-default 'multishell-activate-command-key setting)
  86   (when (or setting multishell--responsible-for-command-key)
  87     (multishell-implement-command-key-choice (not setting))))
  88 (defun multishell-implement-command-key-choice (&optional unbind)
  89   "If settings dicate, implement binding of multishell command key.
  90
  91 If optional UNBIND is true, globally unbind the key.
  92
  93 * `multishell-activate-command-key' - Set this to get the binding or not.
  94 * `multishell-command-key' - The key to use for the binding, if appropriate."
  95   (cond (unbind
  96          (when (and (boundp 'multishell-command-key) multishell-command-key)
  97            (global-unset-key multishell-command-key)))
  98         ((not (and (boundp 'multishell-activate-command-key)
  99                    (boundp 'multishell-command-key)))
 100          nil)
 101         ((and multishell-activate-command-key multishell-command-key)
 102          (setq multishell--responsible-for-command-key t)
 103          (global-set-key multishell-command-key 'multishell-pop-to-shell))))
 104
 105 (defcustom multishell-activate-command-key nil
 106   "Set this to impose the `multishell-command-key' binding.
 107
 108 You can instead manually bind `multishell-pop-to-shell` using emacs
 109 lisp, eg: (global-set-key \"\\M- \" 'multishell-pop-to-shell)."
 110   :type 'boolean
 111   :set 'multishell-activate-command-key-setter
 112   :group 'multishell)
 113
 114 ;; Assert the customizations whenever the package is loaded:
 115 (with-eval-after-load "multishell"
 116   (multishell-implement-command-key-choice))
 117
 118 (defcustom multishell-pop-to-frame nil
 119   "*If non-nil, jump to a frame already showing the shell, if another is.
 120
 121 Otherwise, disregard already-open windows on the shell if they're
 122 in another frame, and open a new window on the shell in the
 123 current frame.
 124
 125 \(Use `pop-up-windows' to change multishell other-buffer vs
 126 current-buffer behavior.)"
 127   :type 'boolean
 128   :group 'multishell)
 129
 130 ;; (defcustom multishell-persist-shell-names nil
 131 ;;   "Remember shell name/path associations across sessions. Note well:
 132 ;; This will activate minibuffer history persistence, in general, if it's not
 133 ;; already active."
 134 ;;  :type 'boolean
 135 ;;  :set 'multishell-activate-persistence
 136 ;;  :group 'shell)
 137
 138 (defvar multishell-history nil
 139   "Name/path entries, most recent first.")
 140 (when (and (not multishell-history)
 141            (boundp 'multishell-buffer-name-history)
 142            multishell-buffer-name-history)
 143   ;; Migrate few users who had old var to new.
 144   (setq multishell-history multishell-buffer-name-history)
 145  )
 146
 147 (defvar multishell-primary-name "*shell*"
 148   "Shell name to use for un-modified multishell-pop-to-shell buffer target.")
 149
 150 (defun multishell-register-name-to-path (name path)
 151   "Add or replace entry associating NAME with PATH in `multishell-history'."
 152   ;; Add or promote to the front, tracking path changes in the process.
 153   (let* ((entries (multishell-history-entries name))
 154          (becomes (concat name path)))
 155     (dolist (entry entries)
 156       (setq multishell-history (delete entry multishell-history)))
 157     (setq multishell-history (push becomes multishell-history))))
 158
 159 (defun multishell-history-entries (name)
 160   "Return `multishell-history' entry that starts with NAME, or nil if none."
 161   (let ((match-expr (concat "^" name "\\\(/.*$\\\)?"))
 162         got)
 163     (dolist (entry multishell-history)
 164       (when (and (string-match match-expr entry)
 165                  (not (member entry got)))
 166         (setq got (cons entry got))))
 167     got))
 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:/home/myaccount' for a shell buffer in
 233   /home/myaccount on example.net; the buffer will be named
 234   \"*example.net*\".
 235 * '\#ex/ssh:example.net|sudo:root@example.net:/etc' for a root
 236   shell in /etc on example.net named \"*#ex*\".
 237
 238 \(NOTE that you can specify a remote homedir using tramp syntax,
 239 eg '/ssh:example.net:'. However that sometimes fails on an
 240 obscure bug - particularly for remote+sudo with homedir
 241 syntax. Until fixed, you may need to start remote+sudo shells
 242 with an explicit path, then cd to the homedir.)
 243
 244 You can change the startup path for a shell buffer by editing it
 245 at the completion prompt. The new path will be preserved in
 246 history but will not take effect for an already-running shell.
 247
 248 To remove a shell buffer's history entry, kill the buffer and
 249 affirm removal of the entry when prompted.
 250
 251 ===== Activate savehist to persisting your shell buffer names and paths:
 252
 253 To have emacs maintain your history of shell buffer names and paths,
 254 customize the savehist group to activate savehist."
 255
 256   (interactive "P")
 257
 258   (let* ((from-buffer (current-buffer))
 259          (from-buffer-is-shell (derived-mode-p 'shell-mode))
 260          (doublearg (equal arg '(16)))
 261          (target-name-and-path
 262           (multishell-derive-target-name-and-path
 263            (if arg
 264                (multishell-read-bare-shell-buffer-name
 265                 (format "Shell buffer name [%s]%s "
 266                         (substring-no-properties
 267                          multishell-primary-name
 268                          1 (- (length multishell-primary-name) 1))
 269                         (if doublearg " <==" ":"))
 270                 multishell-primary-name)
 271              multishell-primary-name)))
 272          (use-default-dir (cadr target-name-and-path))
 273          (target-shell-buffer-name (car target-name-and-path))
 274          (curr-buff-proc (get-buffer-process from-buffer))
 275          (target-buffer (if from-buffer-is-shell
 276                             from-buffer
 277                           (let ((got (get-buffer target-shell-buffer-name)))
 278                             (if (buffer-live-p got)
 279                                 got
 280                               (kill-buffer got)
 281                               (get-buffer target-shell-buffer-name)))))
 282          inwin
 283          already-there)
 284
 285     (when doublearg
 286       (setq multishell-primary-name target-shell-buffer-name))
 287
 288     ;; Situate:
 289
 290     (cond
 291
 292      ((and (or curr-buff-proc from-buffer-is-shell)
 293            (not arg)
 294            (eq from-buffer target-buffer)
 295            (not (eq target-shell-buffer-name (buffer-name from-buffer))))
 296       ;; In a shell buffer, but not named - stay in buffer, but go to end.
 297       (setq already-there t))
 298
 299      ((string= (buffer-name) target-shell-buffer-name)
 300       ;; Already in the specified shell buffer:
 301       (setq already-there t))
 302
 303      ((or (not target-buffer)
 304           (not (setq inwin
 305                      (multishell-get-visible-window-for-buffer target-buffer))))
 306       ;; No preexisting shell buffer, or not in a visible window:
 307       (pop-to-buffer target-shell-buffer-name pop-up-windows))
 308
 309        ;; Buffer exists and already has a window - jump to it:
 310      (t (if (and multishell-pop-to-frame
 311                  inwin
 312                  (not (equal (window-frame (selected-window))
 313                              (window-frame inwin))))
 314             (select-frame-set-input-focus (window-frame inwin)))
 315         (if (not (string= (buffer-name (current-buffer))
 316                           target-shell-buffer-name))
 317             (pop-to-buffer target-shell-buffer-name t))))
 318
 319     ;; We're in the buffer. Activate:
 320
 321     (cond ((not (comint-check-proc (current-buffer)))
 322            (multishell-start-shell-in-buffer (buffer-name (current-buffer))
 323                                              use-default-dir))
 324           (use-default-dir
 325            (cd use-default-dir)))
 326
 327     ;; If the destination buffer has a stopped process, resume it:
 328     (let ((process (get-buffer-process (current-buffer))))
 329       (if (and process (equal 'stop (process-status process)))
 330           (continue-process process)))
 331     (multishell-register-name-to-path (multishell-unbracket-asterisks
 332                                        target-shell-buffer-name)
 333                                       use-default-dir)
 334     (when (or already-there
 335              (equal (current-buffer) from-buffer))
 336       (goto-char (point-max))
 337       (and (get-buffer-process from-buffer)
 338            (goto-char (process-mark (get-buffer-process from-buffer)))))))
 339
 340 (defun multishell-kill-buffer-query-function ()
 341   "Offer to remove multishell-history entry for buffer."
 342   ;; Removal choice is crucial, so users can, eg, kill and a runaway shell
 343   ;; and keep the history entry to easily restart it.
 344   ;;
 345   ;; We use kill-buffer-query-functions instead of kill-buffer-hook because:
 346   ;;
 347   ;; 1. It enables the user to remove the history without killing the buffer,
 348   ;;    by cancelling the kill-buffer process after affirming history removal.
 349   ;; 2. kill-buffer-hooks often fails to run when killing shell buffers!
 350   ;;    I've failed to resolve that, and like the first reason well enough.
 351
 352   ;; (Use condition-case to avoid inadvertant disruption of kill-buffer
 353   ;; activity.  kill-buffer happens behind the scenes a whole lot.)
 354   (condition-case anyerr
 355       (let ((entries (and (derived-mode-p 'shell-mode)
 356                           (multishell-history-entries
 357                            (multishell-unbracket-asterisks (buffer-name))))))
 358         (dolist (entry entries)
 359           (when (and entry
 360                      (y-or-n-p (format "Remove multishell history entry `%s'? "
 361                                        entry)))
 362             (setq multishell-history
 363                   (delete entry multishell-history)))))
 364     (error nil))
 365   t)
 366 (add-hook 'kill-buffer-query-functions 'multishell-kill-buffer-query-function)
 367
 368 (defun multishell-get-visible-window-for-buffer (buffer)
 369   "Return visible window containing buffer."
 370   (catch 'got-a-vis
 371     (walk-windows
 372      (function (lambda (win)
 373                  (if (and (eq (window-buffer win) buffer)
 374                           (equal (frame-parameter
 375                                   (selected-frame) 'display)
 376                                  (frame-parameter
 377                                   (window-frame win) 'display)))
 378                      (throw 'got-a-vis win))))
 379      nil 'visible)
 380     nil))
 381
 382 (defun multishell-read-bare-shell-buffer-name (prompt default)
 383   "PROMPT for shell buffer name, sans asterisks.
 384
 385 Return the supplied name bracketed with the asterisks, or specified DEFAULT
 386 on empty input."
 387   (let* ((candidates
 388           (append
 389            ;; Plain shell buffer names appended with names from name/path hist:
 390            (remq nil
 391                  (mapcar (lambda (buffer)
 392                            (let* ((name (multishell-unbracket-asterisks
 393                                          (buffer-name buffer))))
 394                              (and (buffer-live-p buffer)
 395                                   (with-current-buffer buffer
 396                                     ;; Shell mode buffers.
 397                                     (derived-mode-p 'shell-mode))
 398                                   (not (multishell-history-entries name))
 399                                   name)))
 400                          (buffer-list)))
 401            multishell-history))
 402          (got (completing-read prompt
 403                                ;; COLLECTION:
 404                                (reverse candidates)
 405                                ;; PREDICATE:
 406                                nil
 407                                ;; REQUIRE-MATCH:
 408                                'confirm
 409                                ;; INITIAL-INPUT
 410                                nil
 411                                ;; HIST:
 412                                'multishell-history)))
 413     (if (not (string= got ""))
 414         (multishell-bracket-asterisks got)
 415       default)))
 416
 417 (defun multishell-derive-target-name-and-path (path-ish)
 418   "Give tramp-style PATH-ISH, determine target name and default directory.
 419
 420 The name is the part of the string before the initial '/' slash,
 421 if any. Otherwise, it's either the host-name, domain-name, final
 422 directory name, or local host name. The path is everything
 423 besides the string before the initial '/' slash.
 424
 425 Return them as a list (name dir), with dir nil if none given."
 426   (let (name (path "") dir)
 427     (cond ((string= path-ish "") (setq dir multishell-primary-name))
 428           ((string-match "^\\*\\([^/]*\\)\\(/.*\\)\\*" path-ish)
 429            ;; We have a path, use it
 430            (let ((overt-name (match-string 1 path-ish)))
 431              (setq path (match-string 2 path-ish))
 432              (if (string= overt-name "") (setq overt-name nil))
 433              (if (string= path "") (setq path nil))
 434              (setq name
 435                    (multishell-bracket-asterisks
 436                     (or overt-name
 437                         (if (file-remote-p path)
 438                             (let ((vec (tramp-dissect-file-name path)))
 439                               (or (tramp-file-name-host vec)
 440                                   (tramp-file-name-domain vec)
 441                                   (tramp-file-name-localname vec)
 442                                   system-name))
 443                           (multishell-unbracket-asterisks
 444                            multishell-primary-name)))))))
 445           (t (setq name (multishell-bracket-asterisks path-ish))))
 446     (list name path)))
 447
 448 (defun multishell-bracket-asterisks (name)
 449   "Return a copy of name, ensuring it has an asterisk at the beginning and end."
 450   (if (not (string= (substring name 0 1) "*"))
 451       (setq name (concat "*" name)))
 452   (if (not (string= (substring name -1) "*"))
 453       (setq name (concat name "*")))
 454   name)
 455 (defun multishell-unbracket-asterisks (name)
 456   "Return a copy of name, removing asterisks, if any, at beginning and end."
 457   (if (string= (substring name 0 1) "*")
 458       (setq name (substring name 1)))
 459   (if (string= (substring name -1) "*")
 460       (setq name (substring name 0 -1)))
 461   name)
 462
 463 (defun multishell-start-shell-in-buffer (buffer-name path)
 464   "Ensure a shell is started, with name NAME and PATH."
 465   ;; We work around shell-mode's bracketing of the buffer name, and do
 466   ;; some tramp-mode hygiene for remote connections.
 467
 468   (let* ((buffer buffer-name)
 469          (prog (or explicit-shell-file-name
 470                    (getenv "ESHELL")
 471                    (getenv "SHELL")
 472                    "/bin/sh"))
 473          (name (file-name-nondirectory prog))
 474          (startfile (concat "~/.emacs_" name))
 475          (xargs-name (intern-soft (concat "explicit-" name "-args")))
 476          is-remote)
 477     (set-buffer buffer-name)
 478     (if (and path (not (string= path "")))
 479         (setq default-directory path))
 480     (setq is-remote (file-remote-p default-directory))
 481     (when (and is-remote
 482                (derived-mode-p 'shell-mode)
 483                (not (comint-check-proc (current-buffer))))
 484       ;; We're returning to an already established but disconnected remote
 485       ;; shell, tidy it:
 486       (tramp-cleanup-connection
 487        (tramp-dissect-file-name default-directory 'noexpand)
 488        'keep-debug 'keep-password))
 489     ;; (cd default-directory) will connect if remote:
 490     (when is-remote
 491       (message "Connecting to %s" default-directory))
 492     (condition-case err
 493         (cd default-directory)
 494       (error
 495        ;; Aargh. Need to isolate this tramp bug.
 496        (when (and (stringp (cadr err))
 497                   (string-equal (cadr err)
 498                                 "Selecting deleted buffer"))
 499          (signal (car err)
 500                  (list
 501                   (format "Tramp shell may fail with homedir paths, %s (\"%s\")"
 502                           "please try with an explicit path"
 503                           (cadr err)))))))
 504     (setq buffer (set-buffer (apply 'make-comint
 505                                     (multishell-unbracket-asterisks buffer-name)
 506                                     prog
 507                                     (if (file-exists-p startfile)
 508                                         startfile)
 509                                     (if (and xargs-name
 510                                              (boundp xargs-name))
 511                                         (symbol-value xargs-name)
 512                                       '("-i")))))
 513     (shell-mode)))
 514
 515 (provide 'multishell)
 516
 517 ;;; multishell.el ends here