Commit | Line | Data |
---|---|---|
e9571d2a ER |
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 |