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