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