| 1 | ;;; shell.el --- specialized comint.el for running the shell. |
| 2 | ;;; Copyright (C) 1988, 1993 Free Software Foundation, Inc. |
| 3 | |
| 4 | ;; Author: Olin Shivers <shivers@cs.cmu.edu> |
| 5 | ;; Adapted-by: Simon Marshall <s.marshall@dcs.hull.ac.uk> |
| 6 | ;; Keywords: processes |
| 7 | |
| 8 | ;;; This file is part of GNU Emacs. |
| 9 | |
| 10 | ;;; GNU Emacs is free software; you can redistribute it and/or modify |
| 11 | ;;; it under the terms of the GNU General Public License as published by |
| 12 | ;;; the Free Software Foundation; either version 2, or (at your option) |
| 13 | ;;; any later version. |
| 14 | |
| 15 | ;;; GNU Emacs is distributed in the hope that it will be useful, |
| 16 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 17 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 18 | ;;; GNU General Public License for more details. |
| 19 | |
| 20 | ;;; You should have received a copy of the GNU General Public License |
| 21 | ;;; along with GNU Emacs; see the file COPYING. If not, write to |
| 22 | ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
| 23 | |
| 24 | ;;; Commentary: |
| 25 | |
| 26 | ;;; Please send me bug reports, bug fixes, and extensions, so that I can |
| 27 | ;;; merge them into the master source. |
| 28 | ;;; - Olin Shivers (shivers@cs.cmu.edu) |
| 29 | ;;; - Simon Marshall (s.marshall@dcs.hull.ac.uk) |
| 30 | |
| 31 | ;;; This file defines a a shell-in-a-buffer package (shell mode) built |
| 32 | ;;; on top of comint mode. This is actually cmushell with things |
| 33 | ;;; renamed to replace its counterpart in Emacs 18. cmushell is more |
| 34 | ;;; featureful, robust, and uniform than the Emacs 18 version. |
| 35 | |
| 36 | ;;; Since this mode is built on top of the general command-interpreter-in- |
| 37 | ;;; a-buffer mode (comint mode), it shares a common base functionality, |
| 38 | ;;; and a common set of bindings, with all modes derived from comint mode. |
| 39 | ;;; This makes these modes easier to use. |
| 40 | |
| 41 | ;;; For documentation on the functionality provided by comint mode, and |
| 42 | ;;; the hooks available for customising it, see the file comint.el. |
| 43 | ;;; For further information on shell mode, see the comments below. |
| 44 | |
| 45 | ;;; Needs fixin: |
| 46 | ;;; When sending text from a source file to a subprocess, the process-mark can |
| 47 | ;;; move off the window, so you can lose sight of the process interactions. |
| 48 | ;;; Maybe I should ensure the process mark is in the window when I send |
| 49 | ;;; text to the process? Switch selectable? |
| 50 | |
| 51 | ;; YOUR .EMACS FILE |
| 52 | ;;============================================================================= |
| 53 | ;; Some suggestions for your .emacs file. |
| 54 | ;; |
| 55 | ;; ;; Define C-c t to run my favorite command in shell mode: |
| 56 | ;; (setq shell-mode-hook |
| 57 | ;; '((lambda () |
| 58 | ;; (define-key shell-mode-map "\C-ct" 'favorite-cmd)))) |
| 59 | |
| 60 | \f |
| 61 | ;;; Brief Command Documentation: |
| 62 | ;;;============================================================================ |
| 63 | ;;; Comint Mode Commands: (common to shell and all comint-derived modes) |
| 64 | ;;; |
| 65 | ;;; m-p comint-previous-input Cycle backwards in input history |
| 66 | ;;; m-n comint-next-input Cycle forwards |
| 67 | ;;; m-r comint-previous-matching-input Previous input matching a regexp |
| 68 | ;;; m-R comint-previous-matching-input-from-input -"- matching input |
| 69 | ;;; m-s comint-next-matching-input Next input that matches |
| 70 | ;;; m-S comint-next-matching-input-from-input -"- matching input |
| 71 | ;;; m-c-l comint-show-output Show last batch of process output |
| 72 | ;;; return comint-send-input |
| 73 | ;;; c-a comint-bol Beginning of line; skip prompt |
| 74 | ;;; c-d comint-delchar-or-maybe-eof Delete char unless at end of buff. |
| 75 | ;;; c-c c-u comint-kill-input ^u |
| 76 | ;;; c-c c-w backward-kill-word ^w |
| 77 | ;;; c-c c-c comint-interrupt-subjob ^c |
| 78 | ;;; c-c c-z comint-stop-subjob ^z |
| 79 | ;;; c-c c-\ comint-quit-subjob ^\ |
| 80 | ;;; c-c c-o comint-kill-output Delete last batch of process output |
| 81 | ;;; c-c c-r comint-show-output Show last batch of process output |
| 82 | ;;; c-c c-h comint-dynamic-list-input-ring List input history |
| 83 | ;;; send-invisible Read line w/o echo & send to proc |
| 84 | ;;; comint-continue-subjob Useful if you accidentally suspend |
| 85 | ;;; top-level job |
| 86 | ;;; comint-mode-hook is the comint mode hook. |
| 87 | |
| 88 | ;;; Shell Mode Commands: |
| 89 | ;;; shell Fires up the shell process |
| 90 | ;;; tab comint-dynamic-complete Complete filename/command/history |
| 91 | ;;; m-? comint-dynamic-list-filename-completions List completions in help buffer |
| 92 | ;;; m-c-f shell-forward-command Forward a shell command |
| 93 | ;;; m-c-b shell-backward-command Backward a shell command |
| 94 | ;;; dirs Resync the buffer's dir stack |
| 95 | ;;; dirtrack-toggle Turn dir tracking on/off |
| 96 | ;;; |
| 97 | ;;; The shell mode hook is shell-mode-hook |
| 98 | ;;; comint-prompt-regexp is initialised to shell-prompt-pattern, for backwards |
| 99 | ;;; compatibility. |
| 100 | |
| 101 | ;;; Read the rest of this file for more information. |
| 102 | \f |
| 103 | ;;; SHELL.EL COMPATIBILITY |
| 104 | ;;; Notes from when this was called cmushell, and was not the standard emacs |
| 105 | ;;; shell package. |
| 106 | ;;;============================================================================ |
| 107 | ;;; In brief: this package should have no trouble coexisting with shell.el. |
| 108 | ;;; |
| 109 | ;;; Most customising variables -- e.g., explicit-shell-file-name -- are the |
| 110 | ;;; same, so the users shouldn't have much trouble. Hooks have different |
| 111 | ;;; names, however, so you can customise shell mode differently from cmushell |
| 112 | ;;; mode. You basically just have to remember to type M-x cmushell instead of |
| 113 | ;;; M-x shell. |
| 114 | ;;; |
| 115 | ;;; It would be nice if this file was completely plug-compatible with the old |
| 116 | ;;; shell package -- if you could just name this file shell.el, and have it |
| 117 | ;;; transparently replace the old one. But you can't. Several other packages |
| 118 | ;;; (tex-mode, background, dbx, gdb, kermit, monkey, prolog, telnet) are also |
| 119 | ;;; clients of shell mode. These packages assume detailed knowledge of shell |
| 120 | ;;; mode internals in ways that are incompatible with cmushell mode (mostly |
| 121 | ;;; because of cmushell mode's greater functionality). So, unless we are |
| 122 | ;;; willing to port all of these packages, we can't have this file be a |
| 123 | ;;; complete replacement for shell.el -- that is, we can't name this file |
| 124 | ;;; shell.el, and its main entry point (shell), because dbx.el will break |
| 125 | ;;; when it loads it in and tries to use it. |
| 126 | ;;; |
| 127 | ;;; There are two ways to fix this. One: rewrite these other modes to use the |
| 128 | ;;; new package. This is a win, but can't be assumed. The other, backwards |
| 129 | ;;; compatible route, is to make this package non-conflict with shell.el, so |
| 130 | ;;; both files can be loaded in at the same time. And *that* is why some |
| 131 | ;;; functions and variables have different names: (cmushell), |
| 132 | ;;; cmushell-mode-map, that sort of thing. All the names have been carefully |
| 133 | ;;; chosen so that shell.el and cmushell.el won't tromp on each other. |
| 134 | \f |
| 135 | ;;; Customization and Buffer Variables |
| 136 | ;;; =========================================================================== |
| 137 | ;;; |
| 138 | |
| 139 | ;;; Code: |
| 140 | |
| 141 | (require 'comint) |
| 142 | |
| 143 | ;;;###autoload |
| 144 | (defvar shell-prompt-pattern "^[^#$%>\n]*[#$%>] *" |
| 145 | "Regexp to match prompts in the inferior shell. |
| 146 | Defaults to \"^[^#$%>\\n]*[#$%>] *\", which works pretty well. |
| 147 | This variable is used to initialise `comint-prompt-regexp' in the |
| 148 | shell buffer. |
| 149 | |
| 150 | The pattern should probably not match more than one line. If it does, |
| 151 | shell-mode may become confused trying to distinguish prompt from input |
| 152 | on lines which don't start with a prompt. |
| 153 | |
| 154 | This is a fine thing to set in your `.emacs' file.") |
| 155 | |
| 156 | (defvar shell-delimiter-argument-list '("|" "&" "<" ">" "(" ")" ";") |
| 157 | "List of characters to recognise as separate arguments. |
| 158 | Defaults to \(\"|\" \"&\" \"\(\" \")\" \";\"), which works pretty well. |
| 159 | This variable is used to initialise `comint-delimiter-argument-list' in the |
| 160 | shell buffer. |
| 161 | |
| 162 | This is a fine thing to set in your `.emacs' file.") |
| 163 | |
| 164 | (defvar shell-command-regexp "\\((.*)\\|[^;&|]\\)+" |
| 165 | "*Regexp to match shell commands. |
| 166 | Elements of pipes are considered as separate commands, forks and redirections |
| 167 | as part of one command.") |
| 168 | |
| 169 | (defvar shell-completion-execonly t |
| 170 | "*If non-nil, use executable files only for completion candidates. |
| 171 | This mirrors the optional behavior of tcsh. |
| 172 | |
| 173 | Detecting executability of files may slow command completion considerably.") |
| 174 | |
| 175 | (defvar shell-popd-regexp "popd" |
| 176 | "*Regexp to match subshell commands equivalent to popd.") |
| 177 | |
| 178 | (defvar shell-pushd-regexp "pushd" |
| 179 | "*Regexp to match subshell commands equivalent to pushd.") |
| 180 | |
| 181 | (defvar shell-pushd-tohome nil |
| 182 | "*If non-nil, make pushd with no arg behave as \"pushd ~\" (like cd). |
| 183 | This mirrors the optional behavior of tcsh.") |
| 184 | |
| 185 | (defvar shell-pushd-dextract nil |
| 186 | "*If non-nil, make \"pushd +n\" pop the nth dir to the stack top. |
| 187 | This mirrors the optional behavior of tcsh.") |
| 188 | |
| 189 | (defvar shell-pushd-dunique nil |
| 190 | "*If non-nil, make pushd only add unique directories to the stack. |
| 191 | This mirrors the optional behavior of tcsh.") |
| 192 | |
| 193 | (defvar shell-cd-regexp "cd" |
| 194 | "*Regexp to match subshell commands equivalent to cd.") |
| 195 | |
| 196 | (defvar explicit-shell-file-name nil |
| 197 | "*If non-nil, is file name to use for explicitly requested inferior shell.") |
| 198 | |
| 199 | (defvar explicit-csh-args |
| 200 | (if (eq system-type 'hpux) |
| 201 | ;; -T persuades HP's csh not to think it is smarter |
| 202 | ;; than us about what terminal modes to use. |
| 203 | '("-i" "-T") |
| 204 | '("-i")) |
| 205 | "*Args passed to inferior shell by M-x shell, if the shell is csh. |
| 206 | Value is a list of strings, which may be nil.") |
| 207 | |
| 208 | (defvar shell-input-autoexpand 'history |
| 209 | "*If non-nil, expand input command history references on completion. |
| 210 | This mirrors the optional behavior of tcsh (its autoexpand and histlit). |
| 211 | |
| 212 | If the value is `input', then the expansion is seen on input. |
| 213 | If the value is `history', then the expansion is only when inserting |
| 214 | into the buffer's input ring. See also `comint-magic-space' and |
| 215 | `comint-dynamic-complete'. |
| 216 | |
| 217 | This variable supplies a default for `comint-input-autoexpand', |
| 218 | for Shell mode only.") |
| 219 | |
| 220 | (defvar shell-dirstack nil |
| 221 | "List of directories saved by pushd in this buffer's shell. |
| 222 | Thus, this does not include the shell's current directory.") |
| 223 | |
| 224 | (defvar shell-dirtrackp t |
| 225 | "Non-nil in a shell buffer means directory tracking is enabled.") |
| 226 | |
| 227 | (defvar shell-last-dir nil |
| 228 | "Keep track of last directory for ksh `cd -' command.") |
| 229 | |
| 230 | (defvar shell-dirstack-query "dirs" |
| 231 | "Command used by `shell-resync-dir' to query the shell.") |
| 232 | |
| 233 | (defvar shell-mode-map nil) |
| 234 | (cond ((not shell-mode-map) |
| 235 | (setq shell-mode-map (copy-keymap comint-mode-map)) |
| 236 | (define-key shell-mode-map "\C-c\C-f" 'shell-forward-command) |
| 237 | (define-key shell-mode-map "\C-c\C-b" 'shell-backward-command) |
| 238 | (define-key shell-mode-map "\t" 'comint-dynamic-complete) |
| 239 | (define-key shell-mode-map "\M-?" |
| 240 | 'comint-dynamic-list-filename-completions))) |
| 241 | |
| 242 | (defvar shell-mode-hook '() |
| 243 | "*Hook for customising Shell mode.") |
| 244 | |
| 245 | \f |
| 246 | ;;; Basic Procedures |
| 247 | ;;; =========================================================================== |
| 248 | ;;; |
| 249 | |
| 250 | (defun shell-mode () |
| 251 | "Major mode for interacting with an inferior shell. |
| 252 | Return after the end of the process' output sends the text from the |
| 253 | end of process to the end of the current line. |
| 254 | Return before end of process output copies the current line (except |
| 255 | for the prompt) to the end of the buffer and sends it. |
| 256 | M-x send-invisible reads a line of text without echoing it, and sends it to |
| 257 | the shell. This is useful for entering passwords. |
| 258 | |
| 259 | If you accidentally suspend your process, use \\[comint-continue-subjob] |
| 260 | to continue it. |
| 261 | |
| 262 | cd, pushd and popd commands given to the shell are watched by Emacs to keep |
| 263 | this buffer's default directory the same as the shell's working directory. |
| 264 | M-x dirs queries the shell and resyncs Emacs' idea of what the current |
| 265 | directory stack is. |
| 266 | M-x dirtrack-toggle turns directory tracking on and off. |
| 267 | |
| 268 | \\{shell-mode-map} |
| 269 | Customization: Entry to this mode runs the hooks on `comint-mode-hook' and |
| 270 | `shell-mode-hook' (in that order). After each shell output, the hooks on |
| 271 | `comint-output-filter-functions' are run. |
| 272 | |
| 273 | Variables `shell-cd-regexp', `shell-pushd-regexp' and `shell-popd-regexp' |
| 274 | are used to match their respective commands, while `shell-pushd-tohome', |
| 275 | `shell-pushd-dextract' and `shell-pushd-dunique' control the behavior of the |
| 276 | relevant command. |
| 277 | |
| 278 | Variables `comint-completion-autolist', `comint-completion-addsuffix' and |
| 279 | `comint-completion-recexact' control the behavior of file name, command name |
| 280 | and variable name completion. Variable `shell-completion-execonly' controls |
| 281 | the behavior of command name completion. |
| 282 | |
| 283 | Variables `comint-input-ring-file-name' and `comint-input-autoexpand' control |
| 284 | the initialisation of the input ring history, and history expansion. |
| 285 | |
| 286 | Variables `comint-output-filter-functions', `comint-scroll-to-bottom-on-input', |
| 287 | and `comint-scroll-to-bottom-on-output' control whether input and output |
| 288 | cause the window to scroll to the end of the buffer." |
| 289 | (interactive) |
| 290 | (comint-mode) |
| 291 | (setq major-mode 'shell-mode) |
| 292 | (setq mode-name "Shell") |
| 293 | (use-local-map shell-mode-map) |
| 294 | (setq comint-prompt-regexp shell-prompt-pattern) |
| 295 | (setq comint-delimiter-argument-list shell-delimiter-argument-list) |
| 296 | (setq comint-after-partial-filename-command 'shell-after-partial-filename) |
| 297 | (setq comint-get-current-command 'shell-get-current-command) |
| 298 | (setq comint-dynamic-complete-command-command 'shell-dynamic-complete-command) |
| 299 | (make-local-variable 'paragraph-start) |
| 300 | (setq paragraph-start comint-prompt-regexp) |
| 301 | (make-local-variable 'shell-dirstack) |
| 302 | (setq shell-dirstack nil) |
| 303 | (setq shell-last-dir nil) |
| 304 | (make-local-variable 'shell-dirtrackp) |
| 305 | (setq shell-dirtrackp t) |
| 306 | (setq comint-input-sentinel 'shell-directory-tracker) |
| 307 | (setq comint-input-autoexpand shell-input-autoexpand) |
| 308 | ;; shell-dependent assignments. |
| 309 | (let ((shell (car (process-command (get-buffer-process (current-buffer)))))) |
| 310 | (setq comint-input-ring-file-name |
| 311 | (or (getenv "HISTFILE") |
| 312 | (cond ((string-match "csh$" shell) "~/.history") |
| 313 | ((string-match "bash$" shell) "~/.bash_history") |
| 314 | ((string-match "ksh$" shell) "~/.sh_history") |
| 315 | (t "~/.history"))))) |
| 316 | (run-hooks 'shell-mode-hook) |
| 317 | (comint-read-input-ring t)) |
| 318 | \f |
| 319 | ;;;###autoload |
| 320 | (defun shell () |
| 321 | "Run an inferior shell, with I/O through buffer *shell*. |
| 322 | If buffer exists but shell process is not running, make new shell. |
| 323 | If buffer exists and shell process is running, just switch to buffer `*shell*'. |
| 324 | Program used comes from variable `explicit-shell-file-name', |
| 325 | or (if that is nil) from the ESHELL environment variable, |
| 326 | or else from SHELL if there is no ESHELL. |
| 327 | If a file `~/.emacs_SHELLNAME' exists, it is given as initial input |
| 328 | (Note that this may lose due to a timing error if the shell |
| 329 | discards input when it starts up.) |
| 330 | The buffer is put in Shell mode, giving commands for sending input |
| 331 | and controlling the subjobs of the shell. See `shell-mode'. |
| 332 | See also the variable `shell-prompt-pattern'. |
| 333 | |
| 334 | The shell file name (sans directories) is used to make a symbol name |
| 335 | such as `explicit-csh-args'. If that symbol is a variable, |
| 336 | its value is used as a list of arguments when invoking the shell. |
| 337 | Otherwise, one argument `-i' is passed to the shell. |
| 338 | |
| 339 | \(Type \\[describe-mode] in the shell buffer for a list of commands.)" |
| 340 | (interactive) |
| 341 | (if (not (comint-check-proc "*shell*")) |
| 342 | (let* ((prog (or explicit-shell-file-name |
| 343 | (getenv "ESHELL") |
| 344 | (getenv "SHELL") |
| 345 | "/bin/sh")) |
| 346 | (name (file-name-nondirectory prog)) |
| 347 | (startfile (concat "~/.emacs_" name)) |
| 348 | (xargs-name (intern-soft (concat "explicit-" name "-args")))) |
| 349 | (set-buffer (apply 'make-comint "shell" prog |
| 350 | (if (file-exists-p startfile) startfile) |
| 351 | (if (and xargs-name (boundp xargs-name)) |
| 352 | (symbol-value xargs-name) |
| 353 | '("-i")))) |
| 354 | (shell-mode))) |
| 355 | (switch-to-buffer "*shell*")) |
| 356 | \f |
| 357 | ;;; Directory tracking |
| 358 | ;;; =========================================================================== |
| 359 | ;;; This code provides the shell mode input sentinel |
| 360 | ;;; SHELL-DIRECTORY-TRACKER |
| 361 | ;;; that tracks cd, pushd, and popd commands issued to the shell, and |
| 362 | ;;; changes the current directory of the shell buffer accordingly. |
| 363 | ;;; |
| 364 | ;;; This is basically a fragile hack, although it's more accurate than |
| 365 | ;;; the version in Emacs 18's shell.el. It has the following failings: |
| 366 | ;;; 1. It doesn't know about the cdpath shell variable. |
| 367 | ;;; 2. It cannot infallibly deal with command sequences, though it does well |
| 368 | ;;; with these and with ignoring commands forked in another shell with ()s. |
| 369 | ;;; 3. More generally, any complex command is going to throw it. Otherwise, |
| 370 | ;;; you'd have to build an entire shell interpreter in emacs lisp. Failing |
| 371 | ;;; that, there's no way to catch shell commands where cd's are buried |
| 372 | ;;; inside conditional expressions, aliases, and so forth. |
| 373 | ;;; |
| 374 | ;;; The whole approach is a crock. Shell aliases mess it up. File sourcing |
| 375 | ;;; messes it up. You run other processes under the shell; these each have |
| 376 | ;;; separate working directories, and some have commands for manipulating |
| 377 | ;;; their w.d.'s (e.g., the lcd command in ftp). Some of these programs have |
| 378 | ;;; commands that do *not* affect the current w.d. at all, but look like they |
| 379 | ;;; do (e.g., the cd command in ftp). In shells that allow you job |
| 380 | ;;; control, you can switch between jobs, all having different w.d.'s. So |
| 381 | ;;; simply saying %3 can shift your w.d.. |
| 382 | ;;; |
| 383 | ;;; The solution is to relax, not stress out about it, and settle for |
| 384 | ;;; a hack that works pretty well in typical circumstances. Remember |
| 385 | ;;; that a half-assed solution is more in keeping with the spirit of Unix, |
| 386 | ;;; anyway. Blech. |
| 387 | ;;; |
| 388 | ;;; One good hack not implemented here for users of programmable shells |
| 389 | ;;; is to program up the shell w.d. manipulation commands to output |
| 390 | ;;; a coded command sequence to the tty. Something like |
| 391 | ;;; ESC | <cwd> | |
| 392 | ;;; where <cwd> is the new current working directory. Then trash the |
| 393 | ;;; directory tracking machinery currently used in this package, and |
| 394 | ;;; replace it with a process filter that watches for and strips out |
| 395 | ;;; these messages. |
| 396 | |
| 397 | (defun shell-directory-tracker (str) |
| 398 | "Tracks cd, pushd and popd commands issued to the shell. |
| 399 | This function is called on each input passed to the shell. |
| 400 | It watches for cd, pushd and popd commands and sets the buffer's |
| 401 | default directory to track these commands. |
| 402 | |
| 403 | You may toggle this tracking on and off with M-x dirtrack-toggle. |
| 404 | If emacs gets confused, you can resync with the shell with M-x dirs. |
| 405 | |
| 406 | See variables `shell-cd-regexp', `shell-pushd-regexp', and `shell-popd-regexp', |
| 407 | while `shell-pushd-tohome', `shell-pushd-dextract' and `shell-pushd-dunique' |
| 408 | control the behavior of the relevant command. |
| 409 | |
| 410 | Environment variables are expanded, see function `substitute-in-file-name'." |
| 411 | (if shell-dirtrackp |
| 412 | ;; We fail gracefully if we think the command will fail in the shell. |
| 413 | (condition-case chdir-failure |
| 414 | (let ((start (progn (string-match "^[;\\s ]*" str) ; skip whitespace |
| 415 | (match-end 0))) |
| 416 | end cmd arg1) |
| 417 | (while (string-match shell-command-regexp str start) |
| 418 | (setq end (match-end 0) |
| 419 | cmd (comint-arguments (substring str start end) 0 0) |
| 420 | arg1 (comint-arguments (substring str start end) 1 1)) |
| 421 | (cond ((eq (string-match shell-popd-regexp cmd) 0) |
| 422 | (shell-process-popd (substitute-in-file-name arg1))) |
| 423 | ((eq (string-match shell-pushd-regexp cmd) 0) |
| 424 | (shell-process-pushd (substitute-in-file-name arg1))) |
| 425 | ((eq (string-match shell-cd-regexp cmd) 0) |
| 426 | (shell-process-cd (substitute-in-file-name arg1)))) |
| 427 | (setq start (progn (string-match "[;\\s ]*" str end) ; skip again |
| 428 | (match-end 0))))) |
| 429 | (error (message "Couldn't cd"))))) |
| 430 | |
| 431 | ;;; popd [+n] |
| 432 | (defun shell-process-popd (arg) |
| 433 | (let ((num (or (shell-extract-num arg) 0))) |
| 434 | (cond ((and num (= num 0) shell-dirstack) |
| 435 | (cd (car shell-dirstack)) |
| 436 | (setq shell-dirstack (cdr shell-dirstack)) |
| 437 | (shell-dirstack-message)) |
| 438 | ((and num (> num 0) (<= num (length shell-dirstack))) |
| 439 | (let* ((ds (cons nil shell-dirstack)) |
| 440 | (cell (nthcdr (1- num) ds))) |
| 441 | (rplacd cell (cdr (cdr cell))) |
| 442 | (setq shell-dirstack (cdr ds)) |
| 443 | (shell-dirstack-message))) |
| 444 | (t |
| 445 | (error (message "Couldn't popd.")))))) |
| 446 | |
| 447 | ;; Return DIR prefixed with comint-file-name-prefix as appropriate. |
| 448 | (defsubst shell-prefixed-directory-name (dir) |
| 449 | (if (file-name-absolute-p dir) |
| 450 | ;; The name is absolute, so prepend the prefix. |
| 451 | (concat comint-file-name-prefix dir) |
| 452 | ;; For a relative name we assume default-directory already has the prefix. |
| 453 | (expand-file-name dir))) |
| 454 | |
| 455 | ;;; cd [dir] |
| 456 | (defun shell-process-cd (arg) |
| 457 | (let ((new-dir (cond ((zerop (length arg)) (concat comint-file-name-prefix |
| 458 | "~")) |
| 459 | ((string-equal "-" arg) shell-last-dir) |
| 460 | (t (shell-prefixed-directory-name arg))))) |
| 461 | (setq shell-last-dir default-directory) |
| 462 | (cd new-dir) |
| 463 | (shell-dirstack-message))) |
| 464 | |
| 465 | ;;; pushd [+n | dir] |
| 466 | (defun shell-process-pushd (arg) |
| 467 | (let ((num (shell-extract-num arg))) |
| 468 | (cond ((zerop (length arg)) |
| 469 | ;; no arg -- swap pwd and car of stack unless shell-pushd-tohome |
| 470 | (cond (shell-pushd-tohome |
| 471 | (shell-process-pushd (concat comint-file-name-prefix "~"))) |
| 472 | (shell-dirstack |
| 473 | (let ((old default-directory)) |
| 474 | (cd (car shell-dirstack)) |
| 475 | (setq shell-dirstack |
| 476 | (cons old (cdr shell-dirstack))) |
| 477 | (shell-dirstack-message))) |
| 478 | (t |
| 479 | (message "Directory stack empty.")))) |
| 480 | ((numberp num) |
| 481 | ;; pushd +n |
| 482 | (cond ((> num (length shell-dirstack)) |
| 483 | (message "Directory stack not that deep.")) |
| 484 | ((= num 0) |
| 485 | (error (message "Couldn't cd."))) |
| 486 | (shell-pushd-dextract |
| 487 | (let ((dir (nth (1- num) shell-dirstack))) |
| 488 | (shell-process-popd arg) |
| 489 | (shell-process-pushd default-directory) |
| 490 | (cd dir) |
| 491 | (shell-dirstack-message))) |
| 492 | (t |
| 493 | (let* ((ds (cons default-directory shell-dirstack)) |
| 494 | (dslen (length ds)) |
| 495 | (front (nthcdr num ds)) |
| 496 | (back (reverse (nthcdr (- dslen num) (reverse ds)))) |
| 497 | (new-ds (append front back))) |
| 498 | (cd (car new-ds)) |
| 499 | (setq shell-dirstack (cdr new-ds)) |
| 500 | (shell-dirstack-message))))) |
| 501 | (t |
| 502 | ;; pushd <dir> |
| 503 | (let ((old-wd default-directory)) |
| 504 | (cd (shell-prefixed-directory-name arg)) |
| 505 | (if (or (null shell-pushd-dunique) |
| 506 | (not (member old-wd shell-dirstack))) |
| 507 | (setq shell-dirstack (cons old-wd shell-dirstack))) |
| 508 | (shell-dirstack-message)))))) |
| 509 | |
| 510 | ;; If STR is of the form +n, for n>0, return n. Otherwise, nil. |
| 511 | (defun shell-extract-num (str) |
| 512 | (and (string-match "^\\+[1-9][0-9]*$" str) |
| 513 | (string-to-int str))) |
| 514 | |
| 515 | |
| 516 | (defun shell-dirtrack-toggle () |
| 517 | "Turn directory tracking on and off in a shell buffer." |
| 518 | (interactive) |
| 519 | (setq shell-dirtrackp (not shell-dirtrackp)) |
| 520 | (message "Directory tracking %s" (if shell-dirtrackp "ON" "OFF"))) |
| 521 | |
| 522 | ;;; For your typing convenience: |
| 523 | (defalias 'dirtrack-toggle 'shell-dirtrack-toggle) |
| 524 | |
| 525 | |
| 526 | (defun shell-resync-dirs () |
| 527 | "Resync the buffer's idea of the current directory stack. |
| 528 | This command queries the shell with the command bound to |
| 529 | `shell-dirstack-query' (default \"dirs\"), reads the next |
| 530 | line output and parses it to form the new directory stack. |
| 531 | DON'T issue this command unless the buffer is at a shell prompt. |
| 532 | Also, note that if some other subprocess decides to do output |
| 533 | immediately after the query, its output will be taken as the |
| 534 | new directory stack -- you lose. If this happens, just do the |
| 535 | command again." |
| 536 | (interactive) |
| 537 | (let* ((proc (get-buffer-process (current-buffer))) |
| 538 | (pmark (process-mark proc))) |
| 539 | (goto-char pmark) |
| 540 | (insert shell-dirstack-query) (insert "\n") |
| 541 | (sit-for 0) ; force redisplay |
| 542 | (comint-send-string proc shell-dirstack-query) |
| 543 | (comint-send-string proc "\n") |
| 544 | (set-marker pmark (point)) |
| 545 | (let ((pt (point))) ; wait for 1 line |
| 546 | ;; This extra newline prevents the user's pending input from spoofing us. |
| 547 | (insert "\n") (backward-char 1) |
| 548 | (while (not (looking-at ".+\n")) |
| 549 | (accept-process-output proc) |
| 550 | (goto-char pt))) |
| 551 | (goto-char pmark) (delete-char 1) ; remove the extra newline |
| 552 | ;; That's the dirlist. grab it & parse it. |
| 553 | (let* ((dl (buffer-substring (match-beginning 0) (1- (match-end 0)))) |
| 554 | (dl-len (length dl)) |
| 555 | (ds '()) ; new dir stack |
| 556 | (i 0)) |
| 557 | (while (< i dl-len) |
| 558 | ;; regexp = optional whitespace, (non-whitespace), optional whitespace |
| 559 | (string-match "\\s *\\(\\S +\\)\\s *" dl i) ; pick off next dir |
| 560 | (setq ds (cons (concat comint-file-name-prefix |
| 561 | (substring dl (match-beginning 1) |
| 562 | (match-end 1))) |
| 563 | ds)) |
| 564 | (setq i (match-end 0))) |
| 565 | (let ((ds (nreverse ds))) |
| 566 | (condition-case nil |
| 567 | (progn (cd (car ds)) |
| 568 | (setq shell-dirstack (cdr ds)) |
| 569 | (shell-dirstack-message)) |
| 570 | (error (message "Couldn't cd."))))))) |
| 571 | |
| 572 | ;;; For your typing convenience: |
| 573 | (defalias 'dirs 'shell-resync-dirs) |
| 574 | |
| 575 | |
| 576 | ;;; Show the current dirstack on the message line. |
| 577 | ;;; Pretty up dirs a bit by changing "/usr/jqr/foo" to "~/foo". |
| 578 | ;;; (This isn't necessary if the dirlisting is generated with a simple "dirs".) |
| 579 | ;;; All the commands that mung the buffer's dirstack finish by calling |
| 580 | ;;; this guy. |
| 581 | (defun shell-dirstack-message () |
| 582 | (let* ((msg "") |
| 583 | (ds (cons default-directory shell-dirstack)) |
| 584 | (home (expand-file-name (concat comint-file-name-prefix "~/"))) |
| 585 | (homelen (length home))) |
| 586 | (while ds |
| 587 | (let ((dir (car ds))) |
| 588 | (and (>= (length dir) homelen) (string= home (substring dir 0 homelen)) |
| 589 | (setq dir (concat "~/" (substring dir homelen)))) |
| 590 | ;; Strip off comint-file-name-prefix if present. |
| 591 | (and comint-file-name-prefix |
| 592 | (>= (length dir) (length comint-file-name-prefix)) |
| 593 | (string= comint-file-name-prefix |
| 594 | (substring dir 0 (length comint-file-name-prefix))) |
| 595 | (setq dir (substring dir (length comint-file-name-prefix))) |
| 596 | (setcar ds dir)) |
| 597 | (setq msg (concat msg (directory-file-name dir) " ")) |
| 598 | (setq ds (cdr ds)))) |
| 599 | (message msg))) |
| 600 | \f |
| 601 | (defun shell-forward-command (&optional arg) |
| 602 | "Move forward across ARG shell command(s). Does not cross lines. |
| 603 | See `shell-command-regexp'." |
| 604 | (interactive "p") |
| 605 | (let ((limit (save-excursion (end-of-line nil) (point)))) |
| 606 | (if (re-search-forward (concat shell-command-regexp "\\([;&|][\\s ]*\\)+") |
| 607 | limit 'move arg) |
| 608 | (skip-syntax-backward " ")))) |
| 609 | |
| 610 | |
| 611 | (defun shell-backward-command (&optional arg) |
| 612 | "Move backward across ARG shell command(s). Does not cross lines. |
| 613 | See `shell-command-regexp'." |
| 614 | (interactive "p") |
| 615 | (let ((limit (save-excursion (comint-bol nil) (point)))) |
| 616 | (if (> limit (point)) |
| 617 | (save-excursion (beginning-of-line) (setq limit (point)))) |
| 618 | (skip-syntax-backward " " limit) |
| 619 | (if (re-search-backward |
| 620 | (format "[;&|]+[\\s ]*\\(%s\\)" shell-command-regexp) limit 'move arg) |
| 621 | (progn (goto-char (match-beginning 1)) |
| 622 | (skip-chars-forward ";&|"))))) |
| 623 | |
| 624 | |
| 625 | (defun shell-get-current-command () |
| 626 | "Function that returns the current command including arguments." |
| 627 | (save-excursion |
| 628 | (if (looking-at "[\t ]*[^;&|\n]") |
| 629 | (goto-char (match-end 0))) |
| 630 | (buffer-substring |
| 631 | (progn (shell-backward-command 1) (point)) |
| 632 | (progn (shell-forward-command 1) (if (eolp) (point) (match-end 1)))))) |
| 633 | |
| 634 | |
| 635 | (defun shell-after-partial-filename () |
| 636 | "Returns t if point is after a file name. |
| 637 | File names are assumed to contain `/'s or not be the first item in the command. |
| 638 | |
| 639 | See also `shell-backward-command'." |
| 640 | (let ((filename (comint-match-partial-filename))) |
| 641 | (or (save-match-data (string-match "/" filename)) |
| 642 | (not (eq (match-beginning 0) |
| 643 | (save-excursion (shell-backward-command 1) (point))))))) |
| 644 | |
| 645 | |
| 646 | (defun shell-dynamic-complete-command () |
| 647 | "Dynamically complete the command at point. |
| 648 | This function is similar to `comint-dynamic-complete-filename', except that it |
| 649 | searches `exec-path' (minus the trailing emacs library path) for completion |
| 650 | candidates. Note that this may not be the same as the shell's idea of the |
| 651 | path. |
| 652 | |
| 653 | Completion is dependent on the value of `shell-completion-execonly', plus |
| 654 | those that effect file completion. See `comint-dynamic-complete-filename'." |
| 655 | (interactive) |
| 656 | (let* ((completion-ignore-case nil) |
| 657 | (filename (comint-match-partial-filename)) |
| 658 | (pathnondir (file-name-nondirectory filename)) |
| 659 | (paths (cdr (reverse exec-path))) |
| 660 | (cwd (file-name-as-directory (expand-file-name default-directory))) |
| 661 | (ignored-extensions |
| 662 | (mapconcat (function (lambda (x) (concat (regexp-quote x) "$"))) |
| 663 | completion-ignored-extensions "\\|")) |
| 664 | (path "") (comps-in-path ()) (file "") (filepath "") (completions ())) |
| 665 | ;; Go thru each path in the search path, finding completions. |
| 666 | (while paths |
| 667 | (setq path (file-name-as-directory (comint-directory (or (car paths) "."))) |
| 668 | comps-in-path (and (file-accessible-directory-p path) |
| 669 | (file-name-all-completions pathnondir path))) |
| 670 | ;; Go thru each completion found, to see whether it should be used. |
| 671 | (while comps-in-path |
| 672 | (setq file (car comps-in-path) |
| 673 | filepath (concat path file)) |
| 674 | (if (and (not (member file completions)) |
| 675 | (not (string-match ignored-extensions file)) |
| 676 | (or (string-equal path cwd) |
| 677 | (not (file-directory-p filepath))) |
| 678 | (or (null shell-completion-execonly) |
| 679 | (file-executable-p filepath))) |
| 680 | (setq completions (cons file completions))) |
| 681 | (setq comps-in-path (cdr comps-in-path))) |
| 682 | (setq paths (cdr paths))) |
| 683 | ;; OK, we've got a list of completions. |
| 684 | (cond ((null completions) |
| 685 | (message "No completions of %s" filename) |
| 686 | (ding)) |
| 687 | ((= 1 (length completions)) ; Gotcha! |
| 688 | (let ((completion (car completions))) |
| 689 | (if (string-equal completion pathnondir) |
| 690 | (message "Sole completion") |
| 691 | (insert (substring (directory-file-name completion) |
| 692 | (length pathnondir))) |
| 693 | (message "Completed")) |
| 694 | (if comint-completion-addsuffix |
| 695 | (insert (if (file-directory-p completion) "/" " "))))) |
| 696 | (t ; There's no unique completion. |
| 697 | (let ((completion |
| 698 | (try-completion pathnondir (mapcar (function (lambda (x) |
| 699 | (list x))) |
| 700 | completions)))) |
| 701 | ;; Insert the longest substring. |
| 702 | (insert (substring (directory-file-name completion) |
| 703 | (length pathnondir))) |
| 704 | (cond ((and comint-completion-recexact comint-completion-addsuffix |
| 705 | (string-equal pathnondir completion) |
| 706 | (member completion completions)) |
| 707 | ;; It's not unique, but user wants shortest match. |
| 708 | (insert (if (file-directory-p completion) "/" " ")) |
| 709 | (message "Completed shortest")) |
| 710 | ((or comint-completion-autolist |
| 711 | (string-equal pathnondir completion)) |
| 712 | ;; It's not unique, list possible completions. |
| 713 | (comint-dynamic-list-completions completions)) |
| 714 | (t |
| 715 | (message "Partially completed")))))))) |
| 716 | \f |
| 717 | ;;; Do the user's customization... |
| 718 | ;;; |
| 719 | ;;; Isn't this what eval-after-load is for? |
| 720 | ;;;(defvar shell-load-hook nil |
| 721 | ;;; "This hook is run when shell is loaded in. |
| 722 | ;;;This is a good place to put keybindings.") |
| 723 | ;;; |
| 724 | ;;;(run-hooks 'shell-load-hook) |
| 725 | |
| 726 | (provide 'shell) |
| 727 | |
| 728 | ;;; shell.el ends here |