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