| 1 | ;;; old-shell.el --- run a shell in an Emacs window |
| 2 | |
| 3 | ;; Copyright (C) 1985, 1986, 1987, 1990 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Keywords: processes |
| 6 | |
| 7 | ;; This file is part of GNU Emacs. |
| 8 | |
| 9 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 10 | ;; it under the terms of the GNU General Public License as published by |
| 11 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 12 | ;; any later version. |
| 13 | |
| 14 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 17 | ;; GNU General Public License for more details. |
| 18 | |
| 19 | ;; You should have received a copy of the GNU General Public License |
| 20 | ;; along with GNU Emacs; see the file COPYING. If not, write to |
| 21 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
| 22 | |
| 23 | ;;; Hacked from tea.el and shell.el by Olin Shivers (shivers@cs.cmu.edu). 8/88 |
| 24 | |
| 25 | ;;; Since this mode is built on top of the general command-interpreter-in- |
| 26 | ;;; a-buffer mode (comint mode), it shares a common base functionality, |
| 27 | ;;; and a common set of bindings, with all modes derived from comint mode. |
| 28 | |
| 29 | ;;; For documentation on the functionality provided by comint mode, and |
| 30 | ;;; the hooks available for customising it, see the file comint.el. |
| 31 | |
| 32 | ;;; Needs fixin: |
| 33 | ;;; When sending text from a source file to a subprocess, the process-mark can |
| 34 | ;;; move off the window, so you can lose sight of the process interactions. |
| 35 | ;;; Maybe I should ensure the process mark is in the window when I send |
| 36 | ;;; text to the process? Switch selectable? |
| 37 | |
| 38 | ;;; Code: |
| 39 | |
| 40 | (require 'comint) |
| 41 | (defvar shell-popd-regexp "popd" |
| 42 | "*Regexp to match subshell commands equivalent to popd.") |
| 43 | |
| 44 | (defvar shell-pushd-regexp "pushd" |
| 45 | "*Regexp to match subshell commands equivalent to pushd.") |
| 46 | |
| 47 | (defvar shell-cd-regexp "cd" |
| 48 | "*Regexp to match subshell commands equivalent to cd.") |
| 49 | |
| 50 | (defvar explicit-shell-file-name nil |
| 51 | "*If non-nil, is file name to use for explicitly requested inferior shell.") |
| 52 | |
| 53 | (defvar explicit-csh-args |
| 54 | (if (eq system-type 'hpux) |
| 55 | ;; -T persuades HP's csh not to think it is smarter |
| 56 | ;; than us about what terminal modes to use. |
| 57 | '("-i" "-T") |
| 58 | '("-i")) |
| 59 | "*Args passed to inferior shell by M-x shell, if the shell is csh. |
| 60 | Value is a list of strings, which may be nil.") |
| 61 | |
| 62 | (defvar shell-dirstack nil |
| 63 | "List of directories saved by pushd in this buffer's shell.") |
| 64 | |
| 65 | (defvar shell-dirstack-query "dirs" |
| 66 | "Command used by shell-resync-dirlist to query shell.") |
| 67 | |
| 68 | (defvar shell-mode-map ()) |
| 69 | (cond ((not shell-mode-map) |
| 70 | (setq shell-mode-map (copy-keymap comint-mode-map)) |
| 71 | (define-key shell-mode-map "\t" 'comint-dynamic-complete) |
| 72 | (define-key shell-mode-map "\M-?" 'comint-dynamic-list-completions))) |
| 73 | |
| 74 | (defvar shell-mode-hook '() |
| 75 | "*Hook for customising shell mode") |
| 76 | |
| 77 | \f |
| 78 | ;;; Basic Procedures |
| 79 | ;;; =========================================================================== |
| 80 | ;;; |
| 81 | |
| 82 | (defun shell-mode () |
| 83 | "Major mode for interacting with an inferior shell. |
| 84 | Return after the end of the process' output sends the text from the |
| 85 | end of process to the end of the current line. |
| 86 | Return before end of process output copies rest of line to end (skipping |
| 87 | the prompt) and sends it. |
| 88 | M-x send-invisible reads a line of text without echoing it, and sends it to |
| 89 | the shell. |
| 90 | |
| 91 | If you accidentally suspend your process, use \\[comint-continue-subjob] |
| 92 | to continue it. |
| 93 | |
| 94 | cd, pushd and popd commands given to the shell are watched by Emacs to keep |
| 95 | this buffer's default directory the same as the shell's working directory. |
| 96 | M-x dirs queries the shell and resyncs Emacs' idea of what the current |
| 97 | directory stack is. |
| 98 | M-x dirtrack-toggle turns directory tracking on and off. |
| 99 | |
| 100 | \\{shell-mode-map} |
| 101 | Customisation: Entry to this mode runs the hooks on comint-mode-hook and |
| 102 | shell-mode-hook (in that order). |
| 103 | |
| 104 | Variables shell-cd-regexp, shell-pushd-regexp and shell-popd-regexp are used |
| 105 | to match their respective commands." |
| 106 | (interactive) |
| 107 | (comint-mode) |
| 108 | (setq major-mode 'shell-mode |
| 109 | mode-name "Shell" |
| 110 | comint-prompt-regexp shell-prompt-pattern |
| 111 | comint-input-sentinel 'shell-directory-tracker) |
| 112 | (use-local-map shell-mode-map) |
| 113 | (make-local-variable 'shell-dirstack) |
| 114 | (set (make-local-variable 'shell-dirtrackp) t) |
| 115 | (run-hooks 'shell-mode-hook)) |
| 116 | |
| 117 | \f |
| 118 | (defun shell () |
| 119 | "Run an inferior shell, with I/O through buffer *shell*. |
| 120 | If buffer exists but shell process is not running, make new shell. |
| 121 | If buffer exists and shell process is running, just switch to buffer *shell*. |
| 122 | |
| 123 | The shell to use comes from the first non-nil variable found from these: |
| 124 | explicit-shell-file-name in Emacs, ESHELL in the environment or SHELL in the |
| 125 | environment. If none is found, /bin/sh is used. |
| 126 | |
| 127 | If a file ~/.emacs_SHELLNAME exists, it is given as initial input, simulating |
| 128 | a start-up file for the shell like .profile or .cshrc. Note that this may |
| 129 | lose due to a timing error if the shell discards input when it starts up. |
| 130 | |
| 131 | The buffer is put in shell-mode, giving commands for sending input |
| 132 | and controlling the subjobs of the shell. |
| 133 | |
| 134 | The shell file name, sans directories, is used to make a symbol name |
| 135 | such as `explicit-csh-arguments'. If that symbol is a variable, |
| 136 | its value is used as a list of arguments when invoking the shell. |
| 137 | Otherwise, one argument `-i' is passed to the shell. |
| 138 | |
| 139 | \(Type \\[describe-mode] in the shell buffer for a list of commands.)" |
| 140 | (interactive) |
| 141 | (if (not (comint-check-proc "*shell*")) |
| 142 | (let* ((prog (or explicit-shell-file-name |
| 143 | (getenv "ESHELL") |
| 144 | (getenv "SHELL") |
| 145 | "/bin/sh")) |
| 146 | (name (file-name-nondirectory prog)) |
| 147 | (startfile (concat "~/.emacs_" name)) |
| 148 | (xargs-name (intern-soft (concat "explicit-" name "-args")))) |
| 149 | (set-buffer (apply 'make-comint "shell" prog |
| 150 | (if (file-exists-p startfile) startfile) |
| 151 | (if (and xargs-name (boundp xargs-name)) |
| 152 | (symbol-value xargs-name) |
| 153 | '("-i")))) |
| 154 | (shell-mode))) |
| 155 | (switch-to-buffer "*shell*")) |
| 156 | |
| 157 | \f |
| 158 | ;;; Directory tracking |
| 159 | ;;; =========================================================================== |
| 160 | ;;; This code provides the shell mode input sentinel |
| 161 | ;;; SHELL-DIRECTORY-TRACKER |
| 162 | ;;; that tracks cd, pushd, and popd commands issued to the shell, and |
| 163 | ;;; changes the current directory of the shell buffer accordingly. |
| 164 | ;;; |
| 165 | ;;; This is basically a fragile hack, although it's more accurate than |
| 166 | ;;; the original version in shell.el. It has the following failings: |
| 167 | ;;; 1. It doesn't know about the cdpath shell variable. |
| 168 | ;;; 2. It only spots the first command in a command sequence. E.g., it will |
| 169 | ;;; miss the cd in "ls; cd foo" |
| 170 | ;;; 3. More generally, any complex command (like ";" sequencing) is going to |
| 171 | ;;; throw it. Otherwise, you'd have to build an entire shell interpreter in |
| 172 | ;;; emacs lisp. Failing that, there's no way to catch shell commands where |
| 173 | ;;; cd's are buried inside conditional expressions, aliases, and so forth. |
| 174 | ;;; |
| 175 | ;;; The whole approach is a crock. Shell aliases mess it up. File sourcing |
| 176 | ;;; messes it up. You run other processes under the shell; these each have |
| 177 | ;;; separate working directories, and some have commands for manipulating |
| 178 | ;;; their w.d.'s (e.g., the lcd command in ftp). Some of these programs have |
| 179 | ;;; commands that do *not* effect the current w.d. at all, but look like they |
| 180 | ;;; do (e.g., the cd command in ftp). In shells that allow you job |
| 181 | ;;; control, you can switch between jobs, all having different w.d.'s. So |
| 182 | ;;; simply saying %3 can shift your w.d.. |
| 183 | ;;; |
| 184 | ;;; The solution is to relax, not stress out about it, and settle for |
| 185 | ;;; a hack that works pretty well in typical circumstances. Remember |
| 186 | ;;; that a half-assed solution is more in keeping with the spirit of Unix, |
| 187 | ;;; anyway. Blech. |
| 188 | ;;; |
| 189 | ;;; One good hack not implemented here for users of programmable shells |
| 190 | ;;; is to program up the shell w.d. manipulation commands to output |
| 191 | ;;; a coded command sequence to the tty. Something like |
| 192 | ;;; ESC | <cwd> | |
| 193 | ;;; where <cwd> is the new current working directory. Then trash the |
| 194 | ;;; directory tracking machinery currently used in this package, and |
| 195 | ;;; replace it with a process filter that watches for and strips out |
| 196 | ;;; these messages. |
| 197 | |
| 198 | ;;; REGEXP is a regular expression. STR is a string. START is a fixnum. |
| 199 | ;;; Returns T if REGEXP matches STR where the match is anchored to start |
| 200 | ;;; at position START in STR. Sort of like LOOKING-AT for strings. |
| 201 | (defun shell-front-match (regexp str start) |
| 202 | (eq start (string-match regexp str start))) |
| 203 | |
| 204 | (defun shell-directory-tracker (str) |
| 205 | "Tracks cd, pushd and popd commands issued to the shell. |
| 206 | This function is called on each input passed to the shell. |
| 207 | It watches for cd, pushd and popd commands and sets the buffer's |
| 208 | default directory to track these commands. |
| 209 | |
| 210 | You may toggle this tracking on and off with M-x dirtrack-toggle. |
| 211 | If emacs gets confused, you can resync with the shell with M-x dirs. |
| 212 | |
| 213 | See variables shell-cd-regexp, shell-pushd-regexp, and shell-popd-regexp. |
| 214 | Environment variables are expanded, see function substitute-in-file-name." |
| 215 | (condition-case err |
| 216 | (cond (shell-dirtrackp |
| 217 | (string-match "^\\s *" str) ; skip whitespace |
| 218 | (let ((bos (match-end 0)) |
| 219 | (x nil)) |
| 220 | (cond ((setq x (shell-match-cmd-w/optional-arg shell-popd-regexp |
| 221 | str bos)) |
| 222 | (shell-process-popd (substitute-in-file-name x))) |
| 223 | ((setq x (shell-match-cmd-w/optional-arg shell-pushd-regexp |
| 224 | str bos)) |
| 225 | (shell-process-pushd (substitute-in-file-name x))) |
| 226 | ((setq x (shell-match-cmd-w/optional-arg shell-cd-regexp |
| 227 | str bos)) |
| 228 | (shell-process-cd (substitute-in-file-name x))))))) |
| 229 | (error (message (car (cdr err)))))) |
| 230 | |
| 231 | |
| 232 | ;;; Try to match regexp CMD to string, anchored at position START. |
| 233 | ;;; CMD may be followed by a single argument. If a match, then return |
| 234 | ;;; the argument, if there is one, or the empty string if not. If |
| 235 | ;;; no match, return nil. |
| 236 | |
| 237 | (defun shell-match-cmd-w/optional-arg (cmd str start) |
| 238 | (and (shell-front-match cmd str start) |
| 239 | (let ((eoc (match-end 0))) ; end of command |
| 240 | (cond ((shell-front-match "\\s *\\(\;\\|$\\)" str eoc) |
| 241 | "") ; no arg |
| 242 | ((shell-front-match "\\s +\\([^ \t\;]+\\)\\s *\\(\;\\|$\\)" |
| 243 | str eoc) |
| 244 | (substring str (match-beginning 1) (match-end 1))) ; arg |
| 245 | (t nil))))) ; something else. |
| 246 | ;;; The first regexp is [optional whitespace, (";" or the end of string)]. |
| 247 | ;;; The second regexp is [whitespace, (an arg), optional whitespace, |
| 248 | ;;; (";" or end of string)]. |
| 249 | |
| 250 | |
| 251 | ;;; popd [+n] |
| 252 | (defun shell-process-popd (arg) |
| 253 | (let ((num (if (zerop (length arg)) 0 ; no arg means +0 |
| 254 | (shell-extract-num arg)))) |
| 255 | (if (and num (< num (length shell-dirstack))) |
| 256 | (if (= num 0) ; condition-case because the CD could lose. |
| 257 | (condition-case nil (progn (cd (car shell-dirstack)) |
| 258 | (setq shell-dirstack |
| 259 | (cdr shell-dirstack)) |
| 260 | (shell-dirstack-message)) |
| 261 | (error (message "Couldn't cd."))) |
| 262 | (let* ((ds (cons nil shell-dirstack)) |
| 263 | (cell (nthcdr (- num 1) ds))) |
| 264 | (rplacd cell (cdr (cdr cell))) |
| 265 | (setq shell-dirstack (cdr ds)) |
| 266 | (shell-dirstack-message))) |
| 267 | (message "Bad popd.")))) |
| 268 | |
| 269 | |
| 270 | ;;; cd [dir] |
| 271 | (defun shell-process-cd (arg) |
| 272 | (condition-case nil (progn (cd (if (zerop (length arg)) (getenv "HOME") |
| 273 | arg)) |
| 274 | (shell-dirstack-message)) |
| 275 | (error (message "Couldn't cd.")))) |
| 276 | |
| 277 | |
| 278 | ;;; pushd [+n | dir] |
| 279 | (defun shell-process-pushd (arg) |
| 280 | (if (zerop (length arg)) |
| 281 | ;; no arg -- swap pwd and car of shell stack |
| 282 | (condition-case nil (if shell-dirstack |
| 283 | (let ((old default-directory)) |
| 284 | (cd (car shell-dirstack)) |
| 285 | (setq shell-dirstack |
| 286 | (cons old (cdr shell-dirstack))) |
| 287 | (shell-dirstack-message)) |
| 288 | (message "Directory stack empty.")) |
| 289 | (message "Couldn't cd.")) |
| 290 | |
| 291 | (let ((num (shell-extract-num arg))) |
| 292 | (if num ; pushd +n |
| 293 | (if (> num (length shell-dirstack)) |
| 294 | (message "Directory stack not that deep.") |
| 295 | (let* ((ds (cons default-directory shell-dirstack)) |
| 296 | (dslen (length ds)) |
| 297 | (front (nthcdr num ds)) |
| 298 | (back (reverse (nthcdr (- dslen num) (reverse ds)))) |
| 299 | (new-ds (append front back))) |
| 300 | (condition-case nil |
| 301 | (progn (cd (car new-ds)) |
| 302 | (setq shell-dirstack (cdr new-ds)) |
| 303 | (shell-dirstack-message)) |
| 304 | (error (message "Couldn't cd."))))) |
| 305 | |
| 306 | ;; pushd <dir> |
| 307 | (let ((old-wd default-directory)) |
| 308 | (condition-case nil |
| 309 | (progn (cd arg) |
| 310 | (setq shell-dirstack |
| 311 | (cons old-wd shell-dirstack)) |
| 312 | (shell-dirstack-message)) |
| 313 | (error (message "Couldn't cd.")))))))) |
| 314 | |
| 315 | ;; If STR is of the form +n, for n>0, return n. Otherwise, nil. |
| 316 | (defun shell-extract-num (str) |
| 317 | (and (string-match "^\\+[1-9][0-9]*$" str) |
| 318 | (string-to-int str))) |
| 319 | |
| 320 | |
| 321 | (defun shell-dirtrack-toggle () |
| 322 | "Turn directory tracking on and off in a shell buffer." |
| 323 | (interactive) |
| 324 | (setq shell-dirtrackp (not shell-dirtrackp)) |
| 325 | (message "directory tracking %s." |
| 326 | (if shell-dirtrackp "ON" "OFF"))) |
| 327 | |
| 328 | ;;; For your typing convenience: |
| 329 | (fset 'dirtrack-toggle 'shell-dirtrack-toggle) |
| 330 | |
| 331 | |
| 332 | (defun shell-resync-dirs () |
| 333 | "Resync the buffer's idea of the current directory stack. |
| 334 | This command queries the shell with the command bound to |
| 335 | shell-dirstack-query (default \"dirs\"), reads the next |
| 336 | line output and parses it to form the new directory stack. |
| 337 | DON'T issue this command unless the buffer is at a shell prompt. |
| 338 | Also, note that if some other subprocess decides to do output |
| 339 | immediately after the query, its output will be taken as the |
| 340 | new directory stack -- you lose. If this happens, just do the |
| 341 | command again." |
| 342 | (interactive) |
| 343 | (let* ((proc (get-buffer-process (current-buffer))) |
| 344 | (pmark (process-mark proc))) |
| 345 | (goto-char pmark) |
| 346 | (insert shell-dirstack-query) (insert "\n") |
| 347 | (sit-for 0) ; force redisplay |
| 348 | (comint-send-string proc shell-dirstack-query) |
| 349 | (comint-send-string proc "\n") |
| 350 | (set-marker pmark (point)) |
| 351 | (let ((pt (point))) ; wait for 1 line |
| 352 | ;; This extra newline prevents the user's pending input from spoofing us. |
| 353 | (insert "\n") (backward-char 1) |
| 354 | (while (not (looking-at ".+\n")) |
| 355 | (accept-process-output proc) |
| 356 | (goto-char pt))) |
| 357 | (goto-char pmark) (delete-char 1) ; remove the extra newline |
| 358 | ;; That's the dirlist. grab it & parse it. |
| 359 | (let* ((dl (buffer-substring (match-beginning 0) (- (match-end 0) 1))) |
| 360 | (dl-len (length dl)) |
| 361 | (ds '()) ; new dir stack |
| 362 | (i 0)) |
| 363 | (while (< i dl-len) |
| 364 | ;; regexp = optional whitespace, (non-whitespace), optional whitespace |
| 365 | (string-match "\\s *\\(\\S +\\)\\s *" dl i) ; pick off next dir |
| 366 | (setq ds (cons (substring dl (match-beginning 1) (match-end 1)) |
| 367 | ds)) |
| 368 | (setq i (match-end 0))) |
| 369 | (let ((ds (reverse ds))) |
| 370 | (condition-case nil |
| 371 | (progn (cd (car ds)) |
| 372 | (setq shell-dirstack (cdr ds)) |
| 373 | (shell-dirstack-message)) |
| 374 | (error (message "Couldn't cd."))))))) |
| 375 | |
| 376 | ;;; For your typing convenience: |
| 377 | (fset 'dirs 'shell-resync-dirs) |
| 378 | |
| 379 | |
| 380 | ;;; Show the current dirstack on the message line. |
| 381 | ;;; Pretty up dirs a bit by changing "/usr/jqr/foo" to "~/foo". |
| 382 | ;;; (This isn't necessary if the dirlisting is generated with a simple "dirs".) |
| 383 | ;;; All the commands that mung the buffer's dirstack finish by calling |
| 384 | ;;; this guy. |
| 385 | (defun shell-dirstack-message () |
| 386 | (let ((msg "") |
| 387 | (ds (cons default-directory shell-dirstack))) |
| 388 | (while ds |
| 389 | (let ((dir (car ds))) |
| 390 | (if (string-match (format "^%s\\(/\\|$\\)" (getenv "HOME")) dir) |
| 391 | (setq dir (concat "~/" (substring dir (match-end 0))))) |
| 392 | (if (string-equal dir "~/") (setq dir "~")) |
| 393 | (setq msg (concat msg dir " ")) |
| 394 | (setq ds (cdr ds)))) |
| 395 | (message msg))) |
| 396 | |
| 397 | (provide 'shell) |
| 398 | |
| 399 | ;;; old-shell.el ends here |