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