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

   1 ;;; poptoshell.el --- get to the process buffer and input mark
   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 ;; I bind to M-<space>, via eg: (global-set-key "\M- " 'pop-to-shell)
  14 ;; See the pop-to-shell docstring for details.
  15 ;;
  16 ;; TODO
  17 ;; * Change name to multishell.
  18 ;;   - Most functions will be prefixed, eg multishell:pop-to-shell
  19 ;; * Provide for saved history
  20
  21 (defvar non-interactive-process-buffers '("*compilation*" "*grep*"))
  22
  23 (require 'comint)
  24 (require 'shell)
  25
  26 (defcustom pop-to-shell-frame nil
  27   "*If non-nil, jump to a frame already showing the shell, if any.
  28
  29 Otherwise, open a new window in the current frame."
  30   :type 'boolean
  31   :group 'comint)
  32
  33 (defvar pop-to-shell-primary-name "*shell*"
  34   "Shell name to use for un-modified pop-to-shell buffer target.")
  35 (defvar multishell:buffer-name-history nil
  36   "Distinct pop-to-shell completion history container.")
  37
  38 (defun pop-to-shell (&optional arg)
  39
  40   "Navigate to or within local and remote shell buffers.
  41
  42 Use universal arguments to launch and choose between alternate
  43 shell buffers and to select which is default.  Prepend a path to
  44 a new shell name to launch a shell in that directory, and use
  45 Emacs tramp syntax to launch a remote shell.
  46
  47 ==== Basic operation:
  48
  49  - If the current buffer is associated with a subprocess (that is
  50    not among those named on `non-interactive-process-buffers'),
  51    then focus is moved to the process input point.
  52
  53    \(You can use a universal argument go to a different shell
  54    buffer when already in a buffer that has a process - see
  55    below.)
  56
  57  - If not in a shell buffer (or with universal argument), go to a
  58    window that is already showing the (a) shell buffer, if any.
  59
  60    We use `pop-up-windows', so you can adjust/customize it
  61    to set the other-buffer/same-buffer behavior.
  62
  63    In this case, the cursor is left in its prior position in the
  64    shell buffer. Repeating the command will then go to the
  65    process input point, per the first item in this list.
  66
  67  - Otherwise, start a new shell buffer, using the current
  68    directory as the working directory..
  69
  70 If the resulting buffer exists and its shell process was
  71 disconnected or otherwise stopped, it's resumed.
  72
  73 ===== Universal arg to start and select between named shell buffers:
  74
  75 You can name alternate shell buffers to create or return to using
  76 single or doubled universal arguments:
  77
  78  - With a single universal argument, prompt for the buffer name
  79    to use (without the asterisks that shell mode will put around
  80    the name), defaulting to 'shell'.
  81
  82    Completion is available.
  83
  84    This combination makes it easy to start and switch between
  85    multiple shell buffers.
  86
  87  - A double universal argument will prompt for the name *and* set
  88    the default to that name, so the target shell becomes the
  89    primary.
  90
  91 ===== Select starting directory and remote host:
  92
  93 The shell buffer name you give to the prompt for a universal arg
  94 can include a preceding path. That will be used for the startup
  95 directory - and can include tramp remote syntax to specify a
  96 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.
  97
  98 For example: '/ssh:myriadicity.net:/' or
  99 '/ssh:myriadicity.net|sudo:root@myriadicity.net:/\#myr', etc.
 100 The stuff between the '/' slashes will be used for
 101 starting the remote shell, and the stuff after the second
 102 slash will be used for the shell name."
 103
 104   (interactive "P")
 105
 106   (if (not (boundp 'shell-buffer-name))
 107       (setq shell-buffer-name "*shell*"))
 108
 109   (let* ((from-buffer (current-buffer))
 110          (doublearg (equal arg '(16)))
 111          (temp (if arg
 112                    (multishell:read-bare-shell-buffer-name
 113                     (format "Shell buffer name [%s]%s "
 114                             (substring-no-properties
 115                              pop-to-shell-primary-name
 116                              1 (- (length pop-to-shell-primary-name) 1))
 117                             (if doublearg " <==" ":"))
 118                     pop-to-shell-primary-name)
 119                  pop-to-shell-primary-name))
 120          ;; Make sure it is bracketed with asterisks; silly.
 121          use-default-dir
 122          (target-shell-buffer-name
 123           ;; Derive target name, and default-dir if any, from temp.
 124           (cond ((string= temp "") pop-to-shell-primary-name)
 125                 ((string-match "^\\*\\(/.*/\\)\\(.*\\)\\*" temp)
 126                  (setq use-default-dir (match-string 1 temp))
 127                  (bracket-asterisks
 128                   (if (string= (match-string 2 temp) "")
 129                       (let ((v (tramp-dissect-file-name
 130                                 use-default-dir)))
 131                         (or (tramp-file-name-host v)
 132                             (tramp-file-name-domain v)
 133                             (tramp-file-name-localname v)
 134                             use-default-dir))
 135                     (match-string 2 temp))))
 136                 (t (bracket-asterisks temp))))
 137          (curr-buff-proc (get-buffer-process from-buffer))
 138          (target-buffer (if (and curr-buff-proc
 139                         (not (member (buffer-name from-buffer)
 140                                      non-interactive-process-buffers)))
 141                    from-buffer
 142                  (get-buffer target-shell-buffer-name)))
 143          inwin
 144          already-there)
 145
 146     (when doublearg
 147       (setq pop-to-shell-primary-name target-shell-buffer-name))
 148
 149     ;; Situate:
 150
 151     (cond
 152
 153      ((and curr-buff-proc
 154            (not arg)
 155            (eq from-buffer target-buffer)
 156            (not (eq target-shell-buffer-name (buffer-name from-buffer))))
 157       ;; In a shell buffer, but not named - stay in buffer, but go to end.
 158       (setq already-there t))
 159
 160      ((string= (buffer-name) target-shell-buffer-name)
 161       ;; Already in the specified shell buffer:
 162       (setq already-there t))
 163
 164      ((or (not target-buffer)
 165           (not (setq inwin (get-visible-win-for-buffer target-buffer))))
 166       ;; No preexisting shell buffer, or not in a visible window:
 167       (pop-to-buffer target-shell-buffer-name pop-up-windows))
 168
 169        ;; Buffer exists and already has a window - jump to it:
 170      (t (if (and pop-to-shell-frame
 171                  inwin
 172                  (not (equal (window-frame (selected-window))
 173                              (window-frame inwin))))
 174             (select-frame-set-input-focus (window-frame inwin)))
 175         (if (not (string= (buffer-name (current-buffer))
 176                           target-shell-buffer-name))
 177             (pop-to-buffer target-shell-buffer-name t))))
 178
 179     ;; We're in the buffer.
 180
 181     ;; If we have a use-default-dir, impose it:
 182     (when use-default-dir
 183         (cd use-default-dir))
 184
 185     ;; Activate:
 186
 187     (if (not (comint-check-proc (current-buffer)))
 188         (start-shell-in-buffer (buffer-name (current-buffer))))
 189
 190     ;; If the destination buffer has a stopped process, resume it:
 191     (let ((process (get-buffer-process (current-buffer))))
 192       (if (and process (equal 'stop (process-status process)))
 193           (continue-process process)))
 194     (if (and (not already-there)
 195              (not (equal (current-buffer) from-buffer)))
 196         t
 197       (goto-char (point-max))
 198       (and (get-buffer-process from-buffer)
 199            (goto-char (process-mark (get-buffer-process from-buffer)))))
 200     )
 201 )
 202
 203 (defun get-visible-win-for-buffer (buffer)
 204   "Return visible window containing buffer."
 205   (catch 'got-a-vis
 206     (walk-windows
 207      (function (lambda (win)
 208                  (if (and (eq (window-buffer win) buffer)
 209                           (equal (frame-parameter
 210                                   (selected-frame) 'display)
 211                                  (frame-parameter
 212                                   (window-frame win) 'display)))
 213                      (throw 'got-a-vis win))))
 214      nil 'visible)
 215     nil))
 216
 217 (defun multishell:read-bare-shell-buffer-name (prompt default)
 218   "PROMPT for shell buffer name, sans asterisks.
 219
 220 Return the supplied name bracketed with the asterisks, or specified DEFAULT
 221 on empty input."
 222   (let* ((candidates (append
 223                       (remq nil
 224                             (mapcar (lambda (buffer)
 225                                       (let ((name (buffer-name buffer)))
 226                                         (if (with-current-buffer buffer
 227                                               (eq major-mode 'shell-mode))
 228                                             ;; Shell mode buffers.
 229                                             (if (> (length name) 2)
 230                                                 ;; Strip asterisks.
 231                                                 (substring name 1
 232                                                            (1- (length name)))
 233                                               name))))
 234                                     (buffer-list)))))
 235          (got (completing-read prompt
 236                                candidates ; COLLECTION
 237                                nil        ; PREDICATE
 238                                'confirm   ; REQUIRE-MATCH
 239                                nil        ; INITIAL-INPUT
 240                                'multishell:buffer-name-history ; HIST
 241                                )))
 242     (if (not (string= got "")) (bracket-asterisks got) default)))
 243
 244 (defun bracket-asterisks (name)
 245   "Return a copy of name, ensuring it has an asterisk at the beginning and end."
 246   (if (not (string= (substring name 0 1) "*"))
 247       (setq name (concat "*" name)))
 248   (if (not (string= (substring name -1) "*"))
 249       (setq name (concat name "*")))
 250   name)
 251 (defun unbracket-asterisks (name)
 252   "Return a copy of name, removing asterisks, if any, at beginning and end."
 253   (if (string= (substring name 0 1) "*")
 254       (setq name (substring name 1)))
 255   (if (string= (substring name -1) "*")
 256       (setq name (substring name 0 -1)))
 257   name)
 258 (defun start-shell-in-buffer (buffer-name)
 259   "Ensure a shell is started, using whatever name we're passed."
 260   ;; We work around shell-mode's bracketing of the buffer name, and do
 261   ;; some tramp-mode hygiene for remote connections.
 262
 263   (require 'comint)
 264   (require 'shell)
 265
 266   (let* ((buffer buffer-name)
 267          (prog (or explicit-shell-file-name
 268                    (getenv "ESHELL")
 269                    (getenv "SHELL")
 270                    "/bin/sh"))
 271          (name (file-name-nondirectory prog))
 272          (startfile (concat "~/.emacs_" name))
 273          (xargs-name (intern-soft (concat "explicit-" name "-args"))))
 274     (set-buffer buffer-name)
 275     (when (and (file-remote-p default-directory)
 276                (eq major-mode 'shell-mode)
 277                (not (comint-check-proc (current-buffer))))
 278       ;; We're returning to an already established but disconnected remote
 279       ;; shell, tidy it:
 280       (tramp-cleanup-connection
 281        (tramp-dissect-file-name default-directory 'noexpand)
 282        'keep-debug 'keep-password))
 283     (setq buffer (set-buffer (apply 'make-comint
 284                                     (unbracket-asterisks buffer-name)
 285                                     prog
 286                                     (if (file-exists-p startfile)
 287                                         startfile)
 288                                     (if (and xargs-name
 289                                              (boundp xargs-name))
 290                                         (symbol-value xargs-name)
 291                                       '("-i")))))
 292     (shell-mode)))
 293
 294 (provide 'poptoshell)