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