code.delx.au - gnu-emacs-elpa/blob - poptoshell.el

   1 ;;; poptoshell.el --- easily manage interaction with multiple shells
   2
   3 ;; Copyright (C) 1999-2011 Free Software Foundation, Inc. and Ken Manheimer
   4
   5 ;; Author: Ken Manheimer <ken dot manheimer at gmail...>
   6 ;; Maintainer: Ken Manheimer <ken dot manheimer at gmail...>
   7 ;; Created: 1999 -- first public release
   8 ;; Keywords: processes
   9 ;; Website: https://github.com/kenmanheimer/EmacsUtils
  10 ;;
  11 ;;; Commentary:
  12 ;;
  13 ;; See the pop-to-shell docstring for details.
  14 ;; I bind to M-<space>, via eg: (global-set-key "\M- " 'pop-to-shell)
  15 ;;
  16 ;; TODO:
  17 ;; * Change name to multishell.
  18 ;;   - Most functions will be prefixed, eg multishell:pop-to-shell
  19 ;; * Preservable (savehist) history that associates names with paths
  20 ;;   - Using an association list between names and paths
  21 ;;   - Searched for search backwards/forwards on isearch-like M-r/M-s bindings
  22 ;;     - *Not* searched for regular completion
  23 ;;   - Editible
  24 ;;     - Using isearch keybinding M-e
  25 ;;     - Edits path
  26 ;;     - New association overrides previous
  27 ;;     - Deleting path removes association and history entry
  28 ;; * Customize provision for activating the saves
  29 ;;   - Customize entry has warning about activating savehist
  30 ;;   - Adds the name/path association list to savehist-additional-variables
  31 ;;   - Activates savehist, if inactive
  32 ;; * Customize provision for keybinding
  33 ;;   - See allout.el allout-command-prefix for dynamic customization example.
  34
  35 (defvar non-interactive-process-buffers '("*compilation*" "*grep*"))
  36
  37 (require 'comint)
  38 (require 'shell)
  39
  40 (defgroup multishell nil
  41   "Allout extension that highlights outline structure graphically.
  42
  43 Customize `allout-widgets-auto-activation' to activate allout-widgets
  44 with allout-mode."
  45   :group 'shell)
  46
  47 (defcustom multishell:non-interactive-process-buffers
  48   '("*compilation*" "*grep*")
  49   "Buffers with processes but not for interaction."
  50   :type '(repeat string)
  51   :group 'multishell)
  52 (defcustom multishell:command-key "\M- "
  53   "Choose a key to use for "
  54   :type 'string
  55   :group 'multishell)
  56 (defun multishell:assert-command-key-or-not (&optional force)
  57   "Activate multishell command key if customizations dictate.
  58
  59 If optional FORCE is true and customizations dictate, globally
  60 unbind the key.
  61
  62 * `multishell:assert-command-key' - Establish or keep the binding if true
  63 * `multishell:command-key' - Which key to use."
  64   (if (boundp 'multishell:assert-command-key)
  65       (cond ((and multishell:assert-command-key multishell:command-key)
  66              (global-set-key multishell:command-key 'pop-to-shell))
  67             ((and force (not multishell:assert-command-key))
  68              (global-unset-key multishell:command-key)))
  69     )
  70   )
  71 (defun multishell:do-assert-command-key (option-name option-value)
  72   "If `multishell:assert-command-key', globally bind pop-to-shell.
  73
  74 Use keybinding identified by `multishell:command-key'."
  75   (multishell:assert-command-key-or-not (not option-value))
  76   )
  77 (defcustom multishell:assert-command-key nil
  78   "Set this to impose the `multishell-command-key binding."
  79   :type 'boolean
  80   :set 'multishell:do-assert-command-key
  81   :group 'multishell)
  82
  83 (defcustom multishell:pop-to-frame nil
  84   "*If non-nil, jump to a frame already showing the shell, if any.
  85
  86 Otherwise, open a new window in the current frame."
  87   :type 'boolean
  88   :group 'shell)
  89
  90 (defcustom pop-to-shell-persist-shell-names nil
  91   "Remember shell name/path associations across sessions. Note well:
  92 This will activate minibuffer history persistence, in general, if it's not
  93 already active."
  94   :type 'boolean
  95   :group 'shell)
  96
  97 (defvar multishell:name-path-assoc nil
  98   "Assoc list from name to path")
  99
 100 (defvar pop-to-shell-primary-name "*shell*"
 101   "Shell name to use for un-modified pop-to-shell buffer target.")
 102 (defvar multishell:buffer-name-history nil
 103   "Distinct pop-to-shell completion history container.")
 104
 105 (defun pop-to-shell (&optional arg)
 106
 107   "Navigate to or within local and remote shell buffers.
 108
 109 Use universal arguments to launch and choose between alternate
 110 shell buffers and to select which is default.  Prepend a path to
 111 a new shell name to launch a shell in that directory, and use
 112 Emacs tramp syntax to launch a remote shell.
 113
 114 ==== Basic operation:
 115
 116  - If the current buffer is associated with a subprocess (that is
 117    not among those named on `non-interactive-process-buffers'),
 118    then focus is moved to the process input point.
 119
 120    \(You can use a universal argument go to a different shell
 121    buffer when already in a buffer that has a process - see
 122    below.)
 123
 124  - If not in a shell buffer (or with universal argument), go to a
 125    window that is already showing the (a) shell buffer, if any.
 126
 127    In this case, the cursor is left in its prior position in the
 128    shell buffer. (Repeating the command will then go to the
 129    process input point, by the previous behavior.)
 130
 131  - Otherwise, start a new shell buffer, using the current
 132    directory as the working directory..
 133
 134 If the resulting buffer exists and its shell process was
 135 disconnected or otherwise stopped, it's resumed.
 136
 137 ===== Universal arg to start and select between named shell buffers:
 138
 139 You can name alternate shell buffers to create or return to using
 140 single or doubled universal arguments:
 141
 142  - With a single universal argument, prompt for the buffer name
 143    to use (without the asterisks that shell mode will put around
 144    the name), defaulting to 'shell'.
 145
 146    Completion is available.
 147
 148    This combination makes it easy to start and switch between
 149    multiple shell buffers.
 150
 151  - A double universal argument will prompt for the name *and* set
 152    the default to that name, so the target shell becomes the
 153    primary.
 154
 155 ===== Select starting directory and remote host:
 156
 157 The shell buffer name you give to the prompt for a universal arg
 158 can include a preceding path. That will be used for the startup
 159 directory - and can include tramp remote syntax to specify a
 160 remote shell. If there is an element after a final '/', that's used for the buffer name. Otherwise, the host, domain, or path is used.
 161
 162 For example: '/ssh:myriadicity.net:/' or
 163 '/ssh:myriadicity.net|sudo:root@myriadicity.net:/\#myr', etc.
 164 The stuff between the '/' slashes will be used for
 165 starting the remote shell, and the stuff after the second
 166 slash will be used for the shell name.
 167
 168 ===== Persisting your alternate shell buffer names and paths:
 169
 170 You can use emacs builtin SaveHist to preserve your alternate
 171 shell buffer names and paths across emacs sessions. To do so,
 172 customize the `savehist' group, and:
 173
 174 1. Add `pop-to-shell-buffer-name-history' to Savehist Additional Variables.
 175 2. Activate Savehist Mode, if not already activated.
 176 3. Save."
 177
 178   (interactive "P")
 179
 180   (if (not (boundp 'shell-buffer-name))
 181       (setq shell-buffer-name "*shell*"))
 182
 183   (let* ((from-buffer (current-buffer))
 184          (doublearg (equal arg '(16)))
 185          (temp (if arg
 186                    (multishell:read-bare-shell-buffer-name
 187                     (format "Shell buffer name [%s]%s "
 188                             (substring-no-properties
 189                              pop-to-shell-primary-name
 190                              1 (- (length pop-to-shell-primary-name) 1))
 191                             (if doublearg " <==" ":"))
 192                     pop-to-shell-primary-name)
 193                  pop-to-shell-primary-name))
 194          ;; Make sure it is bracketed with asterisks; silly.
 195          use-default-dir
 196          (target-shell-buffer-name
 197           ;; Derive target name, and default-dir if any, from temp.
 198           (cond ((string= temp "") pop-to-shell-primary-name)
 199                 ((string-match "^\\*\\(/.*/\\)\\(.*\\)\\*" temp)
 200                  (setq use-default-dir (match-string 1 temp))
 201                  (bracket-asterisks
 202                   (if (string= (match-string 2 temp) "")
 203                       (let ((v (tramp-dissect-file-name
 204                                 use-default-dir)))
 205                         (or (tramp-file-name-host v)
 206                             (tramp-file-name-domain v)
 207                             (tramp-file-name-localname v)
 208                             use-default-dir))
 209                     (match-string 2 temp))))
 210                 (t (bracket-asterisks temp))))
 211          (curr-buff-proc (get-buffer-process from-buffer))
 212          (target-buffer (if (and curr-buff-proc
 213                         (not (member (buffer-name from-buffer)
 214                                      non-interactive-process-buffers)))
 215                    from-buffer
 216                  (get-buffer target-shell-buffer-name)))
 217          inwin
 218          already-there)
 219
 220     (when doublearg
 221       (setq pop-to-shell-primary-name target-shell-buffer-name))
 222
 223     ;; Situate:
 224
 225     (cond
 226
 227      ((and curr-buff-proc
 228            (not arg)
 229            (eq from-buffer target-buffer)
 230            (not (eq target-shell-buffer-name (buffer-name from-buffer))))
 231       ;; In a shell buffer, but not named - stay in buffer, but go to end.
 232       (setq already-there t))
 233
 234      ((string= (buffer-name) target-shell-buffer-name)
 235       ;; Already in the specified shell buffer:
 236       (setq already-there t))
 237
 238      ((or (not target-buffer)
 239           (not (setq inwin (get-visible-win-for-buffer target-buffer))))
 240       ;; No preexisting shell buffer, or not in a visible window:
 241       (pop-to-buffer target-shell-buffer-name pop-up-windows))
 242
 243        ;; Buffer exists and already has a window - jump to it:
 244      (t (if (and multishell:pop-to-frame
 245                  inwin
 246                  (not (equal (window-frame (selected-window))
 247                              (window-frame inwin))))
 248             (select-frame-set-input-focus (window-frame inwin)))
 249         (if (not (string= (buffer-name (current-buffer))
 250                           target-shell-buffer-name))
 251             (pop-to-buffer target-shell-buffer-name t))))
 252
 253     ;; We're in the buffer.
 254
 255     ;; If we have a use-default-dir, impose it:
 256     (when use-default-dir
 257         (cd use-default-dir))
 258
 259     ;; Activate:
 260
 261     (if (not (comint-check-proc (current-buffer)))
 262         (start-shell-in-buffer (buffer-name (current-buffer))))
 263
 264     ;; If the destination buffer has a stopped process, resume it:
 265     (let ((process (get-buffer-process (current-buffer))))
 266       (if (and process (equal 'stop (process-status process)))
 267           (continue-process process)))
 268     (if (and (not already-there)
 269              (not (equal (current-buffer) from-buffer)))
 270         t
 271       (goto-char (point-max))
 272       (and (get-buffer-process from-buffer)
 273            (goto-char (process-mark (get-buffer-process from-buffer)))))
 274     )
 275 )
 276
 277 (defun get-visible-win-for-buffer (buffer)
 278   "Return visible window containing buffer."
 279   (catch 'got-a-vis
 280     (walk-windows
 281      (function (lambda (win)
 282                  (if (and (eq (window-buffer win) buffer)
 283                           (equal (frame-parameter
 284                                   (selected-frame) 'display)
 285                                  (frame-parameter
 286                                   (window-frame win) 'display)))
 287                      (throw 'got-a-vis win))))
 288      nil 'visible)
 289     nil))
 290
 291 (defun multishell:read-bare-shell-buffer-name (prompt default)
 292   "PROMPT for shell buffer name, sans asterisks.
 293
 294 Return the supplied name bracketed with the asterisks, or specified DEFAULT
 295 on empty input."
 296   (let* ((candidates (append
 297                       (remq nil
 298                             (mapcar (lambda (buffer)
 299                                       (let ((name (buffer-name buffer)))
 300                                         (if (with-current-buffer buffer
 301                                               (eq major-mode 'shell-mode))
 302                                             ;; Shell mode buffers.
 303                                             (if (> (length name) 2)
 304                                                 ;; Strip asterisks.
 305                                                 (substring name 1
 306                                                            (1- (length name)))
 307                                               name))))
 308                                     (buffer-list)))))
 309          (got (completing-read prompt
 310                                candidates ; COLLECTION
 311                                nil        ; PREDICATE
 312                                'confirm   ; REQUIRE-MATCH
 313                                nil        ; INITIAL-INPUT
 314                                'multishell:buffer-name-history ; HIST
 315                                )))
 316     (if (not (string= got "")) (bracket-asterisks got) default)))
 317
 318 (defun bracket-asterisks (name)
 319   "Return a copy of name, ensuring it has an asterisk at the beginning and end."
 320   (if (not (string= (substring name 0 1) "*"))
 321       (setq name (concat "*" name)))
 322   (if (not (string= (substring name -1) "*"))
 323       (setq name (concat name "*")))
 324   name)
 325 (defun unbracket-asterisks (name)
 326   "Return a copy of name, removing asterisks, if any, at beginning and end."
 327   (if (string= (substring name 0 1) "*")
 328       (setq name (substring name 1)))
 329   (if (string= (substring name -1) "*")
 330       (setq name (substring name 0 -1)))
 331   name)
 332 (defun start-shell-in-buffer (buffer-name)
 333   ;; Damn comint requires buffer name be bracketed by "*" asterisks.
 334   (require 'comint)
 335   (require 'shell)
 336
 337   (let* ((buffer buffer-name)
 338          (prog (or explicit-shell-file-name
 339                    (getenv "ESHELL")
 340                    (getenv "SHELL")
 341                    "/bin/sh"))
 342          (name (file-name-nondirectory prog))
 343          (startfile (concat "~/.emacs_" name))
 344          (xargs-name (intern-soft (concat "explicit-" name "-args"))))
 345     (set-buffer buffer-name)
 346     (when (and (file-remote-p default-directory)
 347                (eq major-mode 'shell-mode)
 348                (not (comint-check-proc (current-buffer))))
 349       ;; We're returning to an already established but disconnected remote
 350       ;; shell, tidy it:
 351       (tramp-cleanup-connection
 352        (tramp-dissect-file-name default-directory 'noexpand)
 353        'keep-debug 'keep-password))
 354     (setq buffer (set-buffer (apply 'make-comint
 355                                     (unbracket-asterisks buffer-name)
 356                                     prog
 357                                     (if (file-exists-p startfile)
 358                                         startfile)
 359                                     (if (and xargs-name
 360                                              (boundp xargs-name))
 361                                         (symbol-value xargs-name)
 362                                       '("-i")))))
 363     (shell-mode)))
 364
 365 (provide 'poptoshell)