aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGerd Moellmann2000-06-23 05:24:10 +0000
committerGerd Moellmann2000-06-23 05:24:10 +0000
commitaffbf6477576c38d98111b55fbb1eb5b13d1a735 (patch)
treee7cccedd38944fc20cf2d20a3949246d8d558bf7
parent022499fab948938bb763c2a33a8c5ba0c5969fcd (diff)
downloademacs-affbf6477576c38d98111b55fbb1eb5b13d1a735.tar.gz
emacs-affbf6477576c38d98111b55fbb1eb5b13d1a735.zip
*** empty log message ***
-rw-r--r--lisp/ChangeLog5
-rw-r--r--lisp/eshell/em-alias.el270
-rw-r--r--lisp/eshell/em-banner.el90
-rw-r--r--lisp/eshell/em-basic.el183
-rw-r--r--lisp/eshell/em-cmpl.el443
-rw-r--r--lisp/eshell/em-dirs.el563
-rw-r--r--lisp/eshell/em-glob.el357
-rw-r--r--lisp/eshell/em-hist.el966
-rw-r--r--lisp/eshell/em-ls.el863
-rw-r--r--lisp/eshell/em-pred.el602
-rw-r--r--lisp/eshell/em-prompt.el174
-rw-r--r--lisp/eshell/em-rebind.el248
-rw-r--r--lisp/eshell/em-script.el130
-rw-r--r--lisp/eshell/em-smart.el305
-rw-r--r--lisp/eshell/em-term.el266
-rw-r--r--lisp/eshell/em-unix.el927
-rw-r--r--lisp/eshell/em-xtra.el119
-rw-r--r--lisp/eshell/esh-arg.el383
-rw-r--r--lisp/eshell/esh-ext.el311
-rw-r--r--lisp/eshell/esh-groups.el135
-rw-r--r--lisp/eshell/esh-io.el509
-rw-r--r--lisp/eshell/esh-maint.el142
-rw-r--r--lisp/eshell/esh-module.el139
-rw-r--r--lisp/eshell/esh-opt.el226
-rw-r--r--lisp/eshell/esh-proc.el447
-rw-r--r--lisp/eshell/esh-test.el242
-rw-r--r--lisp/eshell/esh-toggle.el179
-rw-r--r--lisp/eshell/esh-var.el635
-rw-r--r--lisp/eshell/eshell.el495
-rw-r--r--lisp/pcomplete.el1189
30 files changed, 11543 insertions, 0 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 22877bb8335..9816542a339 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,10 @@
12000-06-23 Gerd Moellmann <gerd@gnu.org> 12000-06-23 Gerd Moellmann <gerd@gnu.org>
2 2
3 * Makefile.in (DONTCOMPILE): Add eshell/esh-maint.el.
4
5 * eshell/esh-cmd.el (eshell-rewrite-for-command): Use cdr and
6 cddr instead of cdddr.
7
3 * eshell/esh-util.el (eshell-sublist): Use eshell-copy-list 8 * eshell/esh-util.el (eshell-sublist): Use eshell-copy-list
4 instead of copy-list. 9 instead of copy-list.
5 10
diff --git a/lisp/eshell/em-alias.el b/lisp/eshell/em-alias.el
new file mode 100644
index 00000000000..84ab339584f
--- /dev/null
+++ b/lisp/eshell/em-alias.el
@@ -0,0 +1,270 @@
1;;; em-alias --- creation and management of command aliases
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'em-alias)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-alias nil
27 "Command aliases allow for easy definition of alternate commands."
28 :tag "Command aliases"
29 :link '(info-link "(eshell.info)Command aliases")
30 :group 'eshell-module)
31
32;;; Commentary:
33
34;; Command aliases greatly simplify the definition of new commands.
35;; They exist as an alternative to alias functions, which are
36;; otherwise quite superior, being more flexible and natural to the
37;; Emacs Lisp environment (if somewhat trickier to define; [Alias
38;; functions]).
39;;
40;;;_* Creating aliases
41;;
42;; The user interface is simple: type 'alias' followed by the command
43;; name followed by the definition. Argument references are made
44;; using '$1', '$2', etc., or '$*'. For example:
45;;
46;; alias ll 'ls -l $*'
47;;
48;; This will cause the command 'll NEWS' to be replaced by 'ls -l
49;; NEWS'. This is then passed back to the command parser for
50;; reparsing.{Only the command text specified in the alias definition
51;; will be reparsed. Argument references (such as '$*') are handled
52;; using variable values, which means that the expansion will not be
53;; reparsed, but used directly.}
54;;
55;; To delete an alias, specify its name without a definition:
56;;
57;; alias ll
58;;
59;; Aliases are written to disk immediately after being defined or
60;; deleted. The filename in which they are kept is defined by the
61;; following variable:
62
63(defcustom eshell-aliases-file (concat eshell-directory-name "alias")
64 "*The file in which aliases are kept.
65Whenever an alias is defined by the user, using the `alias' command,
66it will be written to this file. Thus, alias definitions (and
67deletions) are always permanent. This approach was chosen for the
68sake of simplicity, since that's pretty much the only benefit to be
69gained by using this module."
70 :type 'file
71 :group 'eshell-alias)
72
73;;;
74;; The format of this file is quite basic. It specifies the alias
75;; definitions in almost exactly the same way that the user entered
76;; them, minus any argument quoting (since interpolation is not done
77;; when the file is read). Hence, it is possible to add new aliases
78;; to the alias file directly, using a text editor rather than the
79;; `alias' command. Or, this method can be used for editing aliases
80;; that have already defined.
81;;
82;; Here is an example of a few different aliases, and they would
83;; appear in the aliases file:
84;;
85;; alias clean rm -fr **/.#*~
86;; alias commit cvs commit -m changes $*
87;; alias ll ls -l $*
88;; alias info (info)
89;; alias reindex glimpseindex -o ~/Mail
90;; alias compact for i in ~/Mail/**/*~*.bz2(Lk+50) { bzip2 -9v $i }
91;;
92;;;_* Auto-correction of bad commands
93;;
94;; When a user enters the same unknown command many times during a
95;; session, it is likely that they are experiencing a spelling
96;; difficulty associated with a certain command. To combat this,
97;; Eshell will offer to automatically define an alias for that
98;; mispelled command, once a given tolerance threshold has been
99;; reached.
100
101(defcustom eshell-bad-command-tolerance 3
102 "*The number of failed commands to ignore before creating an alias."
103 :type 'integer
104 :link '(custom-manual "(eshell.info)Auto-correction of bad commands")
105 :group 'eshell-alias)
106
107;;;
108;; Whenever the same bad command name is encountered this many times,
109;; the user will be prompted in the minibuffer to provide an alias
110;; name. An alias definition will then be created which will result
111;; in an equal call to the correct name. In this way, Eshell
112;; gradually learns about the commands that the user mistypes
113;; frequently, and will automatically correct them!
114;;
115;; Note that a '$*' is automatically appended at the end of the alias
116;; definition, so that entering it is unnecessary when specifying the
117;; corrected command name.
118
119;;; Code:
120
121(defcustom eshell-alias-load-hook '(eshell-alias-initialize)
122 "*A hook that gets run when `eshell-alias' is loaded."
123 :type 'hook
124 :group 'eshell-alias)
125
126(defvar eshell-command-aliases-list nil
127 "A list of command aliases currently defined by the user.
128Each element of this alias is a list of the form:
129
130 (NAME DEFINITION)
131
132Where NAME is the textual name of the alias, and DEFINITION is the
133command string to replace that command with.
134
135Note: this list should not be modified in your '.emacs' file. Rather,
136any desired alias definitions should be declared using the `alias'
137command, which will automatically write them to the file named by
138`eshell-aliases-file'.")
139
140(put 'eshell-command-aliases-list 'risky-local-variable t)
141
142(defvar eshell-failed-commands-alist nil
143 "An alist of command name failures.")
144
145(defun eshell-alias-initialize ()
146 "Initialize the alias handling code."
147 (make-local-variable 'eshell-failed-commands-alist)
148 (make-local-hook 'eshell-alternate-command-hook)
149 (add-hook 'eshell-alternate-command-hook 'eshell-fix-bad-commands t t)
150 (eshell-read-aliases-list)
151 (make-local-hook 'eshell-named-command-hook)
152 (add-hook 'eshell-named-command-hook 'eshell-maybe-replace-by-alias t t))
153
154(defun eshell/alias (&optional alias &rest definition)
155 "Define an ALIAS in the user's alias list using DEFINITION."
156 (if (not alias)
157 (eshell-for alias eshell-command-aliases-list
158 (eshell-print (apply 'format "alias %s %s\n" alias)))
159 (if (not definition)
160 (setq eshell-command-aliases-list
161 (delq (assoc alias eshell-command-aliases-list)
162 eshell-command-aliases-list))
163 (and (stringp definition)
164 (set-text-properties 0 (length definition) nil definition))
165 (let ((def (assoc alias eshell-command-aliases-list))
166 (alias-def (list alias
167 (eshell-flatten-and-stringify definition))))
168 (if def
169 (setq eshell-command-aliases-list
170 (delq def eshell-command-aliases-list)))
171 (setq eshell-command-aliases-list
172 (cons alias-def eshell-command-aliases-list))))
173 (eshell-write-aliases-list))
174 nil)
175
176(defun pcomplete/eshell-mode/alias ()
177 "Completion function for Eshell's `alias' command."
178 (pcomplete-here (eshell-alias-completions pcomplete-stub)))
179
180(defun eshell-read-aliases-list ()
181 "Read in an aliases list from `eshell-aliases-file'."
182 (let ((file eshell-aliases-file))
183 (when (file-readable-p file)
184 (setq eshell-command-aliases-list
185 (with-temp-buffer
186 (let (eshell-command-aliases-list)
187 (insert-file-contents file)
188 (while (not (eobp))
189 (if (re-search-forward
190 "^alias\\s-+\\(\\S-+\\)\\s-+\\(.+\\)")
191 (setq eshell-command-aliases-list
192 (cons (list (match-string 1)
193 (match-string 2))
194 eshell-command-aliases-list)))
195 (forward-line 1))
196 eshell-command-aliases-list))))))
197
198(defun eshell-write-aliases-list ()
199 "Write out the current aliases into `eshell-aliases-file'."
200 (if (file-writable-p (file-name-directory eshell-aliases-file))
201 (let ((eshell-current-handles
202 (eshell-create-handles eshell-aliases-file 'overwrite)))
203 (eshell/alias)
204 (eshell-close-handles 0))))
205
206(defsubst eshell-lookup-alias (name)
207 "Check whether NAME is aliased. Return the alias if there is one."
208 (assoc name eshell-command-aliases-list))
209
210(defvar eshell-prevent-alias-expansion nil)
211
212(defun eshell-maybe-replace-by-alias (command args)
213 "If COMMAND has an alias definition, call that instead using RAGS."
214 (unless (and eshell-prevent-alias-expansion
215 (member command eshell-prevent-alias-expansion))
216 (let ((alias (eshell-lookup-alias command)))
217 (if alias
218 (throw 'eshell-replace-command
219 (list
220 'let
221 (list
222 (list 'eshell-command-name
223 (list 'quote eshell-last-command-name))
224 (list 'eshell-command-arguments
225 (list 'quote eshell-last-arguments))
226 (list 'eshell-prevent-alias-expansion
227 (list 'quote
228 (cons command
229 eshell-prevent-alias-expansion))))
230 (eshell-parse-command (nth 1 alias))))))))
231
232(defun eshell-alias-completions (name)
233 "Find all possible completions for NAME.
234These are all the command aliases which begin with NAME."
235 (let (completions)
236 (eshell-for alias eshell-command-aliases-list
237 (if (string-match (concat "^" name) (car alias))
238 (setq completions (cons (car alias) completions))))
239 completions))
240
241(defun eshell-fix-bad-commands (name)
242 "If the user repeatedly a bad command NAME, make an alias for them."
243 (ignore
244 (unless (file-name-directory name)
245 (let ((entry (assoc name eshell-failed-commands-alist)))
246 (if (not entry)
247 (setq eshell-failed-commands-alist
248 (cons (cons name 1) eshell-failed-commands-alist))
249 (if (< (cdr entry) eshell-bad-command-tolerance)
250 (setcdr entry (1+ (cdr entry)))
251 (let ((alias (concat
252 (read-string
253 (format "Define alias for \"%s\": " name))
254 " $*")))
255 (eshell/alias name alias)
256 (throw 'eshell-replace-command
257 (list
258 'let
259 (list
260 (list 'eshell-command-name
261 (list 'quote name))
262 (list 'eshell-command-arguments
263 (list 'quote eshell-last-arguments))
264 (list 'eshell-prevent-alias-expansion
265 (list 'quote
266 (cons name
267 eshell-prevent-alias-expansion))))
268 (eshell-parse-command alias))))))))))
269
270;;; em-alias.el ends here
diff --git a/lisp/eshell/em-banner.el b/lisp/eshell/em-banner.el
new file mode 100644
index 00000000000..f56bef25503
--- /dev/null
+++ b/lisp/eshell/em-banner.el
@@ -0,0 +1,90 @@
1;;; em-banner --- sample module that displays a login banner
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'em-banner)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-banner nil
27 "This sample module displays a welcome banner at login.
28It exists so that others wishing to create their own Eshell extension
29modules may have a simple template to begin with."
30 :tag "Login banner"
31 :link '(info-link "(eshell.info)Login banner")
32 :group 'eshell-module)
33
34;;; Commentary:
35
36;; There is nothing to be done or configured in order to use this
37;; module, other than to select it by customizing the variable
38;; `eshell-modules-list'. It will then display a version information
39;; message whenever Eshell is loaded.
40;;
41;; This code is only an example of a how to write a well-formed
42;; extension module for Eshell. The better way to display login text
43;; is to use the `eshell-script' module, and to echo the desired
44;; strings from the user's `eshell-login-script' file.
45;;
46;; There is one configuration variable, which demonstrates how to
47;; properly define a customization variable in an extension module.
48;; In this case, it allows the user to change the string which
49;; displays at login time.
50
51;;; User Variables:
52
53(defcustom eshell-banner-message "Welcome to the Emacs shell\n\n"
54 "*The banner message to be displayed when Eshell is loaded.
55This can be any sexp, and should end with at least two newlines."
56 :type 'sexp
57 :group 'eshell-banner)
58
59(put 'eshell-banner-message 'risky-local-variable t)
60
61;;; Code:
62
63(require 'esh-util)
64
65(defcustom eshell-banner-load-hook '(eshell-banner-initialize)
66 "*A list of functions to run when `eshell-banner' is loaded."
67 :type 'hook
68 :group 'eshell-banner)
69
70(defun eshell-banner-initialize ()
71 "Output a welcome banner on initialization."
72 ;; it's important to use `eshell-interactive-print' rather than
73 ;; `insert', because `insert' doesn't know how to interact with the
74 ;; I/O code used by Eshell
75 (unless eshell-non-interactive-p
76 (assert eshell-mode)
77 (assert eshell-banner-message)
78 (let ((msg (eval eshell-banner-message)))
79 (assert msg)
80 (eshell-interactive-print msg))))
81
82(eshell-deftest banner banner-displayed
83 "Startup banner is displayed at point-min"
84 (assert eshell-banner-message)
85 (let ((msg (eval eshell-banner-message)))
86 (assert msg)
87 (goto-char (point-min))
88 (looking-at msg)))
89
90;;; em-banner.el ends here
diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el
new file mode 100644
index 00000000000..0a7e9a97573
--- /dev/null
+++ b/lisp/eshell/em-basic.el
@@ -0,0 +1,183 @@
1;;; em-basic --- basic shell builtin commands
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'em-basic)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-basic nil
27 "The \"basic\" code provides a set of convenience functions which
28are traditionally considered shell builtins. Since all of the
29functionality provided by them is accessible through Lisp, they are
30not really builtins at all, but offer a command-oriented way to do the
31same thing."
32 :tag "Basic shell commands"
33 :group 'eshell-module)
34
35;;; Commentary:
36
37;; There are very few basic Eshell commands -- so-called builtins.
38;; They are: echo, umask, and version.
39;;
40;;;_* `echo'
41;;
42;; The `echo' command repeats its arguments to the screen. It is
43;; optional whether this is done in a Lisp-friendly fashion (so that
44;; the value of echo is useful to a Lisp command using the result of
45;; echo as an argument), or whether it should try to act like a normal
46;; shell echo, and always result in a flat string being returned.
47
48(defcustom eshell-plain-echo-behavior nil
49 "*If non-nil, `echo' tries to behave like an ordinary shell echo.
50This comes at some detriment to Lisp functionality. However, the Lisp
51equivalent of `echo' can always be achieved by using `identity'."
52 :type 'boolean
53 :group 'eshell-basic)
54
55;;;
56;; An example of the difference is the following:
57;;
58;; echo Hello world
59;;
60;; If `eshell-plain-echo-behavior' is non-nil, this will yield the
61;; string "Hello world". If Lisp behavior is enabled, however, it
62;; will yield a list whose two elements are the strings "Hello" and
63;; "world". The way to write an equivalent expression for both would
64;; be:
65;;
66;; echo "Hello world"
67;;
68;; This always returns a single string.
69;;
70;;;_* `umask'
71;;
72;; The umask command changes the default file permissions for newly
73;; created files. It uses the same syntax as bash.
74;;
75;;;_* `version'
76;;
77;; This command reports the version number for Eshell and all its
78;; dependent module, including the date when those modules were last
79;; modified.
80
81;;; Code:
82
83(require 'esh-opt)
84
85;;; Functions:
86
87(defun eshell-echo (args &optional output-newline)
88 "Implementation code for a Lisp version of `echo'.
89It returns a formatted value that should be passed to `eshell-print'
90or `eshell-printn' for display."
91 (if eshell-plain-echo-behavior
92 (concat (apply 'eshell-flatten-and-stringify args) "\n")
93 (let ((value
94 (cond
95 ((= (length args) 0) "")
96 ((= (length args) 1)
97 (car args))
98 (t
99 (mapcar
100 (function
101 (lambda (arg)
102 (if (stringp arg)
103 (set-text-properties 0 (length arg) nil arg))
104 arg))
105 args)))))
106 (if output-newline
107 (cond
108 ((stringp value)
109 (concat value "\n"))
110 ((listp value)
111 (append value (list "\n")))
112 (t
113 (concat (eshell-stringify value) "\n")))
114 value))))
115
116(defun eshell/echo (&rest args)
117 "Implementation of `echo'. See `eshell-plain-echo-behavior'."
118 (eshell-eval-using-options
119 "echo" args
120 '((?n nil nil output-newline "terminate with a newline")
121 (?h "help" nil nil "output this help screen")
122 :preserve-args
123 :usage "[-n] [object]")
124 (eshell-echo args output-newline)))
125
126(defun eshell/printnl (&rest args)
127 "Print out each of the argument, separated by newlines."
128 (let ((elems (eshell-flatten-list args)))
129 (while elems
130 (eshell-printn (eshell-echo (list (car elems))))
131 (setq elems (cdr elems)))))
132
133(defun eshell/listify (&rest args)
134 "Return the argument(s) as a single list."
135 (if (> (length args) 1)
136 args
137 (if (listp (car args))
138 (car args)
139 (list (car args)))))
140
141(defun eshell/umask (&rest args)
142 "Shell-like implementation of `umask'."
143 (eshell-eval-using-options
144 "umask" args
145 '((?S "symbolic" nil symbolic-p "display umask symbolically")
146 (?h "help" nil nil "display this usage message")
147 :usage "[-S] [mode]")
148 (if (or (not args) symbolic-p)
149 (let ((modstr
150 (concat "000"
151 (format "%o"
152 (logand (lognot (default-file-modes))
153 511)))))
154 (setq modstr (substring modstr (- (length modstr) 3)))
155 (when symbolic-p
156 (let ((mode (default-file-modes)))
157 (setq modstr
158 (format
159 "u=%s,g=%s,o=%s"
160 (concat (and (= (logand mode 64) 64) "r")
161 (and (= (logand mode 128) 128) "w")
162 (and (= (logand mode 256) 256) "x"))
163 (concat (and (= (logand mode 8) 8) "r")
164 (and (= (logand mode 16) 16) "w")
165 (and (= (logand mode 32) 32) "x"))
166 (concat (and (= (logand mode 1) 1) "r")
167 (and (= (logand mode 2) 2) "w")
168 (and (= (logand mode 4) 4) "x"))))))
169 (eshell-printn modstr))
170 (setcar args (eshell-convert (car args)))
171 (if (numberp (car args))
172 (set-default-file-modes
173 (- 511 (car (read-from-string
174 (concat "?\\" (number-to-string (car args)))))))
175 (error "setting umask symbolically is not yet implemented"))
176 (eshell-print
177 "Warning: umask changed for all new files created by Emacs.\n"))
178 nil))
179
180(eval-when-compile
181 (defvar print-func))
182
183;;; em-basic.el ends here
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el
new file mode 100644
index 00000000000..64f1debca11
--- /dev/null
+++ b/lisp/eshell/em-cmpl.el
@@ -0,0 +1,443 @@
1;;; em-cmpl --- completion using the TAB key
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'em-cmpl)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-cmpl nil
27 "This module provides a programmable completion function bound to
28the TAB key, which allows for completing command names, file names,
29variable names, arguments, etc."
30 :tag "Argument completion"
31 :group 'eshell-module)
32
33;;; Commentary:
34
35;; Eshell, by using the pcomplete package, provides a full
36;; programmable completion facility that is comparable to shells like
37;; tcsh or zsh.
38;;
39;; Completions are context-sensitive, which means that pressing <TAB>
40;; after the command 'rmdir' will result in a list of directories,
41;; while doing so after 'rm' will result in a list of all file
42;; entries.
43;;
44;; Many builtin completion rules are provided, for commands such as
45;; `cvs', or RedHat's `rpm' utility. Adding new completion rules is
46;; no more difficult than writing a plain Lisp functions, and they can
47;; be debugged, profiled, and compiled using exactly the same
48;; facilities (since in fact, they *are* just Lisp functions). See
49;; the definition of the function `pcomplete/make' for an example of
50;; how to write a completion function.
51;;
52;; The completion facility is very easy to use. Just press TAB. If
53;; there are a large number of possible completions, a buffer will
54;; appearing showing a list of them. Completions may be selected from
55;; that buffer using the mouse. If no completion is selected, and the
56;; user starts doing something else, the display buffer will
57;; automatically disappear.
58;;
59;; If the list of possible completions is very small, Eshell will
60;; "cycle" through them, selecting a different entry each time <TAB>
61;; is pressed. <S-TAB> may be used to cycle in the opposite
62;; direction.
63;;
64;; Glob patterns can also be cycled. For example, entering 'echo
65;; x*<tab>' will cycle through all the filenames beginning with 'x'.
66;; This is done because the glob list is treated as though it were a
67;; list of possible completions. Pressing <C-c SPC> will insert all
68;; of the matching glob patterns at point.
69;;
70;; If a Lisp form is being entered, <TAB> will complete the Lisp
71;; symbol name, in exactly the same way that <M-TAB> does in Emacs
72;; Lisp mode.
73;;
74;; The list of possible completions can be viewed at any point by
75;; pressing <M-?>.
76;;
77;; Finally, context-related help can be accessed by pressing <C-c i>.
78;; This only works well if the completion function has provided Eshell
79;; with sufficient pointers to locate the relevant help text.
80
81;;; User Variables:
82
83(defcustom eshell-cmpl-load-hook '(eshell-cmpl-initialize)
84 "*A list of functions to run when `eshell-cmpl' is loaded."
85 :type 'hook
86 :group 'eshell-cmpl)
87
88(defcustom eshell-show-lisp-completions nil
89 "*If non-nil, include Lisp functions in the command completion list.
90If this variable is nil, Lisp completion can still be done in command
91position by using M-TAB instead of TAB."
92 :type 'boolean
93 :group 'eshell-cmpl)
94
95(defcustom eshell-show-lisp-alternatives t
96 "*If non-nil, and no other completions found, show Lisp functions.
97Setting this variable means nothing if `eshell-show-lisp-completions'
98is non-nil."
99 :type 'boolean
100 :group 'eshell-cmpl)
101
102(defcustom eshell-no-completion-during-jobs t
103 "*If non-nil, don't allow completion while a process is running."
104 :type 'boolean
105 :group 'eshell-cmpl)
106
107(defcustom eshell-command-completions-alist
108 '(("acroread" . "\\.pdf\\'")
109 ("xpdf" . "\\.pdf\\'")
110 ("ar" . "\\.[ao]\\'")
111 ("gcc" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
112 ("g++" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
113 ("cc" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
114 ("CC" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
115 ("acc" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
116 ("bcc" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
117 ("objdump" . "\\(\\`[^.]*\\|\\.[ao]\\)\\'")
118 ("nm" . "\\(\\`[^.]*\\|\\.[ao]\\)\\'")
119 ("gdb" . "\\`\\([^.]*\\|a\\.out\\)\\'")
120 ("dbx" . "\\`\\([^.]*\\|a\\.out\\)\\'")
121 ("sdb" . "\\`\\([^.]*\\|a\\.out\\)\\'")
122 ("adb" . "\\`\\([^.]*\\|a\\.out\\)\\'"))
123 "*An alist that defines simple argument type correlations.
124This is provided for common commands, as a simplistic alternative
125to writing a completion function."
126 :type '(repeat (cons string regexp))
127 :group 'eshell-cmpl)
128
129(defcustom eshell-cmpl-file-ignore "~\\'"
130 (documentation-property 'pcomplete-file-ignore
131 'variable-documentation)
132 :type (get 'pcomplete-file-ignore 'custom-type)
133 :group 'eshell-cmpl)
134
135(defcustom eshell-cmpl-dir-ignore
136 (format "\\`\\(\\.\\.?\\|CVS\\)%c\\'" directory-sep-char)
137 (documentation-property 'pcomplete-dir-ignore
138 'variable-documentation)
139 :type (get 'pcomplete-dir-ignore 'custom-type)
140 :group 'eshell-cmpl)
141
142(defcustom eshell-cmpl-ignore-case (eshell-under-windows-p)
143 (documentation-property 'pcomplete-ignore-case
144 'variable-documentation)
145 :type (get 'pcomplete-ignore-case 'custom-type)
146 :group 'eshell-cmpl)
147
148(defcustom eshell-cmpl-autolist nil
149 (documentation-property 'pcomplete-autolist
150 'variable-documentation)
151 :type (get 'pcomplete-autolist 'custom-type)
152 :group 'eshell-cmpl)
153
154(defcustom eshell-cmpl-suffix-list (list directory-sep-char ?:)
155 (documentation-property 'pcomplete-suffix-list
156 'variable-documentation)
157 :type (get 'pcomplete-suffix-list 'custom-type)
158 :group 'pcomplete)
159
160(defcustom eshell-cmpl-recexact nil
161 (documentation-property 'pcomplete-recexact
162 'variable-documentation)
163 :type (get 'pcomplete-recexact 'custom-type)
164 :group 'eshell-cmpl)
165
166(defcustom eshell-cmpl-man-function 'man
167 (documentation-property 'pcomplete-man-function
168 'variable-documentation)
169 :type (get 'pcomplete-man-function 'custom-type)
170 :group 'eshell-cmpl)
171
172(defcustom eshell-cmpl-compare-entry-function 'file-newer-than-file-p
173 (documentation-property 'pcomplete-compare-entry-function
174 'variable-documentation)
175 :type (get 'pcomplete-compare-entry-function 'custom-type)
176 :group 'eshell-cmpl)
177
178(defcustom eshell-cmpl-expand-before-complete nil
179 (documentation-property 'pcomplete-expand-before-complete
180 'variable-documentation)
181 :type (get 'pcomplete-expand-before-complete 'custom-type)
182 :group 'eshell-cmpl)
183
184(defcustom eshell-cmpl-cycle-completions t
185 (documentation-property 'pcomplete-cycle-completions
186 'variable-documentation)
187 :type (get 'pcomplete-cycle-completions 'custom-type)
188 :group 'eshell-cmpl)
189
190(defcustom eshell-cmpl-cycle-cutoff-length 5
191 (documentation-property 'pcomplete-cycle-cutoff-length
192 'variable-documentation)
193 :type (get 'pcomplete-cycle-cutoff-length 'custom-type)
194 :group 'eshell-cmpl)
195
196(defcustom eshell-cmpl-restore-window-delay 1
197 (documentation-property 'pcomplete-restore-window-delay
198 'variable-documentation)
199 :type (get 'pcomplete-restore-window-delay 'custom-type)
200 :group 'eshell-cmpl)
201
202(defcustom eshell-command-completion-function
203 (function
204 (lambda ()
205 (pcomplete-here (eshell-complete-commands-list))))
206 (documentation-property 'pcomplete-command-completion-function
207 'variable-documentation)
208 :type (get 'pcomplete-command-completion-function 'custom-type)
209 :group 'eshell-cmpl)
210
211(defcustom eshell-cmpl-command-name-function
212 'eshell-completion-command-name
213 (documentation-property 'pcomplete-command-name-function
214 'variable-documentation)
215 :type (get 'pcomplete-command-name-function 'custom-type)
216 :group 'eshell-cmpl)
217
218(defcustom eshell-default-completion-function
219 (function
220 (lambda ()
221 (while (pcomplete-here
222 (pcomplete-dirs-or-entries
223 (cdr (assoc (funcall eshell-cmpl-command-name-function)
224 eshell-command-completions-alist)))))))
225 (documentation-property 'pcomplete-default-completion-function
226 'variable-documentation)
227 :type (get 'pcomplete-default-completion-function 'custom-type)
228 :group 'pcomplete)
229
230;;; Functions:
231
232(defun eshell-cmpl-initialize ()
233 "Initialize the completions module."
234 (unless (fboundp 'pcomplete)
235 (load "pcmpl-auto" t t))
236 (set (make-local-variable 'pcomplete-command-completion-function)
237 eshell-command-completion-function)
238 (set (make-local-variable 'pcomplete-command-name-function)
239 eshell-cmpl-command-name-function)
240 (set (make-local-variable 'pcomplete-default-completion-function)
241 eshell-default-completion-function)
242 (set (make-local-variable 'pcomplete-parse-arguments-function)
243 'eshell-complete-parse-arguments)
244 (set (make-local-variable 'pcomplete-file-ignore)
245 eshell-cmpl-file-ignore)
246 (set (make-local-variable 'pcomplete-dir-ignore)
247 eshell-cmpl-dir-ignore)
248 (set (make-local-variable 'pcomplete-ignore-case)
249 eshell-cmpl-ignore-case)
250 (set (make-local-variable 'pcomplete-autolist)
251 eshell-cmpl-autolist)
252 (set (make-local-variable 'pcomplete-suffix-list)
253 eshell-cmpl-suffix-list)
254 (set (make-local-variable 'pcomplete-recexact)
255 eshell-cmpl-recexact)
256 (set (make-local-variable 'pcomplete-man-function)
257 eshell-cmpl-man-function)
258 (set (make-local-variable 'pcomplete-compare-entry-function)
259 eshell-cmpl-compare-entry-function)
260 (set (make-local-variable 'pcomplete-expand-before-complete)
261 eshell-cmpl-expand-before-complete)
262 (set (make-local-variable 'pcomplete-cycle-completions)
263 eshell-cmpl-cycle-completions)
264 (set (make-local-variable 'pcomplete-cycle-cutoff-length)
265 eshell-cmpl-cycle-cutoff-length)
266 (set (make-local-variable 'pcomplete-restore-window-delay)
267 eshell-cmpl-restore-window-delay)
268 ;; `pcomplete-arg-quote-list' should only be set after all the
269 ;; load-hooks for any other extension modules have been run, which
270 ;; is true at the time `eshell-mode-hook' is run
271 (make-local-hook 'eshell-mode-hook)
272 (add-hook 'eshell-mode-hook
273 (function
274 (lambda ()
275 (set (make-local-variable 'pcomplete-arg-quote-list)
276 eshell-special-chars-outside-quoting))) nil t)
277 (make-local-hook 'pcomplete-quote-arg-hook)
278 (add-hook 'pcomplete-quote-arg-hook 'eshell-quote-backslash nil t)
279 (define-key eshell-mode-map [(meta tab)] 'lisp-complete-symbol)
280 (define-key eshell-mode-map [(meta control ?i)] 'lisp-complete-symbol)
281 (define-key eshell-command-map [(meta ?h)] 'eshell-completion-help)
282 (define-key eshell-command-map [tab] 'pcomplete-expand-and-complete)
283 (define-key eshell-command-map [(control ?i)]
284 'pcomplete-expand-and-complete)
285 (define-key eshell-command-map [space] 'pcomplete-expand)
286 (define-key eshell-command-map [? ] 'pcomplete-expand)
287 (define-key eshell-mode-map [tab] 'pcomplete)
288 (define-key eshell-mode-map [(control ?i)] 'pcomplete)
289 ;; jww (1999-10-19): Will this work on anything but X?
290 (if (eshell-under-xemacs-p)
291 (define-key eshell-mode-map [iso-left-tab] 'pcomplete-reverse)
292 (define-key eshell-mode-map [(shift iso-lefttab)] 'pcomplete-reverse)
293 (define-key eshell-mode-map [(shift control ?i)] 'pcomplete-reverse))
294 (define-key eshell-mode-map [(meta ??)] 'pcomplete-list))
295
296(defun eshell-completion-command-name ()
297 "Return the command name, possibly sans globbing."
298 (let ((cmd (file-name-nondirectory (pcomplete-arg 'first))))
299 (setq cmd (if (and (> (length cmd) 0)
300 (eq (aref cmd 0) ?*))
301 (substring cmd 1)
302 cmd))
303 (if (eshell-under-windows-p)
304 (file-name-sans-extension cmd)
305 cmd)))
306
307(defun eshell-completion-help ()
308 (interactive)
309 (if (= (point) eshell-last-output-end)
310 (describe-prefix-bindings)
311 (call-interactively 'pcomplete-help)))
312
313(defun eshell-complete-parse-arguments ()
314 "Parse the command line arguments for `pcomplete-argument'."
315 (when (and eshell-no-completion-during-jobs
316 (eshell-interactive-process))
317 (insert-and-inherit "\t")
318 (throw 'pcompleted t))
319 (let ((end (point-marker))
320 (begin (save-excursion (eshell-bol) (point)))
321 (posns (list t))
322 args delim)
323 (when (memq this-command '(pcomplete-expand
324 pcomplete-expand-and-complete))
325 (run-hook-with-args 'eshell-expand-input-functions begin end)
326 (if (= begin end)
327 (end-of-line))
328 (setq end (point-marker)))
329 (if (setq delim
330 (catch 'eshell-incomplete
331 (ignore
332 (setq args (eshell-parse-arguments begin end)))))
333 (cond ((memq (car delim) '(?\{ ?\<))
334 (setq begin (1+ (cadr delim))
335 args (eshell-parse-arguments begin end)))
336 ((eq (car delim) ?\()
337 (lisp-complete-symbol)
338 (throw 'pcompleted t))
339 (t
340 (insert-and-inherit "\t")
341 (throw 'pcompleted t))))
342 (when (get-text-property (1- end) 'comment)
343 (insert-and-inherit "\t")
344 (throw 'pcompleted t))
345 (let ((pos begin))
346 (while (< pos end)
347 (if (get-text-property pos 'arg-begin)
348 (nconc posns (list pos)))
349 (setq pos (1+ pos))))
350 (setq posns (cdr posns))
351 (assert (= (length args) (length posns)))
352 (let ((a args)
353 (i 0)
354 l final)
355 (while a
356 (if (and (consp (car a))
357 (eq (caar a) 'eshell-operator))
358 (setq l i))
359 (setq a (cdr a) i (1+ i)))
360 (and l
361 (setq args (nthcdr (1+ l) args)
362 posns (nthcdr (1+ l) posns))))
363 (assert (= (length args) (length posns)))
364 (when (and args (eq (char-syntax (char-before end)) ? ))
365 (nconc args (list ""))
366 (nconc posns (list (point))))
367 (cons (mapcar
368 (function
369 (lambda (arg)
370 (let ((val
371 (if (listp arg)
372 (let ((result
373 (eshell-do-eval
374 (list 'eshell-commands arg) t)))
375 (assert (eq (car result) 'quote))
376 (cadr result))
377 arg)))
378 (if (numberp val)
379 (setq val (number-to-string val)))
380 (or val ""))))
381 args)
382 posns)))
383
384(defun eshell-complete-commands-list ()
385 "Generate list of applicable, visible commands."
386 (let ((filename (pcomplete-arg)) glob-name)
387 (if (file-name-directory filename)
388 (pcomplete-executables)
389 (if (and (> (length filename) 0)
390 (eq (aref filename 0) ?*))
391 (setq filename (substring filename 1)
392 pcomplete-stub filename
393 glob-name t))
394 (let* ((paths (split-string (getenv "PATH") path-separator))
395 (cwd (file-name-as-directory
396 (expand-file-name default-directory)))
397 (path "") (comps-in-path ())
398 (file "") (filepath "") (completions ()))
399 ;; Go thru each path in the search path, finding completions.
400 (while paths
401 (setq path (file-name-as-directory
402 (expand-file-name (or (car paths) ".")))
403 comps-in-path
404 (and (file-accessible-directory-p path)
405 (file-name-all-completions filename path)))
406 ;; Go thru each completion found, to see whether it should
407 ;; be used.
408 (while comps-in-path
409 (setq file (car comps-in-path)
410 filepath (concat path file))
411 (if (and (not (member file completions)) ;
412 (or (string-equal path cwd)
413 (not (file-directory-p filepath)))
414 (file-executable-p filepath))
415 (setq completions (cons file completions)))
416 (setq comps-in-path (cdr comps-in-path)))
417 (setq paths (cdr paths)))
418 ;; Add aliases which are currently visible, and Lisp functions.
419 (pcomplete-uniqify-list
420 (if glob-name
421 completions
422 (setq completions
423 (append (and (eshell-using-module 'eshell-alias)
424 (funcall (symbol-function 'eshell-alias-completions)
425 filename))
426 (eshell-winnow-list
427 (mapcar
428 (function
429 (lambda (name)
430 (substring name 7)))
431 (all-completions (concat "eshell/" filename)
432 obarray 'functionp))
433 nil '(eshell-find-alias-function))
434 completions))
435 (append (and (or eshell-show-lisp-completions
436 (and eshell-show-lisp-alternatives
437 (null completions)))
438 (all-completions filename obarray 'functionp))
439 completions)))))))
440
441;;; Code:
442
443;;; em-cmpl.el ends here
diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el
new file mode 100644
index 00000000000..642163cb1bd
--- /dev/null
+++ b/lisp/eshell/em-dirs.el
@@ -0,0 +1,563 @@
1;;; em-dirs --- directory navigation commands
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'em-dirs)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-dirs nil
27 "Directory navigation involves changing directories, examining the
28current directory, maintaining a directory stack, and also keeping
29track of a history of the last directory locations the user was in.
30Emacs does provide standard Lisp definitions of `pwd' and `cd', but
31they lack somewhat in feel from the typical shell equivalents."
32 :tag "Directory navigation"
33 :group 'eshell-module)
34
35;;; Commentary:
36
37;; The only special feature that Eshell offers in the last-dir-ring.
38;; To view the ring, enter:
39;;
40;; cd =
41;;
42;; Changing to an index within the ring is done using:
43;;
44;; cd - ; same as cd -0
45;; cd -4
46;;
47;; Or, it is possible to change the first member in the ring which
48;; matches a regexp:
49;;
50;; cd =bcc ; change to the last directory visited containing "bcc"
51;;
52;; This ring is maintained automatically, and is persisted across
53;; Eshell sessions. It is a separate mechanism from `pushd' and
54;; `popd', and the two may be used at the same time.
55
56(require 'ring)
57(require 'esh-opt)
58
59;;; User Variables:
60
61(defcustom eshell-dirs-load-hook '(eshell-dirs-initialize)
62 "*A hook that gets run when `eshell-dirs' is loaded."
63 :type 'hook
64 :group 'eshell-dirs)
65
66(defcustom eshell-pwd-convert-function (if (eshell-under-windows-p)
67 'expand-file-name
68 'identity)
69 "*The function used to normalize the value of Eshell's `pwd'.
70The value returned by `pwd' is also used when recording the
71last-visited directory in the last-dir-ring, so it will affect the
72form of the list used by 'cd ='."
73 :type '(radio (function-item file-truename)
74 (function-item expand-file-name)
75 (function-item identity)
76 (function :tag "Other"))
77 :group 'eshell-dirs)
78
79(defcustom eshell-ask-to-save-last-dir 'always
80 "*Determine if the last-dir-ring should be automatically saved.
81The last-dir-ring is always preserved when exiting an Eshell buffer.
82However, when Emacs is being shut down, this variable determines
83whether to prompt the user, or just save the ring.
84If set to nil, it means never ask whether to save the last-dir-ring.
85If set to t, always ask if any Eshell buffers are open at exit time.
86If set to `always', the list-dir-ring will always be saved, silently."
87 :type '(choice (const :tag "Never" nil)
88 (const :tag "Ask" t)
89 (const :tag "Always save" always))
90 :group 'eshell-dirs)
91
92(defcustom eshell-cd-shows-directory nil
93 "*If non-nil, using `cd' will report the directory it changes to."
94 :type 'boolean
95 :group 'eshell-dirs)
96
97(defcustom eshell-cd-on-directory t
98 "*If non-nil, do a cd if a directory is in command position."
99 :type 'boolean
100 :group 'eshell-dirs)
101
102(defcustom eshell-directory-change-hook nil
103 "*A hook to run when the current directory changes."
104 :type 'hook
105 :group 'eshell-dirs)
106
107(defcustom eshell-list-files-after-cd nil
108 "*If non-nil, call \"ls\" with any remaining args after doing a cd.
109This is provided for convenience, since the same effect is easily
110achieved by adding a function to `eshell-directory-change-hook' that
111calls \"ls\" and references `eshell-last-arguments'."
112 :type 'boolean
113 :group 'eshell-dirs)
114
115(defcustom eshell-pushd-tohome nil
116 "*If non-nil, make pushd with no arg behave as 'pushd ~' (like `cd').
117This mirrors the optional behavior of tcsh."
118 :type 'boolean
119 :group 'eshell-dirs)
120
121(defcustom eshell-pushd-dextract nil
122 "*If non-nil, make \"pushd +n\" pop the nth dir to the stack top.
123This mirrors the optional behavior of tcsh."
124 :type 'boolean
125 :group 'eshell-dirs)
126
127(defcustom eshell-pushd-dunique nil
128 "*If non-nil, make pushd only add unique directories to the stack.
129This mirrors the optional behavior of tcsh."
130 :type 'boolean
131 :group 'eshell-dirs)
132
133(defcustom eshell-dirtrack-verbose t
134 "*If non-nil, show the directory stack following directory change.
135This is effective only if directory tracking is enabled."
136 :type 'boolean
137 :group 'eshell-dirs)
138
139(defcustom eshell-last-dir-ring-file-name
140 (concat eshell-directory-name "lastdir")
141 "*If non-nil, name of the file to read/write the last-dir-ring.
142See also `eshell-read-last-dir-ring' and `eshell-write-last-dir-ring'.
143If it is nil, the last-dir-ring will not be written to disk."
144 :type 'file
145 :group 'eshell-dirs)
146
147(defcustom eshell-last-dir-ring-size 32
148 "*If non-nil, the size of the directory history ring.
149This ring is added to every time `cd' or `pushd' is used. It simply
150stores the most recent directory locations Eshell has been in. To
151return to the most recent entry, use 'cd -' (equivalent to 'cd -0').
152To return to an older entry, use 'cd -N', where N is an integer less
153than `eshell-last-dir-ring-size'. To return to the last directory
154matching a particular regexp, use 'cd =REGEXP'. To display the
155directory history list, use 'cd ='.
156
157This mechanism is very similar to that provided by `pushd', except
158it's far more automatic. `pushd' allows the user to decide which
159directories gets pushed, and its size is unlimited.
160
161`eshell-last-dir-ring' is meant for users who don't use `pushd'
162explicity very much, but every once in a while would like to return to
163a previously visited directory without having to type in the whole
164thing again."
165 :type 'integer
166 :group 'eshell-dirs)
167
168(defcustom eshell-last-dir-unique t
169 "*If non-nil, `eshell-last-dir-ring' contains only unique entries."
170 :type 'boolean
171 :group 'eshell-dirs)
172
173;;; Internal Variables:
174
175(defvar eshell-dirstack nil
176 "List of directories saved by pushd in the Eshell buffer.
177Thus, this does not include the current directory.")
178
179(defvar eshell-last-dir-ring nil
180 "The last directory that eshell was in.")
181
182;;; Functions:
183
184(defun eshell-dirs-initialize ()
185 "Initialize the builtin functions for Eshell."
186 (make-local-variable 'eshell-variable-aliases-list)
187 (setq eshell-variable-aliases-list
188 (append
189 eshell-variable-aliases-list
190 '(("-" (lambda (indices)
191 (if (not indices)
192 (unless (ring-empty-p eshell-last-dir-ring)
193 (expand-file-name
194 (ring-ref eshell-last-dir-ring 0)))
195 (expand-file-name
196 (eshell-apply-indices eshell-last-dir-ring indices)))))
197 ("+" "PWD")
198 ("PWD" (lambda (indices)
199 (expand-file-name (eshell/pwd))) t)
200 ("OLDPWD" (lambda (indices)
201 (unless (ring-empty-p eshell-last-dir-ring)
202 (expand-file-name
203 (ring-ref eshell-last-dir-ring 0)))) t))))
204
205 (when eshell-cd-on-directory
206 (make-local-variable 'eshell-interpreter-alist)
207 (setq eshell-interpreter-alist
208 (cons (cons 'eshell-lone-directory-p
209 'eshell-dirs-substitute-cd)
210 eshell-interpreter-alist)))
211
212 (make-local-hook 'eshell-parse-argument-hook)
213 (add-hook 'eshell-parse-argument-hook
214 'eshell-parse-user-reference nil t)
215 (if (eshell-under-windows-p)
216 (add-hook 'eshell-parse-argument-hook
217 'eshell-parse-drive-letter nil t))
218
219 (when (eshell-using-module 'eshell-cmpl)
220 (make-local-hook 'pcomplete-try-first-hook)
221 (add-hook 'pcomplete-try-first-hook
222 'eshell-complete-user-reference nil t))
223
224 (make-local-variable 'eshell-dirstack)
225 (make-local-variable 'eshell-last-dir-ring)
226
227 (if eshell-last-dir-ring-file-name
228 (eshell-read-last-dir-ring))
229 (unless eshell-last-dir-ring
230 (setq eshell-last-dir-ring (make-ring eshell-last-dir-ring-size)))
231
232 (make-local-hook 'eshell-exit-hook)
233 (add-hook 'eshell-exit-hook 'eshell-write-last-dir-ring nil t)
234
235 (add-hook 'kill-emacs-hook 'eshell-save-some-last-dir))
236
237(defun eshell-save-some-last-dir ()
238 "Save the list-dir-ring for any open Eshell buffers."
239 (eshell-for buf (buffer-list)
240 (if (buffer-live-p buf)
241 (with-current-buffer buf
242 (if (and eshell-mode
243 eshell-ask-to-save-last-dir
244 (or (eq eshell-ask-to-save-last-dir 'always)
245 (y-or-n-p
246 (format "Save last dir ring for Eshell buffer `%s'? "
247 (buffer-name buf)))))
248 (eshell-write-last-dir-ring))))))
249
250(defun eshell-lone-directory-p (file)
251 "Test whether FILE is just a directory name, and not a command name."
252 (and (file-directory-p file)
253 (or (file-name-directory file)
254 (not (eshell-search-path file)))))
255
256(defun eshell-dirs-substitute-cd (&rest args)
257 "Substitute the given command for a call to `cd' on that name."
258 (if (> (length args) 1)
259 (error "%s: command not found" (car args))
260 (throw 'eshell-replace-command
261 (eshell-parse-command "cd" args))))
262
263(defun eshell-parse-user-reference ()
264 "An argument beginning with ~ is a filename to be expanded."
265 (when (and (not eshell-current-argument)
266 (eq (char-after) ?~))
267 (add-to-list 'eshell-current-modifiers 'expand-file-name)
268 (forward-char)
269 (char-to-string (char-before))))
270
271(defun eshell-parse-drive-letter ()
272 "An argument beginning X:[^/] is a drive letter reference."
273 (when (and (not eshell-current-argument)
274 (looking-at "\\([A-Za-z]:\\)\\([^/\\\\]\\|\\'\\)"))
275 (goto-char (match-end 1))
276 (let* ((letter (match-string 1))
277 (regexp (concat "\\`" letter))
278 (path (eshell-find-previous-directory regexp)))
279 (concat (or path letter)
280 (char-to-string directory-sep-char)))))
281
282(defun eshell-complete-user-reference ()
283 "If there is a user reference, complete it."
284 (let ((arg (pcomplete-actual-arg)))
285 (when (string-match "\\`~[a-z]*\\'" arg)
286 (setq pcomplete-stub (substring arg 1)
287 pcomplete-last-completion-raw t)
288 (throw 'pcomplete-completions
289 (progn
290 (eshell-read-user-names)
291 (pcomplete-uniqify-list
292 (mapcar
293 (function
294 (lambda (user)
295 (file-name-as-directory (cdr user))))
296 eshell-user-names)))))))
297
298(defun eshell/pwd (&rest args) ; ignored
299 "Change output from `pwd` to be cleaner."
300 (let* ((path default-directory)
301 (len (length path)))
302 (if (and (> len 1)
303 (eq (aref path (1- len)) directory-sep-char)
304 (not (and (eshell-under-windows-p)
305 (string-match "\\`[A-Za-z]:[\\\\/]\\'" path))))
306 (setq path (substring path 0 (1- (length path)))))
307 (if eshell-pwd-convert-function
308 (setq path (funcall eshell-pwd-convert-function path)))
309 path))
310
311(defun eshell-expand-multiple-dots (path)
312 "Convert '...' to '../..', '....' to '../../..', etc..
313
314With the following piece of advice, you can make this functionality
315available in most of Emacs, with the exception of filename completion
316in the minibuffer:
317
318 (defadvice expand-file-name
319 (before translate-multiple-dots
320 (filename &optional directory) activate)
321 (setq filename (eshell-expand-multiple-dots filename)))"
322 (while (string-match "\\.\\.\\(\\.+\\)" path)
323 (let* ((extra-dots (match-string 1 path))
324 (len (length extra-dots))
325 replace-text)
326 (while (> len 0)
327 (setq replace-text
328 (concat replace-text
329 (char-to-string directory-sep-char) "..")
330 len (1- len)))
331 (setq path
332 (replace-match replace-text t t path 1))))
333 path)
334
335(defun eshell-find-previous-directory (regexp)
336 "Find the most recent last-dir matching REGEXP."
337 (let ((index 0)
338 (len (ring-length eshell-last-dir-ring))
339 oldpath)
340 (if (> (length regexp) 0)
341 (while (< index len)
342 (setq oldpath (ring-ref eshell-last-dir-ring index))
343 (if (string-match regexp oldpath)
344 (setq index len)
345 (setq oldpath nil
346 index (1+ index)))))
347 oldpath))
348
349(eval-when-compile
350 (defvar dired-directory))
351
352(defun eshell/cd (&rest args) ; all but first ignored
353 "Alias to extend the behavior of `cd'."
354 (let ((path (car args))
355 (subpath (car (cdr args)))
356 handled)
357 (if (numberp path)
358 (setq path (number-to-string path)))
359 (if (numberp subpath)
360 (setq subpath (number-to-string subpath)))
361 (cond
362 (subpath
363 (let ((curdir (eshell/pwd)))
364 (if (string-match path curdir)
365 (setq path (replace-match subpath nil nil curdir))
366 (error "Path substring '%s' not found" path))))
367 ((and path (string-match "^-\\([0-9]*\\)$" path))
368 (let ((index (match-string 1 path)))
369 (setq path
370 (ring-remove eshell-last-dir-ring
371 (if index
372 (string-to-int index)
373 0)))))
374 ((and path (string-match "^=\\(.*\\)$" path))
375 (let ((oldpath (eshell-find-previous-directory
376 (match-string 1 path))))
377 (if oldpath
378 (setq path oldpath)
379 (let ((len (ring-length eshell-last-dir-ring))
380 (index 0))
381 (if (= len 0)
382 (error "Directory ring empty"))
383 (while (< index len)
384 (eshell-printn
385 (concat (number-to-string index) ": "
386 (ring-ref eshell-last-dir-ring index)))
387 (setq index (1+ index)))
388 (setq handled t)))))
389 (path
390 (setq path (eshell-expand-multiple-dots path))))
391 (unless handled
392 (setq dired-directory (or path "~"))
393 (let ((curdir (eshell/pwd)))
394 (unless (equal curdir dired-directory)
395 (eshell-add-to-dir-ring curdir))
396 (let ((result (cd dired-directory)))
397 (and eshell-cd-shows-directory
398 (eshell-printn result)))
399 (run-hooks 'eshell-directory-change-hook)
400 (if eshell-list-files-after-cd
401 (throw 'eshell-replace-command
402 (eshell-parse-command "ls" (cdr args))))
403 nil))))
404
405(defun eshell-add-to-dir-ring (path)
406 "Add PATH to the last-dir-ring, if applicable."
407 (unless (and (not (ring-empty-p eshell-last-dir-ring))
408 (equal path (ring-ref eshell-last-dir-ring 0)))
409 (if eshell-last-dir-unique
410 (let ((index 0)
411 (len (ring-length eshell-last-dir-ring)))
412 (while (< index len)
413 (if (equal (ring-ref eshell-last-dir-ring index) path)
414 (ring-remove eshell-last-dir-ring index)
415 (setq index (1+ index))))))
416 (ring-insert eshell-last-dir-ring path)))
417
418;;; pushd [+n | dir]
419(defun eshell/pushd (&rest args) ; all but first ignored
420 "Implementation of pushd in Lisp."
421 (let ((path (car args)))
422 (cond
423 ((null path)
424 ;; no arg -- swap pwd and car of stack unless eshell-pushd-tohome
425 (cond (eshell-pushd-tohome
426 (eshell/pushd "~"))
427 (eshell-dirstack
428 (let ((old (eshell/pwd)))
429 (eshell/cd (car eshell-dirstack))
430 (setq eshell-dirstack (cons old (cdr eshell-dirstack)))
431 (eshell/dirs t)))
432 (t
433 (error "pushd: No other directory"))))
434 ((string-match "^\\+\\([0-9]\\)" path)
435 ;; pushd +n
436 (setq path (string-to-number (match-string 1 path)))
437 (cond ((> path (length eshell-dirstack))
438 (error "Directory stack not that deep"))
439 ((= path 0)
440 (error "Couldn't cd"))
441 (eshell-pushd-dextract
442 (let ((dir (nth (1- path) eshell-dirstack)))
443 (eshell/popd path)
444 (eshell/pushd (eshell/pwd))
445 (eshell/cd dir)
446 (eshell/dirs t)))
447 (t
448 (let* ((ds (cons (eshell/pwd) eshell-dirstack))
449 (dslen (length ds))
450 (front (nthcdr path ds))
451 (back (nreverse (nthcdr (- dslen path) (reverse ds))))
452 (new-ds (append front back)))
453 (eshell/cd (car new-ds))
454 (setq eshell-dirstack (cdr new-ds))
455 (eshell/dirs t)))))
456 (t
457 ;; pushd <dir>
458 (let ((old-wd (eshell/pwd)))
459 (eshell/cd path)
460 (if (or (null eshell-pushd-dunique)
461 (not (member old-wd eshell-dirstack)))
462 (setq eshell-dirstack (cons old-wd eshell-dirstack)))
463 (eshell/dirs t)))))
464 nil)
465
466;;; popd [+n]
467(defun eshell/popd (&rest args)
468 "Implementation of popd in Lisp."
469 (let ((ref (or (car args) "+0")))
470 (unless (and (stringp ref)
471 (string-match "\\`\\([+-][0-9]+\\)\\'" ref))
472 (error "popd: bad arg `%s'" ref))
473 (setq ref (string-to-number (match-string 1 ref)))
474 (cond ((= ref 0)
475 (unless eshell-dirstack
476 (error "popd: Directory stack empty"))
477 (eshell/cd (car eshell-dirstack))
478 (setq eshell-dirstack (cdr eshell-dirstack))
479 (eshell/dirs t))
480 ((<= (abs ref) (length eshell-dirstack))
481 (let* ((ds (cons nil eshell-dirstack))
482 (cell (nthcdr (if (> ref 0)
483 (1- ref)
484 (+ (length eshell-dirstack) ref)) ds))
485 (dir (cadr cell)))
486 (eshell/cd dir)
487 (setcdr cell (cdr (cdr cell)))
488 (setq eshell-dirstack (cdr ds))
489 (eshell/dirs t)))
490 (t
491 (error "Couldn't popd"))))
492 nil)
493
494(defun eshell/dirs (&optional if-verbose)
495 "Implementation of dirs in Lisp."
496 (when (or (not if-verbose) eshell-dirtrack-verbose)
497 (let* ((msg "")
498 (ds (cons (eshell/pwd) eshell-dirstack))
499 (home (expand-file-name "~/"))
500 (homelen (length home)))
501 (while ds
502 (let ((dir (car ds)))
503 (and (>= (length dir) homelen)
504 (string= home (substring dir 0 homelen))
505 (setq dir (concat "~/" (substring dir homelen))))
506 (setq msg (concat msg (directory-file-name dir) " "))
507 (setq ds (cdr ds))))
508 msg)))
509
510(defun eshell-read-last-dir-ring ()
511 "Sets the buffer's `eshell-last-dir-ring' from a history file."
512 (let ((file eshell-last-dir-ring-file-name))
513 (cond
514 ((or (null file)
515 (equal file "")
516 (not (file-readable-p file)))
517 nil)
518 (t
519 (let* ((count 0)
520 (size eshell-last-dir-ring-size)
521 (ring (make-ring size)))
522 (with-temp-buffer
523 (insert-file-contents file)
524 ;; Save restriction in case file is already visited...
525 ;; Watch for those date stamps in history files!
526 (goto-char (point-max))
527 (while (and (< count size)
528 (re-search-backward "^\\([^\n].*\\)$" nil t))
529 (ring-insert-at-beginning ring (match-string 1))
530 (setq count (1+ count)))
531 ;; never allow the top element to equal the current
532 ;; directory
533 (while (and (not (ring-empty-p ring))
534 (equal (ring-ref ring 0) (eshell/pwd)))
535 (ring-remove ring 0)))
536 (setq eshell-last-dir-ring ring))))))
537
538(defun eshell-write-last-dir-ring ()
539 "Writes the buffer's `eshell-last-dir-ring' to a history file."
540 (let ((file eshell-last-dir-ring-file-name))
541 (cond
542 ((or (null file)
543 (equal file "")
544 (null eshell-last-dir-ring)
545 (ring-empty-p eshell-last-dir-ring))
546 nil)
547 ((not (file-writable-p file))
548 (message "Cannot write last-dir-ring file %s" file))
549 (t
550 (let* ((ring eshell-last-dir-ring)
551 (index (ring-length ring)))
552 (with-temp-buffer
553 (while (> index 0)
554 (setq index (1- index))
555 (insert (ring-ref ring index) ?\n))
556 (insert (eshell/pwd) ?\n)
557 (eshell-with-private-file-modes
558 (write-region (point-min) (point-max) file nil
559 'no-message))))))))
560
561;;; Code:
562
563;;; em-dirs.el ends here
diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el
new file mode 100644
index 00000000000..7bd69d1d932
--- /dev/null
+++ b/lisp/eshell/em-glob.el
@@ -0,0 +1,357 @@
1;;; em-glob --- extended file name globbing
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'em-glob)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-glob nil
27 "This module provides extended globbing syntax, similar what is used
28by zsh for filename generation."
29 :tag "Extended filename globbing"
30 :group 'eshell-module)
31
32;;; Commentary:
33
34;; The globbing code used by Eshell closely follows the syntax used by
35;; zsh. Basically, here is a summary of examples:
36;;
37;; echo a* ; anything starting with 'a'
38;; echo a#b ; zero or more 'a's, then 'b'
39;; echo a##b ; one or more 'a's, then 'b'
40;; echo a? ; a followed by any character
41;; echo a*~ab ; 'a', then anything, but not 'ab'
42;; echo c*~*~ ; all files beginning with 'c', except backups (*~)
43;;
44;; Recursive globbing is also supported:
45;;
46;; echo **/*.c ; all '.c' files at or under current directory
47;; echo ***/*.c ; same as above, but traverse symbolic links
48;;
49;; Using argument predication, the recursive globbing syntax is
50;; sufficient to replace the use of 'find <expr> | xargs <cmd>' in
51;; most cases. For example, to change the readership of all files
52;; belonging to 'johnw' in the '/tmp' directory or lower, use:
53;;
54;; chmod go-r /tmp/**/*(u'johnw')
55;;
56;; The glob above matches all of the files beneath '/tmp' that are
57;; owned by the user 'johnw'. See [Value modifiers and predicates],
58;; for more information about argument predication.
59
60;;; User Variables:
61
62(defcustom eshell-glob-load-hook '(eshell-glob-initialize)
63 "*A list of functions to run when `eshell-glob' is loaded."
64 :type 'hook
65 :group 'eshell-glob)
66
67(defcustom eshell-glob-include-dot-files nil
68 "*If non-nil, glob patterns will match files beginning with a dot."
69 :type 'boolean
70 :group 'eshell-glob)
71
72(defcustom eshell-glob-include-dot-dot t
73 "*If non-nil, glob patterns that match dots will match . and .."
74 :type 'boolean
75 :group 'eshell-glob)
76
77(defcustom eshell-glob-case-insensitive (eshell-under-windows-p)
78 "*If non-nil, glob pattern matching will ignore case."
79 :type 'boolean
80 :group 'eshell-glob)
81
82(defcustom eshell-glob-show-progress t
83 "*If non-nil, display progress messages during a recursive glob."
84 :type 'boolean
85 :group 'eshell-glob)
86
87(defcustom eshell-error-if-no-glob nil
88 "*If non-nil, it is an error for a glob pattern not to match.
89 This mimcs the behavior of zsh if non-nil, but bash if nil."
90 :type 'boolean
91 :group 'eshell-glob)
92
93(defcustom eshell-glob-chars-list '(?\] ?\[ ?* ?? ?~ ?\( ?\) ?| ?#)
94 "*List of additional characters used in extended globbing."
95 :type '(repeat character)
96 :group 'eshell-glob)
97
98(defcustom eshell-glob-translate-alist
99 '((?\] . "]")
100 (?\[ . "[")
101 (?? . ".")
102 (?* . ".*")
103 (?~ . "~")
104 (?\( . "\\(")
105 (?\) . "\\)")
106 (?\| . "\\|")
107 (?# . (lambda (str pos)
108 (if (and (< (1+ pos) (length str))
109 (memq (aref str (1+ pos)) '(?* ?# ?+ ??)))
110 (cons (if (eq (aref str (1+ pos)) ??)
111 "?"
112 (if (eq (aref str (1+ pos)) ?*)
113 "*" "+")) (+ pos 2))
114 (cons "*" (1+ pos))))))
115 "*An alist for translation of extended globbing characters."
116 :type '(repeat (cons character (choice regexp function)))
117 :group 'eshell-glob)
118
119;;; Internal Variables:
120
121(defvar eshell-glob-chars-regexp nil)
122
123;;; Functions:
124
125(defun eshell-glob-initialize ()
126 "Initialize the extended globbing code."
127 ;; it's important that `eshell-glob-chars-list' come first
128 (set (make-local-variable 'eshell-special-chars-outside-quoting)
129 (append eshell-glob-chars-list eshell-special-chars-outside-quoting))
130 (set (make-local-variable 'eshell-glob-chars-regexp)
131 (format "[%s]+" (apply 'string eshell-glob-chars-list)))
132 (make-local-hook 'eshell-parse-argument-hook)
133 (add-hook 'eshell-parse-argument-hook 'eshell-parse-glob-chars t t)
134 (make-local-hook 'eshell-pre-rewrite-command-hook)
135 (add-hook 'eshell-pre-rewrite-command-hook
136 'eshell-no-command-globbing nil t))
137
138(defun eshell-no-command-globbing (terms)
139 "Don't glob the command argument. Reflect this by modifying TERMS."
140 (ignore
141 (when (and (listp (car terms))
142 (eq (caar terms) 'eshell-extended-glob))
143 (setcar terms (cadr (car terms))))))
144
145(defun eshell-add-glob-modifier ()
146 "Add `eshell-extended-glob' to the argument modifier list."
147 (when (memq 'expand-file-name eshell-current-modifiers)
148 (setq eshell-current-modifiers
149 (delq 'expand-file-name eshell-current-modifiers))
150 ;; if this is a glob pattern than needs to be expanded, then it
151 ;; will need to expand each member of the resulting glob list
152 (add-to-list 'eshell-current-modifiers
153 '(lambda (list)
154 (if (listp list)
155 (mapcar 'expand-file-name list)
156 (expand-file-name list)))))
157 (add-to-list 'eshell-current-modifiers 'eshell-extended-glob))
158
159(defun eshell-parse-glob-chars ()
160 "Parse a globbing delimiter.
161The character is not advanced for ordinary globbing characters, so
162that other function may have a chance to override the globbing
163interpretation."
164 (when (memq (char-after) eshell-glob-chars-list)
165 (if (not (memq (char-after) '(?\( ?\[)))
166 (ignore (eshell-add-glob-modifier))
167 (let ((here (point)))
168 (forward-char)
169 (let* ((delim (char-before))
170 (end (eshell-find-delimiter
171 delim (if (eq delim ?\[) ?\] ?\)))))
172 (if (not end)
173 (throw 'eshell-incomplete delim)
174 (if (and (eshell-using-module 'eshell-pred)
175 (eshell-arg-delimiter (1+ end)))
176 (ignore (goto-char here))
177 (eshell-add-glob-modifier)
178 (prog1
179 (buffer-substring-no-properties (1- (point)) (1+ end))
180 (goto-char (1+ end))))))))))
181
182(defun eshell-glob-regexp (pattern)
183 "Convert glob-pattern PATTERN to a regular expression.
184The basic syntax is:
185
186 glob regexp meaning
187 ---- ------ -------
188 ? . matches any single character
189 * .* matches any group of characters (or none)
190 # * matches zero or more occurrences of preceding
191 ## + matches one or more occurrences of preceding
192 (x) \(x\) makes 'x' a regular expression group
193 | \| boolean OR within an expression group
194 [a-b] [a-b] matches a character or range
195 [^a] [^a] excludes a character or range
196
197If any characters in PATTERN have the text property `eshell-escaped'
198set to true, then these characters will match themselves in the
199resulting regular expression."
200 (let ((matched-in-pattern 0) ; How much of PATTERN handled
201 regexp)
202 (while (string-match eshell-glob-chars-regexp
203 pattern matched-in-pattern)
204 (let* ((op-begin (match-beginning 0))
205 (op-char (aref pattern op-begin)))
206 (setq regexp
207 (concat regexp
208 (regexp-quote
209 (substring pattern matched-in-pattern op-begin))))
210 (if (get-text-property op-begin 'escaped pattern)
211 (setq regexp (concat regexp
212 (regexp-quote (char-to-string op-char)))
213 matched-in-pattern (1+ op-begin))
214 (let ((xlat (assq op-char eshell-glob-translate-alist)))
215 (if (not xlat)
216 (error "Unrecognized globbing character '%c'" op-char)
217 (if (stringp (cdr xlat))
218 (setq regexp (concat regexp (cdr xlat))
219 matched-in-pattern (1+ op-begin))
220 (let ((result (funcall (cdr xlat) pattern op-begin)))
221 (setq regexp (concat regexp (car result))
222 matched-in-pattern (cdr result)))))))))
223 (concat "\\`"
224 regexp
225 (regexp-quote (substring pattern matched-in-pattern))
226 "\\'")))
227
228(defun eshell-extended-glob (glob)
229 "Return a list of files generated from GLOB, perhaps looking for DIRS-ONLY.
230 This function almost fully supports zsh style filename generation
231 syntax. Things that are not supported are:
232
233 ^foo for matching everything but foo
234 (foo~bar) tilde within a parenthesis group
235 foo<1-10> numeric ranges
236 foo~x(a|b) (a|b) will be interpreted as a predicate/modifier list
237
238 Mainly they are not supported because file matching is done with Emacs
239 regular expressions, and these cannot support the above constructs.
240
241 If this routine fails, it returns nil. Otherwise, it returns a list
242 the form:
243
244 (INCLUDE-REGEXP EXCLUDE-REGEXP (PRED-FUNC-LIST) (MOD-FUNC-LIST))"
245 (let ((paths (eshell-split-path glob))
246 matches message-shown)
247 (unwind-protect
248 (if (and (cdr paths)
249 (file-name-absolute-p (car paths)))
250 (eshell-glob-entries (file-name-as-directory (car paths))
251 (cdr paths))
252 (eshell-glob-entries (file-name-as-directory ".") paths))
253 (if message-shown
254 (message nil)))
255 (or (and matches (nreverse matches))
256 (if eshell-error-if-no-glob
257 (error "No matches found: %s" glob)
258 glob))))
259
260(eval-when-compile
261 (defvar matches)
262 (defvar message-shown))
263
264;; jww (1999-11-18): this function assumes that directory-sep-char is
265;; a forward slash (/)
266
267(defun eshell-glob-entries (path globs &optional recurse-p)
268 "Glob the entries in PATHS, possibly recursing if RECURSE-P is non-nil."
269 (let* ((entries (ignore-errors
270 (file-name-all-completions "" path)))
271 (case-fold-search eshell-glob-case-insensitive)
272 (glob (car globs))
273 (len (length glob))
274 dirs rdirs
275 incl excl
276 name isdir pathname)
277 (while (cond
278 ((and (= len 3) (equal glob "**/"))
279 (setq recurse-p 2
280 globs (cdr globs)
281 glob (car globs)
282 len (length glob)))
283 ((and (= len 4) (equal glob "***/"))
284 (setq recurse-p 3
285 globs (cdr globs)
286 glob (car globs)
287 len (length glob)))))
288 (if (and recurse-p (not glob))
289 (error "'**' cannot end a globbing pattern"))
290 (let ((index 1))
291 (setq incl glob)
292 (while (and (eq incl glob)
293 (setq index (string-match "~" glob index)))
294 (if (or (get-text-property index 'escaped glob)
295 (or (= (1+ index) len)))
296 (setq index (1+ index))
297 (setq incl (substring glob 0 index)
298 excl (substring glob (1+ index))))))
299 ;; can't use `directory-file-name' because it strips away text
300 ;; properties in the string
301 (let ((len (1- (length incl))))
302 (if (eq (aref incl len) directory-sep-char)
303 (setq incl (substring incl 0 len)))
304 (when excl
305 (setq len (1- (length excl)))
306 (if (eq (aref excl len) directory-sep-char)
307 (setq excl (substring excl 0 len)))))
308 (setq incl (eshell-glob-regexp incl)
309 excl (and excl (eshell-glob-regexp excl)))
310 (if (or eshell-glob-include-dot-files
311 (eq (aref glob 0) ?.))
312 (unless (or eshell-glob-include-dot-dot
313 (cdr globs))
314 (setq excl (if excl
315 (concat "\\(\\`\\.\\.?\\'\\|" excl "\\)")
316 "\\`\\.\\.?\\'")))
317 (setq excl (if excl
318 (concat "\\(\\`\\.\\|" excl "\\)")
319 "\\`\\.")))
320 (when (and recurse-p eshell-glob-show-progress)
321 (message "Building file list...%d so far: %s"
322 (length matches) path)
323 (setq message-shown t))
324 (if (equal path "./") (setq path ""))
325 (while entries
326 (setq name (car entries)
327 len (length name)
328 isdir (eq (aref name (1- len)) directory-sep-char))
329 (if (let ((fname (directory-file-name name)))
330 (and (not (and excl (string-match excl fname)))
331 (string-match incl fname)))
332 (if (cdr globs)
333 (if isdir
334 (setq dirs (cons (concat path name) dirs)))
335 (setq matches (cons (concat path name) matches))))
336 (if (and recurse-p isdir
337 (or (> len 3)
338 (not (or (and (= len 2) (equal name "./"))
339 (and (= len 3) (equal name "../")))))
340 (setq pathname (concat path name))
341 (not (and (= recurse-p 2)
342 (file-symlink-p
343 (directory-file-name pathname)))))
344 (setq rdirs (cons pathname rdirs)))
345 (setq entries (cdr entries)))
346 (setq dirs (nreverse dirs)
347 rdirs (nreverse rdirs))
348 (while dirs
349 (eshell-glob-entries (car dirs) (cdr globs))
350 (setq dirs (cdr dirs)))
351 (while rdirs
352 (eshell-glob-entries (car rdirs) globs recurse-p)
353 (setq rdirs (cdr rdirs)))))
354
355;;; Code:
356
357;;; em-glob.el ends here
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el
new file mode 100644
index 00000000000..5b661bbd748
--- /dev/null
+++ b/lisp/eshell/em-hist.el
@@ -0,0 +1,966 @@
1;;; em-hist --- history list management
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'em-hist)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-hist nil
27 "This module provides command history management."
28 :tag "History list management"
29 :group 'eshell-module)
30
31;;; Commentary:
32
33;; Eshell's history facility imitates the syntax used by bash
34;; ([(bash)History Interaction]). Thus:
35;;
36;; !ls ; repeat the last command beginning with 'ls'
37;; !?ls ; repeat the last command containing ls
38;; echo !ls:2 ; echo the second arg of the last 'ls' command
39;; !ls<tab> ; complete against all possible words in this
40;; ; position, by looking at the history list
41;; !ls<C-c SPC> ; expand any matching history input at point
42;;
43;; Also, most of `comint-mode's keybindings are accepted:
44;;
45;; M-r ; search backward for a previous command by regexp
46;; M-s ; search forward for a previous command by regexp
47;; M-p ; access the last command entered, repeatable
48;; M-n ; access the first command entered, repeatable
49;;
50;; C-c M-r ; using current input, find a matching command thus, with
51;; ; 'ls' as the current input, it will go back to the same
52;; ; command that '!ls' would have selected
53;; C-c M-s ; same, but in reverse order
54;;
55;; Note that some of these keybindings are only available if the
56;; `eshell-rebind' is not in use, in which case M-p does what C-c M-r
57;; normally would do, and C-p is used instead of M-p. It may seem
58;; confusing, but the intention is to make the most useful
59;; functionality the most easily accessible. If `eshell-rebind' is
60;; not being used, history navigation will use comint's keybindings;
61;; if it is, history navigation tries to use similar keybindings to
62;; bash. This is all configurable, of course.
63
64;;; Code:
65
66(require 'ring)
67(require 'esh-opt)
68(require 'em-pred)
69
70;;; User Variables:
71
72(defcustom eshell-hist-load-hook '(eshell-hist-initialize)
73 "*A list of functions to call when loading `eshell-hist'."
74 :type 'hook
75 :group 'eshell-hist)
76
77(defcustom eshell-hist-unload-hook
78 (list
79 (function
80 (lambda ()
81 (remove-hook 'kill-emacs-hook 'eshell-save-some-history))))
82 "*A hook that gets run when `eshell-hist' is unloaded."
83 :type 'hook
84 :group 'eshell-hist)
85
86(defcustom eshell-history-file-name
87 (concat eshell-directory-name "history")
88 "*If non-nil, name of the file to read/write input history.
89See also `eshell-read-history' and `eshell-write-history'.
90If it is nil, Eshell will use the value of HISTFILE."
91 :type 'file
92 :group 'eshell-hist)
93
94(defcustom eshell-history-size 128
95 "*Size of the input history ring. If nil, use envvar HISTSIZE."
96 :type 'integer
97 :group 'eshell-hist)
98
99(defcustom eshell-hist-ignoredups nil
100 "*If non-nil, don't add input matching the last on the input ring.
101This mirrors the optional behavior of bash."
102 :type 'boolean
103 :group 'eshell-hist)
104
105(defcustom eshell-ask-to-save-history t
106 "*Determine if history should be automatically saved.
107History is always preserved after sanely exiting an Eshell buffer.
108However, when Emacs is being shut down, this variable determines
109whether to prompt the user.
110If set to nil, it means never ask whether history should be saved.
111If set to t, always ask if any Eshell buffers are open at exit time.
112If set to `always', history will always be saved, silently."
113 :type '(choice (const :tag "Never" nil)
114 (const :tag "Ask" t)
115 (const :tag "Always save" always))
116 :group 'eshell-hist)
117
118(defcustom eshell-input-filter
119 (function
120 (lambda (str)
121 (not (string-match "\\`\\s-*\\'" str))))
122 "*Predicate for filtering additions to input history.
123Takes one argument, the input. If non-nil, the input may be saved on
124the input history list. Default is to save anything that isn't all
125whitespace."
126 :type 'function
127 :group 'eshell-hist)
128
129(put 'eshell-input-filter 'risky-local-variable t)
130
131(defcustom eshell-hist-match-partial t
132 "*If non-nil, movement through history is constrained by current input.
133Otherwise, typing <M-p> and <M-n> will always go to the next history
134element, regardless of any text on the command line. In that case,
135<C-c M-r> and <C-c M-s> still offer that functionality."
136 :type 'boolean
137 :group 'eshell-hist)
138
139(defcustom eshell-hist-move-to-end t
140 "*If non-nil, move to the end of the buffer before cycling history."
141 :type 'boolean
142 :group 'eshell-hist)
143
144(defcustom eshell-hist-event-designator
145 "^!\\(!\\|-?[0-9]+\\|\\??[^:^$%*?]+\\??\\|#\\)"
146 "*The regexp used to identifier history event designators."
147 :type 'regexp
148 :group 'eshell-hist)
149
150(defcustom eshell-hist-word-designator
151 "^:?\\([0-9]+\\|[$^%*]\\)?\\(\\*\\|-[0-9]*\\|[$^%*]\\)?"
152 "*The regexp used to identify history word designators."
153 :type 'regexp
154 :group 'eshell-hist)
155
156(defcustom eshell-hist-modifier
157 "^\\(:\\([hretpqx&g]\\|s/\\([^/]*\\)/\\([^/]*\\)/\\)\\)*"
158 "*The regexp used to identity history modifiers."
159 :type 'regexp
160 :group 'eshell-hist)
161
162(defcustom eshell-hist-rebind-keys-alist
163 '(([(control ?p)] . eshell-previous-input)
164 ([(control ?n)] . eshell-next-input)
165 ([(control up)] . eshell-previous-input)
166 ([(control down)] . eshell-next-input)
167 ([(control ?r)] . eshell-isearch-backward)
168 ([(control ?s)] . eshell-isearch-forward)
169 ([(meta ?r)] . eshell-previous-matching-input)
170 ([(meta ?s)] . eshell-next-matching-input)
171 ([(meta ?p)] . eshell-previous-matching-input-from-input)
172 ([(meta ?n)] . eshell-next-matching-input-from-input)
173 ([up] . eshell-previous-matching-input-from-input)
174 ([down] . eshell-next-matching-input-from-input))
175 "*History keys to bind differently if point is in input text."
176 :type '(repeat (cons (vector :tag "Keys to bind"
177 (repeat :inline t sexp))
178 (function :tag "Command")))
179 :group 'eshell-hist)
180
181;;; Internal Variables:
182
183(defvar eshell-history-ring nil)
184(defvar eshell-history-index nil)
185(defvar eshell-matching-input-from-input-string "")
186(defvar eshell-save-history-index nil)
187
188(defvar eshell-isearch-map nil)
189
190(unless eshell-isearch-map
191 (setq eshell-isearch-map (copy-keymap isearch-mode-map))
192 (define-key eshell-isearch-map [(control ?m)] 'eshell-isearch-return)
193 (define-key eshell-isearch-map [return] 'eshell-isearch-return)
194 (define-key eshell-isearch-map [(control ?r)] 'eshell-isearch-repeat-backward)
195 (define-key eshell-isearch-map [(control ?s)] 'eshell-isearch-repeat-forward)
196 (define-key eshell-isearch-map [(control ?g)] 'eshell-isearch-abort)
197 (define-key eshell-isearch-map [backspace] 'eshell-isearch-delete-char)
198 (define-key eshell-isearch-map [delete] 'eshell-isearch-delete-char)
199 (defvar eshell-isearch-cancel-map)
200 (define-prefix-command 'eshell-isearch-cancel-map)
201 (define-key eshell-isearch-map [(control ?c)] 'eshell-isearch-cancel-map)
202 (define-key eshell-isearch-cancel-map [(control ?c)] 'eshell-isearch-cancel))
203
204;;; Functions:
205
206(defun eshell-hist-initialize ()
207 "Initialize the history management code for one Eshell buffer."
208 (make-local-hook 'eshell-expand-input-functions)
209 (add-hook 'eshell-expand-input-functions
210 'eshell-expand-history-references nil t)
211
212 (when (eshell-using-module 'eshell-cmpl)
213 (make-local-hook 'pcomplete-try-first-hook)
214 (add-hook 'pcomplete-try-first-hook
215 'eshell-complete-history-reference nil t))
216
217 (if (eshell-using-module 'eshell-rebind)
218 (let ((rebind-alist (symbol-value 'eshell-rebind-keys-alist)))
219 (make-local-variable 'eshell-rebind-keys-alist)
220 (set 'eshell-rebind-keys-alist
221 (append rebind-alist eshell-hist-rebind-keys-alist))
222 (set (make-local-variable 'search-invisible) t)
223 (set (make-local-variable 'search-exit-option) t)
224 (make-local-hook 'isearch-mode-hook)
225 (add-hook 'isearch-mode-hook
226 (function
227 (lambda ()
228 (if (>= (point) eshell-last-output-end)
229 (setq overriding-terminal-local-map
230 eshell-isearch-map)))) nil t)
231 (make-local-hook 'isearch-mode-end-hook)
232 (add-hook 'isearch-mode-end-hook
233 (function
234 (lambda ()
235 (setq overriding-terminal-local-map nil))) nil t))
236 (define-key eshell-mode-map [up] 'eshell-previous-matching-input-from-input)
237 (define-key eshell-mode-map [down] 'eshell-next-matching-input-from-input)
238 (define-key eshell-mode-map [(control up)] 'eshell-previous-input)
239 (define-key eshell-mode-map [(control down)] 'eshell-next-input)
240 (define-key eshell-mode-map [(meta ?r)] 'eshell-previous-matching-input)
241 (define-key eshell-mode-map [(meta ?s)] 'eshell-next-matching-input)
242 (define-key eshell-command-map [(meta ?r)]
243 'eshell-previous-matching-input-from-input)
244 (define-key eshell-command-map [(meta ?s)]
245 'eshell-next-matching-input-from-input)
246 (if eshell-hist-match-partial
247 (progn
248 (define-key eshell-mode-map [(meta ?p)]
249 'eshell-previous-matching-input-from-input)
250 (define-key eshell-mode-map [(meta ?n)]
251 'eshell-next-matching-input-from-input)
252 (define-key eshell-command-map [(meta ?p)] 'eshell-previous-input)
253 (define-key eshell-command-map [(meta ?n)] 'eshell-next-input))
254 (define-key eshell-mode-map [(meta ?p)] 'eshell-previous-input)
255 (define-key eshell-mode-map [(meta ?n)] 'eshell-next-input)
256 (define-key eshell-command-map [(meta ?p)]
257 'eshell-previous-matching-input-from-input)
258 (define-key eshell-command-map [(meta ?n)]
259 'eshell-next-matching-input-from-input)))
260
261 (make-local-variable 'eshell-history-size)
262 (or eshell-history-size
263 (setq eshell-history-size (getenv "HISTSIZE")))
264
265 (make-local-variable 'eshell-history-file-name)
266 (or eshell-history-file-name
267 (setq eshell-history-file-name (getenv "HISTFILE")))
268
269 (make-local-variable 'eshell-history-index)
270 (make-local-variable 'eshell-save-history-index)
271 (make-local-variable 'eshell-history-ring)
272 (if eshell-history-file-name
273 (eshell-read-history nil t))
274 (unless eshell-history-ring
275 (setq eshell-history-ring (make-ring eshell-history-size)))
276
277 (make-local-hook 'eshell-exit-hook)
278 (add-hook 'eshell-exit-hook 'eshell-write-history nil t)
279
280 (add-hook 'kill-emacs-hook 'eshell-save-some-history)
281
282 (make-local-variable 'eshell-input-filter-functions)
283 (add-hook 'eshell-input-filter-functions 'eshell-add-to-history nil t)
284
285 (define-key eshell-command-map [(control ?l)] 'eshell-list-history)
286 (define-key eshell-command-map [(control ?x)] 'eshell-get-next-from-history))
287
288(defun eshell-save-some-history ()
289 "Save the history for any open Eshell buffers."
290 (eshell-for buf (buffer-list)
291 (if (buffer-live-p buf)
292 (with-current-buffer buf
293 (if (and eshell-mode
294 eshell-history-file-name
295 eshell-ask-to-save-history
296 (or (eq eshell-ask-to-save-history 'always)
297 (y-or-n-p
298 (format "Save input history for Eshell buffer `%s'? "
299 (buffer-name buf)))))
300 (eshell-write-history))))))
301
302(defun eshell/history (&rest args)
303 "List in help buffer the buffer's input history."
304 (eshell-init-print-buffer)
305 (eshell-eval-using-options
306 "history" args
307 '((?r "read" nil read-history
308 "read from history file to current history list")
309 (?w "write" nil write-history
310 "write current history list to history file")
311 (?a "append" nil append-history
312 "append current history list to history file")
313 (?h "help" nil nil "display this usage message")
314 :usage "[n] [-rwa [filename]]"
315 :post-usage
316"When Eshell is started, history is read from `eshell-history-file-name'.
317This is also the location where history info will be saved by this command,
318unless a different file is specified on the command line.")
319 (and (or (not (ring-p eshell-history-ring))
320 (ring-empty-p eshell-history-ring))
321 (error "No history"))
322 (let (length command file)
323 (when (and args (string-match "^[0-9]+$" (car args)))
324 (setq length (min (eshell-convert (car args))
325 (ring-length eshell-history-ring))
326 args (cdr args)))
327 (and length
328 (or read-history write-history append-history)
329 (error "history: extra arguments"))
330 (when (and args (stringp (car args)))
331 (setq file (car args)
332 args (cdr args)))
333 (cond
334 (read-history (eshell-read-history file))
335 (write-history (eshell-write-history file))
336 (append-history (eshell-write-history file t))
337 (t
338 (let* ((history nil)
339 (index (1- (or length (ring-length eshell-history-ring))))
340 (ref (- (ring-length eshell-history-ring) index)))
341 ;; We have to build up a list ourselves from the ring vector.
342 (while (>= index 0)
343 (eshell-buffered-print
344 (format "%5d %s\n" ref (eshell-get-history index)))
345 (setq index (1- index)
346 ref (1+ ref)))))))
347 (eshell-flush)
348 nil))
349
350(defun eshell-put-history (input &optional ring at-beginning)
351 "Put a new input line into the history ring."
352 (unless ring (setq ring eshell-history-ring))
353 (subst-char-in-string ?\n ?\177 input t)
354 (if at-beginning
355 (ring-insert-at-beginning ring input)
356 (ring-insert ring input)))
357
358(defun eshell-get-history (index &optional ring)
359 "Get an input line from the history ring."
360 (unless ring (setq ring eshell-history-ring))
361 (let ((input (concat (ring-ref ring index))))
362 (subst-char-in-string ?\177 ?\n input t)
363 input))
364
365(defun eshell-add-to-history ()
366 "Add INPUT to the history ring.
367The input is entered into the input history ring, if the value of
368variable `eshell-input-filter' returns non-nil when called on the
369input."
370 (when (> (1- eshell-last-input-end) eshell-last-input-start)
371 (let ((input (buffer-substring eshell-last-input-start
372 (1- eshell-last-input-end))))
373 (if (and (funcall eshell-input-filter input)
374 (or (null eshell-hist-ignoredups)
375 (not (ring-p eshell-history-ring))
376 (ring-empty-p eshell-history-ring)
377 (not (string-equal (eshell-get-history 0) input))))
378 (eshell-put-history input))
379 (setq eshell-save-history-index eshell-history-ring)
380 (setq eshell-history-index nil))))
381
382(defun eshell-read-history (&optional filename silent)
383 "Sets the buffer's `eshell-history-ring' from a history file.
384The name of the file is given by the variable
385`eshell-history-file-name'. The history ring is of size
386`eshell-history-size', regardless of file size. If
387`eshell-history-file-name' is nil this function does nothing.
388
389If the optional argument SILENT is non-nil, we say nothing about a
390failure to read the history file.
391
392This function is useful for major mode commands and mode hooks.
393
394The structure of the history file should be one input command per
395line, with the most recent command last. See also
396`eshell-hist-ignoredups' and `eshell-write-history'."
397 (let ((file (or filename eshell-history-file-name)))
398 (cond
399 ((or (null file)
400 (equal file ""))
401 nil)
402 ((not (file-readable-p file))
403 (or silent
404 (message "Cannot read history file %s" file)))
405 (t
406 (let* ((count 0)
407 (size eshell-history-size)
408 (ring (make-ring size))
409 (ignore-dups eshell-hist-ignoredups))
410 (with-temp-buffer
411 (insert-file-contents file)
412 ;; Save restriction in case file is already visited...
413 ;; Watch for those date stamps in history files!
414 (goto-char (point-max))
415 (while (and (< count size)
416 (re-search-backward "^[ \t]*\\([^#\n].*\\)[ \t]*$"
417 nil t))
418 (let ((history (match-string 1)))
419 (if (or (null ignore-dups)
420 (ring-empty-p ring)
421 (not (string-equal (ring-ref ring 0) history)))
422 (ring-insert-at-beginning ring history)))
423 (setq count (1+ count))))
424 (setq eshell-history-ring ring
425 eshell-history-index nil))))))
426
427(defun eshell-write-history (&optional filename append)
428 "Writes the buffer's `eshell-history-ring' to a history file.
429The name of the file is given by the variable
430`eshell-history-file-name'. The original contents of the file are
431lost if `eshell-history-ring' is not empty. If
432`eshell-history-file-name' is nil this function does nothing.
433
434Useful within process sentinels.
435
436See also `eshell-read-history'."
437 (let ((file (or filename eshell-history-file-name)))
438 (cond
439 ((or (null file)
440 (equal file "")
441 (null eshell-history-ring)
442 (ring-empty-p eshell-history-ring))
443 nil)
444 ((not (file-writable-p file))
445 (message "Cannot write history file %s" file))
446 (t
447 (let* ((ring eshell-history-ring)
448 (index (ring-length ring)))
449 ;; Write it all out into a buffer first. Much faster, but
450 ;; messier, than writing it one line at a time.
451 (with-temp-buffer
452 (while (> index 0)
453 (setq index (1- index))
454 (insert (ring-ref ring index) ?\n))
455 (eshell-with-private-file-modes
456 (write-region (point-min) (point-max) file append
457 'no-message))))))))
458
459(defun eshell-list-history ()
460 "List in help buffer the buffer's input history."
461 (interactive)
462 (let (prefix prelen)
463 (save-excursion
464 (if (re-search-backward "!\\(.+\\)" (line-beginning-position) t)
465 (setq prefix (match-string 1)
466 prelen (length prefix))))
467 (if (or (not (ring-p eshell-history-ring))
468 (ring-empty-p eshell-history-ring))
469 (message "No history")
470 (let ((history nil)
471 (history-buffer " *Input History*")
472 (index (1- (ring-length eshell-history-ring)))
473 (conf (current-window-configuration)))
474 ;; We have to build up a list ourselves from the ring vector.
475 (while (>= index 0)
476 (let ((hist (eshell-get-history index)))
477 (if (or (not prefix)
478 (and (>= (length hist) prelen)
479 (string= (substring hist 0 prelen) prefix)))
480 (setq history (cons hist history))))
481 (setq index (1- index)))
482 ;; Change "completion" to "history reference"
483 ;; to make the display accurate.
484 (with-output-to-temp-buffer history-buffer
485 (display-completion-list history)
486 (set-buffer history-buffer)
487 (forward-line 3)
488 (while (search-backward "completion" nil 'move)
489 (replace-match "history reference")))
490 (eshell-redisplay)
491 (message "Hit space to flush")
492 (let ((ch (read-event)))
493 (if (eq ch ?\ )
494 (set-window-configuration conf)
495 (setq unread-command-events (list ch))))))))
496
497(defun eshell-hist-word-reference (ref)
498 "Return the word designator index referred to by REF."
499 (cond
500 ((string-match "^[0-9]+$" ref)
501 (string-to-number ref))
502 ((string= "^" ref) 1)
503 ((string= "$" ref) nil)
504 ((string= "%" ref)
505 (error "`%' history word designator not yet implemented"))))
506
507(defun eshell-hist-parse-arguments (&optional silent b e)
508 "Parse current command arguments in a history-code-friendly way."
509 (let ((end (or e (point)))
510 (begin (or b (save-excursion (eshell-bol) (point))))
511 (posb (list t))
512 (pose (list t))
513 (textargs (list t))
514 hist args)
515 (unless (catch 'eshell-incomplete
516 (ignore
517 (setq args (eshell-parse-arguments begin end))))
518 (save-excursion
519 (goto-char begin)
520 (while (< (point) end)
521 (if (get-text-property (point) 'arg-begin)
522 (nconc posb (list (point))))
523 (if (get-text-property (point) 'arg-end)
524 (nconc pose
525 (list (if (= (1+ (point)) end)
526 (1+ (point))
527 (point)))))
528 (forward-char))
529 (setq posb (cdr posb)
530 pose (cdr pose))
531 (assert (= (length posb) (length args)))
532 (assert (<= (length posb) (length pose))))
533 (setq hist (buffer-substring-no-properties begin end))
534 (let ((b posb) (e pose))
535 (while b
536 (nconc textargs
537 (list (substring hist (- (car b) begin)
538 (- (car e) begin))))
539 (setq b (cdr b)
540 e (cdr e))))
541 (setq textargs (cdr textargs))
542 (assert (= (length textargs) (length args)))
543 (list textargs posb pose))))
544
545(defun eshell-expand-history-references (beg end)
546 "Parse and expand any history references in current input."
547 (let ((result (eshell-hist-parse-arguments t beg end)))
548 (when result
549 (let ((textargs (nreverse (nth 0 result)))
550 (posb (nreverse (nth 1 result)))
551 (pose (nreverse (nth 2 result))))
552 (save-excursion
553 (while textargs
554 (let ((str (eshell-history-reference (car textargs))))
555 (unless (eq str (car textargs))
556 (goto-char (car posb))
557 (insert-and-inherit str)
558 (delete-char (- (car pose) (car posb)))))
559 (setq textargs (cdr textargs)
560 posb (cdr posb)
561 pose (cdr pose))))))))
562
563(defun eshell-complete-history-reference ()
564 "Complete a history reference, by completing the event designator."
565 (let ((arg (pcomplete-actual-arg)))
566 (when (string-match "\\`![^:^$*%]*\\'" arg)
567 (setq pcomplete-stub (substring arg 1)
568 pcomplete-last-completion-raw t)
569 (throw 'pcomplete-completions
570 (let ((history nil)
571 (index (1- (ring-length eshell-history-ring)))
572 (stublen (length pcomplete-stub)))
573 ;; We have to build up a list ourselves from the ring
574 ;; vector.
575 (while (>= index 0)
576 (let ((hist (eshell-get-history index)))
577 (if (and (>= (length hist) stublen)
578 (string= (substring hist 0 stublen)
579 pcomplete-stub)
580 (string-match "^\\([^:^$*% \t\n]+\\)" hist))
581 (setq history (cons (match-string 1 hist)
582 history))))
583 (setq index (1- index)))
584 (let ((fhist (list t)))
585 ;; uniqify the list, but preserve the order
586 (while history
587 (unless (member (car history) fhist)
588 (nconc fhist (list (car history))))
589 (setq history (cdr history)))
590 (cdr fhist)))))))
591
592(defun eshell-history-reference (reference)
593 "Expand directory stack REFERENCE.
594The syntax used here was taken from the Bash info manual.
595Returns the resultant reference, or the same string REFERENCE if none
596matched."
597 ;; `^string1^string2^'
598 ;; Quick Substitution. Repeat the last command, replacing
599 ;; STRING1 with STRING2. Equivalent to `!!:s/string1/string2/'
600 (if (and (eshell-using-module 'eshell-pred)
601 (string-match "\\^\\([^^]+\\)\\^\\([^^]+\\)\\^?\\s-*$"
602 reference))
603 (setq reference (format "!!:s/%s/%s/"
604 (match-string 1 reference)
605 (match-string 2 reference))))
606 ;; `!'
607 ;; Start a history substitution, except when followed by a
608 ;; space, tab, the end of the line, = or (.
609 (if (not (string-match "^![^ \t\n=\(]" reference))
610 reference
611 (setq eshell-history-index nil)
612 (let ((event (eshell-hist-parse-event-designator reference)))
613 (unless event
614 (error "Could not find history event `%s'" reference))
615 (setq eshell-history-index (car event)
616 reference (substring reference (cdr event))
617 event (eshell-get-history eshell-history-index))
618 (if (not (string-match "^[:^$*%]" reference))
619 event
620 (let ((word (eshell-hist-parse-word-designator
621 event reference)))
622 (unless word
623 (error "Unable to honor word designator `%s'" reference))
624 (unless (string-match "^[:^$*%][[$^*%0-9-]" reference)
625 (setcdr word 0))
626 (setq event (car word)
627 reference (substring reference (cdr word)))
628 (if (not (and (eshell-using-module 'eshell-pred)
629 (string-match "^:" reference)))
630 event
631 (eshell-hist-parse-modifier event reference)))))))
632
633(defun eshell-hist-parse-event-designator (reference)
634 "Parse a history event designator beginning in REFERENCE."
635 (let* ((index (string-match eshell-hist-event-designator reference))
636 (end (and index (match-end 0))))
637 (unless index
638 (error "Invalid history event designator `%s'" reference))
639 (let* ((event (match-string 1 reference))
640 (pos
641 (cond
642 ((string= event "!") (ring-length eshell-history-ring))
643 ((string= event "#") (error "!# not yet implemented"))
644 ((string-match "^-?[0-9]+$" event)
645 (let ((num (string-to-number event)))
646 (if (>= num 0)
647 (- (ring-length eshell-history-ring) num)
648 (1- (abs num)))))
649 ((string-match "^\\(\\??\\)\\([^?]+\\)\\??$" event)
650 (let ((pref (if (> (length (match-string 1 event)) 0)
651 "" "^"))
652 (str (match-string 2 event)))
653 (save-match-data
654 (eshell-previous-matching-input-string-position
655 (concat pref (regexp-quote str)) 1))))
656 (t
657 (error "Failed to parse event designator `%s'" event)))))
658 (and pos (cons pos end)))))
659
660(defun eshell-hist-parse-word-designator (hist reference)
661 "Parse a history word designator beginning for HIST in REFERENCE."
662 (let* ((index (string-match eshell-hist-word-designator reference))
663 (end (and index (match-end 0))))
664 (unless (memq (aref reference 0) '(?: ?^ ?$ ?* ?%))
665 (error "Invalid history word designator `%s'" reference))
666 (let ((nth (match-string 1 reference))
667 (mth (match-string 2 reference))
668 (here (point))
669 textargs)
670 (insert hist)
671 (setq textargs (car (eshell-hist-parse-arguments nil here (point))))
672 (delete-region here (point))
673 (if (string= nth "*")
674 (if mth
675 (error "Invalid history word designator `%s'"
676 reference)
677 (setq nth 1 mth "-$")))
678 (if (not mth)
679 (if nth
680 (setq mth nth)
681 (setq nth 0 mth "$"))
682 (if (string= mth "-")
683 (setq mth (- (length textargs) 2))
684 (if (string= mth "*")
685 (setq mth "$")
686 (if (not (and (> (length mth) 1)
687 (eq (aref mth 0) ?-)))
688 (error "Invalid history word designator `%s'"
689 reference)
690 (setq mth (substring mth 1))))))
691 (unless (numberp nth)
692 (setq nth (eshell-hist-word-reference nth)))
693 (unless (numberp mth)
694 (setq mth (eshell-hist-word-reference mth)))
695 (cons (mapconcat 'identity (eshell-sublist textargs nth mth) "")
696 end))))
697
698(defun eshell-hist-parse-modifier (hist reference)
699 "Parse a history modifier beginning for HIST in REFERENCE."
700 (let ((here (point)))
701 (insert reference)
702 (prog1
703 (save-restriction
704 (narrow-to-region here (point))
705 (goto-char (point-min))
706 (let ((modifiers (cdr (eshell-parse-modifiers))))
707 (eshell-for mod modifiers
708 (setq hist (funcall mod hist)))
709 hist))
710 (delete-region here (point)))))
711
712(defun eshell-get-next-from-history ()
713 "After fetching a line from input history, this fetches the next.
714In other words, this recalls the input line after the line you
715recalled last. You can use this to repeat a sequence of input lines."
716 (interactive)
717 (if eshell-save-history-index
718 (progn
719 (setq eshell-history-index (1+ eshell-save-history-index))
720 (eshell-next-input 1))
721 (message "No previous history command")))
722
723(defun eshell-search-arg (arg)
724 ;; First make sure there is a ring and that we are after the process
725 ;; mark
726 (if (and eshell-hist-move-to-end
727 (< (point) eshell-last-output-end))
728 (goto-char eshell-last-output-end))
729 (cond ((or (null eshell-history-ring)
730 (ring-empty-p eshell-history-ring))
731 (error "Empty input ring"))
732 ((zerop arg)
733 ;; arg of zero resets search from beginning, and uses arg of
734 ;; 1
735 (setq eshell-history-index nil)
736 1)
737 (t
738 arg)))
739
740(defun eshell-search-start (arg)
741 "Index to start a directional search, starting at `eshell-history-index'."
742 (if eshell-history-index
743 ;; If a search is running, offset by 1 in direction of arg
744 (mod (+ eshell-history-index (if (> arg 0) 1 -1))
745 (ring-length eshell-history-ring))
746 ;; For a new search, start from beginning or end, as appropriate
747 (if (>= arg 0)
748 0 ; First elt for forward search
749 ;; Last elt for backward search
750 (1- (ring-length eshell-history-ring)))))
751
752(defun eshell-previous-input-string (arg)
753 "Return the string ARG places along the input ring.
754Moves relative to `eshell-history-index'."
755 (eshell-get-history (if eshell-history-index
756 (mod (+ arg eshell-history-index)
757 (ring-length eshell-history-ring))
758 arg)))
759
760(defun eshell-previous-input (arg)
761 "Cycle backwards through input history."
762 (interactive "*p")
763 (eshell-previous-matching-input "." arg))
764
765(defun eshell-next-input (arg)
766 "Cycle forwards through input history."
767 (interactive "*p")
768 (eshell-previous-input (- arg)))
769
770(defun eshell-previous-matching-input-string (regexp arg)
771 "Return the string matching REGEXP ARG places along the input ring.
772Moves relative to `eshell-history-index'."
773 (let* ((pos (eshell-previous-matching-input-string-position regexp arg)))
774 (if pos (eshell-get-history pos))))
775
776(defun eshell-previous-matching-input-string-position
777 (regexp arg &optional start)
778 "Return the index matching REGEXP ARG places along the input ring.
779Moves relative to START, or `eshell-history-index'."
780 (if (or (not (ring-p eshell-history-ring))
781 (ring-empty-p eshell-history-ring))
782 (error "No history"))
783 (let* ((len (ring-length eshell-history-ring))
784 (motion (if (> arg 0) 1 -1))
785 (n (mod (- (or start (eshell-search-start arg)) motion) len))
786 (tried-each-ring-item nil)
787 (case-fold-search (eshell-under-windows-p))
788 (prev nil))
789 ;; Do the whole search as many times as the argument says.
790 (while (and (/= arg 0) (not tried-each-ring-item))
791 ;; Step once.
792 (setq prev n
793 n (mod (+ n motion) len))
794 ;; If we haven't reached a match, step some more.
795 (while (and (< n len) (not tried-each-ring-item)
796 (not (string-match regexp (eshell-get-history n))))
797 (setq n (mod (+ n motion) len)
798 ;; If we have gone all the way around in this search.
799 tried-each-ring-item (= n prev)))
800 (setq arg (if (> arg 0) (1- arg) (1+ arg))))
801 ;; Now that we know which ring element to use, if we found it,
802 ;; return that.
803 (if (string-match regexp (eshell-get-history n))
804 n)))
805
806(defun eshell-previous-matching-input (regexp arg)
807 "Search backwards through input history for match for REGEXP.
808\(Previous history elements are earlier commands.)
809With prefix argument N, search for Nth previous match.
810If N is negative, find the next or Nth next match."
811 (interactive (eshell-regexp-arg "Previous input matching (regexp): "))
812 (setq arg (eshell-search-arg arg))
813 (let ((pos (eshell-previous-matching-input-string-position regexp arg)))
814 ;; Has a match been found?
815 (if (null pos)
816 (error "Not found")
817 (setq eshell-history-index pos)
818 (message "History item: %d" (- (ring-length eshell-history-ring) pos))
819 ;; Can't use kill-region as it sets this-command
820 (delete-region (save-excursion (eshell-bol) (point)) (point))
821 (insert-and-inherit (eshell-get-history pos)))))
822
823(defun eshell-next-matching-input (regexp arg)
824 "Search forwards through input history for match for REGEXP.
825\(Later history elements are more recent commands.)
826With prefix argument N, search for Nth following match.
827If N is negative, find the previous or Nth previous match."
828 (interactive (eshell-regexp-arg "Next input matching (regexp): "))
829 (eshell-previous-matching-input regexp (- arg)))
830
831(defun eshell-previous-matching-input-from-input (arg)
832 "Search backwards through input history for match for current input.
833\(Previous history elements are earlier commands.)
834With prefix argument N, search for Nth previous match.
835If N is negative, search forwards for the -Nth following match."
836 (interactive "p")
837 (if (not (memq last-command '(eshell-previous-matching-input-from-input
838 eshell-next-matching-input-from-input)))
839 ;; Starting a new search
840 (setq eshell-matching-input-from-input-string
841 (buffer-substring (save-excursion (eshell-bol) (point))
842 (point))
843 eshell-history-index nil))
844 (eshell-previous-matching-input
845 (concat "^" (regexp-quote eshell-matching-input-from-input-string))
846 arg))
847
848(defun eshell-next-matching-input-from-input (arg)
849 "Search forwards through input history for match for current input.
850\(Following history elements are more recent commands.)
851With prefix argument N, search for Nth following match.
852If N is negative, search backwards for the -Nth previous match."
853 (interactive "p")
854 (eshell-previous-matching-input-from-input (- arg)))
855
856(defun eshell-test-imatch ()
857 "If isearch match good, put point at the beginning and return non-nil."
858 (if (get-text-property (point) 'history)
859 (progn (beginning-of-line) t)
860 (let ((before (point)))
861 (eshell-bol)
862 (if (and (not (bolp))
863 (<= (point) before))
864 t
865 (if isearch-forward
866 (progn
867 (end-of-line)
868 (forward-char))
869 (beginning-of-line)
870 (backward-char))))))
871
872(defun eshell-return-to-prompt ()
873 "Once a search string matches, insert it at the end and go there."
874 (setq isearch-other-end nil)
875 (let ((found (eshell-test-imatch)) before)
876 (while (and (not found)
877 (setq before
878 (funcall (if isearch-forward
879 're-search-forward
880 're-search-backward)
881 isearch-string nil t)))
882 (setq found (eshell-test-imatch)))
883 (if (not found)
884 (progn
885 (goto-char eshell-last-output-end)
886 (delete-region (point) (point-max)))
887 (setq before (point))
888 (let ((text (buffer-substring-no-properties
889 (point) (line-end-position)))
890 (orig (marker-position eshell-last-output-end)))
891 (goto-char eshell-last-output-end)
892 (delete-region (point) (point-max))
893 (when (and text (> (length text) 0))
894 (subst-char-in-string ?\177 ?\n text t)
895 (insert text)
896 (put-text-property (1- (point)) (point)
897 'last-search-pos before)
898 (set-marker eshell-last-output-end orig)
899 (goto-char eshell-last-output-end))))))
900
901(defun eshell-prepare-for-search ()
902 "Make sure the old history file is at the beginning of the buffer."
903 (unless (get-text-property (point-min) 'history)
904 (save-excursion
905 (goto-char (point-min))
906 (let ((end (copy-marker (point) t)))
907 (insert-file-contents eshell-history-file-name)
908 (set-text-properties (point-min) end
909 '(history t invisible t))))))
910
911(defun eshell-isearch-backward (&optional invert)
912 "Do incremental regexp search backward through past commands."
913 (interactive)
914 (let ((inhibit-read-only t) end)
915 (eshell-prepare-for-search)
916 (goto-char (point-max))
917 (set-marker eshell-last-output-end (point))
918 (delete-region (point) (point-max)))
919 (isearch-mode invert t 'eshell-return-to-prompt))
920
921(defun eshell-isearch-repeat-backward (&optional invert)
922 "Do incremental regexp search backward through past commands."
923 (interactive)
924 (let ((old-pos (get-text-property (1- (point-max))
925 'last-search-pos)))
926 (when old-pos
927 (goto-char old-pos)
928 (if invert
929 (end-of-line)
930 (backward-char)))
931 (setq isearch-forward invert)
932 (isearch-search-and-update)))
933
934(defun eshell-isearch-forward ()
935 "Do incremental regexp search backward through past commands."
936 (interactive)
937 (eshell-isearch-backward t))
938
939(defun eshell-isearch-repeat-forward ()
940 "Do incremental regexp search backward through past commands."
941 (interactive)
942 (eshell-isearch-repeat-backward t))
943
944(defun eshell-isearch-cancel ()
945 (interactive)
946 (goto-char eshell-last-output-end)
947 (delete-region (point) (point-max))
948 (call-interactively 'isearch-cancel))
949
950(defun eshell-isearch-abort ()
951 (interactive)
952 (goto-char eshell-last-output-end)
953 (delete-region (point) (point-max))
954 (call-interactively 'isearch-abort))
955
956(defun eshell-isearch-delete-char ()
957 (interactive)
958 (save-excursion
959 (isearch-delete-char)))
960
961(defun eshell-isearch-return ()
962 (interactive)
963 (isearch-done)
964 (eshell-send-input))
965
966;;; em-hist.el ends here
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el
new file mode 100644
index 00000000000..1cea10314ba
--- /dev/null
+++ b/lisp/eshell/em-ls.el
@@ -0,0 +1,863 @@
1;;; em-ls --- implementation of ls in Lisp
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'em-ls)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-ls nil
27 "This module implements the \"ls\" utility fully in Lisp. If it is
28passed any unrecognized command switches, it will revert to the
29operating system's version. This version of \"ls\" uses text
30properties to colorize its output based on the setting of
31`eshell-ls-use-colors'."
32 :tag "Implementation of `ls' in Lisp"
33 :group 'eshell-module)
34
35;;; Commentary:
36
37;; Most of the command switches recognized by GNU's ls utility are
38;; supported ([(fileutils)ls invocation]).
39
40(require 'esh-util)
41(require 'esh-opt)
42
43;;; User Variables:
44
45(defvar eshell-ls-orig-insert-directory
46 (symbol-function 'insert-directory)
47 "Preserve the original definition of `insert-directory'.")
48
49(defcustom eshell-ls-unload-hook
50 (list
51 (function
52 (lambda ()
53 (fset 'insert-directory eshell-ls-orig-insert-directory))))
54 "*When unloading `eshell-ls', restore the definition of `insert-directory'."
55 :type 'hook
56 :group 'eshell-ls)
57
58(defcustom eshell-ls-use-in-dired nil
59 "*If non-nil, use `eshell-ls' to read directories in dired."
60 :set (lambda (symbol value)
61 (if value
62 (unless (and (boundp 'eshell-ls-use-in-dired)
63 eshell-ls-use-in-dired)
64 (fset 'insert-directory 'eshell-ls-insert-directory))
65 (when (and (boundp 'eshell-ls-insert-directory)
66 eshell-ls-use-in-dired)
67 (fset 'insert-directory eshell-ls-orig-insert-directory)))
68 (setq eshell-ls-use-in-dired value))
69 :type 'boolean
70 :require 'em-ls
71 :group 'eshell-ls)
72
73(defcustom eshell-ls-default-blocksize 1024
74 "*The default blocksize to use when display file sizes with -s."
75 :type 'integer
76 :group 'eshell-ls)
77
78(defcustom eshell-ls-exclude-regexp "\\`\\."
79 "*Unless -a is specified, files matching this regexp will not be shown."
80 :type 'regexp
81 :group 'eshell-ls)
82
83(defcustom eshell-ls-use-colors t
84 "*If non-nil, use colors in file listings."
85 :type 'boolean
86 :group 'eshell-ls)
87
88(defface eshell-ls-directory-face
89 '((((class color) (background light)) (:foreground "Blue" :bold t))
90 (((class color) (background dark)) (:foreground "SkyBlue" :bold t))
91 (t (:bold t)))
92 "*The face used for highlight directories."
93 :group 'eshell-ls)
94
95(defface eshell-ls-symlink-face
96 '((((class color) (background light)) (:foreground "Dark Cyan" :bold t))
97 (((class color) (background dark)) (:foreground "Cyan" :bold t)))
98 "*The face used for highlight symbolic links."
99 :group 'eshell-ls)
100
101(defface eshell-ls-executable-face
102 '((((class color) (background light)) (:foreground "ForestGreen" :bold t))
103 (((class color) (background dark)) (:foreground "Green" :bold t)))
104 "*The face used for highlighting executables (not directories, though)."
105 :group 'eshell-ls)
106
107(defface eshell-ls-readonly-face
108 '((((class color) (background light)) (:foreground "Brown"))
109 (((class color) (background dark)) (:foreground "Pink")))
110 "*The face used for highlighting read-only files."
111 :group 'eshell-ls)
112
113(defface eshell-ls-unreadable-face
114 '((((class color) (background light)) (:foreground "Grey30"))
115 (((class color) (background dark)) (:foreground "DarkGrey")))
116 "*The face used for highlighting unreadable files."
117 :group 'eshell-ls)
118
119(defface eshell-ls-special-face
120 '((((class color) (background light)) (:foreground "Magenta" :bold t))
121 (((class color) (background dark)) (:foreground "Magenta" :bold t)))
122 "*The face used for highlighting non-regular files."
123 :group 'eshell-ls)
124
125(defface eshell-ls-missing-face
126 '((((class color) (background light)) (:foreground "Red" :bold t))
127 (((class color) (background dark)) (:foreground "Red" :bold t)))
128 "*The face used for highlighting non-existant file names."
129 :group 'eshell-ls)
130
131(defcustom eshell-ls-archive-regexp
132 (concat "\\.\\(t\\(a[rz]\\|gz\\)\\|arj\\|lzh\\|"
133 "zip\\|[zZ]\\|gz\\|bz2\\|deb\\|rpm\\)\\'")
134 "*A regular expression that matches names of file archives.
135This typically includes both traditional archives and compressed
136files."
137 :type 'regexp
138 :group 'eshell-ls)
139
140(defface eshell-ls-archive-face
141 '((((class color) (background light)) (:foreground "Orchid" :bold t))
142 (((class color) (background dark)) (:foreground "Orchid" :bold t)))
143 "*The face used for highlighting archived and compressed file names."
144 :group 'eshell-ls)
145
146(defcustom eshell-ls-backup-regexp
147 "\\(\\`\\.?#\\|\\(\\.bak\\|~\\)\\'\\)"
148 "*A regular expression that matches names of backup files."
149 :type 'regexp
150 :group 'eshell-ls)
151
152(defface eshell-ls-backup-face
153 '((((class color) (background light)) (:foreground "OrangeRed"))
154 (((class color) (background dark)) (:foreground "LightSalmon")))
155 "*The face used for highlighting backup file names."
156 :group 'eshell-ls)
157
158(defcustom eshell-ls-product-regexp
159 "\\.\\(elc\\|o\\(bj\\)?\\|a\\||lib\\|res\\)\\'"
160 "*A regular expression that matches names of product files.
161Products are files that get generated from a source file, and hence
162ought to be recreatable if they are deleted."
163 :type 'regexp
164 :group 'eshell-ls)
165
166(defface eshell-ls-product-face
167 '((((class color) (background light)) (:foreground "OrangeRed"))
168 (((class color) (background dark)) (:foreground "LightSalmon")))
169 "*The face used for highlighting files that are build products."
170 :group 'eshell-ls)
171
172(defcustom eshell-ls-clutter-regexp
173 "\\(^texput\\.log\\|^core\\)\\'"
174 "*A regular expression that matches names of junk files.
175These are mainly files that get created for various reasons, but don't
176really need to stick around for very long."
177 :type 'regexp
178 :group 'eshell-ls)
179
180(defface eshell-ls-clutter-face
181 '((((class color) (background light)) (:foreground "OrangeRed" :bold t))
182 (((class color) (background dark)) (:foreground "OrangeRed" :bold t)))
183 "*The face used for highlighting junk file names."
184 :group 'eshell-ls)
185
186(defsubst eshell-ls-filetype-p (attrs type)
187 "Test whether ATTRS specifies a directory."
188 (if (nth 8 attrs)
189 (eq (aref (nth 8 attrs) 0) type)))
190
191(defmacro eshell-ls-applicable (attrs index func file)
192 "Test whether, for ATTRS, the user UID can do what corresponds to INDEX.
193This is really just for efficiency, to avoid having to stat the file
194yet again."
195 `(if (= (user-uid) (nth 2 ,attrs))
196 (not (eq (aref (nth 8 ,attrs) ,index) ?-))
197 (,(eval func) ,file)))
198
199(defcustom eshell-ls-highlight-alist nil
200 "*This alist correlates test functions to color.
201The format of the members of this alist is
202
203 (TEST-SEXP . FACE)
204
205If TEST-SEXP evals to non-nil, that face will be used to highlight the
206name of the file. The first match wins. `file' and `attrs' are in
207scope during the evaluation of TEST-SEXP."
208 :type '(repeat (cons function face))
209 :group 'eshell-ls)
210
211;;; Functions:
212
213(defun eshell-ls-insert-directory
214 (file switches &optional wildcard full-directory-p)
215 "Insert directory listing for FILE, formatted according to SWITCHES.
216Leaves point after the inserted text.
217SWITCHES may be a string of options, or a list of strings.
218Optional third arg WILDCARD means treat FILE as shell wildcard.
219Optional fourth arg FULL-DIRECTORY-P means file is a directory and
220switches do not contain `d', so that a full listing is expected.
221
222This version of the function uses `eshell/ls'. If any of the switches
223passed are not recognized, the operating system's version will be used
224instead."
225 (let ((handler (find-file-name-handler file 'insert-directory)))
226 (if handler
227 (funcall handler 'insert-directory file switches
228 wildcard full-directory-p)
229 (if (stringp switches)
230 (setq switches (split-string switches)))
231 (let (eshell-current-handles
232 eshell-current-subjob-p)
233 ;; use the fancy highlighting in `eshell-ls' rather than font-lock
234 (when (and eshell-ls-use-colors
235 (featurep 'font-lock))
236 (font-lock-mode -1)
237 (if (boundp 'font-lock-buffers)
238 (set 'font-lock-buffers
239 (delq (current-buffer)
240 (symbol-value 'font-lock-buffers)))))
241 (let ((insert-func 'insert)
242 (error-func 'insert)
243 (flush-func 'ignore))
244 (eshell-do-ls (append switches (list file))))))))
245
246(defsubst eshell/ls (&rest args)
247 "An alias version of `eshell-do-ls'."
248 (let ((insert-func 'eshell-buffered-print)
249 (error-func 'eshell-error)
250 (flush-func 'eshell-flush))
251 (eshell-do-ls args)))
252
253(eval-when-compile
254 (defvar block-size)
255 (defvar dereference-links)
256 (defvar dir-literal)
257 (defvar error-func)
258 (defvar flush-func)
259 (defvar human-readable)
260 (defvar ignore-pattern)
261 (defvar insert-func)
262 (defvar listing-style)
263 (defvar numeric-uid-gid)
264 (defvar reverse-list)
265 (defvar show-all)
266 (defvar show-recursive)
267 (defvar show-size)
268 (defvar sort-method))
269
270(defun eshell-do-ls (&rest args)
271 "Implementation of \"ls\" in Lisp, passing ARGS."
272 (funcall flush-func -1)
273 ;; process the command arguments, and begin listing files
274 (eshell-eval-using-options
275 "ls" args
276 `((?a "all" nil show-all
277 "show all files in directory")
278 (?c nil by-ctime sort-method
279 "sort by modification time")
280 (?d "directory" nil dir-literal
281 "list directory entries instead of contents")
282 (?k "kilobytes" 1024 block-size
283 "using 1024 as the block size")
284 (?h "human-readable" 1024 human-readable
285 "print sizes in human readable format")
286 (?H "si" 1000 human-readable
287 "likewise, but use powers of 1000 not 1024")
288 (?I "ignore" t ignore-pattern
289 "do not list implied entries matching pattern")
290 (?l nil long-listing listing-style
291 "use a long listing format")
292 (?n "numeric-uid-gid" nil numeric-uid-gid
293 "list numeric UIDs and GIDs instead of names")
294 (?r "reverse" nil reverse-list
295 "reverse order while sorting")
296 (?s "size" nil show-size
297 "print size of each file, in blocks")
298 (?t nil by-mtime sort-method
299 "sort by modification time")
300 (?u nil by-atime sort-method
301 "sort by last access time")
302 (?x nil by-lines listing-style
303 "list entries by lines instead of by columns")
304 (?C nil by-columns listing-style
305 "list entries by columns")
306 (?L "deference" nil dereference-links
307 "list entries pointed to by symbolic links")
308 (?R "recursive" nil show-recursive
309 "list subdirectories recursively")
310 (?S nil by-size sort-method
311 "sort by file size")
312 (?U nil unsorted sort-method
313 "do not sort; list entries in directory order")
314 (?X nil by-extension sort-method
315 "sort alphabetically by entry extension")
316 (?1 nil single-column listing-style
317 "list one file per line")
318 (nil "help" nil nil
319 "show this usage display")
320 :external "ls"
321 :usage "[OPTION]... [FILE]...
322List information about the FILEs (the current directory by default).
323Sort entries alphabetically across.")
324 ;; setup some defaults, based on what the user selected
325 (unless block-size
326 (setq block-size eshell-ls-default-blocksize))
327 (unless listing-style
328 (setq listing-style 'by-columns))
329 (unless args
330 (setq args (list ".")))
331 (let ((eshell-ls-exclude-regexp eshell-ls-exclude-regexp))
332 (when ignore-pattern
333 (unless (eshell-using-module 'eshell-glob)
334 (error (concat "-I option requires that `eshell-glob'"
335 " be a member of `eshell-modules-list'")))
336 (set-text-properties 0 (length ignore-pattern) nil ignore-pattern)
337 (if eshell-ls-exclude-regexp
338 (setq eshell-ls-exclude-regexp
339 (concat "\\(" eshell-ls-exclude-regexp "\\|"
340 (eshell-glob-regexp ignore-pattern) "\\)"))
341 (setq eshell-ls-exclude-regexp (eshell-glob-regexp ignore-pattern))))
342 ;; list the files!
343 (eshell-ls-entries
344 (mapcar (function
345 (lambda (arg)
346 (cons (if (and (eshell-under-windows-p)
347 (file-name-absolute-p arg))
348 (expand-file-name arg)
349 arg)
350 (file-attributes arg)))) args)
351 t (expand-file-name default-directory)))
352 (funcall flush-func)))
353
354(defsubst eshell-ls-printable-size (filesize &optional by-blocksize)
355 "Return a printable FILESIZE."
356 (eshell-printable-size filesize human-readable
357 (and by-blocksize block-size)
358 eshell-ls-use-colors))
359
360(defsubst eshell-ls-size-string (attrs size-width)
361 "Return the size string for ATTRS length, using SIZE-WIDTH."
362 (let* ((str (eshell-ls-printable-size (nth 7 attrs) t))
363 (len (length str)))
364 (if (< len size-width)
365 (concat (make-string (- size-width len) ? ) str)
366 str)))
367
368(defun eshell-ls-annotate (fileinfo)
369 "Given a FILEINFO object, return a resolved, decorated FILEINFO.
370This means resolving any symbolic links, determining what face the
371name should be displayed as, etc. Think of it as cooking a FILEINFO."
372 (if (not (and (stringp (cadr fileinfo))
373 (or dereference-links
374 (eq listing-style 'long-listing))))
375 (setcar fileinfo (eshell-ls-decorated-name fileinfo))
376 (let (dir attr)
377 (unless (file-name-absolute-p (cadr fileinfo))
378 (setq dir (file-truename
379 (file-name-directory
380 (expand-file-name (car fileinfo))))))
381 (setq attr
382 (file-attributes
383 (let ((target (if dir
384 (expand-file-name (cadr fileinfo) dir)
385 (cadr fileinfo))))
386 (if dereference-links
387 (file-truename target)
388 target))))
389 (if (or dereference-links
390 (string-match "^\\.\\.?$" (car fileinfo)))
391 (progn
392 (setcdr fileinfo attr)
393 (setcar fileinfo (eshell-ls-decorated-name fileinfo)))
394 (assert (eq listing-style 'long-listing))
395 (setcar fileinfo
396 (concat (eshell-ls-decorated-name fileinfo) " -> "
397 (eshell-ls-decorated-name
398 (cons (cadr fileinfo) attr)))))))
399 fileinfo)
400
401(defun eshell-ls-file (fileinfo &optional size-width copy-fileinfo)
402 "Output FILE in long format.
403FILE may be a string, or a cons cell whose car is the filename and
404whose cdr is the list of file attributes."
405 (if (not (cdr fileinfo))
406 (funcall error-func (format "%s: No such file or directory\n"
407 (car fileinfo)))
408 (setq fileinfo
409 (eshell-ls-annotate (if copy-fileinfo
410 (cons (car fileinfo)
411 (cdr fileinfo))
412 fileinfo)))
413 (let ((file (car fileinfo))
414 (attrs (cdr fileinfo)))
415 (if (not (eq listing-style 'long-listing))
416 (if show-size
417 (funcall insert-func (eshell-ls-size-string attrs size-width)
418 " " file "\n")
419 (funcall insert-func file "\n"))
420 (let ((line
421 (concat
422 (if show-size
423 (concat (eshell-ls-size-string attrs size-width) " "))
424 (format
425 "%s%4d %-8s %-8s "
426 (or (nth 8 attrs) "??????????")
427 (or (nth 1 attrs) 0)
428 (or (and (not numeric-uid-gid)
429 (nth 2 attrs)
430 (eshell-substring
431 (user-login-name (nth 2 attrs)) 8))
432 (nth 2 attrs)
433 "")
434 (or (and (not numeric-uid-gid)
435 (nth 3 attrs)
436 (eshell-substring
437 (eshell-group-name (nth 3 attrs)) 8))
438 (nth 3 attrs)
439 ""))
440 (let* ((str (eshell-ls-printable-size (nth 7 attrs)))
441 (len (length str)))
442 (if (< len 8)
443 (concat (make-string (- 8 len) ? ) str)
444 str))
445 " " (format-time-string
446 (concat
447 "%b %e "
448 (if (= (nth 5 (decode-time (current-time)))
449 (nth 5 (decode-time
450 (nth (cond
451 ((eq sort-method 'by-atime) 4)
452 ((eq sort-method 'by-ctime) 6)
453 (t 5)) attrs))))
454 "%H:%M"
455 " %Y")) (nth (cond
456 ((eq sort-method 'by-atime) 4)
457 ((eq sort-method 'by-ctime) 6)
458 (t 5)) attrs)) " ")))
459 (funcall insert-func line file "\n"))))))
460
461(defun eshell-ls-dir (dirinfo &optional insert-name root-dir size-width)
462 "Output the entries in DIRINFO.
463If INSERT-NAME is non-nil, the name of DIRINFO will be output. If
464ROOT-DIR is also non-nil, and a directory name, DIRINFO will be output
465relative to that directory."
466 (let ((dir (car dirinfo)))
467 (if (not (cdr dirinfo))
468 (funcall error-func (format "%s: No such file or directory\n" dir))
469 (if dir-literal
470 (eshell-ls-file dirinfo size-width)
471 (if insert-name
472 (funcall insert-func
473 (eshell-ls-decorated-name
474 (cons (concat
475 (if root-dir
476 (file-relative-name dir root-dir)
477 (expand-file-name dir)))
478 (cdr dirinfo))) ":\n"))
479 (let ((entries
480 (eshell-directory-files-and-attributes dir nil nil t)))
481 (unless show-all
482 (while (and entries
483 (string-match eshell-ls-exclude-regexp
484 (caar entries)))
485 (setq entries (cdr entries)))
486 (let ((e entries))
487 (while (cdr e)
488 (if (string-match eshell-ls-exclude-regexp (car (cadr e)))
489 (setcdr e (cddr e))
490 (setq e (cdr e))))))
491 (when (or (eq listing-style 'long-listing) show-size)
492 (let ((total 0.0))
493 (setq size-width 0)
494 (eshell-for e entries
495 (if (nth 7 (cdr e))
496 (setq total (+ total (nth 7 (cdr e)))
497 size-width
498 (max size-width
499 (length (eshell-ls-printable-size
500 (nth 7 (cdr e)) t))))))
501 (funcall insert-func "total "
502 (eshell-ls-printable-size total t) "\n")))
503 (let ((default-directory (expand-file-name dir)))
504 (if show-recursive
505 (eshell-ls-entries
506 (let ((e entries) (good-entries (list t)))
507 (while e
508 (unless (let ((len (length (caar e))))
509 (and (eq (aref (caar e) 0) ?.)
510 (or (= len 1)
511 (and (= len 2)
512 (eq (aref (caar e) 1) ?.)))))
513 (nconc good-entries (list (car e))))
514 (setq e (cdr e)))
515 (cdr good-entries))
516 nil root-dir)
517 (eshell-ls-files (eshell-ls-sort-entries entries)
518 size-width))))))))
519
520(defsubst eshell-ls-compare-entries (l r inx func)
521 "Compare the time of two files, L and R, the attribute indexed by INX."
522 (let ((lt (nth inx (cdr l)))
523 (rt (nth inx (cdr r))))
524 (if (equal lt rt)
525 (string-lessp (directory-file-name (car l))
526 (directory-file-name (car r)))
527 (funcall func rt lt))))
528
529(defun eshell-ls-sort-entries (entries)
530 "Sort the given ENTRIES, which may be files, directories or both.
531In Eshell's implementation of ls, ENTRIES is always reversed."
532 (if (eq sort-method 'unsorted)
533 (nreverse entries)
534 (sort entries
535 (function
536 (lambda (l r)
537 (let ((result
538 (cond
539 ((eq sort-method 'by-atime)
540 (eshell-ls-compare-entries
541 l r 4 'eshell-time-less-p))
542 ((eq sort-method 'by-mtime)
543 (eshell-ls-compare-entries
544 l r 5 'eshell-time-less-p))
545 ((eq sort-method 'by-ctime)
546 (eshell-ls-compare-entries
547 l r 6 'eshell-time-less-p))
548 ((eq sort-method 'by-size)
549 (eshell-ls-compare-entries
550 l r 7 '<))
551 ((eq sort-method 'by-extension)
552 (let ((lx (file-name-extension
553 (directory-file-name (car l))))
554 (rx (file-name-extension
555 (directory-file-name (car r)))))
556 (cond
557 ((or (and (not lx) (not rx))
558 (equal lx rx))
559 (string-lessp (directory-file-name (car l))
560 (directory-file-name (car r))))
561 ((not lx) t)
562 ((not rx) nil)
563 (t
564 (string-lessp lx rx)))))
565 (t
566 (string-lessp (directory-file-name (car l))
567 (directory-file-name (car r)))))))
568 (if reverse-list
569 (not result)
570 result)))))))
571
572(defun eshell-ls-files (files &optional size-width copy-fileinfo)
573 "Output a list of FILES.
574Each member of FILES is either a string or a cons cell of the form
575\(FILE . ATTRS)."
576 (if (memq listing-style '(long-listing single-column))
577 (eshell-for file files
578 (if file
579 (eshell-ls-file file size-width copy-fileinfo)))
580 (let ((f files)
581 last-f
582 display-files
583 ignore)
584 (while f
585 (if (cdar f)
586 (setq last-f f
587 f (cdr f))
588 (unless ignore
589 (funcall error-func
590 (format "%s: No such file or directory\n" (caar f))))
591 (if (eq f files)
592 (setq files (cdr files)
593 f files)
594 (if (not (cdr f))
595 (progn
596 (setcdr last-f nil)
597 (setq f nil))
598 (setcar f (cadr f))
599 (setcdr f (cddr f))))))
600 (if (not show-size)
601 (setq display-files (mapcar 'eshell-ls-annotate files))
602 (eshell-for file files
603 (let* ((str (eshell-ls-printable-size (nth 7 (cdr file)) t))
604 (len (length str)))
605 (if (< len size-width)
606 (setq str (concat (make-string (- size-width len) ? ) str)))
607 (setq file (eshell-ls-annotate file)
608 display-files (cons (cons (concat str " " (car file))
609 (cdr file))
610 display-files))))
611 (setq display-files (nreverse display-files)))
612 (let* ((col-vals
613 (if (eq listing-style 'by-columns)
614 (eshell-ls-find-column-lengths display-files)
615 (assert (eq listing-style 'by-lines))
616 (eshell-ls-find-column-widths display-files)))
617 (col-widths (car col-vals))
618 (display-files (cdr col-vals))
619 (columns (length col-widths))
620 (col-index 1)
621 need-return)
622 (eshell-for file display-files
623 (let ((name
624 (if (car file)
625 (if show-size
626 (concat (substring (car file) 0 size-width)
627 (eshell-ls-decorated-name
628 (cons (substring (car file) size-width)
629 (cdr file))))
630 (eshell-ls-decorated-name file))
631 "")))
632 (if (< col-index columns)
633 (setq need-return
634 (concat need-return name
635 (make-string
636 (max 0 (- (aref col-widths
637 (1- col-index))
638 (length name))) ? ))
639 col-index (1+ col-index))
640 (funcall insert-func need-return name "\n")
641 (setq col-index 1 need-return nil))))
642 (if need-return
643 (funcall insert-func need-return "\n"))))))
644
645(defun eshell-ls-entries (entries &optional separate root-dir)
646 "Output PATH's directory ENTRIES, formatted according to OPTIONS.
647Each member of ENTRIES may either be a string or a cons cell, the car
648of which is the file name, and the cdr of which is the list of
649attributes.
650If SEPARATE is non-nil, directories name will be entirely separated
651from the filenames. This is the normal behavior, except when doing a
652recursive listing.
653ROOT-DIR, if non-nil, specifies the root directory of the listing, to
654which non-absolute directory names will be made relative if ever they
655need to be printed."
656 (let (dirs files show-names need-return (size-width 0))
657 (eshell-for entry entries
658 (if (and (not dir-literal)
659 (or (eshell-ls-filetype-p (cdr entry) ?d)
660 (and (eshell-ls-filetype-p (cdr entry) ?l)
661 (file-directory-p (car entry)))))
662 (progn
663 (unless separate
664 (setq files (cons entry files)
665 size-width
666 (if show-size
667 (max size-width
668 (length (eshell-ls-printable-size
669 (nth 7 (cdr entry)) t))))))
670 (setq dirs (cons entry dirs)))
671 (setq files (cons entry files)
672 size-width
673 (if show-size
674 (max size-width
675 (length (eshell-ls-printable-size
676 (nth 7 (cdr entry)) t)))))))
677 (when files
678 (eshell-ls-files (eshell-ls-sort-entries files)
679 size-width show-recursive)
680 (setq need-return t))
681 (setq show-names (or show-recursive
682 (> (+ (length files) (length dirs)) 1)))
683 (eshell-for dir (eshell-ls-sort-entries dirs)
684 (if (and need-return (not dir-literal))
685 (funcall insert-func "\n"))
686 (eshell-ls-dir dir show-names
687 (unless (file-name-absolute-p (car dir))
688 root-dir) size-width)
689 (setq need-return t))))
690
691(defun eshell-ls-find-column-widths (files)
692 "Find the best fitting column widths for FILES.
693It will be returned as a vector, whose length is the number of columns
694to use, and each member of which is the width of that column
695\(including spacing)."
696 (let* ((numcols 0)
697 (width 0)
698 (widths
699 (mapcar
700 (function
701 (lambda (file)
702 (+ 2 (length (car file)))))
703 files))
704 ;; must account for the added space...
705 (max-width (+ (window-width) 2))
706 (best-width 0)
707 col-widths)
708
709 ;; determine the largest number of columns in the first row
710 (let ((w widths))
711 (while (and w (< width max-width))
712 (setq width (+ width (car w))
713 numcols (1+ numcols)
714 w (cdr w))))
715
716 ;; refine it based on the following rows
717 (while (> numcols 0)
718 (let ((i 0)
719 (colw (make-vector numcols 0))
720 (w widths))
721 (while w
722 (if (= i numcols)
723 (setq i 0))
724 (aset colw i (max (aref colw i) (car w)))
725 (setq w (cdr w) i (1+ i)))
726 (setq i 0 width 0)
727 (while (< i numcols)
728 (setq width (+ width (aref colw i))
729 i (1+ i)))
730 (if (and (< width max-width)
731 (> width best-width))
732 (setq col-widths colw
733 best-width width)))
734 (setq numcols (1- numcols)))
735
736 (cons (or col-widths (vector max-width)) files)))
737
738(defun eshell-ls-find-column-lengths (files)
739 "Find the best fitting column lengths for FILES.
740It will be returned as a vector, whose length is the number of columns
741to use, and each member of which is the width of that column
742\(including spacing)."
743 (let* ((numcols 1)
744 (width 0)
745 (widths
746 (mapcar
747 (function
748 (lambda (file)
749 (+ 2 (length (car file)))))
750 files))
751 (max-width (+ (window-width) 2))
752 col-widths
753 colw)
754
755 ;; refine it based on the following rows
756 (while numcols
757 (let* ((rows (ceiling (/ (length widths)
758 (float numcols))))
759 (w widths)
760 (len (* rows numcols))
761 (index 0)
762 (i 0))
763 (setq width 0)
764 (unless (or (= rows 0)
765 (<= (/ (length widths) (float rows))
766 (float (1- numcols))))
767 (setq colw (make-vector numcols 0))
768 (while (> len 0)
769 (if (= i numcols)
770 (setq i 0 index (1+ index)))
771 (aset colw i
772 (max (aref colw i)
773 (or (nth (+ (* i rows) index) w) 0)))
774 (setq len (1- len) i (1+ i)))
775 (setq i 0)
776 (while (< i numcols)
777 (setq width (+ width (aref colw i))
778 i (1+ i))))
779 (if (>= width max-width)
780 (setq numcols nil)
781 (if colw
782 (setq col-widths colw))
783 (if (>= numcols (length widths))
784 (setq numcols nil)
785 (setq numcols (1+ numcols))))))
786
787 (if (not col-widths)
788 (cons (vector max-width) files)
789 (setq numcols (length col-widths))
790 (let* ((rows (ceiling (/ (length widths)
791 (float numcols))))
792 (len (* rows numcols))
793 (newfiles (make-list len nil))
794 (index 0)
795 (i 0)
796 (j 0))
797 (while (< j len)
798 (if (= i numcols)
799 (setq i 0 index (1+ index)))
800 (setcar (nthcdr j newfiles)
801 (nth (+ (* i rows) index) files))
802 (setq j (1+ j) i (1+ i)))
803 (cons col-widths newfiles)))))
804
805(defun eshell-ls-decorated-name (file)
806 "Return FILE, possibly decorated.
807Use TRUENAME for predicate tests, if passed."
808 (if eshell-ls-use-colors
809 (let ((face
810 (cond
811 ((not (cdr file))
812 'eshell-ls-missing-face)
813
814 ((stringp (cadr file))
815 'eshell-ls-symlink-face)
816
817 ((eq (cadr file) t)
818 'eshell-ls-directory-face)
819
820 ((not (eshell-ls-filetype-p (cdr file) ?-))
821 'eshell-ls-special-face)
822
823 ((and (not (= (user-uid) 0)) ; root can execute anything
824 (eshell-ls-applicable (cdr file) 3
825 'file-executable-p (car file)))
826 'eshell-ls-executable-face)
827
828 ((not (eshell-ls-applicable (cdr file) 1
829 'file-readable-p (car file)))
830 'eshell-ls-unreadable-face)
831
832 ((string-match eshell-ls-archive-regexp (car file))
833 'eshell-ls-archive-face)
834
835 ((string-match eshell-ls-backup-regexp (car file))
836 'eshell-ls-backup-face)
837
838 ((string-match eshell-ls-product-regexp (car file))
839 'eshell-ls-product-face)
840
841 ((string-match eshell-ls-clutter-regexp (car file))
842 'eshell-ls-clutter-face)
843
844 ((not (eshell-ls-applicable (cdr file) 2
845 'file-writable-p (car file)))
846 'eshell-ls-readonly-face)
847 (eshell-ls-highlight-alist
848 (let ((tests eshell-ls-highlight-alist)
849 value)
850 (while tests
851 (if (funcall (caar tests) (car file) (cdr file))
852 (setq value (cdar tests) tests nil)
853 (setq tests (cdr tests))))
854 value)))))
855 (if face
856 (add-text-properties 0 (length (car file))
857 (list 'face face)
858 (car file)))))
859 (car file))
860
861;;; Code:
862
863;;; em-ls.el ends here
diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el
new file mode 100644
index 00000000000..f2a5a30733a
--- /dev/null
+++ b/lisp/eshell/em-pred.el
@@ -0,0 +1,602 @@
1;;; em-pred --- argument predicates and modifiers (ala zsh)
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'em-pred)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-pred nil
27 "This module allows for predicates to be applied to globbing
28patterns (similar to zsh), in addition to string modifiers which can
29be applied either to globbing results, variable references, or just
30ordinary strings."
31 :tag "Value modifiers and predicates"
32 :group 'eshell-module)
33
34;;; Commentary:
35
36;; Argument predication is used to affect which members of a list are
37;; selected for use as argument. This is most useful with globbing,
38;; but can be used on any list argument, to select certain members.
39;;
40;; Argument modifiers are used to manipulate argument values. For
41;; example, sorting lists, upcasing words, substituting characters,
42;; etc.
43;;
44;; Here are some examples of how to use argument predication. Most of
45;; the predicates and modifiers are modeled after those provided by
46;; zsh.
47;;
48;; ls -ld *(/) ; list all directories
49;; ls -l *(@u'johnw') ; list all symlinks owned by 'johnw'
50;; bzip2 -9v **/*(a+30) ; compress everything which hasn't been
51;; accessed in 30 days
52;; echo *.c(:o:R) ; a reversed, sorted list of C files
53;; *(^@:U^u0) ; all non-symlinks not owned by 'root', upcased
54;; chmod u-x *(U*) : remove exec bit on all executables owned by user
55;;
56;; See the zsh docs for more on the syntax ([(zsh.info)Filename
57;; Generation]).
58
59;;; User Variables:
60
61(defcustom eshell-pred-load-hook '(eshell-pred-initialize)
62 "*A list of functions to run when `eshell-pred' is loaded."
63 :type 'hook
64 :group 'eshell-pred)
65
66(defcustom eshell-predicate-alist
67 '((?/ . (eshell-pred-file-type ?d)) ; directories
68 (?. . (eshell-pred-file-type ?-)) ; regular files
69 (?s . (eshell-pred-file-type ?s)) ; sockets
70 (?p . (eshell-pred-file-type ?p)) ; named pipes
71 (?@ . (eshell-pred-file-type ?l)) ; symbolic links
72 (?% . (eshell-pred-file-type ?%)) ; allow user to specify (c def.)
73 (?r . (eshell-pred-file-mode 0400)) ; owner-readable
74 (?w . (eshell-pred-file-mode 0200)) ; owner-writable
75 (?x . (eshell-pred-file-mode 0100)) ; owner-executable
76 (?A . (eshell-pred-file-mode 0040)) ; group-readable
77 (?I . (eshell-pred-file-mode 0020)) ; group-writable
78 (?E . (eshell-pred-file-mode 0010)) ; group-executable
79 (?R . (eshell-pred-file-mode 0004)) ; world-readable
80 (?W . (eshell-pred-file-mode 0002)) ; world-writable
81 (?X . (eshell-pred-file-mode 0001)) ; world-executable
82 (?s . (eshell-pred-file-mode 4000)) ; setuid
83 (?S . (eshell-pred-file-mode 2000)) ; setgid
84 (?t . (eshell-pred-file-mode 1000)) ; sticky bit
85 (?U . '(lambda (file) ; owned by effective uid
86 (if (file-exists-p file)
87 (= (nth 2 (file-attributes file)) (user-uid)))))
88;;; (?G . '(lambda (file) ; owned by effective gid
89;;; (if (file-exists-p file)
90;;; (= (nth 2 (file-attributes file)) (user-uid)))))
91 (?* . '(lambda (file)
92 (and (file-regular-p file)
93 (not (file-symlink-p file))
94 (file-executable-p file))))
95 (?l . (eshell-pred-file-links))
96 (?u . (eshell-pred-user-or-group ?u "user" 2 'eshell-user-id))
97 (?g . (eshell-pred-user-or-group ?g "group" 3 'eshell-group-id))
98 (?a . (eshell-pred-file-time ?a "access" 4))
99 (?m . (eshell-pred-file-time ?m "modification" 5))
100 (?c . (eshell-pred-file-time ?c "change" 6))
101 (?L . (eshell-pred-file-size)))
102 "*A list of predicates than can be applied to a globbing pattern.
103The format of each entry is
104
105 (CHAR . PREDICATE-FUNC-SEXP)"
106 :type '(repeat (cons character sexp))
107 :group 'eshell-pred)
108
109(put 'eshell-predicate-alist 'risky-local-variable t)
110
111(defcustom eshell-modifier-alist
112 '((?e . '(lambda (lst)
113 (mapcar
114 (function
115 (lambda (str)
116 (eshell-stringify
117 (car (eshell-parse-argument str))))) lst)))
118 (?L . '(lambda (lst)
119 (mapcar 'downcase lst)))
120 (?U . '(lambda (lst)
121 (mapcar 'upcase lst)))
122 (?C . '(lambda (lst)
123 (mapcar 'capitalize lst)))
124 (?h . '(lambda (lst)
125 (mapcar 'file-name-directory lst)))
126 (?i . (eshell-include-members))
127 (?x . (eshell-include-members t))
128 (?r . '(lambda (lst)
129 (mapcar 'file-name-sans-extension lst)))
130 (?e . '(lambda (lst)
131 (mapcar 'file-name-extension lst)))
132 (?t . '(lambda (lst)
133 (mapcar 'file-name-nondirectory lst)))
134 (?q . '(lambda (lst)
135 (mapcar 'eshell-escape-arg lst)))
136 (?u . '(lambda (lst)
137 (eshell-uniqify-list lst)))
138 (?o . '(lambda (lst)
139 (sort lst 'string-lessp)))
140 (?O . '(lambda (lst)
141 (nreverse (sort lst 'string-lessp))))
142 (?j . (eshell-join-members))
143 (?S . (eshell-split-members))
144 (?R . 'reverse)
145 (?g . (progn
146 (forward-char)
147 (if (eq (char-before) ?s)
148 (eshell-pred-substitute t)
149 (error "`g' modifier cannot be used alone"))))
150 (?s . (eshell-pred-substitute)))
151 "*A list of modifiers than can be applied to an argument expansion.
152The format of each entry is
153
154 (CHAR ENTRYWISE-P MODIFIER-FUNC-SEXP)"
155 :type '(repeat (cons character sexp))
156 :group 'eshell-pred)
157
158(put 'eshell-modifier-alist 'risky-local-variable t)
159
160(defvar eshell-predicate-help-string
161 "Eshell predicate quick reference:
162
163 - follow symbolic references for predicates after the `-'
164 ^ invert sense of predicates after the `^'
165
166FILE TYPE:
167 / directories s sockets
168 . regular files p named pipes
169 * executable (files only) @ symbolic links
170
171 %x file type == `x' (as by ls -l; so `c' = char device, etc.)
172
173PERMISSION BITS (for owner/group/world):
174 r/A/R readable s setuid
175 w/I/W writable S setgid
176 x/E/X executable t sticky bit
177
178OWNERSHIP:
179 U owned by effective uid
180 u(UID|'user') owned by UID/user
181 g(GID|'group') owned by GID/group
182
183FILE ATTRIBUTES:
184 l[+-]N +/-/= N links
185 a[Mwhm][+-](N|'FILE') access time +/-/= N mnths/weeks/days/mins
186 if FILE specified, use as comparison basis;
187 so a+'file.c' shows files accessed before
188 file.c was last accessed
189 m[Mwhm][+-](N|'FILE') modification time...
190 c[Mwhm][+-](N|'FILE') change time...
191 L[kmp][+-]N file size +/-/= N Kb/Mb/blocks
192
193EXAMPLES:
194 *(^@) all non-dot files which are not symlinks
195 .#*(^@) all files which are not symbolic links
196 **/.#*(*) all executable files, searched recursively
197 ***/*~f*(-/) recursively (though not traversing symlinks),
198 find all directories (or symlinks referring to
199 directories) whose names do not begin with f.
200 e*(*Lk+50) executables 50k or larger beginning with 'e'")
201
202(defvar eshell-modifier-help-string
203 "Eshell modifier quick reference:
204
205FOR SINGLE ARGUMENTS, or each argument of a list of strings:
206 e evaluate again
207 L lowercase
208 U uppercase
209 C capitalize
210 h dirname
211 t basename
212 e file extension
213 r strip file extension
214 q escape special characters
215
216 S split string at any whitespace character
217 S/PAT/ split string at each occurance of PAT
218
219FOR LISTS OF ARGUMENTS:
220 o sort alphabetically
221 O reverse sort alphabetically
222 u uniq list (typically used after :o or :O)
223 R reverse list
224
225 j join list members, separated by a space
226 j/PAT/ join list members, separated by PAT
227 i/PAT/ exclude all members not matching PAT
228 x/PAT/ exclude all members matching PAT
229
230 s/pat/match/ substitute PAT with MATCH
231 g/pat/match/ substitute PAT with MATCH for all occurances
232
233EXAMPLES:
234 *.c(:o) sorted list of .c files")
235
236;;; Functions:
237
238(defun eshell-display-predicate-help ()
239 (interactive)
240 (with-electric-help
241 (function
242 (lambda ()
243 (insert eshell-predicate-help-string)))))
244
245(defun eshell-display-modifier-help ()
246 (interactive)
247 (with-electric-help
248 (function
249 (lambda ()
250 (insert eshell-modifier-help-string)))))
251
252(defun eshell-pred-initialize ()
253 "Initialize the predicate/modifier code."
254 (make-local-hook 'eshell-parse-argument-hook)
255 (add-hook 'eshell-parse-argument-hook
256 'eshell-parse-arg-modifier t t)
257 (define-key eshell-command-map [(meta ?q)] 'eshell-display-predicate-help)
258 (define-key eshell-command-map [(meta ?m)] 'eshell-display-modifier-help))
259
260(defun eshell-apply-modifiers (lst predicates modifiers)
261 "Apply to LIST a series of PREDICATES and MODIFIERS."
262 (let (stringified)
263 (if (stringp lst)
264 (setq lst (list lst)
265 stringified t))
266 (when (listp lst)
267 (setq lst (eshell-winnow-list lst nil predicates))
268 (while modifiers
269 (setq lst (funcall (car modifiers) lst)
270 modifiers (cdr modifiers)))
271 (if (and stringified
272 (= (length lst) 1))
273 (car lst)
274 lst))))
275
276(defun eshell-parse-arg-modifier ()
277 "Parse a modifier that has been specified after an argument.
278This function is specially for adding onto `eshell-parse-argument-hook'."
279 (when (eq (char-after) ?\()
280 (forward-char)
281 (let ((end (eshell-find-delimiter ?\( ?\))))
282 (if (not end)
283 (throw 'eshell-incomplete ?\()
284 (when (eshell-arg-delimiter (1+ end))
285 (save-restriction
286 (narrow-to-region (point) end)
287 (let* ((modifiers (eshell-parse-modifiers))
288 (preds (car modifiers))
289 (mods (cdr modifiers)))
290 (if (or preds mods)
291 ;; has to go at the end, which is only natural since
292 ;; syntactically it can only occur at the end
293 (setq eshell-current-modifiers
294 (append
295 eshell-current-modifiers
296 (list
297 `(lambda (lst)
298 (eshell-apply-modifiers
299 lst (quote ,preds) (quote ,mods)))))))))
300 (goto-char (1+ end))
301 (eshell-finish-arg))))))
302
303(defun eshell-parse-modifiers ()
304 "Parse value modifiers and predicates at point.
305If ALLOW-PREDS is non-nil, predicates will be parsed as well.
306Return a cons cell of the form
307
308 (PRED-FUNC-LIST . MOD-FUNC-LIST)
309
310NEW-STRING is STRING minus any modifiers. PRED-FUNC-LIST is a list of
311predicate functions. MOD-FUNC-LIST is a list of result modifier
312functions. PRED-FUNCS take a filename and return t if the test
313succeeds; MOD-FUNCS take any string and preform a modification,
314returning the resultant string."
315 (let (result negate follow preds mods)
316 (condition-case err
317 (while (not (eobp))
318 (let ((char (char-after)))
319 (cond
320 ((eq char ?')
321 (forward-char)
322 (if (looking-at "[^|':]")
323 (let ((func (read (current-buffer))))
324 (if (and func (functionp func))
325 (setq preds (eshell-add-pred-func func preds
326 negate follow))
327 (error "Invalid function predicate '%s'"
328 (eshell-stringify func))))
329 (error "Invalid function predicate")))
330 ((eq char ?^)
331 (forward-char)
332 (setq negate (not negate)))
333 ((eq char ?-)
334 (forward-char)
335 (setq follow (not follow)))
336 ((eq char ?|)
337 (forward-char)
338 (if (looking-at "[^|':]")
339 (let ((func (read (current-buffer))))
340 (if (and func (functionp func))
341 (setq mods
342 (cons `(lambda (lst)
343 (mapcar (function ,func) lst))
344 mods))
345 (error "Invalid function modifier '%s'"
346 (eshell-stringify func))))
347 (error "Invalid function modifier")))
348 ((eq char ?:)
349 (forward-char)
350 (let ((mod (assq (char-after) eshell-modifier-alist)))
351 (if (not mod)
352 (error "Unknown modifier character '%c'" (char-after))
353 (forward-char)
354 (setq mods (cons (eval (cdr mod)) mods)))))
355 (t
356 (let ((pred (assq char eshell-predicate-alist)))
357 (if (not pred)
358 (error "Unknown predicate character '%c'" char)
359 (forward-char)
360 (setq preds
361 (eshell-add-pred-func (eval (cdr pred)) preds
362 negate follow))))))))
363 (end-of-buffer
364 (error "Predicate or modifier ended prematurely")))
365 (cons (nreverse preds) (nreverse mods))))
366
367(defun eshell-add-pred-func (pred funcs negate follow)
368 "Add the predicate function PRED to FUNCS."
369 (if negate
370 (setq pred `(lambda (file)
371 (not (funcall ,pred file)))))
372 (if follow
373 (setq pred `(lambda (file)
374 (funcall ,pred (file-truename file)))))
375 (cons pred funcs))
376
377(defun eshell-pred-user-or-group (mod-char mod-type attr-index get-id-func)
378 "Return a predicate to test whether a file match a given user/group id."
379 (let (ugid open close end)
380 (if (looking-at "[0-9]+")
381 (progn
382 (setq ugid (string-to-number (match-string 0)))
383 (goto-char (match-end 0)))
384 (setq open (char-after))
385 (if (setq close (memq open '(?\( ?\[ ?\< ?\{)))
386 (setq close (car (last '(?\) ?\] ?\> ?\})
387 (length close))))
388 (setq close open))
389 (forward-char)
390 (setq end (eshell-find-delimiter open close))
391 (unless end
392 (error "Malformed %s name string for modifier `%c'"
393 mod-type mod-char))
394 (setq ugid
395 (funcall get-id-func (buffer-substring (point) end)))
396 (goto-char (1+ end)))
397 (unless ugid
398 (error "Unknown %s name specified for modifier `%c'"
399 mod-type mod-char))
400 `(lambda (file)
401 (let ((attrs (file-attributes file)))
402 (if attrs
403 (= (nth ,attr-index attrs) ,ugid))))))
404
405(defun eshell-pred-file-time (mod-char mod-type attr-index)
406 "Return a predicate to test whether a file matches a certain time."
407 (let* ((quantum 86400)
408 qual amount when open close end)
409 (when (memq (char-after) '(?M ?w ?h ?m))
410 (setq quantum (char-after))
411 (cond
412 ((eq quantum ?M)
413 (setq quantum (* 60 60 24 30)))
414 ((eq quantum ?w)
415 (setq quantum (* 60 60 24 7)))
416 ((eq quantum ?h)
417 (setq quantum (* 60 60)))
418 ((eq quantum ?m)
419 (setq quantum 60))
420 ((eq quantum ?s)
421 (setq quantum 1)))
422 (forward-char))
423 (when (memq (char-after) '(?+ ?-))
424 (setq qual (char-after))
425 (forward-char))
426 (if (looking-at "[0-9]+")
427 (progn
428 (setq when (- (eshell-time-to-seconds (current-time))
429 (* (string-to-number (match-string 0))
430 quantum)))
431 (goto-char (match-end 0)))
432 (setq open (char-after))
433 (if (setq close (memq open '(?\( ?\[ ?\< ?\{)))
434 (setq close (car (last '(?\) ?\] ?\> ?\})
435 (length close))))
436 (setq close open))
437 (forward-char)
438 (setq end (eshell-find-delimiter open close))
439 (unless end
440 (error "Malformed %s time modifier `%c'" mod-type mod-char))
441 (let* ((file (buffer-substring (point) end))
442 (attrs (file-attributes file)))
443 (unless attrs
444 (error "Cannot stat file `%s'" file))
445 (setq when (eshell-time-to-seconds (nth attr-index attrs))))
446 (goto-char (1+ end)))
447 `(lambda (file)
448 (let ((attrs (file-attributes file)))
449 (if attrs
450 (,(if (eq qual ?-)
451 '<
452 (if (eq qual ?+)
453 '>
454 '=)) ,when (eshell-time-to-seconds
455 (nth ,attr-index attrs))))))))
456
457(defun eshell-pred-file-type (type)
458 "Return a test which tests that the file is of a certain TYPE.
459TYPE must be a character, and should be one of the possible options
460that 'ls -l' will show in the first column of its display. "
461 (when (eq type ?%)
462 (setq type (char-after))
463 (if (memq type '(?b ?c))
464 (forward-char)
465 (setq type ?%)))
466 `(lambda (file)
467 (let ((attrs (file-attributes (directory-file-name file))))
468 (if attrs
469 (memq (aref (nth 8 attrs) 0)
470 ,(if (eq type ?%)
471 '(?b ?c)
472 (list 'quote (list type))))))))
473
474(defsubst eshell-pred-file-mode (mode)
475 "Return a test which tests that MODE pertains to the file."
476 `(lambda (file)
477 (let ((modes (file-modes file)))
478 (if modes
479 (logand ,mode modes)))))
480
481(defun eshell-pred-file-links ()
482 "Return a predicate to test whether a file has a given number of links."
483 (let (qual amount)
484 (when (memq (char-after) '(?- ?+))
485 (setq qual (char-after))
486 (forward-char))
487 (unless (looking-at "[0-9]+")
488 (error "Invalid file link count modifier `l'"))
489 (setq amount (string-to-number (match-string 0)))
490 (goto-char (match-end 0))
491 `(lambda (file)
492 (let ((attrs (file-attributes file)))
493 (if attrs
494 (,(if (eq qual ?-)
495 '<
496 (if (eq qual ?+)
497 '>
498 '=)) (nth 1 attrs) ,amount))))))
499
500(defun eshell-pred-file-size ()
501 "Return a predicate to test whether a file is of a given size."
502 (let ((quantum 1) qual amount)
503 (when (memq (downcase (char-after)) '(?k ?m ?p))
504 (setq qual (downcase (char-after)))
505 (cond
506 ((eq qual ?k)
507 (setq quantum 1024))
508 ((eq qual ?m)
509 (setq quantum (* 1024 1024)))
510 ((eq qual ?p)
511 (setq quantum 512)))
512 (forward-char))
513 (when (memq (char-after) '(?- ?+))
514 (setq qual (char-after))
515 (forward-char))
516 (unless (looking-at "[0-9]+")
517 (error "Invalid file size modifier `L'"))
518 (setq amount (* (string-to-number (match-string 0)) quantum))
519 (goto-char (match-end 0))
520 `(lambda (file)
521 (let ((attrs (file-attributes file)))
522 (if attrs
523 (,(if (eq qual ?-)
524 '<
525 (if (eq qual ?+)
526 '>
527 '=)) (nth 7 attrs) ,amount))))))
528
529(defun eshell-pred-substitute (&optional repeat)
530 "Return a modifier function that will substitute matches."
531 (let ((delim (char-after))
532 match replace end)
533 (forward-char)
534 (setq end (eshell-find-delimiter delim delim nil nil t)
535 match (buffer-substring-no-properties (point) end))
536 (goto-char (1+ end))
537 (setq end (eshell-find-delimiter delim delim nil nil t)
538 replace (buffer-substring-no-properties (point) end))
539 (goto-char (1+ end))
540 (if repeat
541 `(lambda (lst)
542 (mapcar
543 (function
544 (lambda (str)
545 (let ((i 0))
546 (while (setq i (string-match ,match str i))
547 (setq str (replace-match ,replace t nil str))))
548 str)) lst))
549 `(lambda (lst)
550 (mapcar
551 (function
552 (lambda (str)
553 (if (string-match ,match str)
554 (setq str (replace-match ,replace t nil str)))
555 str)) lst)))))
556
557(defun eshell-include-members (&optional invert-p)
558 "Include only lisp members matching a regexp."
559 (let ((delim (char-after))
560 regexp end)
561 (forward-char)
562 (setq end (eshell-find-delimiter delim delim nil nil t)
563 regexp (buffer-substring-no-properties (point) end))
564 (goto-char (1+ end))
565 `(lambda (lst)
566 (eshell-winnow-list
567 lst nil '((lambda (elem)
568 ,(if invert-p
569 `(not (string-match ,regexp elem))
570 `(string-match ,regexp elem))))))))
571
572(defun eshell-join-members ()
573 "Return a modifier function that join matches."
574 (let ((delim (char-after))
575 str end)
576 (if (not (memq delim '(?' ?/)))
577 (setq delim " ")
578 (forward-char)
579 (setq end (eshell-find-delimiter delim delim nil nil t)
580 str (buffer-substring-no-properties (point) end))
581 (goto-char (1+ end)))
582 `(lambda (lst)
583 (mapconcat 'identity lst ,str))))
584
585(defun eshell-split-members ()
586 "Return a modifier function that splits members."
587 (let ((delim (char-after))
588 sep end)
589 (when (memq delim '(?' ?/))
590 (forward-char)
591 (setq end (eshell-find-delimiter delim delim nil nil t)
592 sep (buffer-substring-no-properties (point) end))
593 (goto-char (1+ end)))
594 `(lambda (lst)
595 (mapcar
596 (function
597 (lambda (str)
598 (split-string str ,sep))) lst))))
599
600;;; Code:
601
602;;; em-pred.el ends here
diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el
new file mode 100644
index 00000000000..5cc37dbc287
--- /dev/null
+++ b/lisp/eshell/em-prompt.el
@@ -0,0 +1,174 @@
1;;; em-prompt --- command prompts
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'em-prompt)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-prompt nil
27 "This module provides command prompts, and navigation between them,
28as is common with most shells."
29 :tag "Command prompts"
30 :group 'eshell-module)
31
32;;; Commentary:
33
34;; Most of the prompt navigation commands of `comint-mode' are
35;; supported, such as C-c C-n, C-c C-p, etc.
36
37;;; User Variables:
38
39(defcustom eshell-prompt-load-hook '(eshell-prompt-initialize)
40 "*A list of functions to call when loading `eshell-prompt'."
41 :type 'hook
42 :group 'eshell-prompt)
43
44(defcustom eshell-prompt-function
45 (function
46 (lambda ()
47 (concat (eshell/pwd)
48 (if (= (user-uid) 0) " # " " $ "))))
49 "*A function that returns the Eshell prompt string.
50Make sure to update `eshell-prompt-regexp' so that it will match your
51prompt."
52 :type 'function
53 :group 'eshell-prompt)
54
55(defcustom eshell-prompt-regexp "^[^#$\n]* [#$] "
56 "*A regexp which fully matches your eshell prompt.
57This setting is important, since it affects how eshell will interpret
58the lines that are passed to it.
59If this variable is changed, all Eshell buffers must be exited and
60re-entered for it to take effect."
61 :type 'regexp
62 :group 'eshell-prompt)
63
64(defcustom eshell-highlight-prompt t
65 "*If non-nil, Eshell should highlight the prompt."
66 :type 'boolean
67 :group 'eshell-prompt)
68
69(defface eshell-prompt-face
70 '((((class color) (background light)) (:foreground "Red" :bold t))
71 (((class color) (background dark)) (:foreground "Pink" :bold t))
72 (t (:bold t)))
73 "*The face used to highlight prompt strings.
74For highlighting other kinds of strings -- similar to shell mode's
75behavior -- simply use an output filer which changes text properties."
76 :group 'eshell-prompt)
77
78(defcustom eshell-before-prompt-hook nil
79 "*A list of functions to call before outputting the prompt."
80 :type 'hook
81 :options '(eshell-begin-on-new-line)
82 :group 'eshell-prompt)
83
84(defcustom eshell-after-prompt-hook nil
85 "*A list of functions to call after outputting the prompt.
86Note that if `eshell-scroll-show-maximum-output' is non-nil, then
87setting `eshell-show-maximum-output' here won't do much. It depends
88on whether the user wants the resizing to happen while output is
89arriving, or after."
90 :type 'hook
91 :options '(eshell-show-maximum-output)
92 :group 'eshell-prompt)
93
94;;; Functions:
95
96(defun eshell-prompt-initialize ()
97 "Initialize the prompting code."
98 (unless eshell-non-interactive-p
99 (make-local-hook 'eshell-post-command-hook)
100 (add-hook 'eshell-post-command-hook 'eshell-emit-prompt nil t)
101
102 (make-local-variable 'eshell-prompt-regexp)
103 (if eshell-prompt-regexp
104 (set (make-local-variable 'paragraph-start) eshell-prompt-regexp))
105
106 (set (make-local-variable 'eshell-skip-prompt-function)
107 'eshell-skip-prompt)
108
109 (define-key eshell-command-map [(control ?n)] 'eshell-next-prompt)
110 (define-key eshell-command-map [(control ?p)] 'eshell-previous-prompt)))
111
112(defun eshell-emit-prompt ()
113 "Emit a prompt if eshell is being used interactively."
114 (run-hooks 'eshell-before-prompt-hook)
115 (if (not eshell-prompt-function)
116 (set-marker eshell-last-output-end (point))
117 (let ((prompt (funcall eshell-prompt-function)))
118 (and eshell-highlight-prompt
119 (add-text-properties 0 (length prompt)
120 '(read-only t
121 face eshell-prompt-face
122 rear-nonsticky (face read-only))
123 prompt))
124 (eshell-interactive-print prompt)))
125 (run-hooks 'eshell-after-prompt-hook))
126
127(defun eshell-backward-matching-input (regexp arg)
128 "Search backward through buffer for match for REGEXP.
129Matches are searched for on lines that match `eshell-prompt-regexp'.
130With prefix argument N, search for Nth previous match.
131If N is negative, find the next or Nth next match."
132 (interactive (eshell-regexp-arg "Backward input matching (regexp): "))
133 (let* ((re (concat eshell-prompt-regexp ".*" regexp))
134 (pos (save-excursion (end-of-line (if (> arg 0) 0 1))
135 (if (re-search-backward re nil t arg)
136 (point)))))
137 (if (null pos)
138 (progn (message "Not found")
139 (ding))
140 (goto-char pos)
141 (eshell-bol))))
142
143(defun eshell-forward-matching-input (regexp arg)
144 "Search forward through buffer for match for REGEXP.
145Matches are searched for on lines that match `eshell-prompt-regexp'.
146With prefix argument N, search for Nth following match.
147If N is negative, find the previous or Nth previous match."
148 (interactive (eshell-regexp-arg "Forward input matching (regexp): "))
149 (eshell-backward-matching-input regexp (- arg)))
150
151(defun eshell-next-prompt (n)
152 "Move to end of Nth next prompt in the buffer.
153See `eshell-prompt-regexp'."
154 (interactive "p")
155 (forward-paragraph n)
156 (eshell-skip-prompt))
157
158(defun eshell-previous-prompt (n)
159 "Move to end of Nth previous prompt in the buffer.
160See `eshell-prompt-regexp'."
161 (interactive "p")
162 (eshell-next-prompt (- (1+ n))))
163
164(defun eshell-skip-prompt ()
165 "Skip past the text matching regexp `eshell-prompt-regexp'.
166If this takes us past the end of the current line, don't skip at all."
167 (let ((eol (line-end-position)))
168 (if (and (looking-at eshell-prompt-regexp)
169 (<= (match-end 0) eol))
170 (goto-char (match-end 0)))))
171
172;;; Code:
173
174;;; em-prompt.el ends here
diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el
new file mode 100644
index 00000000000..112cff536e7
--- /dev/null
+++ b/lisp/eshell/em-rebind.el
@@ -0,0 +1,248 @@
1;;; em-rebind --- rebind keys when point is at current input
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'em-rebind)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-rebind nil
27 "This module allows for special keybindings that only take effect
28while the point is in a region of input text. By default, it binds
29C-a to move to the beginning of the input text (rather than just the
30beginning of the line), and C-p and C-n to move through the input
31history, C-u kills the current input text, etc. It also, if
32`eshell-confine-point-to-input' is non-nil, does not allow certain
33commands to cause the point to leave the input area, such as
34`backward-word', `previous-line', etc. This module intends to mimic
35the behavior of normal shells while the user editing new input text."
36 :tag "Rebind keys at input"
37 :group 'eshell-module)
38
39;;; Commentary:
40
41;;; User Variables:
42
43(defcustom eshell-rebind-load-hook '(eshell-rebind-initialize)
44 "*A list of functions to call when loading `eshell-rebind'."
45 :type 'hook
46 :group 'eshell-rebind)
47
48(defcustom eshell-rebind-keys-alist
49 '(([(control ?a)] . eshell-bol)
50 ([home] . eshell-bol)
51 ([(control ?d)] . eshell-delchar-or-maybe-eof)
52 ([backspace] . eshell-delete-backward-char)
53 ([delete] . eshell-delete-backward-char)
54 ([(control ?w)] . backward-kill-word)
55 ([(control ?u)] . eshell-kill-input))
56 "*Bind some keys differently if point is in input text."
57 :type '(repeat (cons (vector :tag "Keys to bind"
58 (repeat :inline t sexp))
59 (function :tag "Command")))
60 :group 'eshell-rebind)
61
62(defcustom eshell-confine-point-to-input t
63 "*If non-nil, do not allow the point to leave the current input.
64This is more difficult to do nicely in Emacs than one might think.
65Basically, the `point-left' attribute is added to the input text, and
66a function is placed on that hook to take the point back to
67`eshell-last-output-end' every time the user tries to move away. But
68since there are many cases in which the point _ought_ to move away
69\(for programmatic reasons), the variable
70`eshell-cannot-leave-input-list' defines commands which are affected
71from this rule. However, this list is by no means as complete as it
72probably should be, so basically all one can hope for is that other
73people will left the point alone in the Eshell buffer. Sigh."
74 :type 'boolean
75 :group 'eshell-rebind)
76
77(defcustom eshell-error-if-move-away t
78 "*If non-nil, consider it an error to try to move outside current input.
79This is default behavior of shells like bash."
80 :type 'boolean
81 :group 'eshell-rebind)
82
83(defcustom eshell-remap-previous-input t
84 "*If non-nil, remap input keybindings on previous prompts as well."
85 :type 'boolean
86 :group 'eshell-rebind)
87
88(defcustom eshell-cannot-leave-input-list
89 '(beginning-of-line-text
90 beginning-of-line
91 move-to-column
92 move-to-column-force
93 move-to-left-margin
94 move-to-tab-stop
95 forward-char
96 backward-char
97 delete-char
98 delete-backward-char
99 backward-delete-char
100 backward-delete-char-untabify
101 kill-paragraph
102 backward-kill-paragraph
103 kill-sentence
104 backward-kill-sentence
105 kill-sexp
106 backward-kill-sexp
107 kill-word
108 backward-kill-word
109 kill-region
110 forward-list
111 backward-list
112 forward-page
113 backward-page
114 forward-point
115 forward-paragraph
116 backward-paragraph
117 backward-prefix-chars
118 forward-sentence
119 backward-sentence
120 forward-sexp
121 backward-sexp
122 forward-to-indentation
123 backward-to-indentation
124 backward-up-list
125 forward-word
126 backward-word
127 forward-line
128 backward-line
129 previous-line
130 next-line
131 forward-visible-line
132 forward-comment
133 forward-thing)
134 "*A list of commands that cannot leave the input area."
135 :type '(repeat function)
136 :group 'eshell-rebind)
137
138;; Internal Variables:
139
140(defvar eshell-input-keymap)
141(defvar eshell-previous-point)
142(defvar eshell-lock-keymap)
143
144;;; Functions:
145
146(defun eshell-rebind-initialize ()
147 "Initialize the inputing code."
148 (unless eshell-non-interactive-p
149 (make-local-hook 'eshell-mode-hook)
150 (add-hook 'eshell-mode-hook 'eshell-setup-input-keymap nil t)
151 (make-local-hook 'pre-command-hook)
152 (make-local-variable 'eshell-previous-point)
153 (add-hook 'pre-command-hook 'eshell-save-previous-point nil t)
154 (make-local-hook 'post-command-hook)
155 (make-local-variable 'overriding-local-map)
156 (add-hook 'post-command-hook 'eshell-rebind-input-map nil t)
157 (set (make-local-variable 'eshell-lock-keymap) nil)
158 (define-key eshell-command-map [(meta ?l)] 'eshell-lock-local-map)))
159
160(defun eshell-lock-local-map (&optional arg)
161 "Lock or unlock the current local keymap.
162Within a prefix arg, set the local keymap to its normal value, and
163lock it at that."
164 (interactive "P")
165 (if (or arg (not eshell-lock-keymap))
166 (progn
167 (use-local-map eshell-mode-map)
168 (setq eshell-lock-keymap t)
169 (message "Local keymap locked in normal mode"))
170 (use-local-map eshell-input-keymap)
171 (setq eshell-lock-keymap nil)
172 (message "Local keymap unlocked: obey context")))
173
174(defun eshell-save-previous-point ()
175 "Save the location of point before the next command is run."
176 (setq eshell-previous-point (point)))
177
178(defsubst eshell-point-within-input-p (pos)
179 "Test whether POS is within an input range."
180 (let (begin)
181 (or (and (>= pos eshell-last-output-end)
182 eshell-last-output-end)
183 (and eshell-remap-previous-input
184 (setq begin
185 (save-excursion
186 (eshell-bol)
187 (and (not (bolp)) (point))))
188 (>= pos begin)
189 (<= pos (line-end-position))
190 begin))))
191
192(defun eshell-rebind-input-map ()
193 "Rebind the input keymap based on the location of the cursor."
194 (ignore-errors
195 (unless eshell-lock-keymap
196 (if (eshell-point-within-input-p (point))
197 (use-local-map eshell-input-keymap)
198 (let (begin)
199 (if (and eshell-confine-point-to-input
200 (setq begin
201 (eshell-point-within-input-p eshell-previous-point))
202 (memq this-command eshell-cannot-leave-input-list))
203 (progn
204 (use-local-map eshell-input-keymap)
205 (goto-char begin)
206 (if (and eshell-error-if-move-away
207 (not (eq this-command 'kill-region)))
208 (beep)))
209 (use-local-map eshell-mode-map)))))))
210
211(defun eshell-setup-input-keymap ()
212 "Setup the input keymap to be used during input editing."
213 (make-local-variable 'eshell-input-keymap)
214 (setq eshell-input-keymap (make-sparse-keymap))
215 (set-keymap-parent eshell-input-keymap eshell-mode-map)
216 (let ((bindings eshell-rebind-keys-alist))
217 (while bindings
218 (define-key eshell-input-keymap (caar bindings)
219 (cdar bindings))
220 (setq bindings (cdr bindings)))))
221
222(defun eshell-delete-backward-char (n &optional killflag)
223 "Delete the last character, unless it's part of the output."
224 (interactive "P")
225 (let ((count (prefix-numeric-value n)))
226 (if (eshell-point-within-input-p (- (point) count))
227 (delete-backward-char count n)
228 (beep))))
229
230(defun eshell-delchar-or-maybe-eof (arg)
231 "Delete ARG characters forward or send an EOF to subprocess.
232Sends an EOF only if point is at the end of the buffer and there is no
233input."
234 (interactive "p")
235 (let ((proc (get-buffer-process (current-buffer))))
236 (if (eobp)
237 (cond
238 ((not (= (point) eshell-last-output-end))
239 (beep))
240 (proc
241 (process-send-eof))
242 (t
243 (eshell-life-is-too-much)))
244 (eshell-delete-backward-char (- arg)))))
245
246;;; Code:
247
248;;; em-rebind.el ends here
diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el
new file mode 100644
index 00000000000..fd290b2d229
--- /dev/null
+++ b/lisp/eshell/em-script.el
@@ -0,0 +1,130 @@
1;;; em-script --- Eshell script files
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'em-script)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-script nil
27 "This module allows for the execution of files containing Eshell
28commands, as a script file."
29 :tag "Running script files."
30 :group 'eshell-module)
31
32;;; Commentary:
33
34;;; User Variables:
35
36(defcustom eshell-script-load-hook '(eshell-script-initialize)
37 "*A list of functions to call when loading `eshell-script'."
38 :type 'hook
39 :group 'eshell-script)
40
41(defcustom eshell-login-script (concat eshell-directory-name "login")
42 "*If non-nil, a file to invoke when starting up Eshell interactively.
43This file should be a file containing Eshell commands, where comment
44lines begin with '#'."
45 :type 'file
46 :group 'eshell-script)
47
48(defcustom eshell-rc-script (concat eshell-directory-name "profile")
49 "*If non-nil, a file to invoke whenever Eshell is started.
50This includes when running `eshell-command'."
51 :type 'file
52 :group 'eshell-script)
53
54;;; Functions:
55
56(defun eshell-script-initialize ()
57 "Initialize the script parsing code."
58 (make-local-variable 'eshell-interpreter-alist)
59 (setq eshell-interpreter-alist
60 (cons '((lambda (file)
61 (string= (file-name-nondirectory file)
62 "eshell")) . eshell/source)
63 eshell-interpreter-alist))
64 ;; these two variables are changed through usage, but we don't want
65 ;; to ruin it for other modules
66 (let (eshell-inside-quote-regexp
67 eshell-outside-quote-regexp)
68 (and (not eshell-non-interactive-p)
69 eshell-login-script
70 (file-readable-p eshell-login-script)
71 (eshell-do-eval
72 (list 'eshell-commands
73 (catch 'eshell-replace-command
74 (eshell-source-file eshell-login-script))) t))
75 (and eshell-rc-script
76 (file-readable-p eshell-rc-script)
77 (eshell-do-eval
78 (list 'eshell-commands
79 (catch 'eshell-replace-command
80 (eshell-source-file eshell-rc-script))) t))))
81
82(defun eshell-source-file (file &optional args subcommand-p)
83 "Execute a series of Eshell commands in FILE, passing ARGS.
84Comments begin with '#'."
85 (interactive "f")
86 (let ((orig (point))
87 (here (point-max))
88 (inhibit-point-motion-hooks t)
89 after-change-functions)
90 (goto-char (point-max))
91 (insert-file-contents file)
92 (goto-char (point-max))
93 (throw 'eshell-replace-command
94 (prog1
95 (list 'let
96 (list (list 'eshell-command-name (list 'quote file))
97 (list 'eshell-command-arguments
98 (list 'quote args)))
99 (let ((cmd (eshell-parse-command (cons here (point)))))
100 (if subcommand-p
101 (setq cmd (list 'eshell-as-subcommand cmd)))
102 cmd))
103 (delete-region here (point))
104 (goto-char orig)))))
105
106(defun eshell/source (&rest args)
107 "Source a file in a subshell environment."
108 (eshell-eval-using-options
109 "source" args
110 '((?h "help" nil nil "show this usage screen")
111 :show-usage
112 :usage "FILE [ARGS]
113Invoke the Eshell commands in FILE in a subshell, binding ARGS to $1,
114$2, etc.")
115 (eshell-source-file (car args) (cdr args) t)))
116
117(defun eshell/. (&rest args)
118 "Source a file in the current environment."
119 (eshell-eval-using-options
120 "." args
121 '((?h "help" nil nil "show this usage screen")
122 :show-usage
123 :usage "FILE [ARGS]
124Invoke the Eshell commands in FILE within the current shell
125environment, binding ARGS to $1, $2, etc.")
126 (eshell-source-file (car args) (cdr args))))
127
128;;; Code:
129
130;;; em-script.el ends here
diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el
new file mode 100644
index 00000000000..ac2545b728b
--- /dev/null
+++ b/lisp/eshell/em-smart.el
@@ -0,0 +1,305 @@
1;;; em-smart --- smart display of output
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'em-smart)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-smart nil
27 "This module combines the facility of normal, modern shells with
28some of the edit/review concepts inherent in the design of Plan 9's
299term. See the docs for more details.
30
31Most likely you will have to turn this option on and play around with
32it to get a real sense of how it works."
33 :tag "Smart display of output"
34 :link '(info-link "(eshell.info)Smart display of output")
35 :group 'eshell-module)
36
37;;; Commentary:
38
39;; The best way to get a sense of what this code is trying to do is by
40;; using it. Basically, the philosophy represents a blend between the
41;; ease of use of modern day shells, and the review-before-you-proceed
42;; mentality of Plan 9's 9term.
43;;
44;; @ When you invoke a command, it is assumed that you want to read
45;; the output of that command.
46;;
47;; @ If the output is not what you wanted, it is assumed that you will
48;; want to edit, and then resubmit a refined version of that
49;; command.
50;;
51;; @ If the output is valid, pressing any self-inserting character key
52;; will jump to end of the buffer and insert that character, in
53;; order to begin entry of a new command.
54;;
55;; @ If you show an intention to edit the previous command -- by
56;; moving around within it -- then the next self-inserting
57;; characters will insert *there*, instead of at the bottom of the
58;; buffer.
59;;
60;; @ If you show an intention to review old commands, such as M-p or
61;; M-r, point will jump to the bottom of the buffer before invoking
62;; that command.
63;;
64;; @ If none of the above has happened yet (i.e., your point is just
65;; sitting on the previous command), you can use SPACE and BACKSPACE
66;; (or DELETE) to page forward and backward *through the output of
67;; the last command only*. It will constrain the movement of the
68;; point and window so that the maximum amount of output is always
69;; displayed at all times.
70;;
71;; @ While output is being generated from a command, the window will
72;; be constantly reconfigured (until it would otherwise make no
73;; difference) in order to always show you the most output from the
74;; command possible. This happens if you change window sizes,
75;; scroll, etc.
76;;
77;; @ Like I said, it's not really comprehensible until you try it! ;)
78
79;;; User Variables:
80
81(defcustom eshell-smart-load-hook '(eshell-smart-initialize)
82 "*A list of functions to call when loading `eshell-smart'."
83 :type 'hook
84 :group 'eshell-smart)
85
86(defcustom eshell-smart-unload-hook
87 (list
88 (function
89 (lambda ()
90 (remove-hook 'window-configuration-change-hook
91 'eshell-refresh-windows))))
92 "*A hook that gets run when `eshell-smart' is unloaded."
93 :type 'hook
94 :group 'eshell-smart)
95
96(defcustom eshell-review-quick-commands nil
97 "*If nil, point does not stay on quick commands.
98A quick command is one that produces no output, and exits
99successfully."
100 :type 'boolean
101 :group 'eshell-smart)
102
103(defcustom eshell-smart-display-navigate-list
104 '(insert-parentheses
105 mouse-yank-at-click
106 mouse-yank-secondary
107 yank-pop
108 yank-rectangle
109 yank)
110 "*A list of commands which cause Eshell to jump to the end of buffer."
111 :type '(repeat function)
112 :group 'eshell-smart)
113
114(defcustom eshell-smart-space-goes-to-end t
115 "*If non-nil, space will go to end of buffer when point-max is visible.
116That is, if a command is running and the user presses SPACE at a time
117when the end of the buffer is visible, point will go to the end of the
118buffer and smart-display will be turned off (that is, subsequently
119pressing backspace will not cause the buffer to scroll down).
120
121This feature is provided to make it very easy to watch the output of a
122long-running command, such as make, where it's more desirable to see
123the output go by than to review it afterward.
124
125Setting this variable to nil means that space and backspace will
126always have a consistent behavior, which is to move back and forth
127through displayed output. But it also means that enabling output
128tracking requires the user to manually move point to the end of the
129buffer using \\[end-of-buffer]."
130 :type 'boolean
131 :group 'eshell-smart)
132
133(defcustom eshell-where-to-jump 'begin
134 "*This variable indicates where point should jump to after a command.
135The options are `begin', `after' or `end'."
136 :type '(radio (const :tag "Beginning of command" begin)
137 (const :tag "After command word" after)
138 (const :tag "End of command" end))
139 :group 'eshell-smart)
140
141;;; Internal Variables:
142
143(defvar eshell-smart-displayed nil)
144(defvar eshell-smart-command-done nil)
145
146;;; Functions:
147
148(defun eshell-smart-initialize ()
149 "Setup Eshell smart display."
150 (unless eshell-non-interactive-p
151 ;; override a few variables, since they would interfere with the
152 ;; smart display functionality.
153 (set (make-local-variable 'eshell-scroll-to-bottom-on-output) nil)
154 (set (make-local-variable 'eshell-scroll-to-bottom-on-input) nil)
155 (set (make-local-variable 'eshell-scroll-show-maximum-output) t)
156
157 (make-local-hook 'window-scroll-functions)
158 (add-hook 'window-scroll-functions 'eshell-smart-scroll-window nil t)
159 (add-hook 'window-configuration-change-hook 'eshell-refresh-windows)
160
161 (make-local-hook 'eshell-output-filter-functions)
162 (add-hook 'eshell-output-filter-functions 'eshell-refresh-windows t t)
163
164 (make-local-hook 'pre-command-hook)
165 (make-local-hook 'after-change-functions)
166 (add-hook 'after-change-functions
167 'eshell-disable-after-change nil t)
168
169 (make-local-hook 'eshell-input-filter-functions)
170 (add-hook 'eshell-input-filter-functions
171 'eshell-smart-display-setup nil t)
172
173 (make-local-variable 'eshell-smart-command-done)
174 (make-local-hook 'eshell-post-command-hook)
175 (add-hook 'eshell-post-command-hook
176 (function
177 (lambda ()
178 (setq eshell-smart-command-done t))) t t)
179
180 (unless eshell-review-quick-commands
181 (add-hook 'eshell-post-command-hook
182 'eshell-smart-maybe-jump-to-end nil t))))
183
184(defun eshell-smart-scroll-window (wind start)
185 "Scroll the given Eshell window accordingly."
186 (unless eshell-currently-handling-window
187 (let ((inhibit-point-motion-hooks t)
188 (eshell-currently-handling-window t))
189 (save-current-buffer
190 (save-selected-window
191 (select-window wind)
192 (eshell-smart-redisplay))))))
193
194(defun eshell-refresh-windows (&optional frame)
195 "Refresh all visible Eshell buffers."
196 (let (affected)
197 (walk-windows
198 (function
199 (lambda (wind)
200 (with-current-buffer (window-buffer wind)
201 (when eshell-mode
202 (let (window-scroll-functions)
203 (eshell-smart-scroll-window wind (window-start))
204 (setq affected t))))))
205 0 frame)
206 (if affected
207 (let (window-scroll-functions)
208 (eshell-redisplay)))))
209
210(defun eshell-smart-display-setup ()
211 "Set the point to somewhere in the beginning of the last command."
212 (cond
213 ((eq eshell-where-to-jump 'begin)
214 (goto-char eshell-last-input-start))
215 ((eq eshell-where-to-jump 'after)
216 (goto-char (next-single-property-change
217 eshell-last-input-start 'arg-end))
218 (if (= (point) (- eshell-last-input-end 2))
219 (forward-char)))
220 ((eq eshell-where-to-jump 'end)
221 (goto-char (1- eshell-last-input-end)))
222 (t
223 (error "Invalid value for `eshell-where-to-jump'")))
224 (setq eshell-smart-command-done nil)
225 (add-hook 'pre-command-hook 'eshell-smart-display-move nil t)
226 (eshell-refresh-windows))
227
228(defun eshell-disable-after-change (b e l)
229 "Disable smart display mode if the buffer changes in any way."
230 (when eshell-smart-command-done
231 (remove-hook 'pre-command-hook 'eshell-smart-display-move t)
232 (setq eshell-smart-command-done nil)))
233
234(defun eshell-smart-maybe-jump-to-end ()
235 "Jump to the end of the input buffer.
236This is done whenever a command exits sucessfully that displayed no
237output."
238 (when (and (= eshell-last-command-status 0)
239 (= (count-lines eshell-last-input-end
240 eshell-last-output-end) 0))
241 (goto-char (point-max))
242 (remove-hook 'pre-command-hook 'eshell-smart-display-move t)))
243
244(defun eshell-smart-redisplay ()
245 "Display as much output as possible, smartly."
246 (if (eobp)
247 (recenter -1)
248 (and (memq 'eshell-smart-display-move pre-command-hook)
249 (>= (point) eshell-last-input-start)
250 (< (point) eshell-last-input-end)
251 (set-window-start (selected-window)
252 (line-beginning-position) t))
253 (if (pos-visible-in-window-p (point-max))
254 (save-excursion
255 (goto-char (point-max))
256 (recenter -1)))))
257
258(defun eshell-smart-goto-end ()
259 "Like `end-of-buffer', but do not push a mark."
260 (interactive)
261 (goto-char (point-max)))
262
263(defun eshell-smart-display-move ()
264 "Handle self-inserting or movement commands intelligently."
265 (let (clear)
266 (if (or current-prefix-arg
267 (and (> (point) eshell-last-input-start)
268 (< (point) eshell-last-input-end))
269 (>= (point) eshell-last-output-end))
270 (setq clear t)
271 (cond
272 ((eq this-command 'self-insert-command)
273 (if (eq last-command-char ? )
274 (if (and eshell-smart-space-goes-to-end
275 eshell-current-command)
276 (if (not (pos-visible-in-window-p (point-max)))
277 (setq this-command 'scroll-up)
278 (setq this-command 'eshell-smart-goto-end))
279 (setq this-command 'scroll-up))
280 (setq clear t)
281 (goto-char (point-max))))
282 ((eq this-command 'delete-backward-char)
283 (setq this-command 'ignore)
284 (if (< (point) eshell-last-input-start)
285 (eshell-show-output)
286 (if (pos-visible-in-window-p eshell-last-input-start)
287 (progn
288 (ignore-errors
289 (scroll-down))
290 (eshell-show-output))
291 (scroll-down)
292 (if (pos-visible-in-window-p eshell-last-input-end)
293 (eshell-show-output)))))
294 ((or (memq this-command eshell-smart-display-navigate-list)
295 (and (eq this-command 'eshell-send-input)
296 (not (and (>= (point) eshell-last-input-start)
297 (< (point) eshell-last-input-end)))))
298 (setq clear t)
299 (goto-char (point-max)))))
300 (if clear
301 (remove-hook 'pre-command-hook 'eshell-smart-display-move t))))
302
303;;; Code:
304
305;;; em-smart.el ends here
diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el
new file mode 100644
index 00000000000..2871070c043
--- /dev/null
+++ b/lisp/eshell/em-term.el
@@ -0,0 +1,266 @@
1;;; em-term --- running visual commands
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'em-term)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-term nil
27 "This module causes visual commands (e.g., 'vi') to be executed by
28the `term' package, which comes with Emacs. This package handles most
29of the ANSI control codes, allowing curses-based applications to run
30within an Emacs window. The variable `eshell-visual-commands' defines
31which commands are considered visual in nature."
32 :tag "Running visual commands"
33 :group 'eshell-module)
34
35;;; Commentary:
36
37;; At the moment, eshell is stream-based in its interactive input and
38;; output. This means that full-screen commands, such as "vi" or
39;; "lynx", will not display correctly. These are therefore thought of
40;; as "visual" programs. In order to run these progrem under Emacs,
41;; Eshell uses the term.el package, and invokes them in a separate
42;; buffer, giving the illusion that Eshell itself is allowing these
43;; visual processes to execute.
44
45(require 'term)
46
47;;; User Variables:
48
49(defcustom eshell-term-load-hook '(eshell-term-initialize)
50 "*A list of functions to call when loading `eshell-term'."
51 :type 'hook
52 :group 'eshell-term)
53
54(defcustom eshell-visual-commands
55 '("vi" ; what is going on??
56 "screen" "top" ; ok, a valid program...
57 "less" "more" ; M-x view-file
58 "lynx" "ncftp" ; w3.el, ange-ftp
59 "pine" "tin" "trn" "elm") ; GNUS!!
60 "*A list of commands that present their output in a visual fashion."
61 :type '(repeat string)
62 :group 'eshell-term)
63
64(defcustom eshell-term-name "eterm"
65 "*Name to use for the TERM variable when running visual commands.
66See `term-term-name' in term.el for more information on how this is
67used."
68 :type 'string
69 :group 'eshell-term)
70
71(defcustom eshell-escape-control-x t
72 "*If non-nil, allow <C-x> to be handled by Emacs key in visual buffers.
73See the variable `eshell-visual-commands'. If this variable is set to
74nil, <C-x> will send that control character to the invoked process."
75 :type 'boolean
76 :group 'eshell-term)
77
78;;; Internal Variables:
79
80(defvar eshell-parent-buffer)
81
82;;; Functions:
83
84(defun eshell-term-initialize ()
85 "Initialize the `term' interface code."
86 (make-local-variable 'eshell-interpreter-alist)
87 (setq eshell-interpreter-alist
88 (cons (cons (function
89 (lambda (command)
90 (member (file-name-nondirectory command)
91 eshell-visual-commands)))
92 'eshell-exec-visual)
93 eshell-interpreter-alist)))
94
95(defun eshell-exec-visual (&rest args)
96 "Run the specified PROGRAM in a terminal emulation buffer.
97ARGS are passed to the program. At the moment, no piping of input is
98allowed."
99 (let* (eshell-interpreter-alist
100 (interp (eshell-find-interpreter (car args)))
101 (program (car interp))
102 (args (eshell-flatten-list
103 (eshell-stringify-list (append (cdr interp)
104 (cdr args)))))
105 (term-buf
106 (generate-new-buffer
107 (concat "*" (file-name-nondirectory program) "*")))
108 (eshell-buf (current-buffer)))
109 (save-current-buffer
110 (switch-to-buffer term-buf)
111 (term-mode)
112 (set (make-local-variable 'term-term-name) eshell-term-name)
113 (make-local-variable 'eshell-parent-buffer)
114 (setq eshell-parent-buffer eshell-buf)
115 (term-exec term-buf program program nil args)
116 (let ((proc (get-buffer-process term-buf)))
117 (if (and proc (eq 'run (process-status proc)))
118 (set-process-sentinel proc 'eshell-term-sentinel)
119 (error "Failed to invoke visual command")))
120 (term-char-mode)
121 (if eshell-escape-control-x
122 (term-set-escape-char ?\C-x))))
123 nil)
124
125(defun eshell-term-sentinel (proc string)
126 "Destroy the buffer visiting PROC."
127 (let ((proc-buf (process-buffer proc)))
128 (when (and proc-buf (buffer-live-p proc-buf)
129 (not (eq 'run (process-status proc)))
130 (= (process-exit-status proc) 0))
131 (if (eq (current-buffer) proc-buf)
132 (let ((buf (and (boundp 'eshell-parent-buffer)
133 eshell-parent-buffer
134 (buffer-live-p eshell-parent-buffer)
135 eshell-parent-buffer)))
136 (if buf
137 (switch-to-buffer buf))))
138 (kill-buffer proc-buf))))
139
140;; jww (1999-09-17): The code below will allow Eshell to send input
141;; characters directly to the currently running interactive process.
142;; However, since this would introduce other problems that would need
143;; solutions, I'm going to let it wait until after 2.1.
144
145; (defvar eshell-term-raw-map nil
146; "Keyboard map for sending characters directly to the inferior process.")
147; (defvar eshell-term-escape-char nil
148; "Escape character for char-sub-mode of term mode.
149; Do not change it directly; use term-set-escape-char instead.")
150; (defvar eshell-term-raw-escape-map nil)
151
152; (defun eshell-term-send-raw-string (chars)
153; (goto-char eshell-last-output-end)
154; (process-send-string (eshell-interactive-process) chars))
155
156; (defun eshell-term-send-raw ()
157; "Send the last character typed through the terminal-emulator
158; without any interpretation."
159; (interactive)
160; ;; Convert `return' to C-m, etc.
161; (if (and (symbolp last-input-char)
162; (get last-input-char 'ascii-character))
163; (setq last-input-char (get last-input-char 'ascii-character)))
164; (eshell-term-send-raw-string (make-string 1 last-input-char)))
165
166; (defun eshell-term-send-raw-meta ()
167; (interactive)
168; (if (symbolp last-input-char)
169; ;; Convert `return' to C-m, etc.
170; (let ((tmp (get last-input-char 'event-symbol-elements)))
171; (if tmp
172; (setq last-input-char (car tmp)))
173; (if (symbolp last-input-char)
174; (progn
175; (setq tmp (get last-input-char 'ascii-character))
176; (if tmp (setq last-input-char tmp))))))
177; (eshell-term-send-raw-string (if (and (numberp last-input-char)
178; (> last-input-char 127)
179; (< last-input-char 256))
180; (make-string 1 last-input-char)
181; (format "\e%c" last-input-char))))
182
183; (defun eshell-term-mouse-paste (click arg)
184; "Insert the last stretch of killed text at the position clicked on."
185; (interactive "e\nP")
186; (if (boundp 'xemacs-logo)
187; (eshell-term-send-raw-string
188; (or (condition-case () (x-get-selection) (error ()))
189; (x-get-cutbuffer)
190; (error "No selection or cut buffer available")))
191; ;; Give temporary modes such as isearch a chance to turn off.
192; (run-hooks 'mouse-leave-buffer-hook)
193; (setq this-command 'yank)
194; (eshell-term-send-raw-string
195; (current-kill (cond ((listp arg) 0)
196; ((eq arg '-) -1)
197; (t (1- arg)))))))
198
199; ;; Which would be better: "\e[A" or "\eOA"? readline accepts either.
200; ;; For my configuration it's definitely better \eOA but YMMV. -mm
201; ;; For example: vi works with \eOA while elm wants \e[A ...
202; (defun eshell-term-send-up () (interactive) (eshell-term-send-raw-string "\eOA"))
203; (defun eshell-term-send-down () (interactive) (eshell-term-send-raw-string "\eOB"))
204; (defun eshell-term-send-right () (interactive) (eshell-term-send-raw-string "\eOC"))
205; (defun eshell-term-send-left () (interactive) (eshell-term-send-raw-string "\eOD"))
206; (defun eshell-term-send-home () (interactive) (eshell-term-send-raw-string "\e[1~"))
207; (defun eshell-term-send-end () (interactive) (eshell-term-send-raw-string "\e[4~"))
208; (defun eshell-term-send-prior () (interactive) (eshell-term-send-raw-string "\e[5~"))
209; (defun eshell-term-send-next () (interactive) (eshell-term-send-raw-string "\e[6~"))
210; (defun eshell-term-send-del () (interactive) (eshell-term-send-raw-string "\C-?"))
211; (defun eshell-term-send-backspace () (interactive) (eshell-term-send-raw-string "\C-H"))
212
213; (defun eshell-term-set-escape-char (c)
214; "Change term-escape-char and keymaps that depend on it."
215; (if eshell-term-escape-char
216; (define-key eshell-term-raw-map eshell-term-escape-char 'eshell-term-send-raw))
217; (setq c (make-string 1 c))
218; (define-key eshell-term-raw-map c eshell-term-raw-escape-map)
219; ;; Define standard bindings in eshell-term-raw-escape-map
220; (define-key eshell-term-raw-escape-map "\C-x"
221; (lookup-key (current-global-map) "\C-x"))
222; (define-key eshell-term-raw-escape-map "\C-v"
223; (lookup-key (current-global-map) "\C-v"))
224; (define-key eshell-term-raw-escape-map "\C-u"
225; (lookup-key (current-global-map) "\C-u"))
226; (define-key eshell-term-raw-escape-map c 'eshell-term-send-raw))
227
228; (defun eshell-term-char-mode ()
229; "Switch to char (\"raw\") sub-mode of term mode.
230; Each character you type is sent directly to the inferior without
231; intervention from Emacs, except for the escape character (usually C-c)."
232; (interactive)
233; (if (not eshell-term-raw-map)
234; (let* ((map (make-keymap))
235; (esc-map (make-keymap))
236; (i 0))
237; (while (< i 128)
238; (define-key map (make-string 1 i) 'eshell-term-send-raw)
239; (define-key esc-map (make-string 1 i) 'eshell-term-send-raw-meta)
240; (setq i (1+ i)))
241; (define-key map "\e" esc-map)
242; (setq eshell-term-raw-map map)
243; (setq eshell-term-raw-escape-map
244; (copy-keymap (lookup-key (current-global-map) "\C-x")))
245; (if (boundp 'xemacs-logo)
246; (define-key eshell-term-raw-map [button2] 'eshell-term-mouse-paste)
247; (define-key eshell-term-raw-map [mouse-2] 'eshell-term-mouse-paste))
248; (define-key eshell-term-raw-map [up] 'eshell-term-send-up)
249; (define-key eshell-term-raw-map [down] 'eshell-term-send-down)
250; (define-key eshell-term-raw-map [right] 'eshell-term-send-right)
251; (define-key eshell-term-raw-map [left] 'eshell-term-send-left)
252; (define-key eshell-term-raw-map [delete] 'eshell-term-send-del)
253; (define-key eshell-term-raw-map [backspace] 'eshell-term-send-backspace)
254; (define-key eshell-term-raw-map [home] 'eshell-term-send-home)
255; (define-key eshell-term-raw-map [end] 'eshell-term-send-end)
256; (define-key eshell-term-raw-map [prior] 'eshell-term-send-prior)
257; (define-key eshell-term-raw-map [next] 'eshell-term-send-next)
258; (eshell-term-set-escape-char ?\C-c))))
259
260; (defun eshell-term-line-mode ()
261; "Switch to line (\"cooked\") sub-mode of eshell-term mode."
262; (use-local-map term-old-mode-map))
263
264;;; Code:
265
266;;; em-term.el ends here
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el
new file mode 100644
index 00000000000..365f7931789
--- /dev/null
+++ b/lisp/eshell/em-unix.el
@@ -0,0 +1,927 @@
1;;; em-unix --- UNIX command aliases
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'em-unix)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-unix nil
27 "This module defines many of the more common UNIX utilities as
28aliases implemented in Lisp. These include mv, ln, cp, rm, etc. If
29the user passes arguments which are too complex, or are unrecognized
30by the Lisp variant, the external version will be called (if
31available). The only reason not to use them would be because they are
32usually much slower. But in several cases their tight integration
33with Eshell makes them more versatile than their traditional cousins
34\(such as being able to use `kill' to kill Eshell background processes
35by name)."
36 :tag "UNIX commands in Lisp"
37 :group 'eshell-module)
38
39;;; Commentary:
40
41;; This file contains implementations of several UNIX command in Emacs
42;; Lisp, for several reasons:
43;;
44;; 1) it makes them available on all platforms where the Lisp
45;; functions used are available
46;;
47;; 2) it makes their functionality accessible and modified by the
48;; Lisp programmer.
49;;
50;; 3) it allows Eshell to refrain from having to invoke external
51;; processes for common operations.
52
53(defcustom eshell-unix-load-hook '(eshell-unix-initialize)
54 "*A list of functions to run when `eshell-unix' is loaded."
55 :type 'hook
56 :group 'eshell-unix)
57
58(defcustom eshell-plain-grep-behavior nil
59 "*If non-nil, standalone \"grep\" commands will behave normally.
60Standalone in this context means not redirected, and not on the
61receiving side of a command pipeline."
62 :type 'boolean
63 :group 'eshell-unix)
64
65(defcustom eshell-no-grep-available (not (eshell-search-path "grep"))
66 "*If non-nil, no grep is available on the current machine."
67 :type 'boolean
68 :group 'eshell-unix)
69
70(defcustom eshell-plain-diff-behavior nil
71 "*If non-nil, standalone \"diff\" commands will behave normally.
72Standalone in this context means not redirected, and not on the
73receiving side of a command pipeline."
74 :type 'boolean
75 :group 'eshell-unix)
76
77(defcustom eshell-plain-locate-behavior nil
78 "*If non-nil, standalone \"locate\" commands will behave normally.
79Standalone in this context means not redirected, and not on the
80receiving side of a command pipeline."
81 :type 'boolean
82 :group 'eshell-unix)
83
84(defcustom eshell-rm-removes-directories nil
85 "*If non-nil, `rm' will remove directory entries.
86Otherwise, `rmdir' is required."
87 :type 'boolean
88 :group 'eshell-unix)
89
90(defcustom eshell-rm-interactive-query (= (user-uid) 0)
91 "*If non-nil, `rm' will query before removing anything."
92 :type 'boolean
93 :group 'eshell-unix)
94
95(defcustom eshell-mv-interactive-query (= (user-uid) 0)
96 "*If non-nil, `mv' will query before overwriting anything."
97 :type 'boolean
98 :group 'eshell-unix)
99
100(defcustom eshell-mv-overwrite-files t
101 "*If non-nil, `mv' will overwrite files without warning."
102 :type 'boolean
103 :group 'eshell-unix)
104
105(defcustom eshell-cp-interactive-query (= (user-uid) 0)
106 "*If non-nil, `cp' will query before overwriting anything."
107 :type 'boolean
108 :group 'eshell-unix)
109
110(defcustom eshell-cp-overwrite-files t
111 "*If non-nil, `cp' will overwrite files without warning."
112 :type 'boolean
113 :group 'eshell-unix)
114
115(defcustom eshell-ln-interactive-query (= (user-uid) 0)
116 "*If non-nil, `ln' will query before overwriting anything."
117 :type 'boolean
118 :group 'eshell-unix)
119
120(defcustom eshell-ln-overwrite-files t
121 "*If non-nil, `ln' will overwrite files without warning."
122 :type 'boolean
123 :group 'eshell-unix)
124
125(require 'esh-opt)
126
127;;; Functions:
128
129(defun eshell-unix-initialize ()
130 "Initialize the UNIX support/emulation code."
131 (make-local-hook 'eshell-post-command-hook)
132 (when (eshell-using-module 'eshell-cmpl)
133 (make-local-hook 'pcomplete-try-first-hook)
134 (add-hook 'pcomplete-try-first-hook
135 'eshell-complete-host-reference nil t)))
136
137(defalias 'eshell/date 'current-time-string)
138(defalias 'eshell/basename 'file-name-nondirectory)
139(defalias 'eshell/dirname 'file-name-directory)
140
141(eval-when-compile
142 (defvar interactive)
143 (defvar preview)
144 (defvar recursive)
145 (defvar verbose))
146
147(defun eshell/man (&rest args)
148 "Invoke man, flattening the arguments appropriately."
149 (funcall 'man (apply 'eshell-flatten-and-stringify args)))
150
151(defun eshell-remove-entries (path files &optional top-level)
152 (while files
153 (if (string-match "\\`\\.\\.?\\'"
154 (file-name-nondirectory (car files)))
155 (if top-level
156 (eshell-error "rm: cannot remove `.' or `..'\n"))
157 (if (and (file-directory-p (car files))
158 (not (file-symlink-p (car files))))
159 (let ((dir (file-name-as-directory (car files))))
160 (eshell-remove-entries dir
161 (mapcar
162 (function
163 (lambda (file)
164 (concat dir file)))
165 (directory-files dir)))
166 (if verbose
167 (eshell-printn (format "rm: removing directory `%s'"
168 (car files))))
169 (unless
170 (or preview
171 (and interactive
172 (not (y-or-n-p
173 (format "rm: remove directory `%s'? "
174 (car files))))))
175 (eshell-funcalln 'delete-directory (car files))))
176 (if verbose
177 (eshell-printn (format "rm: removing file `%s'"
178 (car files))))
179 (unless (or preview
180 (and interactive
181 (not (y-or-n-p
182 (format "rm: remove `%s'? "
183 (car files))))))
184 (eshell-funcalln 'delete-file (car files)))))
185 (setq files (cdr files))))
186
187(defun eshell/rm (&rest args)
188 "Implementation of rm in Lisp.
189This is implemented to call either `delete-file', `kill-buffer',
190`kill-process', or `unintern', depending on the nature of the
191argument."
192 (setq args (eshell-flatten-list args))
193 (eshell-eval-using-options
194 "rm" args
195 '((?h "help" nil nil "show this usage screen")
196 (?f "force" nil force-removal "force removal")
197 (?i "interactive" nil interactive "prompt before any removal")
198 (?n "preview" nil preview "don't change anything on disk")
199 (?r "recursive" nil recursive
200 "remove the contents of directories recursively")
201 (?R nil nil recursive "(same)")
202 (?v "verbose" nil verbose "explain what is being done")
203 :preserve-args
204 :external "rm"
205 :show-usage
206 :usage "[OPTION]... FILE...
207Remove (unlink) the FILE(s).")
208 (unless interactive
209 (setq interactive eshell-rm-interactive-query))
210 (if (and force-removal interactive)
211 (setq interactive nil))
212 (while args
213 (let ((entry (if (stringp (car args))
214 (directory-file-name (car args))
215 (if (numberp (car args))
216 (number-to-string (car args))
217 (car args)))))
218 (cond
219 ((bufferp entry)
220 (if verbose
221 (eshell-printn (format "rm: removing buffer `%s'" entry)))
222 (unless (or preview
223 (and interactive
224 (not (y-or-n-p (format "rm: delete buffer `%s'? "
225 entry)))))
226 (eshell-funcalln 'kill-buffer entry)))
227 ((processp entry)
228 (if verbose
229 (eshell-printn (format "rm: killing process `%s'" entry)))
230 (unless (or preview
231 (and interactive
232 (not (y-or-n-p (format "rm: kill process `%s'? "
233 entry)))))
234 (eshell-funcalln 'kill-process entry)))
235 ((symbolp entry)
236 (if verbose
237 (eshell-printn (format "rm: uninterning symbol `%s'" entry)))
238 (unless
239 (or preview
240 (and interactive
241 (not (y-or-n-p (format "rm: unintern symbol `%s'? "
242 entry)))))
243 (eshell-funcalln 'unintern entry)))
244 ((stringp entry)
245 (if (and (file-directory-p entry)
246 (not (file-symlink-p entry)))
247 (if (or recursive
248 eshell-rm-removes-directories)
249 (if (or preview
250 (not interactive)
251 (y-or-n-p
252 (format "rm: descend into directory `%s'? "
253 entry)))
254 (eshell-remove-entries nil (list entry) t))
255 (eshell-error (format "rm: %s: is a directory\n" entry)))
256 (eshell-remove-entries nil (list entry) t)))))
257 (setq args (cdr args)))
258 nil))
259
260(defun eshell/mkdir (&rest args)
261 "Implementation of mkdir in Lisp."
262 (eshell-eval-using-options
263 "mkdir" args
264 '((?h "help" nil nil "show this usage screen")
265 :external "mkdir"
266 :show-usage
267 :usage "[OPTION] DIRECTORY...
268Create the DIRECTORY(ies), if they do not already exist.")
269 (while args
270 (eshell-funcalln 'make-directory (car args))
271 (setq args (cdr args)))
272 nil))
273
274(defun eshell/rmdir (&rest args)
275 "Implementation of rmdir in Lisp."
276 (eshell-eval-using-options
277 "rmdir" args
278 '((?h "help" nil nil "show this usage screen")
279 :external "rmdir"
280 :show-usage
281 :usage "[OPTION] DIRECTORY...
282Remove the DIRECTORY(ies), if they are empty.")
283 (while args
284 (eshell-funcalln 'delete-directory (car args))
285 (setq args (cdr args)))
286 nil))
287
288(eval-when-compile
289 (defvar no-dereference)
290 (defvar preview)
291 (defvar verbose))
292
293(defvar eshell-warn-dot-directories t)
294
295(defun eshell-shuffle-files (command action files target func deep &rest args)
296 "Shuffle around some filesystem entries, using FUNC to do the work."
297 (if (null target)
298 (error "%s: missing destination file" command))
299 (let ((attr-target (file-attributes target))
300 (is-dir (or (file-directory-p target)
301 (and preview (not eshell-warn-dot-directories))))
302 attr)
303 (if (and (not preview) (not is-dir)
304 (> (length files) 1))
305 (error "%s: when %s multiple files, last argument must be a directory"
306 command action))
307 (while files
308 (setcar files (directory-file-name (car files)))
309 (cond
310 ((string-match "\\`\\.\\.?\\'"
311 (file-name-nondirectory (car files)))
312 (if eshell-warn-dot-directories
313 (eshell-error (format "%s: %s: omitting directory\n"
314 command (car files)))))
315 ((and attr-target
316 (not (eshell-under-windows-p))
317 (setq attr (file-attributes (car files)))
318 (= (nth 10 attr-target) (nth 10 attr))
319 (= (nth 11 attr-target) (nth 11 attr)))
320 (eshell-error (format "%s: `%s' and `%s' are the same file\n"
321 command (car files) target)))
322 (t
323 (let ((source (car files))
324 (target (if is-dir
325 (expand-file-name
326 (file-name-nondirectory (car files)) target)
327 target))
328 link)
329 (if (and (file-directory-p source)
330 (or (not no-dereference)
331 (not (file-symlink-p source)))
332 (not (memq func '(make-symbolic-link
333 add-name-to-file))))
334 (if (and (eq func 'copy-file)
335 (not recursive))
336 (eshell-error (format "%s: %s: omitting directory\n"
337 command (car files)))
338 (let (eshell-warn-dot-directories)
339 (if (and (not deep)
340 (eq func 'rename-file)
341 (= (nth 11 (file-attributes
342 (file-name-directory
343 (expand-file-name source))))
344 (nth 11 (file-attributes
345 (file-name-directory
346 (expand-file-name target))))))
347 (apply 'eshell-funcalln func source target args)
348 (unless (file-directory-p target)
349 (if verbose
350 (eshell-printn
351 (format "%s: making directory %s"
352 command target)))
353 (unless preview
354 (eshell-funcalln 'make-directory target)))
355 (eshell-shuffle-files command action
356 (mapcar
357 (function
358 (lambda (file)
359 (concat source "/" file)))
360 (directory-files source))
361 target func t args)
362 (when (eq func 'rename-file)
363 (if verbose
364 (eshell-printn
365 (format "%s: deleting directory %s"
366 command source)))
367 (unless preview
368 (eshell-funcalln 'delete-directory source))))))
369 (if verbose
370 (eshell-printn (format "%s: %s -> %s" command
371 source target)))
372 (unless preview
373 (if (and no-dereference
374 (setq link (file-symlink-p source)))
375 (progn
376 (apply 'eshell-funcalln 'make-symbolic-link
377 link target args)
378 (if (eq func 'rename-file)
379 (if (and (file-directory-p source)
380 (not (file-symlink-p source)))
381 (eshell-funcalln 'delete-directory source)
382 (eshell-funcalln 'delete-file source))))
383 (apply 'eshell-funcalln func source target args)))))))
384 (setq files (cdr files)))))
385
386(defun eshell-shorthand-tar-command (command args)
387 "Rewrite `cp -v dir a.tar.gz' to `tar cvzf a.tar.gz dir'."
388 (let* ((archive (car (last args)))
389 (tar-args
390 (cond ((string-match "z2" archive) "If")
391 ((string-match "gz" archive) "zf")
392 ((string-match "\\(az\\|Z\\)" archive) "Zf")
393 (t "f"))))
394 (if (file-exists-p archive)
395 (setq tar-args (concat "u" tar-args))
396 (setq tar-args (concat "c" tar-args)))
397 (if verbose
398 (setq tar-args (concat "v" tar-args)))
399 (if (equal command "mv")
400 (setq tar-args (concat "--remove-files -" tar-args)))
401 ;; truncate the archive name from the arguments
402 (setcdr (last args 2) nil)
403 (throw 'eshell-replace-command
404 (eshell-parse-command
405 (format "tar %s %s" tar-args archive) args))))
406
407;; this is to avoid duplicating code...
408(defmacro eshell-mvcp-template
409 (command action func query-var force-var &optional preserve)
410 `(if (and (string-match eshell-tar-regexp (car (last args)))
411 (or (> (length args) 2)
412 (and (file-directory-p (car args))
413 (or (not no-dereference)
414 (not (file-symlink-p (car args)))))))
415 (eshell-shorthand-tar-command ,command args)
416 (let (target)
417 (if (> (length args) 1)
418 (progn
419 (setq target (car (last args)))
420 (setcdr (last args 2) nil))
421 (setq args nil))
422 (eshell-shuffle-files
423 ,command ,action args target ,func nil
424 ,@(append
425 `((if (and (or interactive
426 ,query-var)
427 (not force))
428 1 (or force ,force-var)))
429 (if preserve
430 (list preserve)))))
431 nil))
432
433(defun eshell/mv (&rest args)
434 "Implementation of mv in Lisp."
435 (eshell-eval-using-options
436 "mv" args
437 '((?f "force" nil force
438 "remove existing destinations, never prompt")
439 (?i "interactive" nil interactive
440 "request confirmation if target already exists")
441 (?n "preview" nil preview
442 "don't change anything on disk")
443 (?v "verbose" nil verbose
444 "explain what is being done")
445 (nil "help" nil nil "show this usage screen")
446 :external "mv"
447 :show-usage
448 :usage "[OPTION]... SOURCE DEST
449 or: mv [OPTION]... SOURCE... DIRECTORY
450Rename SOURCE to DEST, or move SOURCE(s) to DIRECTORY.
451\[OPTION] DIRECTORY...")
452 (let ((no-dereference t))
453 (eshell-mvcp-template "mv" "moving" 'rename-file
454 eshell-mv-interactive-query
455 eshell-mv-overwrite-files))))
456
457(defun eshell/cp (&rest args)
458 "Implementation of cp in Lisp."
459 (eshell-eval-using-options
460 "cp" args
461 '((?a "archive" nil archive
462 "same as -dpR")
463 (?d "no-dereference" nil no-dereference
464 "preserve links")
465 (?f "force" nil force
466 "remove existing destinations, never prompt")
467 (?i "interactive" nil interactive
468 "request confirmation if target already exists")
469 (?n "preview" nil preview
470 "don't change anything on disk")
471 (?p "preserve" nil preserve
472 "preserve file attributes if possible")
473 (?R "recursive" nil recursive
474 "copy directories recursively")
475 (?v "verbose" nil verbose
476 "explain what is being done")
477 (nil "help" nil nil "show this usage screen")
478 :external "cp"
479 :show-usage
480 :usage "[OPTION]... SOURCE DEST
481 or: cp [OPTION]... SOURCE... DIRECTORY
482Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.")
483 (if archive
484 (setq preserve t no-dereference t recursive t))
485 (eshell-mvcp-template "cp" "copying" 'copy-file
486 eshell-cp-interactive-query
487 eshell-cp-overwrite-files preserve)))
488
489(defun eshell/ln (&rest args)
490 "Implementation of ln in Lisp."
491 (eshell-eval-using-options
492 "ln" args
493 '((?h "help" nil nil "show this usage screen")
494 (?s "symbolic" nil symbolic
495 "make symbolic links instead of hard links")
496 (?i "interactive" nil interactive "request confirmation if target already exists")
497 (?f "force" nil force "remove existing destinations, never prompt")
498 (?n "preview" nil preview
499 "don't change anything on disk")
500 (?v "verbose" nil verbose "explain what is being done")
501 :external "ln"
502 :show-usage
503 :usage "[OPTION]... TARGET [LINK_NAME]
504 or: ln [OPTION]... TARGET... DIRECTORY
505Create a link to the specified TARGET with optional LINK_NAME. If there is
506more than one TARGET, the last argument must be a directory; create links
507in DIRECTORY to each TARGET. Create hard links by default, symbolic links
508with '--symbolic'. When creating hard links, each TARGET must exist.")
509 (let (target no-dereference)
510 (if (> (length args) 1)
511 (progn
512 (setq target (car (last args)))
513 (setcdr (last args 2) nil))
514 (setq args nil))
515 (eshell-shuffle-files "ln" "linking" args target
516 (if symbolic
517 'make-symbolic-link
518 'add-name-to-file) nil
519 (if (and (or interactive
520 eshell-ln-interactive-query)
521 (not force))
522 1 (or force eshell-ln-overwrite-files))))
523 nil))
524
525(defun eshell/cat (&rest args)
526 "Implementation of cat in Lisp."
527 (if eshell-in-pipeline-p
528 (throw 'eshell-replace-command
529 (eshell-parse-command "*cat" args))
530 (eshell-init-print-buffer)
531 (eshell-eval-using-options
532 "cat" args
533 '((?h "help" nil nil "show this usage screen")
534 :external "cat"
535 :show-usage
536 :usage "[OPTION] FILE...
537Concatenate FILE(s), or standard input, to standard output.")
538 (eshell-for file args
539 (if (string= file "-")
540 (throw 'eshell-external
541 (eshell-external-command "cat" args))))
542 (let ((curbuf (current-buffer)))
543 (eshell-for file args
544 (with-temp-buffer
545 (insert-file-contents file)
546 (goto-char (point-min))
547 (while (not (eobp))
548 (let ((str (buffer-substring
549 (point) (min (1+ (line-end-position))
550 (point-max)))))
551 (with-current-buffer curbuf
552 (eshell-buffered-print str)))
553 (forward-line)))))
554 (eshell-flush)
555 ;; if the file does not end in a newline, do not emit one
556 (setq eshell-ensure-newline-p nil))))
557
558;; special front-end functions for compilation-mode buffers
559
560(defun eshell/make (&rest args)
561 "Use `compile' to do background makes."
562 (if (and eshell-current-subjob-p
563 (eshell-interactive-output-p))
564 (let ((compilation-process-setup-function
565 (list 'lambda nil
566 (list 'setq 'process-environment
567 (list 'quote (eshell-copy-environment))))))
568 (compile (concat "make " (eshell-flatten-and-stringify args))))
569 (throw 'eshell-replace-command
570 (eshell-parse-command "*make" args))))
571
572(defun eshell-occur-mode-goto-occurrence ()
573 "Go to the occurrence the current line describes."
574 (interactive)
575 (let ((pos (occur-mode-find-occurrence)))
576 (pop-to-buffer (marker-buffer pos))
577 (goto-char (marker-position pos))))
578
579(defun eshell-occur-mode-mouse-goto (event)
580 "In Occur mode, go to the occurrence whose line you click on."
581 (interactive "e")
582 (let (buffer pos)
583 (save-excursion
584 (set-buffer (window-buffer (posn-window (event-end event))))
585 (save-excursion
586 (goto-char (posn-point (event-end event)))
587 (setq pos (occur-mode-find-occurrence))
588 (setq buffer occur-buffer)))
589 (pop-to-buffer (marker-buffer pos))
590 (goto-char (marker-position pos))))
591
592(defun eshell-poor-mans-grep (args)
593 "A poor version of grep that opens every file and uses `occur'.
594This eats up memory, since it leaves the buffers open (to speed future
595searches), and it's very slow. But, if your system has no grep
596available..."
597 (save-selected-window
598 (let ((default-dir default-directory))
599 (with-current-buffer (get-buffer-create "*grep*")
600 (let ((inhibit-read-only t)
601 (default-directory default-dir))
602 (erase-buffer)
603 (occur-mode)
604 (let ((files (eshell-flatten-list (cdr args)))
605 (inhibit-redisplay t)
606 string)
607 (when (car args)
608 (if (get-buffer "*Occur*")
609 (kill-buffer (get-buffer "*Occur*")))
610 (setq string nil)
611 (while files
612 (with-current-buffer (find-file-noselect (car files))
613 (save-excursion
614 (ignore-errors
615 (occur (car args))))
616 (if (get-buffer "*Occur*")
617 (with-current-buffer (get-buffer "*Occur*")
618 (setq string (buffer-string))
619 (kill-buffer (current-buffer)))))
620 (if string (insert string))
621 (setq string nil
622 files (cdr files)))))
623 (setq occur-buffer (current-buffer))
624 (local-set-key [mouse-2] 'eshell-occur-mode-mouse-goto)
625 (local-set-key [(control ?c) (control ?c)]
626 'eshell-occur-mode-goto-occurrence)
627 (local-set-key [(control ?m)]
628 'eshell-occur-mode-goto-occurrence)
629 (local-set-key [return] 'eshell-occur-mode-goto-occurrence)
630 (pop-to-buffer (current-buffer) t)
631 (goto-char (point-min))
632 (resize-temp-buffer-window))))))
633
634(defun eshell-grep (command args &optional maybe-use-occur)
635 "Generic service function for the various grep aliases.
636It calls Emacs' grep utility if the command is not redirecting output,
637and if it's not part of a command pipeline. Otherwise, it calls the
638external command."
639 (if (and maybe-use-occur eshell-no-grep-available)
640 (eshell-poor-mans-grep args)
641 (if (or eshell-plain-grep-behavior
642 (not (and (eshell-interactive-output-p)
643 (not eshell-in-pipeline-p)
644 (not eshell-in-subcommand-p))))
645 (throw 'eshell-replace-command
646 (eshell-parse-command (concat "*" command) args))
647 (let* ((compilation-process-setup-function
648 (list 'lambda nil
649 (list 'setq 'process-environment
650 (list 'quote (eshell-copy-environment)))))
651 (args (mapconcat 'identity
652 (mapcar 'shell-quote-argument
653 (eshell-flatten-list args))
654 " "))
655 (cmd (progn
656 (set-text-properties 0 (length args)
657 '(invisible t) args)
658 (format "%s -n %s" command args)))
659 compilation-scroll-output)
660 (grep cmd)))))
661
662(defun eshell/grep (&rest args)
663 "Use Emacs grep facility instead of calling external grep."
664 (eshell-grep "grep" args t))
665
666(defun eshell/egrep (&rest args)
667 "Use Emacs grep facility instead of calling external egrep."
668 (eshell-grep "egrep" args t))
669
670(defun eshell/fgrep (&rest args)
671 "Use Emacs grep facility instead of calling external fgrep."
672 (eshell-grep "fgrep" args t))
673
674(defun eshell/agrep (&rest args)
675 "Use Emacs grep facility instead of calling external agrep."
676 (eshell-grep "agrep" args))
677
678(defun eshell/glimpse (&rest args)
679 "Use Emacs grep facility instead of calling external glimpse."
680 (let (null-device)
681 (eshell-grep "glimpse" (append '("-z" "-y") args))))
682
683;; completions rules for some common UNIX commands
684
685(defsubst eshell-complete-hostname ()
686 "Complete a command that wants a hostname for an argument."
687 (pcomplete-here (eshell-read-host-names)))
688
689(defun eshell-complete-host-reference ()
690 "If there is a host reference, complete it."
691 (let ((arg (pcomplete-actual-arg))
692 index)
693 (when (setq index (string-match "@[a-z.]*\\'" arg))
694 (setq pcomplete-stub (substring arg (1+ index))
695 pcomplete-last-completion-raw t)
696 (throw 'pcomplete-completions (eshell-read-host-names)))))
697
698(defalias 'pcomplete/ftp 'eshell-complete-hostname)
699(defalias 'pcomplete/ncftp 'eshell-complete-hostname)
700(defalias 'pcomplete/ping 'eshell-complete-hostname)
701(defalias 'pcomplete/rlogin 'eshell-complete-hostname)
702
703(defun pcomplete/telnet ()
704 (require 'pcmpl-unix)
705 (pcomplete-opt "xl(pcmpl-unix-user-names)")
706 (eshell-complete-hostname))
707
708(defun pcomplete/rsh ()
709 "Complete `rsh', which, after the user and hostname, is like xargs."
710 (require 'pcmpl-unix)
711 (pcomplete-opt "l(pcmpl-unix-user-names)")
712 (eshell-complete-hostname)
713 (pcomplete-here (funcall pcomplete-command-completion-function))
714 (funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
715 pcomplete-default-completion-function)))
716
717(defalias 'pcomplete/ssh 'pcomplete/rsh)
718
719(eval-when-compile
720 (defvar block-size)
721 (defvar by-bytes)
722 (defvar dereference-links)
723 (defvar grand-total)
724 (defvar human-readable)
725 (defvar max-depth)
726 (defvar only-one-filesystem)
727 (defvar show-all))
728
729(defsubst eshell-du-size-string (size)
730 (let* ((str (eshell-printable-size size human-readable block-size t))
731 (len (length str)))
732 (concat str (if (< len 8)
733 (make-string (- 8 len) ? )))))
734
735(defun eshell-du-sum-directory (path depth)
736 "Summarize PATH, and its member directories."
737 (let ((entries (eshell-directory-files-and-attributes path))
738 (size 0.0))
739 (while entries
740 (unless (string-match "\\`\\.\\.?\\'" (caar entries))
741 (let* ((entry (concat path (char-to-string directory-sep-char)
742 (caar entries)))
743 (symlink (and (stringp (cadr (car entries)))
744 (cadr (car entries)))))
745 (unless (or (and symlink (not dereference-links))
746 (and only-one-filesystem
747 (not (= only-one-filesystem
748 (nth 12 (car entries))))))
749 (if symlink
750 (setq entry symlink))
751 (setq size
752 (+ size
753 (if (eq t (cadr (car entries)))
754 (eshell-du-sum-directory entry (1+ depth))
755 (let ((file-size (nth 8 (car entries))))
756 (prog1
757 file-size
758 (if show-all
759 (eshell-print
760 (concat (eshell-du-size-string file-size)
761 entry "\n")))))))))))
762 (setq entries (cdr entries)))
763 (if (or (not max-depth)
764 (= depth max-depth)
765 (= depth 0))
766 (eshell-print (concat (eshell-du-size-string size)
767 (directory-file-name path) "\n")))
768 size))
769
770(defun eshell/du (&rest args)
771 "Implementation of \"du\" in Lisp, passing RAGS."
772 (if (eshell-search-path "du")
773 (throw 'eshell-replace-command
774 (eshell-parse-command "*du" args))
775 (eshell-eval-using-options
776 "du" args
777 '((?a "all" nil show-all
778 "write counts for all files, not just directories")
779 (nil "block-size" t block-size
780 "use SIZE-byte blocks (i.e., --block-size SIZE)")
781 (?b "bytes" nil by-bytes
782 "print size in bytes")
783 (?c "total" nil grand-total
784 "produce a grand total")
785 (?d "max-depth" t max-depth
786 "display data only this many levels of data")
787 (?h "human-readable" 1024 human-readable
788 "print sizes in human readable format")
789 (?H "is" 1000 human-readable
790 "likewise, but use powers of 1000 not 1024")
791 (?k "kilobytes" 1024 block-size
792 "like --block-size 1024")
793 (?L "dereference" nil dereference-links
794 "dereference all symbolic links")
795 (?m "megabytes" 1048576 block-size
796 "like --block-size 1048576")
797 (?s "summarize" 0 max-depth
798 "display only a total for each argument")
799 (?x "one-file-system" nil only-one-filesystem
800 "skip directories on different filesystems")
801 (nil "help" nil nil
802 "show this usage screen")
803 :external "du"
804 :usage "[OPTION]... FILE...
805Summarize disk usage of each FILE, recursively for directories.")
806 (unless by-bytes
807 (setq block-size (or block-size 1024)))
808 (if (and max-depth (stringp max-depth))
809 (setq max-depth (string-to-int max-depth)))
810 ;; filesystem support means nothing under Windows
811 (if (eshell-under-windows-p)
812 (setq only-one-filesystem nil))
813 (unless args
814 (setq args '(".")))
815 (let ((size 0.0))
816 (while args
817 (if only-one-filesystem
818 (setq only-one-filesystem
819 (nth 11 (file-attributes
820 (file-name-as-directory (car args))))))
821 (setq size (+ size (eshell-du-sum-directory
822 (directory-file-name (car args)) 0)))
823 (setq args (cdr args)))
824 (if grand-total
825 (eshell-print (concat (eshell-du-size-string size)
826 "total\n")))))))
827
828(defvar eshell-time-start nil)
829
830(defun eshell-show-elapsed-time ()
831 (let ((elapsed (format "%.3f secs\n"
832 (- (eshell-time-to-seconds (current-time))
833 eshell-time-start))))
834 (set-text-properties 0 (length elapsed) '(face bold) elapsed)
835 (eshell-interactive-print elapsed))
836 (remove-hook 'eshell-post-command-hook 'eshell-show-elapsed-time t))
837
838(defun eshell/time (&rest args)
839 "Implementation of \"time\" in Lisp."
840 (let ((time-args (copy-alist args))
841 (continue t)
842 last-arg)
843 (while (and continue args)
844 (if (not (string-match "^-" (car args)))
845 (progn
846 (if last-arg
847 (setcdr last-arg nil)
848 (setq args '("")))
849 (setq continue nil))
850 (setq last-arg args
851 args (cdr args))))
852 (eshell-eval-using-options
853 "time" args
854 '((?h "help" nil nil "show this usage screen")
855 :external "time"
856 :show-usage
857 :usage "COMMAND...
858Show wall-clock time elapsed during execution of COMMAND.")
859 (setq eshell-time-start (eshell-time-to-seconds (current-time)))
860 (add-hook 'eshell-post-command-hook 'eshell-show-elapsed-time nil t)
861 ;; after setting
862 (throw 'eshell-replace-command
863 (eshell-parse-command (car time-args) (cdr time-args))))))
864
865(defalias 'eshell/whoami 'user-login-name)
866
867(defvar eshell-diff-window-config nil)
868
869(defun eshell-diff-quit ()
870 "Restore the window configuration previous to diff'ing."
871 (interactive)
872 (if eshell-diff-window-config
873 (set-window-configuration eshell-diff-window-config)))
874
875(defun eshell/diff (&rest args)
876 "Alias \"diff\" to call Emacs `diff' function."
877 (if (or eshell-plain-diff-behavior
878 (not (and (eshell-interactive-output-p)
879 (not eshell-in-pipeline-p)
880 (not eshell-in-subcommand-p))))
881 (throw 'eshell-replace-command
882 (eshell-parse-command "*diff" args))
883 (setq args (eshell-flatten-list args))
884 (if (< (length args) 2)
885 (error "diff: missing operand"))
886 (let ((old (car (last args 2)))
887 (new (car (last args)))
888 (config (current-window-configuration)))
889 (if (= (length args) 2)
890 (setq args nil)
891 (setcdr (last args 3) nil))
892 (with-current-buffer
893 (diff old new (eshell-flatten-and-stringify args))
894 (when (fboundp 'diff-mode)
895 (diff-mode)
896 (set (make-local-variable 'eshell-diff-window-config) config)
897 (local-set-key [?q] 'eshell-diff-quit)
898 (if (fboundp 'turn-on-font-lock-if-enabled)
899 (turn-on-font-lock-if-enabled))))
900 (other-window 1)
901 (goto-char (point-min))
902 nil)))
903
904(defun eshell/locate (&rest args)
905 "Alias \"locate\" to call Emacs `locate' function."
906 (if (or eshell-plain-locate-behavior
907 (not (and (eshell-interactive-output-p)
908 (not eshell-in-pipeline-p)
909 (not eshell-in-subcommand-p)))
910 (and (stringp (car args))
911 (string-match "^-" (car args))))
912 (throw 'eshell-replace-command
913 (eshell-parse-command "*locate" args))
914 (save-selected-window
915 (let ((locate-history-list (list (car args))))
916 (locate-with-filter (car args) (cadr args))))))
917
918(defun eshell/occur (&rest args)
919 "Alias \"occur\" to call Emacs `occur' function."
920 (let ((inhibit-read-only t))
921 (if args
922 (error "usage: occur: (REGEXP)")
923 (occur (car args)))))
924
925;;; Code:
926
927;;; em-unix.el ends here
diff --git a/lisp/eshell/em-xtra.el b/lisp/eshell/em-xtra.el
new file mode 100644
index 00000000000..9baa46a3e97
--- /dev/null
+++ b/lisp/eshell/em-xtra.el
@@ -0,0 +1,119 @@
1;;; em-xtra --- extra alias functions
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'em-xtra)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-xtra nil
27 "This module defines some extra alias functions which are entirely
28optional. They can be viewed as samples for how to write Eshell alias
29functions, or as aliases which make some of Emacs' behavior more
30naturally accessible within Emacs."
31 :tag "Extra alias functions"
32 :group 'eshell-module)
33
34;;; Commentary:
35
36(require 'compile)
37
38;;; Functions:
39
40(defun eshell/expr (&rest args)
41 "Implementation of expr, using the calc package."
42 (if (not (fboundp 'calc-eval))
43 (throw 'eshell-replace-command
44 (eshell-parse-command "*expr" args))
45 ;; to fool the byte-compiler...
46 (let ((func 'calc-eval))
47 (funcall func (eshell-flatten-and-stringify args)))))
48
49(defun eshell/substitute (&rest args)
50 "Easy front-end to `intersection', for comparing lists of strings."
51 (apply 'substitute (car args) (cadr args) :test 'equal
52 (cddr args)))
53
54(defun eshell/count (&rest args)
55 "Easy front-end to `intersection', for comparing lists of strings."
56 (apply 'count (car args) (cadr args) :test 'equal
57 (cddr args)))
58
59(defun eshell/mismatch (&rest args)
60 "Easy front-end to `intersection', for comparing lists of strings."
61 (apply 'mismatch (car args) (cadr args) :test 'equal
62 (cddr args)))
63
64(defun eshell/union (&rest args)
65 "Easy front-end to `intersection', for comparing lists of strings."
66 (apply 'union (car args) (cadr args) :test 'equal
67 (cddr args)))
68
69(defun eshell/intersection (&rest args)
70 "Easy front-end to `intersection', for comparing lists of strings."
71 (apply 'intersection (car args) (cadr args) :test 'equal
72 (cddr args)))
73
74(defun eshell/set-difference (&rest args)
75 "Easy front-end to `intersection', for comparing lists of strings."
76 (apply 'set-difference (car args) (cadr args) :test 'equal
77 (cddr args)))
78
79(defun eshell/set-exclusive-or (&rest args)
80 "Easy front-end to `intersection', for comparing lists of strings."
81 (apply 'set-exclusive-or (car args) (cadr args) :test 'equal
82 (cddr args)))
83
84(defalias 'eshell/ff 'find-name-dired)
85(defalias 'eshell/gf 'find-grep-dired)
86
87(defun pcomplete/bcc32 ()
88 "Completion function for Borland's C++ compiler."
89 (let ((cur (pcomplete-arg 0)))
90 (cond
91 ((string-match "\\`-w\\([^;]+;\\)*\\([^;]*\\)\\'" cur)
92 (pcomplete-here
93 '("ali" "amb" "amp" "asc" "asm" "aus" "bbf" "bei" "big" "ccc"
94 "cln" "cod" "com" "cpt" "csu" "def" "dig" "dpu" "dsz" "dup"
95 "eas" "eff" "ext" "hch" "hid" "ias" "ibc" "ifr" "ill" "nil"
96 "lin" "lvc" "mcs" "mes" "mpc" "mpd" "msg" "nak" "ncf" "nci"
97 "ncl" "nfd" "ngu" "nin" "nma" "nmu" "nod" "nop" "npp" "nsf"
98 "nst" "ntd" "nto" "nvf" "obi" "obs" "ofp" "osh" "ovf" "par"
99 "pch" "pck" "pia" "pin" "pow" "prc" "pre" "pro" "rch" "ret"
100 "rng" "rpt" "rvl" "sig" "spa" "stl" "stu" "stv" "sus" "tai"
101 "tes" "thr" "ucp" "use" "voi" "zdi") (match-string 2 cur)))
102 ((string-match "\\`-[LIn]\\([^;]+;\\)*\\([^;]*\\)\\'" cur)
103 (pcomplete-here (pcomplete-dirs) (match-string 2 cur)))
104 ((string-match "\\`-[Ee]\\(.*\\)\\'" cur)
105 (pcomplete-here (pcomplete-dirs-or-entries "\\.[Ee][Xx][Ee]\\'")
106 (match-string 1 cur)))
107 ((string-match "\\`-o\\(.*\\)\\'" cur)
108 (pcomplete-here (pcomplete-dirs-or-entries "\\.[Oo][Bb][Jj]\\'")
109 (match-string 1 cur)))
110 (t
111 (pcomplete-opt "3456ABCDEHIKLMNOPRSTUVXabcdefgijklnoptuvwxyz"))))
112 (while (pcomplete-here
113 (pcomplete-dirs-or-entries "\\.[iCc]\\([Pp][Pp]\\)?\\'"))))
114
115(defalias 'pcomplete/bcc 'pcomplete/bcc32)
116
117;;; Code:
118
119;;; em-xtra.el ends here
diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el
new file mode 100644
index 00000000000..49fe815abc8
--- /dev/null
+++ b/lisp/eshell/esh-arg.el
@@ -0,0 +1,383 @@
1;;; esh-arg --- argument processing
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'esh-arg)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-arg nil
27 "Argument parsing involves transforming the arguments passed on the
28command line into equivalent Lisp forms that, when evaluated, will
29yield the values intended."
30 :tag "Argument parsing"
31 :group 'eshell)
32
33;;; Commentary:
34
35;; Parsing of arguments can be extended by adding functions to the
36;; hook `eshell-parse-argument-hook'. For a good example of this, see
37;; `eshell-parse-drive-letter', defined in eshell-dirs.el.
38
39(defcustom eshell-parse-argument-hook
40 (list
41 ;; a term such as #<buffer NAME>, or #<process NAME> is a buffer
42 ;; or process reference
43 'eshell-parse-special-reference
44
45 ;; numbers convert to numbers if they stand alone
46 (function
47 (lambda ()
48 (when (and (not eshell-current-argument)
49 (not eshell-current-quoted)
50 (looking-at eshell-number-regexp)
51 (eshell-arg-delimiter (match-end 0)))
52 (goto-char (match-end 0))
53 (string-to-number (match-string 0)))))
54
55 ;; parse any non-special characters, based on the current context
56 (function
57 (lambda ()
58 (unless eshell-inside-quote-regexp
59 (setq eshell-inside-quote-regexp
60 (format "[^%s]+"
61 (apply 'string eshell-special-chars-inside-quoting))))
62 (unless eshell-outside-quote-regexp
63 (setq eshell-outside-quote-regexp
64 (format "[^%s]+"
65 (apply 'string eshell-special-chars-outside-quoting))))
66 (when (looking-at (if eshell-current-quoted
67 eshell-inside-quote-regexp
68 eshell-outside-quote-regexp))
69 (goto-char (match-end 0))
70 (let ((str (match-string 0)))
71 (if str
72 (set-text-properties 0 (length str) nil str))
73 str))))
74
75 ;; whitespace or a comment is an argument delimiter
76 (function
77 (lambda ()
78 (let (comment-p)
79 (when (or (looking-at "[ \t]+")
80 (and (not eshell-current-argument)
81 (looking-at "#\\([^<'].*\\|$\\)")
82 (setq comment-p t)))
83 (if comment-p
84 (add-text-properties (match-beginning 0) (match-end 0)
85 '(comment t)))
86 (goto-char (match-end 0))
87 (eshell-finish-arg)))))
88
89 ;; backslash before a special character means escape it
90 'eshell-parse-backslash
91
92 ;; text beginning with ' is a literally quoted
93 'eshell-parse-literal-quote
94
95 ;; text beginning with " is interpolably quoted
96 'eshell-parse-double-quote
97
98 ;; argument delimiter
99 'eshell-parse-delimiter)
100 "*Define how to process Eshell command line arguments.
101When each function on this hook is called, point will be at the
102current position within the argument list. The function should either
103return nil, meaning that it did no argument parsing, or it should
104return the result of the parse as a sexp. It is also responsible for
105moving the point forward to reflect the amount of input text that was
106parsed.
107
108If no function handles the current character at point, it will be
109treated as a literal character."
110 :type 'hook
111 :group 'eshell-arg)
112
113;;; Code:
114
115;;; User Variables:
116
117(defcustom eshell-arg-load-hook '(eshell-arg-initialize)
118 "*A hook that gets run when `eshell-arg' is loaded."
119 :type 'hook
120 :group 'eshell-arg)
121
122(defcustom eshell-delimiter-argument-list '(?\; ?& ?\| ?\> ? ?\t ?\n)
123 "List of characters to recognize as argument separators."
124 :type '(repeat character)
125 :group 'eshell-arg)
126
127(defcustom eshell-special-chars-inside-quoting '(?\\ ?\")
128 "*Characters which are still special inside double quotes."
129 :type '(repeat character)
130 :group 'eshell-arg)
131
132(defcustom eshell-special-chars-outside-quoting
133 (append eshell-delimiter-argument-list '(?# ?! ?\\ ?\" ?\'))
134 "*Characters that require escaping outside of double quotes.
135Without escaping them, they will introduce a change in the argument."
136 :type '(repeat character)
137 :group 'eshell-arg)
138
139;;; Internal Variables:
140
141(defvar eshell-current-argument nil)
142(defvar eshell-current-modifiers nil)
143(defvar eshell-arg-listified nil)
144(defvar eshell-nested-argument nil)
145(defvar eshell-current-quoted nil)
146(defvar eshell-inside-quote-regexp nil)
147(defvar eshell-outside-quote-regexp nil)
148
149;;; Functions:
150
151(defun eshell-arg-initialize ()
152 "Initialize the argument parsing code."
153 (define-key eshell-command-map [(meta ?b)] 'eshell-insert-buffer-name)
154 (set (make-local-variable 'eshell-inside-quote-regexp) nil)
155 (set (make-local-variable 'eshell-outside-quote-regexp) nil))
156
157(defun eshell-insert-buffer-name (buffer-name)
158 "Insert BUFFER-NAME into the current buffer at point."
159 (interactive "BName of buffer: ")
160 (insert-and-inherit "#<buffer " buffer-name ">"))
161
162(defsubst eshell-escape-arg (string)
163 "Return STRING with the `escaped' property on it."
164 (if (stringp string)
165 (add-text-properties 0 (length string) '(escaped t) string))
166 string)
167
168(defun eshell-resolve-current-argument ()
169 "If there are pending modifications to be made, make them now."
170 (when eshell-current-argument
171 (when eshell-arg-listified
172 (let ((parts eshell-current-argument))
173 (while parts
174 (unless (stringp (car parts))
175 (setcar parts
176 (list 'eshell-to-flat-string (car parts))))
177 (setq parts (cdr parts)))
178 (setq eshell-current-argument
179 (list 'eshell-convert
180 (append (list 'concat) eshell-current-argument))))
181 (setq eshell-arg-listified nil))
182 (while eshell-current-modifiers
183 (setq eshell-current-argument
184 (list (car eshell-current-modifiers) eshell-current-argument)
185 eshell-current-modifiers (cdr eshell-current-modifiers))))
186 (setq eshell-current-modifiers nil))
187
188(defun eshell-finish-arg (&optional argument)
189 "Finish the current argument being processed."
190 (if argument
191 (setq eshell-current-argument argument))
192 (throw 'eshell-arg-done t))
193
194(defsubst eshell-arg-delimiter (&optional pos)
195 "Return non-nil if POS is an argument delimiter.
196If POS is nil, the location of point is checked."
197 (let ((pos (or pos (point))))
198 (or (= pos (point-max))
199 (memq (char-after pos) eshell-delimiter-argument-list))))
200
201;; Argument parsing
202
203(defun eshell-parse-arguments (beg end)
204 "Parse all of the arguments at point from BEG to END.
205Returns the list of arguments in their raw form.
206Point is left at the end of the arguments."
207 (save-excursion
208 (save-restriction
209 (goto-char beg)
210 (narrow-to-region beg end)
211 (let ((inhibit-point-motion-hooks t)
212 (args (list t))
213 after-change-functions
214 delim)
215 (remove-text-properties (point-min) (point-max)
216 '(arg-begin nil arg-end nil))
217 (if (setq
218 delim
219 (catch 'eshell-incomplete
220 (while (not (eobp))
221 (let* ((here (point))
222 (arg (eshell-parse-argument)))
223 (if (= (point) here)
224 (error "Failed to parse argument '%s'"
225 (buffer-substring here (point-max))))
226 (and arg (nconc args (list arg)))))))
227 (if (listp delim)
228 (throw 'eshell-incomplete delim)
229 (throw 'eshell-incomplete
230 (list delim (point) (cdr args)))))
231 (cdr args)))))
232
233(defun eshell-parse-argument ()
234 "Get the next argument. Leave point after it."
235 (let* ((outer (null eshell-nested-argument))
236 (arg-begin (and outer (point)))
237 (eshell-nested-argument t)
238 eshell-current-argument
239 eshell-current-modifiers
240 eshell-arg-listified)
241 (catch 'eshell-arg-done
242 (while (not (eobp))
243 (let ((result
244 (or (run-hook-with-args-until-success
245 'eshell-parse-argument-hook)
246 (prog1
247 (char-to-string (char-after))
248 (forward-char)))))
249 (if (not eshell-current-argument)
250 (setq eshell-current-argument result)
251 (unless eshell-arg-listified
252 (setq eshell-current-argument
253 (list eshell-current-argument)
254 eshell-arg-listified t))
255 (nconc eshell-current-argument (list result))))))
256 (when (and outer eshell-current-argument)
257 (add-text-properties arg-begin (1+ arg-begin)
258 '(arg-begin t rear-nonsticky
259 (arg-begin arg-end)))
260 (add-text-properties (1- (point)) (point)
261 '(arg-end t rear-nonsticky
262 (arg-end arg-begin))))
263 (eshell-resolve-current-argument)
264 eshell-current-argument))
265
266(defsubst eshell-operator (&rest args)
267 "A stub function that generates an error if a floating operator is found."
268 (error "Unhandled operator in input text"))
269
270(defsubst eshell-looking-at-backslash-return (pos)
271 "Test whether a backslash-return sequence occurs at POS."
272 (and (eq (char-after pos) ?\\)
273 (or (= (1+ pos) (point-max))
274 (and (eq (char-after (1+ pos)) ?\n)
275 (= (+ pos 2) (point-max))))))
276
277(defun eshell-quote-backslash (string &optional index)
278 "Intelligently backslash the character occuring in STRING at INDEX.
279If the character is itself a backslash, it needs no escaping."
280 (let ((char (aref string index)))
281 (if (eq char ?\\)
282 (char-to-string char)
283 (if (memq char eshell-special-chars-outside-quoting)
284 (string ?\\ char)))))
285
286(defun eshell-parse-backslash ()
287 "Parse a single backslash (\) character, which might mean escape.
288It only means escape if the character immediately following is a
289special character that is not itself a backslash."
290 (when (eq (char-after) ?\\)
291 (if (eshell-looking-at-backslash-return (point))
292 (throw 'eshell-incomplete ?\\)
293 (if (and (not (eq (char-after (1+ (point))) ?\\))
294 (if eshell-current-quoted
295 (memq (char-after (1+ (point)))
296 eshell-special-chars-inside-quoting)
297 (memq (char-after (1+ (point)))
298 eshell-special-chars-outside-quoting)))
299 (progn
300 (forward-char 2)
301 (list 'eshell-escape-arg
302 (char-to-string (char-before))))
303 ;; allow \\<RET> to mean a literal "\" character followed by a
304 ;; normal return, rather than a backslash followed by a line
305 ;; continuator (i.e., "\\ + \n" rather than "\ + \\n"). This
306 ;; is necessary because backslashes in Eshell are not special
307 ;; unless they either precede something special, or precede a
308 ;; backslash that precedes something special. (Mainly this is
309 ;; done to make using backslash on Windows systems more
310 ;; natural-feeling).
311 (if (eshell-looking-at-backslash-return (1+ (point)))
312 (forward-char))
313 (forward-char)
314 "\\"))))
315
316(defun eshell-parse-literal-quote ()
317 "Parse a literally quoted string. Nothing has special meaning!"
318 (if (eq (char-after) ?\')
319 (let ((end (eshell-find-delimiter ?\' ?\')))
320 (if (not end)
321 (throw 'eshell-incomplete ?\')
322 (let ((string (buffer-substring-no-properties (1+ (point)) end)))
323 (goto-char (1+ end))
324 (while (string-match "''" string)
325 (setq string (replace-match "'" t t string)))
326 (list 'eshell-escape-arg string))))))
327
328(defun eshell-parse-double-quote ()
329 "Parse a double quoted string, which allows for variable interpolation."
330 (when (eq (char-after) ?\")
331 (forward-char)
332 (let* ((end (eshell-find-delimiter ?\" ?\" nil nil t))
333 (eshell-current-quoted t))
334 (if (not end)
335 (throw 'eshell-incomplete ?\")
336 (prog1
337 (save-restriction
338 (narrow-to-region (point) end)
339 (list 'eshell-escape-arg
340 (eshell-parse-argument)))
341 (goto-char (1+ end)))))))
342
343(defun eshell-parse-special-reference ()
344 "Parse a special syntax reference, of the form '#<type arg>'."
345 (if (and (not eshell-current-argument)
346 (not eshell-current-quoted)
347 (looking-at "#<\\(buffer\\|process\\)\\s-"))
348 (let ((here (point)))
349 (goto-char (match-end 0))
350 (let* ((buffer-p (string= (match-string 1) "buffer"))
351 (end (eshell-find-delimiter ?\< ?\>)))
352 (if (not end)
353 (throw 'eshell-incomplete ?\<)
354 (if (eshell-arg-delimiter (1+ end))
355 (prog1
356 (list (if buffer-p 'get-buffer-create 'get-process)
357 (buffer-substring-no-properties (point) end))
358 (goto-char (1+ end)))
359 (ignore (goto-char here))))))))
360
361(defun eshell-parse-delimiter ()
362 "Parse an argument delimiter, which is essentially a command operator."
363 ;; this `eshell-operator' keyword gets parsed out by
364 ;; `eshell-separate-commands'. Right now the only possibility for
365 ;; error is an incorrect output redirection specifier.
366 (when (looking-at "[&|;\n]\\s-*")
367 (let ((end (match-end 0)))
368 (if eshell-current-argument
369 (eshell-finish-arg)
370 (eshell-finish-arg
371 (prog1
372 (list 'eshell-operator
373 (cond
374 ((eq (char-after end) ?\&)
375 (setq end (1+ end)) "&&")
376 ((eq (char-after end) ?\|)
377 (setq end (1+ end)) "||")
378 ((eq (char-after) ?\n) ";")
379 (t
380 (char-to-string (char-after)))))
381 (goto-char end)))))))
382
383;;; esh-arg.el ends here
diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el
new file mode 100644
index 00000000000..51139fb37bd
--- /dev/null
+++ b/lisp/eshell/esh-ext.el
@@ -0,0 +1,311 @@
1;;; esh-ext --- commands external to Eshell
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'esh-ext)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-ext nil
27 "External commands are invoked when operating system executables are
28loaded into memory, thus beginning a new process."
29 :tag "External commands"
30 :group 'eshell)
31
32;;; Commentary:
33
34;; To force a command to invoked external, either provide an explicit
35;; pathname for the command argument, or prefix the command name with
36;; an asterix character. Example:
37;;
38;; grep ; make invoke `grep' Lisp function, or `eshell/grep'
39;; /bin/grep ; will definitely invoke /bin/grep
40;; *grep ; will also invoke /bin/grep
41
42;;; User Variables:
43
44(defcustom eshell-ext-load-hook '(eshell-ext-initialize)
45 "*A hook that gets run when `eshell-ext' is loaded."
46 :type 'hook
47 :group 'eshell-ext)
48
49(defcustom eshell-binary-suffixes
50 (if (eshell-under-windows-p)
51 '(".exe" ".com" ".bat" ".cmd" "")
52 '(""))
53 "*A list of suffixes used when searching for executable files."
54 :type '(repeat string)
55 :group 'eshell-ext)
56
57(defcustom eshell-force-execution nil
58 "*If non-nil, try to execute binary files regardless of permissions.
59This can be useful on systems like Windows, where the operating system
60doesn't happen to honor the permission bits in certain cases; or in
61cases where you want to associate an interpreter with a particular
62kind of script file, but the language won't let you but a '#!'
63interpreter line in the file, and you don't want to make it executable
64since nothing else but Eshell will be able to understand
65`eshell-interpreter-alist'."
66 :type 'boolean
67 :group 'eshell-ext)
68
69(defun eshell-search-path (name)
70 "Search the environment path for NAME."
71 (if (file-name-absolute-p name)
72 name
73 (let ((list (parse-colon-path (getenv "PATH")))
74 suffixes n1 n2 file)
75 (while list
76 (setq n1 (concat (car list) name))
77 (setq suffixes eshell-binary-suffixes)
78 (while suffixes
79 (setq n2 (concat n1 (car suffixes)))
80 (if (and (or (file-executable-p n2)
81 (and eshell-force-execution
82 (file-readable-p n2)))
83 (not (file-directory-p n2)))
84 (setq file n2 suffixes nil list nil))
85 (setq suffixes (cdr suffixes)))
86 (setq list (cdr list)))
87 file)))
88
89(defcustom eshell-windows-shell-file
90 (if (eshell-under-windows-p)
91 (if (string-match "\\(\\`cmdproxy\\|sh\\)\\.\\(com\\|exe\\)"
92 shell-file-name)
93 (or (eshell-search-path "cmd.exe")
94 (eshell-search-path "command.exe"))
95 shell-file-name))
96 "*The name of the shell command to use for DOS/Windows batch files.
97This defaults to nil on non-Windows systems, where this variable is
98wholly ignored."
99 :type 'file
100 :group 'eshell-ext)
101
102(defsubst eshell-invoke-batch-file (&rest args)
103 "Invoke a .BAT or .CMD file on DOS/Windows systems."
104 ;; since CMD.EXE can't handle forward slashes in the initial
105 ;; argument...
106 (setcar args (subst-char-in-string directory-sep-char
107 ?\\ (car args)))
108 (throw 'eshell-replace-command
109 (eshell-parse-command eshell-windows-shell-file
110 (cons "/c" args))))
111
112(defcustom eshell-interpreter-alist
113 (if (eshell-under-windows-p)
114 '(("\\.\\(bat\\|cmd\\)\\'" . eshell-invoke-batch-file)))
115 "*An alist defining interpreter substitutions.
116Each member is a cons cell of the form:
117
118 (MATCH . INTERPRETER)
119
120MATCH should be a regexp, which is matched against the command name,
121or a function. If either returns a non-nil value, then INTERPRETER
122will be used for that command.
123
124If INTERPRETER is a string, it will be called as the command name,
125with the original command name passed as the first argument, with all
126subsequent arguments following. If INTERPRETER is a function, it will
127be called with all of those arguments. Note that interpreter
128functions should throw `eshell-replace-command' with the alternate
129command form, or they should return a value compatible with the
130possible return values of `eshell-external-command', which see."
131 :type '(repeat (cons (choice regexp (function :tag "Predicate"))
132 (choice string (function :tag "Interpreter"))))
133 :group 'eshell-ext)
134
135(defcustom eshell-alternate-command-hook nil
136 "*A hook run whenever external command lookup fails.
137If a functions wishes to provide an alternate command, they must throw
138it using the tag `eshell-replace-command'. This is done because the
139substituted command need not be external at all, and therefore must be
140passed up to a higher level for re-evaluation.
141
142Or, if the function returns a filename, that filename will be invoked
143with the current command arguments rather than the command specified
144by the user on the command line."
145 :type 'hook
146 :group 'eshell-ext)
147
148(defcustom eshell-command-interpreter-max-length 256
149 "*The maximum length of any command interpreter string, plus args."
150 :type 'integer
151 :group 'eshell-ext)
152
153;;; Functions:
154
155(defun eshell-ext-initialize ()
156 "Initialize the external command handling code."
157 (make-local-hook 'eshell-named-command-hook)
158 (add-hook 'eshell-named-command-hook 'eshell-explicit-command nil t))
159
160(defun eshell-explicit-command (command args)
161 "If a command name begins with `*', call it externally always.
162This bypasses all Lisp functions and aliases."
163 (when (and (> (length command) 1)
164 (eq (aref command 0) ?*))
165 (let ((cmd (eshell-search-path (substring command 1))))
166 (if cmd
167 (or (eshell-external-command cmd args)
168 (error "%s: external command failed" cmd))
169 (error "%s: external command not found"
170 (substring command 1))))))
171
172(defun eshell-remote-command (handler command args)
173 "Insert output from a remote COMMAND, using ARGS.
174A remote command is something that executes on a different machine.
175An external command simply means external to Emacs.
176
177Note that this function is very crude at the moment. It gathers up
178all the output from the remote command, and sends it all at once,
179causing the user to wonder if anything's really going on..."
180 (let ((outbuf (generate-new-buffer " *eshell remote output*"))
181 (errbuf (generate-new-buffer " *eshell remote error*"))
182 (exitcode 1))
183 (unwind-protect
184 (progn
185 (setq exitcode
186 (funcall handler 'shell-command
187 (mapconcat 'shell-quote-argument
188 (append (list command) args) " ")
189 outbuf errbuf))
190 (eshell-print (save-excursion (set-buffer outbuf)
191 (buffer-string)))
192 (eshell-error (save-excursion (set-buffer errbuf)
193 (buffer-string))))
194 (eshell-close-handles exitcode 'nil)
195 (kill-buffer outbuf)
196 (kill-buffer errbuf))))
197
198(defun eshell-external-command (command args)
199 "Insert output from an external COMMAND, using ARGS."
200 (setq args (eshell-stringify-list (eshell-flatten-list args)))
201 (let ((handler
202 (unless (or (equal default-directory "/")
203 (and (eshell-under-windows-p)
204 (string-match "\\`[A-Za-z]:[/\\\\]\\'"
205 default-directory)))
206 (find-file-name-handler default-directory
207 'shell-command))))
208 (if handler
209 (eshell-remote-command handler command args))
210 (let ((interp (eshell-find-interpreter command)))
211 (assert interp)
212 (if (functionp (car interp))
213 (apply (car interp) (append (cdr interp) args))
214 (eshell-gather-process-output
215 (car interp) (append (cdr interp) args))))))
216
217(defun eshell/addpath (&rest args)
218 "Add a set of paths to PATH."
219 (eshell-eval-using-options
220 "addpath" args
221 '((?b "begin" nil prepend "add path element at beginning")
222 (?h "help" nil nil "display this usage message")
223 :usage "[-b] PATH
224Adds the given PATH to $PATH.")
225 (if args
226 (progn
227 (if prepend
228 (setq args (nreverse args)))
229 (while args
230 (setenv "PATH"
231 (if prepend
232 (concat (car args) path-separator
233 (getenv "PATH"))
234 (concat (getenv "PATH") path-separator
235 (car args))))
236 (setq args (cdr args))))
237 (let ((paths (parse-colon-path (getenv "PATH"))))
238 (while paths
239 (eshell-printn (car paths))
240 (setq paths (cdr paths)))))))
241
242(defun eshell-script-interpreter (file)
243 "Extract the script to run from FILE, if it has #!<interp> in it.
244Return nil, or a list of the form:
245
246 (INTERPRETER [ARGS] FILE)"
247 (let ((maxlen eshell-command-interpreter-max-length))
248 (if (and (file-readable-p file)
249 (file-regular-p file))
250 (with-temp-buffer
251 (insert-file-contents-literally file nil 0 maxlen)
252 (if (looking-at "#!\\([^ \t\n]+\\)\\([ \t]+\\(.+\\)\\)?")
253 (if (match-string 3)
254 (list (match-string 1)
255 (match-string 3)
256 file)
257 (list (match-string 1)
258 file)))))))
259
260(defun eshell-find-interpreter (file &optional no-examine-p)
261 "Find the command interpreter with which to execute FILE.
262If NO-EXAMINE-P is non-nil, FILE will not be inspected for a script
263line of the form #!<interp>."
264 (let ((finterp
265 (catch 'found
266 (ignore
267 (eshell-for possible eshell-interpreter-alist
268 (cond
269 ((functionp (car possible))
270 (and (funcall (car possible) file)
271 (throw 'found (cdr possible))))
272 ((stringp (car possible))
273 (and (string-match (car possible) file)
274 (throw 'found (cdr possible))))
275 (t
276 (error "Invalid interpreter-alist test"))))))))
277 (if finterp ; first check
278 (list finterp file)
279 (let ((fullname (if (file-name-directory file) file
280 (eshell-search-path file)))
281 (suffixes eshell-binary-suffixes))
282 (if (and fullname (not (or eshell-force-execution
283 (file-executable-p fullname))))
284 (while suffixes
285 (let ((try (concat fullname (car suffixes))))
286 (if (or (file-executable-p try)
287 (and eshell-force-execution
288 (file-readable-p try)))
289 (setq fullname try suffixes nil)
290 (setq suffixes (cdr suffixes))))))
291 (cond ((not (and fullname (file-exists-p fullname)))
292 (let ((name (or fullname file)))
293 (unless (setq fullname
294 (run-hook-with-args-until-success
295 'eshell-alternate-command-hook file))
296 (error "%s: command not found" name))))
297 ((not (or eshell-force-execution
298 (file-executable-p fullname)))
299 (error "%s: Permission denied" fullname)))
300 (let (interp)
301 (unless no-examine-p
302 (setq interp (eshell-script-interpreter fullname))
303 (if interp
304 (setq interp
305 (cons (car (eshell-find-interpreter (car interp) t))
306 (cdr interp)))))
307 (or interp (list fullname)))))))
308
309;;; Code:
310
311;;; esh-ext.el ends here
diff --git a/lisp/eshell/esh-groups.el b/lisp/eshell/esh-groups.el
new file mode 100644
index 00000000000..64348b00b7c
--- /dev/null
+++ b/lisp/eshell/esh-groups.el
@@ -0,0 +1,135 @@
1;;; do not modify this file; it is auto-generated
2
3(defgroup eshell-alias nil
4 "Command aliases allow for easy definition of alternate commands."
5 :tag "Command aliases"
6 :link '(info-link "(eshell.info)Command aliases")
7 :group 'eshell-module)
8
9(defgroup eshell-banner nil
10 "This sample module displays a welcome banner at login.
11It exists so that others wishing to create their own Eshell extension
12modules may have a simple template to begin with."
13 :tag "Login banner"
14 :link '(info-link "(eshell.info)Login banner")
15 :group 'eshell-module)
16
17(defgroup eshell-basic nil
18 "The \"basic\" code provides a set of convenience functions which
19are traditionally considered shell builtins. Since all of the
20functionality provided by them is accessible through Lisp, they are
21not really builtins at all, but offer a command-oriented way to do the
22same thing."
23 :tag "Basic shell commands"
24 :group 'eshell-module)
25
26(defgroup eshell-cmpl nil
27 "This module provides a programmable completion function bound to
28the TAB key, which allows for completing command names, file names,
29variable names, arguments, etc."
30 :tag "Argument completion"
31 :group 'eshell-module)
32
33(defgroup eshell-dirs nil
34 "Directory navigation involves changing directories, examining the
35current directory, maintaining a directory stack, and also keeping
36track of a history of the last directory locations the user was in.
37Emacs does provide standard Lisp definitions of `pwd' and `cd', but
38they lack somewhat in feel from the typical shell equivalents."
39 :tag "Directory navigation"
40 :group 'eshell-module)
41
42(defgroup eshell-glob nil
43 "This module provides extended globbing syntax, similar what is used
44by zsh for filename generation."
45 :tag "Extended filename globbing"
46 :group 'eshell-module)
47
48(defgroup eshell-hist nil
49 "This module provides command history management."
50 :tag "History list management"
51 :group 'eshell-module)
52
53(defgroup eshell-ls nil
54 "This module implements the \"ls\" utility fully in Lisp. If it is
55passed any unrecognized command switches, it will revert to the
56operating system's version. This version of \"ls\" uses text
57properties to colorize its output based on the setting of
58`eshell-ls-use-colors'."
59 :tag "Implementation of `ls' in Lisp"
60 :group 'eshell-module)
61
62(defgroup eshell-pred nil
63 "This module allows for predicates to be applied to globbing
64patterns (similar to zsh), in addition to string modifiers which can
65be applied either to globbing results, variable references, or just
66ordinary strings."
67 :tag "Value modifiers and predicates"
68 :group 'eshell-module)
69
70(defgroup eshell-prompt nil
71 "This module provides command prompts, and navigation between them,
72as is common with most shells."
73 :tag "Command prompts"
74 :group 'eshell-module)
75
76(defgroup eshell-rebind nil
77 "This module allows for special keybindings that only take effect
78while the point is in a region of input text. By default, it binds
79C-a to move to the beginning of the input text (rather than just the
80beginning of the line), and C-p and C-n to move through the input
81history, C-u kills the current input text, etc. It also, if
82`eshell-confine-point-to-input' is non-nil, does not allow certain
83commands to cause the point to leave the input area, such as
84`backward-word', `previous-line', etc. This module intends to mimic
85the behavior of normal shells while the user editing new input text."
86 :tag "Rebind keys at input"
87 :group 'eshell-module)
88
89(defgroup eshell-script nil
90 "This module allows for the execution of files containing Eshell
91commands, as a script file."
92 :tag "Running script files."
93 :group 'eshell-module)
94
95(defgroup eshell-smart nil
96 "This module combines the facility of normal, modern shells with
97some of the edit/review concepts inherent in the design of Plan 9's
989term. See the docs for more details.
99
100Most likely you will have to turn this option on and play around with
101it to get a real sense of how it works."
102 :tag "Smart display of output"
103 :link '(info-link "(eshell.info)Smart display of output")
104 :group 'eshell-module)
105
106(defgroup eshell-term nil
107 "This module causes visual commands (e.g., 'vi') to be executed by
108the `term' package, which comes with Emacs. This package handles most
109of the ANSI control codes, allowing curses-based applications to run
110within an Emacs window. The variable `eshell-visual-commands' defines
111which commands are considered visual in nature."
112 :tag "Running visual commands"
113 :group 'eshell-module)
114
115(defgroup eshell-unix nil
116 "This module defines many of the more common UNIX utilities as
117aliases implemented in Lisp. These include mv, ln, cp, rm, etc. If
118the user passes arguments which are too complex, or are unrecognized
119by the Lisp variant, the external version will be called (if
120available). The only reason not to use them would be because they are
121usually much slower. But in several cases their tight integration
122with Eshell makes them more versatile than their traditional cousins
123\(such as being able to use `kill' to kill Eshell background processes
124by name)."
125 :tag "UNIX commands in Lisp"
126 :group 'eshell-module)
127
128(defgroup eshell-xtra nil
129 "This module defines some extra alias functions which are entirely
130optional. They can be viewed as samples for how to write Eshell alias
131functions, or as aliases which make some of Emacs' behavior more
132naturally accessible within Emacs."
133 :tag "Extra alias functions"
134 :group 'eshell-module)
135
diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el
new file mode 100644
index 00000000000..04840509fa1
--- /dev/null
+++ b/lisp/eshell/esh-io.el
@@ -0,0 +1,509 @@
1;;; esh-io --- I/O management
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'esh-io)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-io nil
27 "Eshell's I/O management code provides a scheme for treating many
28different kinds of objects -- symbols, files, buffers, etc. -- as
29though they were files."
30 :tag "I/O management"
31 :group 'eshell)
32
33;;; Commentary:
34
35;; At the moment, only output redirection is supported in Eshell. To
36;; use input redirection, the following syntax will work, assuming
37;; that the command after the pipe is always an external command:
38;;
39;; cat <file> | <command>
40;;
41;; Otherwise, output redirection and piping are provided in a manner
42;; consistent with most shells. Therefore, only unique features are
43;; mentioned here.
44;;
45;;;_* Insertion
46;;
47;; To insert at the location of point in a buffer, use '>>>':
48;;
49;; echo alpha >>> #<buffer *scratch*>;
50;;
51;;;_* Pseudo-devices
52;;
53;; A few pseudo-devices are provided, since Emacs cannot write
54;; directly to a UNIX device file:
55;;
56;; echo alpha > /dev/null ; the bit bucket
57;; echo alpha > /dev/kill ; set the kill ring
58;; echo alpha >> /dev/clip ; append to the clipboard
59;;
60;;;_* Multiple output targets
61;;
62;; Eshell can write to multiple output targets, including pipes.
63;; Example:
64;;
65;; (+ 1 2) > a > b > c ; prints number to all three files
66;; (+ 1 2) > a | wc ; prints to 'a', and pipes to 'wc'
67
68;;; User Variables:
69
70(defcustom eshell-io-load-hook '(eshell-io-initialize)
71 "*A hook that gets run when `eshell-io' is loaded."
72 :type 'hook
73 :group 'eshell-io)
74
75(defcustom eshell-number-of-handles 3
76 "*The number of file handles that eshell supports.
77Currently this is standard input, output and error. But even all of
78these Emacs does not currently support with asynchronous processes
79\(which is what eshell uses so that you can continue doing work in
80other buffers) ."
81 :type 'integer
82 :group 'eshell-io)
83
84(defcustom eshell-output-handle 1
85 "*The index of the standard output handle."
86 :type 'integer
87 :group 'eshell-io)
88
89(defcustom eshell-error-handle 2
90 "*The index of the standard error handle."
91 :type 'integer
92 :group 'eshell-io)
93
94(defcustom eshell-buffer-shorthand nil
95 "*If non-nil, a symbol name can be used for a buffer in redirection.
96If nil, redirecting to a buffer requires buffer name syntax. If this
97variable is set, redirection directly to Lisp symbols will be
98impossible.
99
100Example:
101
102 echo hello > '*scratch* ; works if `eshell-buffer-shorthand' is t
103 echo hello > #<buffer *scratch*> ; always works"
104 :type 'boolean
105 :group 'eshell-io)
106
107(defcustom eshell-print-queue-size 5
108 "*The size of the print queue, for doing buffered printing.
109This is basically a speed enhancement, to avoid blocking the Lisp code
110from executing while Emacs is redisplaying."
111 :type 'integer
112 :group 'eshell-io)
113
114(defcustom eshell-virtual-targets
115 '(("/dev/eshell" eshell-interactive-print nil)
116 ("/dev/kill" (lambda (mode)
117 (if (eq mode 'overwrite)
118 (kill-new ""))
119 'eshell-kill-append) t)
120 ("/dev/clip" (lambda (mode)
121 (if (eq mode 'overwrite)
122 (let ((x-select-enable-clipboard t))
123 (kill-new "")))
124 'eshell-clipboard-append) t))
125 "*Map virtual devices name to Emacs Lisp functions.
126If the user specifies any of the filenames above as a redirection
127target, the function in the second element will be called.
128
129If the third element is non-nil, the redirection mode is passed as an
130argument (which is the symbol `overwrite', `append' or `insert'), and
131the function is expected to return another function -- which is the
132output function. Otherwise, the second element itself is the output
133function.
134
135The output function is then called repeatedly with a single strings,
136with represents success pieces of the output of the command, until nil
137is passed, meaning EOF.
138
139NOTE: /dev/null is handled specially as a virtual target, and should
140not be added to this variable."
141 :type '(repeat
142 (list (string :tag "Target")
143 function
144 (choice (const :tag "Func returns output-func" t)
145 (const :tag "Func is output-func" nil))))
146 :group 'eshell-io)
147
148(put 'eshell-virtual-targets 'risky-local-variable t)
149
150;;; Internal Variables:
151
152(defvar eshell-current-handles nil)
153
154(defvar eshell-last-command-status 0
155 "The exit code from the last command. 0 if successful.")
156
157(defvar eshell-last-command-result nil
158 "The result of the last command. Not related to success.")
159
160(defvar eshell-output-file-buffer nil
161 "If non-nil, the current buffer is a file output buffer.")
162
163(defvar eshell-print-count)
164(defvar eshell-current-redirections)
165
166;;; Functions:
167
168(defun eshell-io-initialize ()
169 "Initialize the I/O subsystem code."
170 (make-local-hook 'eshell-parse-argument-hook)
171 (add-hook 'eshell-parse-argument-hook
172 'eshell-parse-redirection nil t)
173 (make-local-variable 'eshell-current-redirections)
174 (make-local-hook 'eshell-pre-rewrite-command-hook)
175 (add-hook 'eshell-pre-rewrite-command-hook
176 'eshell-strip-redirections nil t)
177 (make-local-hook 'eshell-post-rewrite-command-hook)
178 (add-hook 'eshell-post-rewrite-command-hook
179 'eshell-apply-redirections nil t))
180
181(defun eshell-parse-redirection ()
182 "Parse an output redirection, such as '2>'."
183 (if (and (not eshell-current-quoted)
184 (looking-at "\\([0-9]\\)?\\(<\\|>+\\)&?\\([0-9]\\)?\\s-*"))
185 (if eshell-current-argument
186 (eshell-finish-arg)
187 (let ((sh (match-string 1))
188 (oper (match-string 2))
189; (th (match-string 3))
190 )
191 (if (string= oper "<")
192 (error "Eshell does not support input redirection"))
193 (eshell-finish-arg
194 (prog1
195 (list 'eshell-set-output-handle
196 (or (and sh (string-to-int sh)) 1)
197 (list 'quote
198 (aref [overwrite append insert]
199 (1- (length oper)))))
200 (goto-char (match-end 0))))))))
201
202(defun eshell-strip-redirections (terms)
203 "Rewrite any output redirections in TERMS."
204 (setq eshell-current-redirections (list t))
205 (let ((tl terms)
206 (tt (cdr terms)))
207 (while tt
208 (if (not (and (consp (car tt))
209 (eq (caar tt) 'eshell-set-output-handle)))
210 (setq tt (cdr tt)
211 tl (cdr tl))
212 (unless (cdr tt)
213 (error "Missing redirection target"))
214 (nconc eshell-current-redirections
215 (list (list 'ignore
216 (append (car tt) (list (cadr tt))))))
217 (setcdr tl (cddr tt))
218 (setq tt (cddr tt))))
219 (setq eshell-current-redirections
220 (cdr eshell-current-redirections))))
221
222(defun eshell-apply-redirections (cmdsym)
223 "Apply any redirection which were specified for COMMAND."
224 (if eshell-current-redirections
225 (set cmdsym
226 (append (list 'progn)
227 eshell-current-redirections
228 (list (symbol-value cmdsym))))))
229
230(defun eshell-create-handles
231 (standard-output output-mode &optional standard-error error-mode)
232 "Create a new set of file handles for a command.
233The default location for standard output and standard error will go to
234STANDARD-OUTPUT and STANDARD-ERROR, respectively."
235 (let ((handles (make-vector eshell-number-of-handles nil))
236 (output-target (eshell-get-target standard-output output-mode))
237 (error-target (eshell-get-target standard-error error-mode)))
238 (aset handles eshell-output-handle (cons output-target 1))
239 (if standard-error
240 (aset handles eshell-error-handle (cons error-target 1))
241 (aset handles eshell-error-handle (cons output-target 1)))
242 handles))
243
244(defun eshell-protect-handles (handles)
245 "Protect the handles in HANDLES from a being closed."
246 (let ((idx 0))
247 (while (< idx eshell-number-of-handles)
248 (if (aref handles idx)
249 (setcdr (aref handles idx)
250 (1+ (cdr (aref handles idx)))))
251 (setq idx (1+ idx))))
252 handles)
253
254(defun eshell-close-target (target status)
255 "Close an output TARGET, passing STATUS as the result.
256STATUS should be non-nil on successful termination of the output."
257 (cond
258 ((symbolp target) nil)
259
260 ;; If we were redirecting to a file, save the file and close the
261 ;; buffer.
262 ((markerp target)
263 (let ((buf (marker-buffer target)))
264 (when buf ; somebody's already killed it!
265 (save-current-buffer
266 (set-buffer buf)
267 (when eshell-output-file-buffer
268 (save-buffer)
269 (when (eq eshell-output-file-buffer t)
270 (or status (set-buffer-modified-p nil))
271 (kill-buffer buf)))))))
272
273 ;; If we're redirecting to a process (via a pipe, or process
274 ;; redirection), send it EOF so that it knows we're finished.
275 ((processp target)
276 (if (eq (process-status target) 'run)
277 (process-send-eof target)))
278
279 ;; A plain function redirection needs no additional arguments
280 ;; passed.
281 ((functionp target)
282 (funcall target status))
283
284 ;; But a more complicated function redirection (which can only
285 ;; happen with aliases at the moment) has arguments that need to be
286 ;; passed along with it.
287 ((consp target)
288 (apply (car target) status (cdr target)))))
289
290(defun eshell-close-handles (exit-code &optional result handles)
291 "Close all of the current handles, taking refcounts into account.
292EXIT-CODE is the process exit code; mainly, it is zero, if the command
293completed successfully. RESULT is the quoted value of the last
294command. If nil, then the meta variables for keeping track of the
295last execution result should not be changed."
296 (let ((idx 0))
297 (assert (or (not result) (eq (car result) 'quote)))
298 (setq eshell-last-command-status exit-code
299 eshell-last-command-result (cadr result))
300 (while (< idx eshell-number-of-handles)
301 (let ((handles (or handles eshell-current-handles)))
302 (when (aref handles idx)
303 (setcdr (aref handles idx)
304 (1- (cdr (aref handles idx))))
305 (when (= (cdr (aref handles idx)) 0)
306 (let ((target (car (aref handles idx))))
307 (if (not (listp target))
308 (eshell-close-target target (= exit-code 0))
309 (while target
310 (eshell-close-target (car target) (= exit-code 0))
311 (setq target (cdr target)))))
312 (setcar (aref handles idx) nil))))
313 (setq idx (1+ idx)))
314 nil))
315
316(defun eshell-kill-append (string)
317 "Call `kill-append' with STRING, if it is indeed a string."
318 (if (stringp string)
319 (kill-append string nil)))
320
321(defun eshell-clipboard-append (string)
322 "Call `kill-append' with STRING, if it is indeed a string."
323 (if (stringp string)
324 (let ((x-select-enable-clipboard t))
325 (kill-append string nil))))
326
327(defun eshell-get-target (target &optional mode)
328 "Convert TARGET, which is a raw argument, into a valid output target.
329MODE is either `overwrite', `append' or `insert'."
330 (setq mode (or mode 'insert))
331 (cond
332 ((stringp target)
333 (let ((redir (assoc target eshell-virtual-targets)))
334 (if redir
335 (if (nth 2 redir)
336 (funcall (nth 1 redir) mode)
337 (nth 1 redir))
338 (let* ((exists (get-file-buffer target))
339 (buf (find-file-noselect target t)))
340 (with-current-buffer buf
341 (if buffer-read-only
342 (error "Cannot write to read-only file `%s'" target))
343 (set (make-local-variable 'eshell-output-file-buffer)
344 (if (eq exists buf) 0 t))
345 (cond ((eq mode 'overwrite)
346 (erase-buffer))
347 ((eq mode 'append)
348 (goto-char (point-max))))
349 (point-marker))))))
350 ((or (bufferp target)
351 (and (boundp 'eshell-buffer-shorthand)
352 (symbol-value 'eshell-buffer-shorthand)
353 (symbolp target)))
354 (let ((buf (if (bufferp target)
355 target
356 (get-buffer-create
357 (symbol-name target)))))
358 (with-current-buffer buf
359 (cond ((eq mode 'overwrite)
360 (erase-buffer))
361 ((eq mode 'append)
362 (goto-char (point-max))))
363 (point-marker))))
364 ((functionp target)
365 nil)
366 ((symbolp target)
367 (if (eq mode 'overwrite)
368 (set target nil))
369 target)
370 ((or (processp target)
371 (markerp target))
372 target)
373 (t
374 (error "Illegal redirection target: %s"
375 (eshell-stringify target)))))
376
377(eval-when-compile
378 (defvar grep-null-device))
379
380(defun eshell-set-output-handle (index mode &optional target)
381 "Set handle INDEX, using MODE, to point to TARGET."
382 (when target
383 (if (and (stringp target)
384 (or (cond
385 ((boundp 'null-device)
386 (string= target null-device))
387 ((boundp 'grep-null-device)
388 (string= target grep-null-device))
389 (t nil))
390 (string= target "/dev/null")))
391 (aset eshell-current-handles index nil)
392 (let ((where (eshell-get-target target mode))
393 (current (car (aref eshell-current-handles index))))
394 (if (and (listp current)
395 (not (member where current)))
396 (setq current (append current (list where)))
397 (setq current (list where)))
398 (if (not (aref eshell-current-handles index))
399 (aset eshell-current-handles index (cons nil 1)))
400 (setcar (aref eshell-current-handles index) current)))))
401
402(defun eshell-interactive-output-p ()
403 "Return non-nil if current handles are bound for interactive display."
404 (and (eq (car (aref eshell-current-handles
405 eshell-output-handle)) t)
406 (eq (car (aref eshell-current-handles
407 eshell-error-handle)) t)))
408
409(defvar eshell-print-queue nil)
410(defvar eshell-print-queue-count -1)
411
412(defun eshell-flush (&optional reset-p)
413 "Flush out any lines that have been queued for printing.
414Must be called before printing begins with -1 as its argument, and
415after all printing is over with no argument."
416 (ignore
417 (if reset-p
418 (setq eshell-print-queue nil
419 eshell-print-queue-count reset-p)
420 (if eshell-print-queue
421 (eshell-print eshell-print-queue))
422 (eshell-flush 0))))
423
424(defun eshell-init-print-buffer ()
425 "Initialize the buffered printing queue."
426 (eshell-flush -1))
427
428(defun eshell-buffered-print (&rest strings)
429 "A buffered print -- *for strings only*."
430 (if (< eshell-print-queue-count 0)
431 (progn
432 (eshell-print (apply 'concat strings))
433 (setq eshell-print-queue-count 0))
434 (if (= eshell-print-queue-count eshell-print-queue-size)
435 (eshell-flush))
436 (setq eshell-print-queue
437 (concat eshell-print-queue (apply 'concat strings))
438 eshell-print-queue-count (1+ eshell-print-queue-count))))
439
440(defsubst eshell-print (object)
441 "Output OBJECT to the error handle."
442 (eshell-output-object object eshell-output-handle))
443
444(defsubst eshell-error (object)
445 "Output OBJECT to the error handle."
446 (eshell-output-object object eshell-error-handle))
447
448(defsubst eshell-errorn (object)
449 "Output OBJECT to the error handle."
450 (eshell-error object)
451 (eshell-error "\n"))
452
453(defsubst eshell-printn (object)
454 "Output OBJECT to the error handle."
455 (eshell-print object)
456 (eshell-print "\n"))
457
458(defun eshell-output-object-to-target (object target)
459 "Insert OBJECT into TARGET.
460Returns what was actually sent, or nil if nothing was sent."
461 (cond
462 ((functionp target)
463 (funcall target object))
464
465 ((symbolp target)
466 (if (eq target t) ; means "print to display"
467 (eshell-output-filter nil (eshell-stringify object))
468 (if (not (symbol-value target))
469 (set target object)
470 (setq object (eshell-stringify object))
471 (if (not (stringp (symbol-value target)))
472 (set target (eshell-stringify
473 (symbol-value target))))
474 (set target (concat (symbol-value target) object)))))
475
476 ((markerp target)
477 (if (buffer-live-p (marker-buffer target))
478 (with-current-buffer (marker-buffer target)
479 (let ((moving (= (point) target)))
480 (save-excursion
481 (goto-char target)
482 (setq object (eshell-stringify object))
483 (insert-and-inherit object)
484 (set-marker target (point-marker)))
485 (if moving
486 (goto-char target))))))
487
488 ((processp target)
489 (when (eq (process-status target) 'run)
490 (setq object (eshell-stringify object))
491 (process-send-string target object)))
492
493 ((consp target)
494 (apply (car target) object (cdr target))))
495 object)
496
497(defun eshell-output-object (object &optional handle-index handles)
498 "Insert OBJECT, using HANDLE-INDEX specifically)."
499 (let ((target (car (aref (or handles eshell-current-handles)
500 (or handle-index eshell-output-handle)))))
501 (if (and target (not (listp target)))
502 (eshell-output-object-to-target object target)
503 (while target
504 (eshell-output-object-to-target object (car target))
505 (setq target (cdr target))))))
506
507;;; Code:
508
509;;; esh-io.el ends here
diff --git a/lisp/eshell/esh-maint.el b/lisp/eshell/esh-maint.el
new file mode 100644
index 00000000000..7c6f33f3e62
--- /dev/null
+++ b/lisp/eshell/esh-maint.el
@@ -0,0 +1,142 @@
1;;; esh-maint --- init code for building eshell
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22;;; Commentary:
23
24;;; Code:
25
26(provide 'esh-maint)
27
28(and (fboundp 'font-lock-add-keywords)
29 (font-lock-add-keywords
30 'emacs-lisp-mode
31 '(("(eshell-for\\>" . font-lock-keyword-face)
32 ("(eshell-deftest\\>" . font-lock-keyword-face)
33 ("(eshell-condition-case\\>" . font-lock-keyword-face))))
34
35(if (file-directory-p "../pcomplete")
36 (add-to-list 'load-path "../pcomplete"))
37
38(if (locate-library "pcomplete")
39 (require 'pcomplete))
40
41(eval-when-compile
42 (require 'cl)
43 (setq cl-optimize-speed 9))
44
45;; (defun eshell-generate-autoloads ()
46;; (interactive)
47;; (require 'autoload)
48;; (setq generated-autoload-file
49;; (expand-file-name (car command-line-args-left)))
50;; (setq command-line-args-left (cdr command-line-args-left))
51;; (batch-update-autoloads))
52
53(require 'eshell)
54(require 'esh-mode) ; brings in eshell-util
55(require 'esh-opt)
56(require 'esh-test)
57
58;; (defun eshell-generate-main-menu ()
59;; "Create the main menu for the eshell documentation."
60;; (insert "@menu
61;; * The Emacs shell:: eshell.
62
63;; Core Functionality\n")
64;; (eshell-for module
65;; (sort (eshell-subgroups 'eshell)
66;; (function
67;; (lambda (a b)
68;; (string-lessp (symbol-name a)
69;; (symbol-name b)))))
70;; (insert (format "* %-34s"
71;; (concat (get module 'custom-tag) "::"))
72;; (symbol-name module) ".\n"))
73;; (insert "\nOptional Functionality\n")
74;; (eshell-for module
75;; (sort (eshell-subgroups 'eshell-module)
76;; (function
77;; (lambda (a b)
78;; (string-lessp (symbol-name a)
79;; (symbol-name b)))))
80;; (insert (format "* %-34s"
81;; (concat (get module 'custom-tag) "::"))
82;; (symbol-name module) ".\n"))
83;; (insert "@end menu\n"))
84
85;; (defun eshell-make-texi ()
86;; "Make the eshell.texi file."
87;; (interactive)
88;; (require 'eshell-auto)
89;; (require 'texidoc)
90;; (require 'pcomplete)
91;; (apply 'texidoc-files 'eshell-generate-main-menu "eshell.doci"
92;; (append
93;; (list "eshell.el")
94;; (sort (mapcar
95;; (function
96;; (lambda (sym)
97;; (let ((name (symbol-name sym)))
98;; (if (string-match "\\`eshell-\\(.*\\)" name)
99;; (setq name (concat "esh-" (match-string 1 name))))
100;; (concat name ".el"))))
101;; (eshell-subgroups 'eshell))
102;; 'string-lessp)
103;; (sort (mapcar
104;; (function
105;; (lambda (sym)
106;; (let ((name (symbol-name sym)))
107;; (if (string-match "\\`eshell-\\(.*\\)" name)
108;; (setq name (concat "em-" (match-string 1 name))))
109;; (concat name ".el"))))
110;; (eshell-subgroups 'eshell-module))
111;; 'string-lessp)
112;; (list "eshell.texi"))))
113
114;; (defun eshell-make-readme ()
115;; "Make the README file from eshell.el."
116;; (interactive)
117;; (require 'eshell-auto)
118;; (require 'texidoc)
119;; (require 'pcomplete)
120;; (texidoc-files nil "eshell.doci" "eshell.el" "README.texi")
121;; (set-buffer (get-buffer "README.texi"))
122;; (goto-char (point-min))
123;; (search-forward "@chapter")
124;; (beginning-of-line)
125;; (forward-line -1)
126;; (kill-line 2)
127;; (re-search-forward "^@section User Options")
128;; (beginning-of-line)
129;; (delete-region (point) (point-max))
130;; (insert "@bye\n")
131;; (save-buffer)
132;; (with-temp-buffer
133;; (call-process "makeinfo" nil t nil "--no-headers" "README.texi")
134;; (goto-char (point-min))
135;; (search-forward "The Emacs Shell")
136;; (beginning-of-line)
137;; (delete-region (point-min) (point))
138;; (write-file "README"))
139;; (delete-file "README.texi")
140;; (kill-buffer "README.texi"))
141
142;;; esh-maint.el ends here
diff --git a/lisp/eshell/esh-module.el b/lisp/eshell/esh-module.el
new file mode 100644
index 00000000000..7de8aecbd73
--- /dev/null
+++ b/lisp/eshell/esh-module.el
@@ -0,0 +1,139 @@
1;;; esh-module --- Eshell modules
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'esh-module)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-module nil
27 "The `eshell-module' group is for Eshell extension modules, which
28provide optional behavior which the user can enable or disable by
29customizing the variable `eshell-modules-list'."
30 :tag "Extension modules"
31 :group 'eshell)
32
33;;; Commentary:
34
35(require 'esh-util)
36
37(defun eshell-load-defgroups (&optional directory)
38 "Load `defgroup' statements from Eshell's module files."
39 (with-current-buffer
40 (find-file-noselect (expand-file-name "esh-groups.el" directory))
41 (erase-buffer)
42 (insert ";;; do not modify this file; it is auto-generated\n\n")
43 (let ((files (directory-files (or directory
44 (car command-line-args-left))
45 nil "\\`em-.*\\.el\\'")))
46 (while files
47 (message "Loading defgroup from `%s'" (car files))
48 (let (defgroup)
49 (catch 'handled
50 (with-current-buffer (find-file-noselect (car files))
51 (goto-char (point-min))
52 (while t
53 (forward-sexp)
54 (if (eobp) (throw 'handled t))
55 (backward-sexp)
56 (let ((begin (point))
57 (defg (looking-at "(defgroup")))
58 (forward-sexp)
59 (if defg
60 (setq defgroup (buffer-substring begin (point))))))))
61 (if defgroup
62 (insert defgroup "\n\n")))
63 (setq files (cdr files))))
64 (save-buffer)))
65
66;; load the defgroup's for the standard extension modules, so that
67;; documentation can be provided when the user customize's
68;; `eshell-modules-list'.
69(eval-when-compile
70 (when (equal (file-name-nondirectory byte-compile-current-file)
71 "esh-module.el")
72 (let* ((directory (file-name-directory byte-compile-current-file))
73 (elc-file (expand-file-name "esh-groups.elc" directory)))
74 (eshell-load-defgroups directory)
75 (if (file-exists-p elc-file) (delete-file elc-file)))))
76
77(load "esh-groups" t t)
78
79;;; User Variables:
80
81(defcustom eshell-module-unload-hook
82 '(eshell-unload-extension-modules)
83 "*A hook run when `eshell-module' is unloaded."
84 :type 'hook
85 :group 'eshell-module)
86
87(defcustom eshell-modules-list
88 '(eshell-alias
89 eshell-banner
90 eshell-basic
91 eshell-cmpl
92 eshell-dirs
93 eshell-glob
94 eshell-hist
95 eshell-ls
96 eshell-pred
97 eshell-prompt
98 eshell-script
99 eshell-term
100 eshell-unix)
101 "*A list of optional add-on modules to be loaded by Eshell.
102Changes will only take effect in future Eshell buffers."
103 :type (append
104 (list 'set ':tag "Supported modules")
105 (mapcar
106 (function
107 (lambda (modname)
108 (let ((modsym (intern modname)))
109 (list 'const
110 ':tag (format "%s -- %s" modname
111 (get modsym 'custom-tag))
112 ':link (caar (get modsym 'custom-links))
113 ':doc (concat "\n" (get modsym 'group-documentation)
114 "\n ")
115 modsym))))
116 (sort (mapcar 'symbol-name
117 (eshell-subgroups 'eshell-module))
118 'string-lessp))
119 '((repeat :inline t :tag "Other modules" symbol)))
120 :group 'eshell-module)
121
122;;; Code:
123
124(defsubst eshell-using-module (module)
125 "Return non-nil if a certain Eshell MODULE is in use.
126The MODULE should be a symbol corresponding to that module's
127customization group. Example: `eshell-cmpl' for that module."
128 (memq module eshell-modules-list))
129
130(defun eshell-unload-extension-modules ()
131 "Unload any memory resident extension modules."
132 (eshell-for module (eshell-subgroups 'eshell-module)
133 (if (featurep module)
134 (ignore-errors
135 (message "Unloading %s..." (symbol-name module))
136 (unload-feature module)
137 (message "Unloading %s...done" (symbol-name module))))))
138
139;;; esh-module.el ends here
diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el
new file mode 100644
index 00000000000..9665bc8cc72
--- /dev/null
+++ b/lisp/eshell/esh-opt.el
@@ -0,0 +1,226 @@
1;;; esh-opt --- command options processing
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'esh-opt)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-opt nil
27 "The options processing code handles command argument parsing for
28Eshell commands implemented in Lisp."
29 :tag "Command options processing"
30 :group 'eshell)
31
32;;; Commentary:
33
34;;; User Functions:
35
36(defmacro eshell-eval-using-options (name macro-args
37 options &rest body-forms)
38 "Process NAME's MACRO-ARGS using a set of command line OPTIONS.
39After doing so, settings will be stored in local symbols as declared
40by OPTIONS; FORMS will then be evaluated -- assuming all was OK.
41
42The syntax of OPTIONS is:
43
44 '((?C nil nil multi-column \"multi-column display\")
45 (nil \"help\" nil nil \"show this usage display\")
46 (?r \"reverse\" nil reverse-list \"reverse order while sorting\")
47 :external \"ls\"
48 :usage \"[OPTION]... [FILE]...
49 List information about the FILEs (the current directory by default).
50 Sort entries alphabetically across.\")
51
52`eshell-eval-using-options' returns the value of the last form in
53BODY-FORMS. If instead an external command is run, the tag
54`eshell-external' will be thrown with the new process for its value.
55
56Lastly, any remaining arguments will be available in a locally
57interned variable `args' (created using a `let' form)."
58 `(let ((temp-args
59 ,(if (memq ':preserve-args (cadr options))
60 macro-args
61 (list 'eshell-stringify-list
62 (list 'eshell-flatten-list macro-args)))))
63 (let ,(append (mapcar (function
64 (lambda (opt)
65 (or (and (listp opt) (nth 3 opt))
66 'eshell-option-stub)))
67 (cadr options))
68 '(usage-msg last-value ext-command args))
69 (eshell-do-opt ,name ,options (quote ,body-forms)))))
70
71;;; Internal Functions:
72
73(eval-when-compile
74 (defvar temp-args)
75 (defvar last-value)
76 (defvar usage-msg)
77 (defvar ext-command)
78 (defvar args))
79
80(defun eshell-do-opt (name options body-forms)
81 "Helper function for `eshell-eval-using-options'.
82This code doesn't really need to be macro expanded everywhere."
83 (setq args temp-args)
84 (if (setq
85 ext-command
86 (catch 'eshell-ext-command
87 (when (setq
88 usage-msg
89 (catch 'eshell-usage
90 (setq last-value nil)
91 (if (and (= (length args) 0)
92 (memq ':show-usage options))
93 (throw 'eshell-usage
94 (eshell-show-usage name options)))
95 (setq args (eshell-process-args name args options)
96 last-value (eval (append (list 'progn)
97 body-forms)))
98 nil))
99 (error usage-msg))))
100 (throw 'eshell-external
101 (eshell-external-command ext-command args))
102 last-value))
103
104(defun eshell-show-usage (name options)
105 "Display the usage message for NAME, using OPTIONS."
106 (let ((usage (format "usage: %s %s\n\n" name
107 (cadr (memq ':usage options))))
108 (extcmd (memq ':external options))
109 (post-usage (memq ':post-usage options))
110 had-option)
111 (while options
112 (when (listp (car options))
113 (let ((opt (car options)))
114 (setq had-option t)
115 (cond ((and (nth 0 opt)
116 (nth 1 opt))
117 (setq usage
118 (concat usage
119 (format " %-20s %s\n"
120 (format "-%c, --%s" (nth 0 opt)
121 (nth 1 opt))
122 (nth 4 opt)))))
123 ((nth 0 opt)
124 (setq usage
125 (concat usage
126 (format " %-20s %s\n"
127 (format "-%c" (nth 0 opt))
128 (nth 4 opt)))))
129 ((nth 1 opt)
130 (setq usage
131 (concat usage
132 (format " %-20s %s\n"
133 (format " --%s" (nth 1 opt))
134 (nth 4 opt)))))
135 (t (setq had-option nil)))))
136 (setq options (cdr options)))
137 (if post-usage
138 (setq usage (concat usage (and had-option "\n")
139 (cadr post-usage))))
140 (when extcmd
141 (setq extcmd (eshell-search-path (cadr extcmd)))
142 (if extcmd
143 (setq usage
144 (concat usage
145 (format "
146This command is implemented in Lisp. If an unrecognized option is
147passed to this command, the external version '%s'
148will be called instead." extcmd)))))
149 (throw 'eshell-usage usage)))
150
151(defun eshell-set-option (name ai opt options)
152 "Using NAME's remaining args (index AI), set the OPT within OPTIONS.
153If the option consumes an argument for its value, the argument list
154will be modified."
155 (if (not (nth 3 opt))
156 (eshell-show-usage name options)
157 (if (eq (nth 2 opt) t)
158 (if (> ai (length args))
159 (error "%s: missing option argument" name)
160 (set (nth 3 opt) (nth ai args))
161 (if (> ai 0)
162 (setcdr (nthcdr (1- ai) args) (nthcdr (1+ ai) args))
163 (setq args (cdr args))))
164 (set (nth 3 opt) (or (nth 2 opt) t)))))
165
166(defun eshell-process-option (name switch kind ai options)
167 "For NAME, process SWITCH (of type KIND), from args at index AI.
168The SWITCH will be looked up in the set of OPTIONS.
169
170SWITCH should be either a string or character. KIND should be the
171integer 0 if it's a character, or 1 if it's a string.
172
173The SWITCH is then be matched against OPTIONS. If no matching handler
174is found, and an :external command is defined (and available), it will
175be called; otherwise, an error will be triggered to say that the
176switch is unrecognized."
177 (let* ((opts options)
178 found)
179 (while opts
180 (if (and (listp (car opts))
181 (nth kind (car opts))
182 (if (= kind 0)
183 (eq switch (nth kind (car opts)))
184 (string= switch (nth kind (car opts)))))
185 (progn
186 (eshell-set-option name ai (car opts) options)
187 (setq found t opts nil))
188 (setq opts (cdr opts))))
189 (unless found
190 (let ((extcmd (memq ':external options)))
191 (when extcmd
192 (setq extcmd (eshell-search-path (cadr extcmd)))
193 (if extcmd
194 (throw 'eshell-ext-command extcmd)
195 (if (char-valid-p switch)
196 (error "%s: unrecognized option -%c" name switch)
197 (error "%s: unrecognized option --%s" name switch))))))))
198
199(defun eshell-process-args (name args options)
200 "Process the given ARGS using OPTIONS.
201This assumes that symbols have been intern'd by `eshell-with-options'."
202 (let ((ai 0) arg)
203 (while (< ai (length args))
204 (setq arg (nth ai args))
205 (if (not (and (stringp arg)
206 (string-match "^-\\(-\\)?\\(.*\\)" arg)))
207 (setq ai (1+ ai))
208 (let* ((dash (match-string 1 arg))
209 (switch (match-string 2 arg)))
210 (if (= ai 0)
211 (setq args (cdr args))
212 (setcdr (nthcdr (1- ai) args) (nthcdr (1+ ai) args)))
213 (if dash
214 (if (> (length switch) 0)
215 (eshell-process-option name switch 1 ai options)
216 (setq ai (length args)))
217 (let ((len (length switch))
218 (index 0))
219 (while (< index len)
220 (eshell-process-option name (aref switch index) 0 ai options)
221 (setq index (1+ index)))))))))
222 args)
223
224;;; Code:
225
226;;; esh-opt.el ends here
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
new file mode 100644
index 00000000000..767d96b10f4
--- /dev/null
+++ b/lisp/eshell/esh-proc.el
@@ -0,0 +1,447 @@
1;;; esh-proc --- process management
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'esh-proc)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-proc nil
27 "When Eshell invokes external commands, it always does so
28asynchronously, so that Emacs isn't tied up waiting for the process to
29finish."
30 :tag "Process management"
31 :group 'eshell)
32
33;;; Commentary:
34
35;;; User Variables:
36
37(defcustom eshell-proc-load-hook '(eshell-proc-initialize)
38 "*A hook that gets run when `eshell-proc' is loaded."
39 :type 'hook
40 :group 'eshell-proc)
41
42(defcustom eshell-process-wait-seconds 0
43 "*The number of seconds to delay waiting for a synchronous process."
44 :type 'integer
45 :group 'eshell-proc)
46
47(defcustom eshell-process-wait-milliseconds 50
48 "*The number of milliseconds to delay waiting for a synchronous process."
49 :type 'integer
50 :group 'eshell-proc)
51
52(defcustom eshell-done-messages-in-minibuffer t
53 "*If non-nil, subjob \"Done\" messages will display in minibuffer."
54 :type 'boolean
55 :group 'eshell-proc)
56
57(defcustom eshell-delete-exited-processes t
58 "*If nil, process entries will stick around until `jobs' is run.
59This variable sets the buffer-local value of `delete-exited-processes'
60in Eshell buffers.
61
62This variable causes Eshell to mimic the behavior of bash when set to
63nil. It allows the user to view the exit status of a completed subjob
64\(process) at their leisure, because the process entry remains in
65memory until the user examines it using \\[list-processes].
66
67Otherwise, if `eshell-done-messages-in-minibuffer' is nil, and this
68variable is set to t, the only indication the user will have that a
69subjob is done is that it will no longer appear in the
70\\[list-processes\\] display.
71
72Note that Eshell will have to be restarted for a change in this
73variable's value to take effect."
74 :type 'boolean
75 :group 'eshell-proc)
76
77(defcustom eshell-reset-signals
78 "^\\(interrupt\\|killed\\|quit\\|stopped\\)"
79 "*If a termination signal matches this regexp, the terminal will be reset."
80 :type 'regexp
81 :group 'eshell-proc)
82
83(defcustom eshell-exec-hook nil
84 "*Called each time a process is exec'd by `eshell-gather-process-output'.
85It is passed one argument, which is the process that was just started.
86It is useful for things that must be done each time a process is
87executed in a eshell mode buffer (e.g., `process-kill-without-query').
88In contrast, `eshell-mode-hook' is only executed once when the buffer
89is created."
90 :type 'hook
91 :group 'eshell-proc)
92
93(defcustom eshell-kill-hook '(eshell-reset-after-proc)
94 "*Called when a process run by `eshell-gather-process-output' has ended.
95It is passed two arguments: the process that was just ended, and the
96termination status (as a string). Note that the first argument may be
97nil, in which case the user attempted to send a signal, but there was
98no relevant process. This can be used for displaying help
99information, for example."
100 :type 'hook
101 :group 'eshell-proc)
102
103;;; Internal Variables:
104
105(defvar eshell-current-subjob-p nil)
106
107(defvar eshell-process-list nil
108 "A list of the current status of subprocesses.")
109
110;;; Functions:
111
112(defun eshell-proc-initialize ()
113 "Initialize the process handling code."
114 (make-local-variable 'eshell-process-list)
115 (define-key eshell-command-map [(meta ?i)] 'eshell-insert-process)
116 (define-key eshell-command-map [(control ?c)] 'eshell-interrupt-process)
117 (define-key eshell-command-map [(control ?k)] 'eshell-kill-process)
118 (define-key eshell-command-map [(control ?d)] 'eshell-send-eof-to-process)
119 (define-key eshell-command-map [(control ?q)] 'eshell-continue-process)
120 (define-key eshell-command-map [(control ?s)] 'list-processes)
121 (define-key eshell-command-map [(control ?z)] 'eshell-stop-process)
122 (define-key eshell-command-map [(control ?\\)] 'eshell-quit-process))
123
124(defun eshell-reset-after-proc (proc status)
125 "Reset the command input location after a process terminates.
126The signals which will cause this to happen are matched by
127`eshell-reset-signals'."
128 (if (string-match eshell-reset-signals status)
129 (eshell-reset)))
130
131(defun eshell-wait-for-process (&rest procs)
132 "Wait until PROC has successfully completed."
133 (while procs
134 (let ((proc (car procs)))
135 (when (processp proc)
136 ;; NYI: If the process gets stopped here, that's bad.
137 (while (assq proc eshell-process-list)
138 (if (input-pending-p)
139 (discard-input))
140 (sit-for eshell-process-wait-seconds
141 eshell-process-wait-milliseconds))))
142 (setq procs (cdr procs))))
143
144(defalias 'eshell/wait 'eshell-wait-for-process)
145
146(defun eshell/jobs (&rest args)
147 "List processes, if there are any."
148 (and (process-list)
149 (list-processes)))
150
151(defun eshell/kill (&rest args)
152 "Kill processes, buffers, symbol or files."
153 (let ((ptr args)
154 (signum 'SIGINT))
155 (while ptr
156 (if (or (processp (car ptr))
157 (and (stringp (car ptr))
158 (string-match "^[A-Za-z/][A-Za-z0-9<>/]+$"
159 (car ptr))))
160 ;; What about when $lisp-variable is possible here?
161 ;; It could very well name a process.
162 (setcar ptr (get-process (car ptr))))
163 (setq ptr (cdr ptr)))
164 (while args
165 (let ((id (if (processp (car args))
166 (process-id (car args))
167 (car args))))
168 (when id
169 (cond
170 ((null id)
171 (error "kill: bad signal spec"))
172 ((and (numberp id) (= id 0))
173 (error "kill: bad signal spec `%d'" id))
174 ((and (stringp id)
175 (string-match "^-?[0-9]+$" id))
176 (setq signum (abs (string-to-number id))))
177 ((stringp id)
178 (let (case-fold-search)
179 (if (string-match "^-\\([A-Z]+\\)$" id)
180 (setq signum
181 (intern (concat "SIG" (match-string 1 id))))
182 (error "kill: bad signal spec `%s'" id))))
183 ((< id 0)
184 (setq signum (abs id)))
185 (t
186 (signal-process id signum)))))
187 (setq args (cdr args)))
188 nil))
189
190(defun eshell-read-process-name (prompt)
191 "Read the name of a process from the minibuffer, using completion.
192The prompt will be set to PROMPT."
193 (completing-read prompt
194 (mapcar
195 (function
196 (lambda (proc)
197 (cons (process-name proc) t)))
198 (process-list)) nil t))
199
200(defun eshell-insert-process (process)
201 "Insert the name of PROCESS into the current buffer at point."
202 (interactive
203 (list (get-process
204 (eshell-read-process-name "Name of process: "))))
205 (insert-and-inherit "#<process " (process-name process) ">"))
206
207(defsubst eshell-record-process-object (object)
208 "Record OBJECT as now running."
209 (if (and (processp object)
210 eshell-current-subjob-p)
211 (eshell-interactive-print
212 (format "[%s] %d\n" (process-name object) (process-id object))))
213 (setq eshell-process-list
214 (cons (list object eshell-current-handles
215 eshell-current-subjob-p nil nil)
216 eshell-process-list)))
217
218(defun eshell-remove-process-entry (entry)
219 "Record the process ENTRY as fully completed."
220 (if (and (processp (car entry))
221 (nth 2 entry)
222 eshell-done-messages-in-minibuffer)
223 (message (format "[%s]+ Done %s" (process-name (car entry))
224 (process-command (car entry)))))
225 (setq eshell-process-list
226 (delq entry eshell-process-list)))
227
228(defun eshell-gather-process-output (command args)
229 "Gather the output from COMMAND + ARGS."
230 (unless (and (file-executable-p command)
231 (file-regular-p command))
232 (error "%s: not an executable file" command))
233 (let* ((delete-exited-processes
234 (if eshell-current-subjob-p
235 eshell-delete-exited-processes
236 delete-exited-processes))
237 (process-environment (eshell-environment-variables))
238 (proc (apply 'start-process
239 (file-name-nondirectory command) nil
240 ;; `start-process' can't deal with relative
241 ;; filenames
242 (append (list (expand-file-name command)) args)))
243 decoding encoding changed)
244 (eshell-record-process-object proc)
245 (set-process-buffer proc (current-buffer))
246 (if (eshell-interactive-output-p)
247 (set-process-filter proc 'eshell-output-filter)
248 (set-process-filter proc 'eshell-insertion-filter))
249 (set-process-sentinel proc 'eshell-sentinel)
250 (run-hook-with-args 'eshell-exec-hook proc)
251 (when (fboundp 'process-coding-system)
252 (let ((coding-systems (process-coding-system proc)))
253 (setq decoding (car coding-systems)
254 encoding (cdr coding-systems)))
255 ;; If start-process decided to use some coding system for
256 ;; decoding data sent from the process and the coding system
257 ;; doesn't specify EOL conversion, we had better convert CRLF
258 ;; to LF.
259 (if (vectorp (coding-system-eol-type decoding))
260 (setq decoding (coding-system-change-eol-conversion decoding 'dos)
261 changed t))
262 ;; Even if start-process left the coding system for encoding
263 ;; data sent from the process undecided, we had better use the
264 ;; same one as what we use for decoding. But, we should
265 ;; suppress EOL conversion.
266 (if (and decoding (not encoding))
267 (setq encoding (coding-system-change-eol-conversion decoding 'unix)
268 changed t))
269 (if changed
270 (set-process-coding-system proc decoding encoding)))
271 proc))
272
273(defun eshell-insertion-filter (proc string)
274 "Insert a string into the eshell buffer, or a process/file/buffer.
275PROC is the process for which we're inserting output. STRING is the
276output."
277 (when (buffer-live-p (process-buffer proc))
278 (set-buffer (process-buffer proc))
279 (let ((entry (assq proc eshell-process-list)))
280 (when entry
281 (setcar (nthcdr 3 entry)
282 (concat (nth 3 entry) string))
283 (unless (nth 4 entry) ; already being handled?
284 (while (nth 3 entry)
285 (let ((data (nth 3 entry)))
286 (setcar (nthcdr 3 entry) nil)
287 (setcar (nthcdr 4 entry) t)
288 (eshell-output-object data nil (cadr entry))
289 (setcar (nthcdr 4 entry) nil))))))))
290
291(defun eshell-sentinel (proc string)
292 "Generic sentinel for command processes. Reports only signals.
293PROC is the process that's exiting. STRING is the exit message."
294 (when (buffer-live-p (process-buffer proc))
295 (set-buffer (process-buffer proc))
296 (unwind-protect
297 (let* ((entry (assq proc eshell-process-list)))
298; (if (not entry)
299; (error "Sentinel called for unowned process `%s'"
300; (process-name proc))
301 (when entry
302 (unwind-protect
303 (progn
304 (unless (string= string "run")
305 (unless (string-match "^\\(finished\\|exited\\)" string)
306 (eshell-insertion-filter proc string))
307 (eshell-close-handles (process-exit-status proc) 'nil
308 (cadr entry))))
309 (eshell-remove-process-entry entry))))
310 (run-hook-with-args 'eshell-kill-hook proc string))))
311
312(defun eshell-process-interact (func &optional all query)
313 "Interact with a process, using PROMPT if more than one, via FUNC.
314If ALL is non-nil, background processes will be interacted with as well.
315If QUERY is non-nil, query the user with QUERY before calling FUNC."
316 (let (defunct result)
317 (eshell-for entry eshell-process-list
318 (if (and (memq (process-status (car entry))
319 '(run stop open closed))
320 (or all
321 (not (nth 2 entry)))
322 (or (not query)
323 (y-or-n-p (format query (process-name (car entry))))))
324 (setq result (funcall func (car entry))))
325 (unless (memq (process-status (car entry))
326 '(run stop open closed))
327 (setq defunct (cons entry defunct))))
328 ;; clean up the process list; this can get dirty if an error
329 ;; occurred that brought the user into the debugger, and then they
330 ;; quit, so that the sentinel was never called.
331 (eshell-for d defunct
332 (eshell-remove-process-entry d))
333 result))
334
335(defcustom eshell-kill-process-wait-time 5
336 "*Seconds to wait between sending termination signals to a subprocess."
337 :type 'integer
338 :group 'eshell-proc)
339
340(defcustom eshell-kill-process-signals '(SIGINT SIGQUIT SIGKILL)
341 "*Signals used to kill processes when an Eshell buffer exits.
342Eshell calls each of these signals in order when an Eshell buffer is
343killed; if the process is still alive afterwards, Eshell waits a
344number of seconds defined by `eshell-kill-process-wait-time', and
345tries the next signal in the list."
346 :type '(repeat symbol)
347 :group 'eshell-proc)
348
349(defcustom eshell-kill-processes-on-exit nil
350 "*If non-nil, kill active processes when exiting an Eshell buffer.
351Emacs will only kill processes owned by that Eshell buffer.
352
353If nil, ownership of background and foreground processes reverts to
354Emacs itself, and will die only if the user exits Emacs, calls
355`kill-process', or terminates the processes externally.
356
357If `ask', Emacs prompts the user before killing any processes.
358
359If `every', it prompts once for every process.
360
361If t, it kills all buffer-owned processes without asking.
362
363Processes are first sent SIGHUP, then SIGINT, then SIGQUIT, then
364SIGKILL. The variable `eshell-kill-process-wait-time' specifies how
365long to delay between signals."
366 :type '(choice (const :tag "Kill all, don't ask" t)
367 (const :tag "Ask before killing" ask)
368 (const :tag "Ask for each process" every)
369 (const :tag "Don't kill subprocesses" nil))
370 :group 'eshell-proc)
371
372(defun eshell-round-robin-kill (&optional query)
373 "Kill current process by trying various signals in sequence.
374See the variable `eshell-kill-processes-on-exit'."
375 (let ((sigs eshell-kill-process-signals))
376 (while sigs
377 (eshell-process-interact
378 (function
379 (lambda (proc)
380 (signal-process (process-id proc) (car sigs)))) t query)
381 (setq query nil)
382 (if (not eshell-process-list)
383 (setq sigs nil)
384 (sleep-for eshell-kill-process-wait-time)
385 (setq sigs (cdr sigs))))))
386
387(defun eshell-query-kill-processes ()
388 "Kill processes belonging to the current Eshell buffer, possibly w/ query."
389 (when (and eshell-kill-processes-on-exit
390 eshell-process-list)
391 (save-window-excursion
392 (list-processes)
393 (if (or (not (eq eshell-kill-processes-on-exit 'ask))
394 (y-or-n-p (format "Kill processes owned by `%s'? "
395 (buffer-name))))
396 (eshell-round-robin-kill
397 (if (eq eshell-kill-processes-on-exit 'every)
398 "Kill Eshell child process `%s'? ")))
399 (let ((buf (get-buffer "*Process List*")))
400 (if (and buf (buffer-live-p buf))
401 (kill-buffer buf)))
402 (message nil))))
403
404(custom-add-option 'eshell-exit-hook 'eshell-query-kill-processes)
405
406(defun eshell-interrupt-process ()
407 "Interrupt a process."
408 (interactive)
409 (unless (eshell-process-interact 'interrupt-process)
410 (run-hook-with-args 'eshell-kill-hook nil "interrupt")))
411
412(defun eshell-kill-process ()
413 "Kill a process."
414 (interactive)
415 (unless (eshell-process-interact 'kill-process)
416 (run-hook-with-args 'eshell-kill-hook nil "killed")))
417
418(defun eshell-quit-process ()
419 "Send quit signal to process."
420 (interactive)
421 (unless (eshell-process-interact 'quit-process)
422 (run-hook-with-args 'eshell-kill-hook nil "quit")))
423
424(defun eshell-stop-process ()
425 "Send STOP signal to process."
426 (interactive)
427 (unless (eshell-process-interact 'stop-process)
428 (run-hook-with-args 'eshell-kill-hook nil "stopped")))
429
430(defun eshell-continue-process ()
431 "Send CONTINUE signal to process."
432 (interactive)
433 (unless (eshell-process-interact 'continue-process)
434 ;; jww (1999-09-17): this signal is not dealt with yet. For
435 ;; example, `eshell-reset' will be called, and so will
436 ;; `eshell-resume-eval'.
437 (run-hook-with-args 'eshell-kill-hook nil "continue")))
438
439(defun eshell-send-eof-to-process ()
440 "Send EOF to process."
441 (interactive)
442 (eshell-send-input nil nil t)
443 (eshell-process-interact 'process-send-eof))
444
445;;; Code:
446
447;;; esh-proc.el ends here
diff --git a/lisp/eshell/esh-test.el b/lisp/eshell/esh-test.el
new file mode 100644
index 00000000000..64a3a00aae7
--- /dev/null
+++ b/lisp/eshell/esh-test.el
@@ -0,0 +1,242 @@
1;;; esh-test --- Eshell test suite
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'esh-test)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-test nil
27 "This module is meant to ensure that Eshell is working correctly."
28 :tag "Eshell test suite"
29 :group 'eshell)
30
31;;; Commentary:
32
33;; The purpose of this module is to verify that Eshell works as
34;; expected. To run it on your system, use the command
35;; \\[eshell-test].
36
37;;; Code:
38
39(require 'esh-mode)
40
41;;; User Variables:
42
43(defface eshell-test-ok-face
44 '((((class color) (background light)) (:foreground "Green" :bold t))
45 (((class color) (background dark)) (:foreground "Green" :bold t)))
46 "*The face used to highlight OK result strings."
47 :group 'eshell-test)
48
49(defface eshell-test-failed-face
50 '((((class color) (background light)) (:foreground "OrangeRed" :bold t))
51 (((class color) (background dark)) (:foreground "OrangeRed" :bold t))
52 (t (:bold t)))
53 "*The face used to highlight FAILED result strings."
54 :group 'eshell-test)
55
56(defcustom eshell-show-usage-metrics nil
57 "*If non-nil, display different usage metrics for each Eshell command."
58 :set (lambda (symbol value)
59 (if value
60 (add-hook 'eshell-mode-hook 'eshell-show-usage-metrics)
61 (remove-hook 'eshell-mode-hook 'eshell-show-usage-metrics))
62 (set symbol value))
63 :type '(choice (const :tag "No metrics" nil)
64 (const :tag "Cons cells consumed" t)
65 (const :tag "Time elapsed" 0))
66 :group 'eshell-test)
67
68;;; Code:
69
70(eval-when-compile
71 (defvar test-buffer))
72
73(defun eshell-insert-command (text &optional func)
74 "Insert a command at the end of the buffer."
75 (goto-char eshell-last-output-end)
76 (insert-and-inherit text)
77 (funcall (or func 'eshell-send-input)))
78
79(defun eshell-match-result (regexp)
80 "Insert a command at the end of the buffer."
81 (goto-char eshell-last-input-end)
82 (looking-at regexp))
83
84(defun eshell-command-result-p (text regexp &optional func)
85 "Insert a command at the end of the buffer."
86 (eshell-insert-command text func)
87 (eshell-match-result regexp))
88
89(defvar eshell-test-failures nil)
90
91(defun eshell-run-test (module funcsym label command)
92 "Test whether FORM evaluates to a non-nil value."
93 (when (let ((sym (intern-soft (concat "eshell-" (symbol-name module)))))
94 (or (memq sym (eshell-subgroups 'eshell))
95 (eshell-using-module sym)))
96 (with-current-buffer test-buffer
97 (insert-before-markers
98 (format "%-70s " (substring label 0 (min 70 (length label)))))
99 (insert-before-markers " ....")
100 (eshell-redisplay))
101 (let ((truth (eval command)))
102 (with-current-buffer test-buffer
103 (delete-backward-char 6)
104 (insert-before-markers
105 "[" (let (str)
106 (if truth
107 (progn
108 (setq str " OK ")
109 (put-text-property 0 6 'face
110 'eshell-test-ok-face str))
111 (setq str "FAILED")
112 (setq eshell-test-failures (1+ eshell-test-failures))
113 (put-text-property 0 6 'face
114 'eshell-test-failed-face str))
115 str) "]")
116 (add-text-properties (line-beginning-position) (point)
117 (list 'test-func funcsym))
118 (eshell-redisplay)))))
119
120(defun eshell-test-goto-func ()
121 "Jump to the function that defines a particular test."
122 (interactive)
123 (let ((fsym (get-text-property (point) 'test-func)))
124 (when fsym
125 (let* ((def (symbol-function fsym))
126 (library (locate-library (symbol-file fsym)))
127 (name (substring (symbol-name fsym)
128 (length "eshell-test--")))
129 (inhibit-redisplay t))
130 (find-file library)
131 (goto-char (point-min))
132 (re-search-forward (concat "^(eshell-deftest\\s-+\\w+\\s-+"
133 name))
134 (beginning-of-line)))))
135
136(defun eshell-run-one-test (&optional arg)
137 "Jump to the function that defines a particular test."
138 (interactive "P")
139 (let ((fsym (get-text-property (point) 'test-func)))
140 (when fsym
141 (beginning-of-line)
142 (delete-region (point) (line-end-position))
143 (let ((test-buffer (current-buffer)))
144 (set-buffer (let ((inhibit-redisplay t))
145 (save-window-excursion (eshell t))))
146 (funcall fsym)
147 (unless arg
148 (kill-buffer (current-buffer)))))))
149
150;;;###autoload
151(defun eshell-test (&optional arg)
152 "Test Eshell to verify that it works as expected."
153 (interactive "P")
154 (let* ((begin (eshell-time-to-seconds (current-time)))
155 (test-buffer (get-buffer-create "*eshell test*")))
156 (set-buffer (let ((inhibit-redisplay t))
157 (save-window-excursion (eshell t))))
158 (with-current-buffer test-buffer
159 (erase-buffer)
160 (setq major-mode 'eshell-test-mode)
161 (setq mode-name "EShell Test")
162 (set (make-local-variable 'eshell-test-failures) 0)
163 (local-set-key [(control ?c) (control ?c)] 'eshell-test-goto-func)
164 (local-set-key [(control ?c) (control ?r)] 'eshell-run-one-test)
165 (local-set-key [(control ?m)] 'eshell-test-goto-func)
166 (local-set-key [return] 'eshell-test-goto-func)
167
168 (insert "Testing Eshell under "
169 (format "GNU Emacs %s (%s%s)"
170 emacs-version
171 system-configuration
172 (cond ((featurep 'motif) ", Motif")
173 ((featurep 'x-toolkit) ", X toolkit")
174 (t ""))) "\n")
175 (switch-to-buffer test-buffer)
176 (delete-other-windows))
177 (eshell-for funcname
178 (sort (all-completions "eshell-test--" obarray 'functionp)
179 'string-lessp)
180 (with-current-buffer test-buffer
181 (insert "\n"))
182 (funcall (intern-soft funcname)))
183 (with-current-buffer test-buffer
184 (insert (format "\n\n--- %s --- (completed in %d seconds)\n"
185 (current-time-string)
186 (- (eshell-time-to-seconds (current-time))
187 begin)))
188 (message "Eshell test suite completed: %s failure%s"
189 (if (> eshell-test-failures 0)
190 (number-to-string eshell-test-failures)
191 "No")
192 (if (= eshell-test-failures 1) "" "s"))))
193 (goto-char eshell-last-output-end)
194 (unless arg
195 (kill-buffer (current-buffer))))
196
197
198(defvar eshell-metric-before-command 0)
199(defvar eshell-metric-after-command 0)
200
201(defun eshell-show-usage-metrics ()
202 "If run at Eshell mode startup, metrics are shown after each command."
203 (set (make-local-variable 'eshell-metric-before-command)
204 (if (eq eshell-show-usage-metrics t)
205 0
206 (current-time)))
207 (set (make-local-variable 'eshell-metric-after-command)
208 (if (eq eshell-show-usage-metrics t)
209 0
210 (current-time)))
211
212 (make-local-hook 'eshell-pre-command-hook)
213 (add-hook 'eshell-pre-command-hook
214 (function
215 (lambda ()
216 (setq eshell-metric-before-command
217 (if (eq eshell-show-usage-metrics t)
218 (car (memory-use-counts))
219 (current-time))))) nil t)
220
221 (make-local-hook 'eshell-post-command-hook)
222 (add-hook 'eshell-post-command-hook
223 (function
224 (lambda ()
225 (setq eshell-metric-after-command
226 (if (eq eshell-show-usage-metrics t)
227 (car (memory-use-counts))
228 (current-time)))
229 (eshell-interactive-print
230 (concat
231 (int-to-string
232 (if (eq eshell-show-usage-metrics t)
233 (- eshell-metric-after-command
234 eshell-metric-before-command 7)
235 (- (eshell-time-to-seconds
236 eshell-metric-after-command)
237 (eshell-time-to-seconds
238 eshell-metric-before-command))))
239 "\n"))))
240 nil t))
241
242;;; esh-test.el ends here
diff --git a/lisp/eshell/esh-toggle.el b/lisp/eshell/esh-toggle.el
new file mode 100644
index 00000000000..5027b6dc153
--- /dev/null
+++ b/lisp/eshell/esh-toggle.el
@@ -0,0 +1,179 @@
1;;; esh-toggle --- toggle to and from the *eshell* buffer
2
3;; Copyright (C) 1997, 1998 Mikael Sjödin (mic@docs.uu.se)
4
5;; Author: Mikael Sjödin <mic@docs.uu.se>
6;; John Wiegley <johnw@gnu.org>
7;; Created: 19 Nov 1998
8;; Version: 2.0
9;; Keywords: processes
10;; X-URL: http://www.emacs.org/~johnw/eshell.html
11
12;; This program is free software; you can redistribute it and/or
13;; modify it under the terms of the GNU General Public License as
14;; published by the Free Software Foundation; either version 2, or (at
15;; your option) any later version.
16
17;; This program is distributed in the hope that it will be useful, but
18;; WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20;; 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 the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28
29;; Provides the command eshell-toggle which toggles between the
30;; *eshell* buffer and whatever buffer you are editing.
31;;
32;; This is done in an "intelligent" way. Features are:
33;;
34;; - Starts a eshell if non is existing.
35;;
36;; - Minimum distortion of your window configuration.
37;;
38;; - When done in the eshell-buffer you are returned to the same
39;; window configuration you had before you toggled to the eshell.
40;;
41;; - If you desire, you automagically get a "cd" command in the
42;; eshell to the directory where your current buffers file exists;
43;; just call eshell-toggle-cd instead of eshell-toggle.
44;;
45;; - You can convinently choose if you want to have the eshell in
46;; another window or in the whole frame. Just invoke eshell-toggle
47;; again to get the eshell in the whole frame.
48;;
49;; This file has been tested under Emacs 20.2.
50;;
51;; To use, call the functions `eshell-toggle' or `eshell-toggle-cd'.
52;; It's most helpful to bind these to a key.
53
54;;; Thanks to:
55
56;; Christian Stern <Christian.Stern@physik.uni-regensburg.de> for
57;; helpful sugestions.
58
59;;; User Variables:
60
61(defvar eshell-toggle-goto-eob t
62 "*If non-nil `eshell-toggle' moves point to end of Eshell buffer.
63When `eshell-toggle-cd' is called the point is always moved to the
64end of the eshell-buffer")
65
66(defvar eshell-toggle-automatic-cd t
67 "*If non-nil `eshell-toggle-cd' will send a \"cd\" to Eshell.
68If nil `eshell-toggle-cd' will only insert the \"cd\" command in the
69eshell-buffer. Leaving it to the user to press RET to send the
70command to the eshell.")
71
72;;; User Functions:
73
74;;;###autoload
75(defun eshell-toggle-cd ()
76 "Calls `eshell-toggle' with a prefix argument.
77See the command `eshell-toggle'"
78 (interactive)
79 (eshell-toggle t))
80
81;;;###autoload
82(defun eshell-toggle (make-cd)
83 "Toggles between the *eshell* buffer and the current buffer.
84With a prefix ARG also insert a \"cd DIR\" command into the eshell,
85where DIR is the directory of the current buffer.
86
87Call twice in a row to get a full screen window for the *eshell*
88buffer.
89
90When called in the *eshell* buffer returns you to the buffer you were
91editing before caling the first time.
92
93Options: `eshell-toggle-goto-eob'"
94 (interactive "P")
95 ;; Try to descide on one of three possibilities:
96 ;; 1. If not in eshell-buffer, switch to it.
97 ;; 2. If in eshell-buffer and called twice in a row, delete other
98 ;; windows
99 ;; 3. If in eshell-buffer and not called twice in a row, return to
100 ;; state before going to the eshell-buffer
101 (if (eq major-mode 'eshell-mode)
102 (if (and (or (eq last-command 'eshell-toggle)
103 (eq last-command 'eshell-toggle-cd))
104 (not (eq (count-windows) 1)))
105 (delete-other-windows)
106 (eshell-toggle-buffer-return-from-eshell))
107 (eshell-toggle-buffer-goto-eshell make-cd)))
108
109;;; Internal Functions:
110
111(defvar eshell-toggle-pre-eshell-win-conf nil
112 "Contains window config before the *eshell* buffer was selected")
113
114(defun eshell-toggle-buffer-return-from-eshell ()
115 "Restores window config used before switching the *eshell* buffer.
116If no configuration has been stored, just bury the *eshell* buffer."
117 (if (window-configuration-p eshell-toggle-pre-eshell-win-conf)
118 (progn
119 (set-window-configuration eshell-toggle-pre-eshell-win-conf)
120 (setq eshell-toggle-pre-eshell-win-conf nil)
121 (bury-buffer (get-buffer "*eshell*")))
122 (bury-buffer)))
123
124(defun eshell-toggle-buffer-goto-eshell (make-cd)
125 "Switches other window to the *eshell* buffer.
126If no *eshell* buffer exists start a new eshell and switch to it in
127other window. If argument MAKE-CD is non-nil, insert a \"cd DIR\"
128command into the eshell, where DIR is the directory of the current
129buffer.
130Stores the window cofiguration before creating and/or switching window."
131 (setq eshell-toggle-pre-eshell-win-conf (current-window-configuration))
132 (let ((eshell-buffer (get-buffer "*eshell*"))
133 (cd-command
134 ;; Find out which directory we are in (the method differs for
135 ;; different buffers)
136 (or (and make-cd
137 (buffer-file-name)
138 (file-name-directory (buffer-file-name))
139 (concat "cd " (file-name-directory (buffer-file-name))))
140 (and make-cd
141 list-buffers-directory
142 (concat "cd " list-buffers-directory)))))
143 ;; Switch to an existin eshell if one exists, otherwise switch to
144 ;; another window and start a new eshell
145 (if eshell-buffer
146 (switch-to-buffer-other-window eshell-buffer)
147 (eshell-toggle-buffer-switch-to-other-window)
148 ;; Sometimes an error is generated when I call `eshell' (it has
149 ;; to do with my eshell-mode-hook which inserts text into the
150 ;; newly created eshell-buffer and thats not allways a good
151 ;; idea).
152 (condition-case the-error
153 (eshell)
154 (error (switch-to-buffer "*eshell*"))))
155 (if (or cd-command eshell-toggle-goto-eob)
156 (goto-char (point-max)))
157 (if cd-command
158 (progn
159 (insert cd-command)
160 (if eshell-toggle-automatic-cd
161 (eshell-send-input))))))
162
163(defun eshell-toggle-buffer-switch-to-other-window ()
164 "Switches to other window.
165If the current window is the only window in the current frame, create
166a new window and switch to it. (This is less intrusive to the current
167window configuration then `switch-buffer-other-window')"
168 (let ((this-window (selected-window)))
169 (other-window 1)
170 ;; If we did not switch window then we only have one window and
171 ;; need to create a new one.
172 (if (eq this-window (selected-window))
173 (progn
174 (split-window-vertically)
175 (other-window 1)))))
176
177(provide 'esh-toggle)
178
179;;; esh-toggle.el ends here
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
new file mode 100644
index 00000000000..5c74a19c428
--- /dev/null
+++ b/lisp/eshell/esh-var.el
@@ -0,0 +1,635 @@
1;;; esh-var --- handling of variables
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation; either version 2, or (at your option)
10;; any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs; see the file COPYING. If not, write to the
19;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20;; Boston, MA 02111-1307, USA.
21
22(provide 'esh-var)
23
24(eval-when-compile (require 'esh-maint))
25
26(defgroup eshell-var nil
27 "Variable interpolation is introduced whenever the '$' character
28appears unquoted in any argument (except when that argument is
29surrounded by single quotes) . It may be used to interpolate a
30variable value, a subcommand, or even the result of a Lisp form."
31 :tag "Variable handling"
32 :group 'eshell)
33
34;;; Commentary:
35
36;; These are the possible variable interpolation syntaxes. Also keep
37;; in mind that if an argument looks like a number, it will be
38;; converted to a number. This is not significant when invoking
39;; external commands, but it's important when calling Lisp functions.
40;;
41;; $VARIABLE
42;;
43;; Interval the value of an environment variable, or a Lisp variable
44;;
45;; $ALSO-VAR
46;;
47;; "-" is a legal part of a variable name.
48;;
49;; $<MYVAR>-TOO
50;;
51;; Only "MYVAR" is part of the variable name in this case.
52;;
53;; $#VARIABLE
54;;
55;; Returns the length of the value of VARIABLE. This could also be
56;; done using the `length' Lisp function.
57;;
58;; $(lisp)
59;;
60;; Returns result of lisp evaluation. Note: Used alone like this, it
61;; is identical to just saying (lisp); but with the variable expansion
62;; form, the result may be interpolated a larger string, such as
63;; '$(lisp)/other'.
64;;
65;; ${command}
66;;
67;; Returns the value of an eshell subcommand. See the note above
68;; regarding Lisp evaluations.
69;;
70;; $ANYVAR[10]
71;;
72;; Return the 10th element of ANYVAR. If ANYVAR's value is a string,
73;; it will be split in order to make it a list. The splitting will
74;; occur at whitespace.
75;;
76;; $ANYVAR[: 10]
77;;
78;; As above, except that splitting occurs at the colon now.
79;;
80;; $ANYVAR[: 10 20]
81;;
82;; As above, but instead of returning just a string, it now returns a
83;; list of two strings. If the result is being interpolated into a
84;; larger string, this list will be flattened into one big string,
85;; with each element separated by a space.
86;;
87;; $ANYVAR["\\\\" 10]
88;;
89;; Separate on backslash characters. Actually, the first argument --
90;; if it doesn't have the form of a number, or a plain variable name
91;; -- can be any regular expression. So to split on numbers, use
92;; '$ANYVAR["[0-9]+" 10 20]'.
93;;
94;; $ANYVAR[hello]
95;;
96;; Calls `assoc' on ANYVAR with 'hello', expecting it to be an alist.
97;;
98;; $#ANYVAR[hello]
99;;
100;; Returns the length of the cdr of the element of ANYVAR who car is
101;; equal to "hello".
102;;
103;; There are also a few special variables defined by Eshell. '$$' is
104;; the value of the last command (t or nil, in the case of an external
105;; command). This makes it possible to chain results:
106;;
107;; /tmp $ echo /var/spool/mail/johnw
108;; /var/spool/mail/johnw
109;; /tmp $ dirname $$
110;; /var/spool/mail/
111;; /tmp $ cd $$
112;; /var/spool/mail $
113;;
114;; '$_' refers to the last argument of the last command. And $?
115;; contains the exit code of the last command (0 or 1 for Lisp
116;; functions, based on successful completion).
117
118(require 'env)
119(require 'ring)
120
121;;; User Variables:
122
123(defcustom eshell-var-load-hook '(eshell-var-initialize)
124 "*A list of functions to call when loading `eshell-var'."
125 :type 'hook
126 :group 'eshell-var)
127
128(defcustom eshell-prefer-lisp-variables nil
129 "*If non-nil, prefer Lisp variables to environment variables."
130 :type 'boolean
131 :group 'eshell-var)
132
133(defcustom eshell-complete-export-definition t
134 "*If non-nil, completing names for `export' shows current definition."
135 :type 'boolean
136 :group 'eshell-var)
137
138(defcustom eshell-variable-name-regexp "[A-Za-z0-9_-]+"
139 "*A regexp identifying what constitutes a variable name reference.
140Note that this only applies for '$NAME'. If the syntax '$<NAME>' is
141used, then NAME can contain any character, including angle brackets,
142if they are quoted with a backslash."
143 :type 'regexp
144 :group 'eshell-var)
145
146(defcustom eshell-variable-aliases-list
147 '(;; for eshell.el
148 ("COLUMNS" (lambda (indices) (window-width)) t)
149 ("LINES" (lambda (indices) (window-height)) t)
150
151 ;; for eshell-cmd.el
152 ("_" (lambda (indices)
153 (if (not indices)
154 (car (last eshell-last-arguments))
155 (eshell-apply-indices eshell-last-arguments
156 indices))))
157 ("?" eshell-last-command-status)
158 ("$" eshell-last-command-result)
159 ("0" eshell-command-name)
160 ("1" (lambda (indices) (nth 0 eshell-command-arguments)))
161 ("2" (lambda (indices) (nth 1 eshell-command-arguments)))
162 ("3" (lambda (indices) (nth 2 eshell-command-arguments)))
163 ("4" (lambda (indices) (nth 3 eshell-command-arguments)))
164 ("5" (lambda (indices) (nth 4 eshell-command-arguments)))
165 ("6" (lambda (indices) (nth 5 eshell-command-arguments)))
166 ("7" (lambda (indices) (nth 6 eshell-command-arguments)))
167 ("8" (lambda (indices) (nth 7 eshell-command-arguments)))
168 ("9" (lambda (indices) (nth 8 eshell-command-arguments)))
169 ("*" (lambda (indices)
170 (if (not indices)
171 eshell-command-arguments
172 (eshell-apply-indices eshell-command-arguments
173 indices)))))
174 "*This list provides aliasing for variable references.
175It is very similar in concept to what `eshell-user-aliases-list' does
176for commands. Each member of this defines defines the name of a
177command, and the Lisp value to return for that variable if it is
178accessed via the syntax '$NAME'.
179
180If the value is a function, that function will be called with two
181arguments: the list of the indices that was used in the reference, and
182whether the user is requesting the length of the ultimate element.
183For example, a reference of '$NAME[10][20]' would result in the
184function for alias `NAME' being called (assuming it were aliased to a
185function), and the arguments passed to this function would be the list
186'(10 20)', and nil."
187 :type '(repeat (list string sexp
188 (choice (const :tag "Copy to environment" t)
189 (const :tag "Use only in Eshell" nil))))
190 :group 'eshell-var)
191
192(put 'eshell-variable-aliases-list 'risky-local-variable t)
193
194;;; Functions:
195
196(defun eshell-var-initialize ()
197 "Initialize the variable handle code."
198 ;; Break the association with our parent's environment. Otherwise,
199 ;; changing a variable will affect all of Emacs.
200 (set (make-local-variable 'process-environment) (eshell-copy-environment))
201
202 (define-key eshell-command-map [(meta ?v)] 'eshell-insert-envvar)
203
204 (set (make-local-variable 'eshell-special-chars-inside-quoting)
205 (append eshell-special-chars-inside-quoting '(?$)))
206 (set (make-local-variable 'eshell-special-chars-outside-quoting)
207 (append eshell-special-chars-outside-quoting '(?$)))
208
209 (make-local-hook 'eshell-parse-argument-hook)
210 (add-hook 'eshell-parse-argument-hook 'eshell-interpolate-variable t t)
211
212 (make-local-hook 'eshell-prepare-command-hook)
213 (add-hook 'eshell-prepare-command-hook
214 'eshell-handle-local-variables nil t)
215
216 (when (eshell-using-module 'eshell-cmpl)
217 (make-local-hook 'pcomplete-try-first-hook)
218 (add-hook 'pcomplete-try-first-hook
219 'eshell-complete-variable-reference nil t)
220 (add-hook 'pcomplete-try-first-hook
221 'eshell-complete-variable-assignment nil t)))
222
223(defun eshell-handle-local-variables ()
224 "Allow for the syntax 'VAR=val <command> <args>'."
225 ;; strip off any null commands, which can only happen if a variable
226 ;; evaluates to nil, such as "$var x", where `var' is nil. The
227 ;; command name in that case becomes `x', for compatibility with
228 ;; most regular shells (the difference is that they do an
229 ;; interpolation pass before the argument parsing pass, but Eshell
230 ;; does both at the same time).
231 (while (and (not eshell-last-command-name)
232 eshell-last-arguments)
233 (setq eshell-last-command-name (car eshell-last-arguments)
234 eshell-last-arguments (cdr eshell-last-arguments)))
235 (let ((setvar "\\`\\([A-Za-z_][A-Za-z0-9_]*\\)=\\(.*\\)\\'")
236 (command (eshell-stringify eshell-last-command-name))
237 (args eshell-last-arguments))
238 ;; local variable settings (such as 'CFLAGS=-O2 make') are handled
239 ;; by making the whole command into a subcommand, and calling
240 ;; setenv immediately before the command is invoked. This means
241 ;; that 'BLAH=x cd blah' won't work exactly as expected, but that
242 ;; is by no means a typical use of local environment variables.
243 (if (and command (string-match setvar command))
244 (throw
245 'eshell-replace-command
246 (list
247 'eshell-as-subcommand
248 (append
249 (list 'progn)
250 (let ((l (list t)))
251 (while (string-match setvar command)
252 (nconc
253 l (list
254 (list 'setenv (match-string 1 command)
255 (match-string 2 command)
256 (= (length (match-string 2 command)) 0))))
257 (setq command (eshell-stringify (car args))
258 args (cdr args)))
259 (cdr l))
260 (list (list 'eshell-named-command
261 command (list 'quote args)))))))))
262
263(defun eshell-interpolate-variable ()
264 "Parse a variable interpolation.
265This function is explicit for adding to `eshell-parse-argument-hook'."
266 (when (and (eq (char-after) ?$)
267 (not (= (1+ (point)) (point-max))))
268 (forward-char)
269 (list 'eshell-escape-arg
270 (eshell-parse-variable))))
271
272(defun eshell/define (var-alias definition)
273 "Define an VAR-ALIAS using DEFINITION."
274 (if (not definition)
275 (setq eshell-variable-aliases-list
276 (delq (assoc var-alias eshell-variable-aliases-list)
277 eshell-variable-aliases-list))
278 (let ((def (assoc var-alias eshell-variable-aliases-list))
279 (alias-def
280 (list var-alias
281 (list 'quote (if (= (length definition) 1)
282 (car definition)
283 definition)))))
284 (if def
285 (setq eshell-variable-aliases-list
286 (delq (assoc var-alias eshell-variable-aliases-list)
287 eshell-variable-aliases-list)))
288 (setq eshell-variable-aliases-list
289 (cons alias-def
290 eshell-variable-aliases-list))))
291 nil)
292
293(defun eshell/export (&rest sets)
294 "This alias allows the 'export' command to act as bash users expect."
295 (while sets
296 (if (string-match "^\\([^=]+\\)=\\(.*\\)" (car sets))
297 (setenv (match-string 1 (car sets))
298 (match-string 2 (car sets))))
299 (setq sets (cdr sets))))
300
301(defun pcomplete/eshell-mode/export ()
302 "Completion function for Eshell's `export'."
303 (while (pcomplete-here
304 (if eshell-complete-export-definition
305 process-environment
306 (eshell-envvar-names)))))
307
308(defun eshell/setq (&rest args)
309 "Allow command-ish use of `setq'."
310 (let (last-value)
311 (while args
312 (let ((sym (intern (car args)))
313 (val (cadr args)))
314 (setq last-value (set sym val)
315 args (cddr args))))
316 last-value))
317
318(defun pcomplete/eshell-mode/setq ()
319 "Completion function for Eshell's `setq'."
320 (while (and (pcomplete-here (all-completions pcomplete-stub
321 obarray 'boundp))
322 (pcomplete-here))))
323
324(defun eshell/env (&rest args)
325 "Implemention of `env' in Lisp."
326 (eshell-init-print-buffer)
327 (eshell-eval-using-options
328 "env" args
329 '((?h "help" nil nil "show this usage screen")
330 :external "env"
331 :usage "<no arguments>")
332 (eshell-for setting (sort (eshell-environment-variables)
333 'string-lessp)
334 (eshell-buffered-print setting "\n"))
335 (eshell-flush)))
336
337(defun eshell-insert-envvar (envvar-name)
338 "Insert ENVVAR-NAME into the current buffer at point."
339 (interactive
340 (list (read-envvar-name "Name of environment variable: " t)))
341 (insert-and-inherit "$" envvar-name))
342
343(defun eshell-envvar-names (&optional environment)
344 "Return a list of currently visible environment variable names."
345 (mapcar (function
346 (lambda (x)
347 (substring x 0 (string-match "=" x))))
348 (or environment process-environment)))
349
350(defun eshell-environment-variables ()
351 "Return a `process-environment', fully updated.
352This involves setting any variable aliases which affect the
353environment, as specified in `eshell-variable-aliases-list'."
354 (let ((process-environment (eshell-copy-environment)))
355 (eshell-for var-alias eshell-variable-aliases-list
356 (if (nth 2 var-alias)
357 (setenv (car var-alias)
358 (eshell-stringify
359 (or (eshell-get-variable (car var-alias)) "")))))
360 process-environment))
361
362(defun eshell-parse-variable ()
363 "Parse the next variable reference at point.
364The variable name could refer to either an environment variable, or a
365Lisp variable. The priority order depends on the setting of
366`eshell-prefer-lisp-variables'.
367
368Its purpose is to call `eshell-parse-variable-ref', and then to
369process any indices that come after the variable reference."
370 (let* ((get-len (when (eq (char-after) ?#)
371 (forward-char) t))
372 value indices)
373 (setq value (eshell-parse-variable-ref)
374 indices (and (not (eobp))
375 (eq (char-after) ?\[)
376 (eshell-parse-indices))
377 value (list 'let
378 (list (list 'indices
379 (list 'quote indices)))
380 value))
381 (if get-len
382 (list 'length value)
383 value)))
384
385(defun eshell-parse-variable-ref ()
386 "Eval a variable reference.
387Returns a Lisp form which, if evaluated, will return the value of the
388variable.
389
390Possible options are:
391
392 NAME an environment or Lisp variable value
393 <LONG-NAME> disambiguates the length of the name
394 {COMMAND} result of command is variable's value
395 (LISP-FORM) result of Lisp form is variable's value"
396 (let (end)
397 (cond
398 ((eq (char-after) ?{)
399 (let ((end (eshell-find-delimiter ?\{ ?\})))
400 (if (not end)
401 (throw 'eshell-incomplete ?\{)
402 (prog1
403 (list 'eshell-convert
404 (list 'eshell-command-to-value
405 (list 'eshell-as-subcommand
406 (eshell-parse-command
407 (cons (1+ (point)) end)))))
408 (goto-char (1+ end))))))
409 ((memq (char-after) '(?\' ?\"))
410 (let ((name (if (eq (char-after) ?\')
411 (eshell-parse-literal-quote)
412 (eshell-parse-double-quote))))
413 (if name
414 (list 'eshell-get-variable (eval name) 'indices))))
415 ((eq (char-after) ?<)
416 (let ((end (eshell-find-delimiter ?\< ?\>)))
417 (if (not end)
418 (throw 'eshell-incomplete ?\<)
419 (let* ((temp (make-temp-name temporary-file-directory))
420 (cmd (concat (buffer-substring (1+ (point)) end)
421 " > " temp)))
422 (prog1
423 (list
424 'let (list (list 'eshell-current-handles
425 (list 'eshell-create-handles temp
426 (list 'quote 'overwrite))))
427 (list
428 'progn
429 (list 'eshell-as-subcommand
430 (eshell-parse-command cmd))
431 (list 'ignore
432 (list 'nconc 'eshell-this-command-hook
433 (list 'list
434 (list 'function
435 (list 'lambda nil
436 (list 'delete-file temp))))))
437 (list 'quote temp)))
438 (goto-char (1+ end)))))))
439 ((eq (char-after) ?\()
440 (condition-case err
441 (list 'eshell-command-to-value
442 (list 'eshell-lisp-command
443 (list 'quote (read (current-buffer)))))
444 (end-of-file
445 (throw 'eshell-incomplete ?\())))
446 ((assoc (char-to-string (char-after))
447 eshell-variable-aliases-list)
448 (forward-char)
449 (list 'eshell-get-variable
450 (char-to-string (char-before)) 'indices))
451 ((looking-at eshell-variable-name-regexp)
452 (prog1
453 (list 'eshell-get-variable (match-string 0) 'indices)
454 (goto-char (match-end 0))))
455 (t
456 (error "Invalid variable reference")))))
457
458(eshell-deftest var interp-cmd
459 "Interpolate command result"
460 (eshell-command-result-p "+ ${+ 1 2} 3" "6\n"))
461
462(eshell-deftest var interp-lisp
463 "Interpolate Lisp form evalution"
464 (eshell-command-result-p "+ $(+ 1 2) 3" "6\n"))
465
466(eshell-deftest var interp-concat
467 "Interpolate and concat command"
468 (eshell-command-result-p "+ ${+ 1 2}3 3" "36\n"))
469
470(eshell-deftest var interp-concat-lisp
471 "Interpolate and concat Lisp form"
472 (eshell-command-result-p "+ $(+ 1 2)3 3" "36\n"))
473
474(eshell-deftest var interp-concat2
475 "Interpolate and concat two commands"
476 (eshell-command-result-p "+ ${+ 1 2}${+ 1 2} 3" "36\n"))
477
478(eshell-deftest var interp-concat-lisp2
479 "Interpolate and concat two Lisp forms"
480 (eshell-command-result-p "+ $(+ 1 2)$(+ 1 2) 3" "36\n"))
481
482(defun eshell-parse-indices ()
483 "Parse and return a list of list of indices."
484 (let (indices)
485 (while (eq (char-after) ?\[)
486 (let ((end (eshell-find-delimiter ?\[ ?\])))
487 (if (not end)
488 (throw 'eshell-incomplete ?\[)
489 (forward-char)
490 (let (eshell-glob-function)
491 (setq indices (cons (eshell-parse-arguments (point) end)
492 indices)))
493 (goto-char (1+ end)))))
494 (nreverse indices)))
495
496(defun eshell-get-variable (name &optional indices)
497 "Get the value for the variable NAME."
498 (let* ((alias (assoc name eshell-variable-aliases-list))
499 (var (if alias
500 (cadr alias)
501 name)))
502 (if (and alias (functionp var))
503 (funcall var indices)
504 (eshell-apply-indices
505 (cond
506 ((stringp var)
507 (let ((sym (intern-soft var)))
508 (if (and sym (boundp sym)
509 (or eshell-prefer-lisp-variables
510 (not (getenv var))))
511 (symbol-value sym)
512 (getenv var))))
513 ((symbolp var)
514 (symbol-value var))
515 (t
516 (error "Unknown variable `%s'" (eshell-stringify var))))
517 indices))))
518
519(defun eshell-apply-indices (value indices)
520 "Apply to VALUE all of the given INDICES, returning the sub-result.
521The format of INDICES is:
522
523 ((INT-OR-NAME-OR-OTHER INT-OR-NAME INT-OR-NAME ...)
524 ...)
525
526Each member of INDICES represents a level of nesting. If the first
527member of a sublist is not an integer or name, and the value it's
528reference is a string, that will be used as the regexp with which is
529to divide the string into sub-parts. The default is whitespace.
530Otherwise, each INT-OR-NAME refers to an element of the list value.
531Integers imply a direct index, and names, an associate lookup using
532`assoc'.
533
534For example, to retrieve the second element of a user's record in
535'/etc/passwd', the variable reference would look like:
536
537 ${egrep johnw /etc/passwd}[: 2]"
538 (while indices
539 (let ((refs (car indices)))
540 (when (stringp value)
541 (let (separator)
542 (if (not (or (not (stringp (caar indices)))
543 (string-match
544 (concat "^" eshell-variable-name-regexp "$")
545 (caar indices))))
546 (setq separator (caar indices)
547 refs (cdr refs)))
548 (setq value
549 (mapcar 'eshell-convert
550 (split-string value separator)))))
551 (cond
552 ((< (length refs) 0)
553 (error "Illegal array variable index: %s"
554 (eshell-stringify refs)))
555 ((= (length refs) 1)
556 (setq value (eshell-index-value value (car refs))))
557 (t
558 (let ((new-value (list t)))
559 (while refs
560 (nconc new-value
561 (list (eshell-index-value value
562 (car refs))))
563 (setq refs (cdr refs)))
564 (setq value (cdr new-value))))))
565 (setq indices (cdr indices)))
566 value)
567
568(defun eshell-index-value (value index)
569 "Reference VALUE using the given INDEX."
570 (if (stringp index)
571 (cdr (assoc index value))
572 (cond
573 ((ring-p value)
574 (if (> index (ring-length value))
575 (error "Index exceeds length of ring")
576 (ring-ref value index)))
577 ((listp value)
578 (if (> index (length value))
579 (error "Index exceeds length of list")
580 (nth index value)))
581 ((vectorp value)
582 (if (> index (length value))
583 (error "Index exceeds length of vector")
584 (aref value index)))
585 (t
586 (error "Invalid data type for indexing")))))
587
588;;;_* Variable name completion
589
590(defun eshell-complete-variable-reference ()
591 "If there is a variable reference, complete it."
592 (let ((arg (pcomplete-actual-arg)) index)
593 (when (setq index
594 (string-match
595 (concat "\\$\\(" eshell-variable-name-regexp
596 "\\)?\\'") arg))
597 (setq pcomplete-stub (substring arg (1+ index)))
598 (throw 'pcomplete-completions (eshell-variables-list)))))
599
600(defun eshell-variables-list ()
601 "Generate list of applicable variables."
602 (let ((argname pcomplete-stub)
603 completions)
604 (eshell-for alias eshell-variable-aliases-list
605 (if (string-match (concat "^" argname) (car alias))
606 (setq completions (cons (car alias) completions))))
607 (sort
608 (append
609 (mapcar
610 (function
611 (lambda (varname)
612 (let ((value (eshell-get-variable varname)))
613 (if (and value
614 (stringp value)
615 (file-directory-p value))
616 (concat varname (char-to-string directory-sep-char))
617 varname))))
618 (eshell-envvar-names (eshell-environment-variables)))
619 (all-completions argname obarray 'boundp)
620 completions)
621 'string-lessp)))
622
623(defun eshell-complete-variable-assignment ()
624 "If there is a variable assignment, allow completion of entries."
625 (let ((arg (pcomplete-actual-arg)) pos)
626 (when (string-match (concat "\\`" eshell-variable-name-regexp "=") arg)
627 (setq pos (match-end 0))
628 (if (string-match "\\(:\\)[^:]*\\'" arg)
629 (setq pos (match-end 1)))
630 (setq pcomplete-stub (substring arg pos))
631 (throw 'pcomplete-completions (pcomplete-entries)))))
632
633;;; Code:
634
635;;; esh-var.el ends here
diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el
new file mode 100644
index 00000000000..9399bc5e407
--- /dev/null
+++ b/lisp/eshell/eshell.el
@@ -0,0 +1,495 @@
1;;; eshell --- the Emacs command shell
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; Author: John Wiegley <johnw@gnu.org>
6;; Keywords: processes
7;; X-URL: http://www.emacs.org/~johnw/eshell.html
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24;; Boston, MA 02111-1307, USA.
25
26(provide 'eshell)
27
28(eval-when-compile (require 'esh-maint))
29
30(defgroup eshell nil
31 "Eshell is a command shell implemented entirely in Emacs Lisp. It
32invokes no external processes beyond those requested by the user. It
33is intended to be a functional replacement for command shells such as
34bash, zsh, rc, 4dos; since Emacs itself is capable of handling most of
35the tasks accomplished by such tools."
36 :tag "The Emacs shell"
37 :link '(info-link "(eshell.info)The Emacs shell")
38 :group 'applications)
39
40;;; Commentary:
41
42;;;_* What does Eshell offer you?
43;;
44;; Despite the sheer fact that running an Emacs shell can be fun, here
45;; are a few of the unique features offered by Eshell:
46;;
47;; @ Integration with the Emacs Lisp programming environment
48;;
49;; @ A high degree of configurability
50;;
51;; @ The ability to have the same shell on every system Emacs has been
52;; ported to. Since Eshell imposes no external requirements, and
53;; relies upon only the Lisp functions exposed by Emacs, it is quite
54;; operating system independent. Several of the common UNIX
55;; commands, such as ls, mv, rm, ln, etc., have been implemented in
56;; Lisp in order to provide a more consistent work environment.
57;;
58;; For those who might be using an older version of Eshell, version
59;; 2.1 represents an entirely new, module-based architecture. It
60;; supports most of the features offered by modern shells. Here is a
61;; brief list of some of its more visible features:
62;;
63;; @ Command argument completion (tcsh, zsh)
64;; @ Input history management (bash)
65;; @ Intelligent output scrolling
66;; @ Psuedo-devices (such as "/dev/clip" for copying to the clipboard)
67;; @ Extended globbing (zsh)
68;; @ Argument and globbing predication (zsh)
69;; @ I/O redirection to buffers, files, symbols, processes, etc.
70;; @ Many niceties otherwise seen only in 4DOS
71;; @ Alias functions, both Lisp and Eshell-syntax
72;; @ Piping, sequenced commands, background jobs, etc...
73;;
74;;;_* Eshell is free software
75;;
76;; Eshell is free software; you can redistribute it and/or modify it
77;; under the terms of the GNU General Public License as published by
78;; the Free Software Foundation; either version 2, or (at your option)
79;; any later version.
80;;
81;; This program is distributed in the hope that it will be useful, but
82;; WITHOUT ANY WARRANTY; without even the implied warranty of
83;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
84;; General Public License for more details.
85;;
86;; You should have received a copy of the GNU General Public License
87;; along with Eshell; see the file COPYING. If not, write to the Free
88;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
89;; 02111-1307, USA.
90;;
91;;;_* How to begin
92;;
93;; To start using Eshell, add the following to your .emacs file:
94;;
95;; (load "eshell-auto")
96;;
97;; This will define all of the necessary autoloads.
98;;
99;; Now type `M-x eshell'. See the INSTALL file for full installation
100;; instructions.
101;;
102;;;_* Philosophy
103;;
104;; A shell is a layer which metaphorically surrounds the kernel, or
105;; heart of an operating system. This kernel can be seen as an engine
106;; of pure functionality, waiting to serve, while the user programs
107;; take advantage of that functionality to accomplish their purpose.
108;;
109;; The shell's role is to make that functionality accessible to the
110;; user in an unformed state. Very roughly, it associates kernel
111;; functionality with textual commands, allowing the user to interact
112;; with the operating system via linguistic constructs. Process
113;; invocation is perhaps the most significant form this takes, using
114;; the kernel's `fork' and `exec' functions.
115;;
116;; Other programs also interact with the functionality of the kernel,
117;; but these user applications typically offer a specific range of
118;; functionality, and thus are not classed as "shells" proper.
119;; (What they lose in quiddity, they gain in rigidity).
120;;
121;; Emacs is also a user application, but it does make the
122;; functionality of the kernel accessible through an interpreted
123;; language -- namely, Lisp. For that reason, there is little
124;; preventing Emacs from serving the same role as a modern shell. It
125;; too can manipulate the kernel in an unpredetermined way to cause
126;; system changes. All it's missing is the shell-ish linguistic
127;; model.
128;;
129;; Enter Eshell. Eshell translates "shell-like" syntax into Lisp
130;; in order to exercise the kernel in the same manner as typical
131;; system shells. There is a fundamental difference here, however,
132;; although it may seem subtle at first...
133;;
134;; Shells like csh and Bourne shell were written several decades ago,
135;; in different times, under more restrictive circumstances. This
136;; confined perspective shows itself in the paradigm used by nearly
137;; all command-line shells since. They are linear in conception, byte
138;; stream-based, sequential, and confined to movement within a single
139;; host machine.
140;;
141;; Emacs, on the other hand, is more than just a limited translator
142;; that can invoke subprocesses and redirect file handles. It also
143;; manages character buffers, windowing frames, network connections,
144;; registers, bookmarks, processes, etc. In other words, it's a very
145;; multi-dimensional environment, within which eshell emulates a highly
146;; linear methodology.
147;;
148;; Taking a moment, let's look at how this could affect the future of
149;; a shell allowed to develop in such a wider field of play:
150;;
151;; @ There is no reason why directory movement should be linear, and
152;; confined to a single file-system. Emacs, through w3 and ange-ftp,
153;; has access to the entire Web. Why not allow a user to cd to
154;; multiple directories simultaneously, for example? It might make
155;; some tasks easier, such as diff'ing files separated by very long
156;; pathnames.
157;;
158;; @ Data sources are available from anywhere Emacs can derive
159;; information from: not just from files or the output of other
160;; processes.
161;;
162;; @ Multiple shell invocations all share the same environment -- even
163;; the same process list! It would be possible to have "process
164;; views", so that one buffer is watching standard output, another
165;; standard error, and another the result of standard output grep'd
166;; through a regular expression...
167;;
168;; @ It is not necessary to "leave" the shell, losing all input and
169;; output history, environment variables, directory stack, etc.
170;; Emacs could save the contents of your eshell environment, and
171;; restore all of it (or at least as much as possible) each time you
172;; restart. This could occur automatically, without requiring
173;; complex initialization scripts.
174;;
175;; @ Typos occur all of the time; many of them are repeats of common
176;; errors, such as 'dri' for `dir'. Since executing non-existent
177;; programs is rarely the intention of the user, eshell could prompt
178;; for the replacement string, and then record that in a database of
179;; known misspellings. (Note: The typo at the beginning of this
180;; paragraph wasn't discovered until two months after I wrote the
181;; text; it was not intentional).
182;;
183;; @ Emacs' register and bookmarking facilities can be used for
184;; remembering where you've been, and what you've seen -- to varying
185;; levels of persistence. They could perhaps even be tied to
186;; specific "moments" during eshell execution, which would include
187;; the environment at that time, as well as other variables.
188;; Although this would require functionality orthogonal to Emacs'
189;; own bookmarking facilities, the interface used could be made to
190;; operate very similarly.
191;;
192;; This presents a brief idea of what the fuller dimensionality of an
193;; Emacs shell could offer. It's not just the language of a shell
194;; that determines how it's used, but also the Weltanschauung
195;; underlying its design -- and which is felt behind even the smallest
196;; feature. I would hope the freedom provided by using Emacs as a
197;; parent environment will invite rich ideas from others. It
198;; certainly feels as though all I've done so far is to tie down the
199;; horse, so to speak, so that he will run at a man's pace.
200;;
201;;;_* Influences
202;;
203;; The author of Eshell has been a long-time user of the following
204;; shells, all of which contributed to Eshell's design:
205;;
206;; @ rc
207;; @ bash
208;; @ zsh
209;; @ sh
210;; @ 4nt
211;; @ csh
212
213;;;_* User Options
214;;
215;; The following user options modify the behavior of Eshell overall.
216
217(load "esh-util" nil t)
218
219(defsubst eshell-add-to-window-buffer-names ()
220 "Add `eshell-buffer-name' to `same-window-buffer-names'."
221 (add-to-list 'same-window-buffer-names eshell-buffer-name))
222
223(defsubst eshell-remove-from-window-buffer-names ()
224 "Remove `eshell-buffer-name' from `same-window-buffer-names'."
225 (setq same-window-buffer-names
226 (delete eshell-buffer-name same-window-buffer-names)))
227
228(defcustom eshell-load-hook nil
229 "*A hook run once Eshell has been loaded."
230 :type 'hook
231 :group 'eshell)
232
233(defcustom eshell-unload-hook
234 '(eshell-remove-from-window-buffer-names
235 eshell-unload-all-modules)
236 "*A hook run when Eshell is unloaded from memory."
237 :type 'hook
238 :group 'eshell)
239
240(defcustom eshell-buffer-name "*eshell*"
241 "*The basename used for Eshell buffers."
242 :set (lambda (symbol value)
243 ;; remove the old value of `eshell-buffer-name', if present
244 (if (boundp 'eshell-buffer-name)
245 (eshell-remove-from-window-buffer-names))
246 (set symbol value)
247 ;; add the new value
248 (eshell-add-to-window-buffer-names)
249 value)
250 :type 'string
251 :group 'eshell)
252
253(eshell-deftest mode same-window-buffer-names
254 "`eshell-buffer-name' is a member of `same-window-buffer-names'"
255 (member eshell-buffer-name same-window-buffer-names))
256
257(defcustom eshell-directory-name "~/.eshell/"
258 "*The directory where Eshell control files should be kept."
259 :type 'directory
260 :group 'eshell)
261
262(eshell-deftest mode eshell-directory-exists
263 "`eshell-directory-name' exists and is writable"
264 (file-writable-p eshell-directory-name))
265
266(eshell-deftest mode eshell-directory-modes
267 "`eshell-directory-name' has correct access protections"
268 (or (eshell-under-windows-p)
269 (= (file-modes eshell-directory-name)
270 eshell-private-directory-modes)))
271
272(defcustom eshell-prefer-to-shell nil
273 "*If non-nil, \\[shell-command] will use Eshell instead of shell-mode."
274 :set (lambda (symbol value)
275 ;; modifying the global keymap directly is odious, but how
276 ;; else to achieve the takeover?
277 (if value
278 (progn
279 (define-key global-map [(meta ?!)] 'eshell-command)
280;;; (define-key global-map [(meta ?|)] 'eshell-command-on-region)
281 )
282 (define-key global-map [(meta ?!)] 'shell-command)
283;;; (define-key global-map [(meta ?|)] 'shell-command-on-region)
284 )
285 (set symbol value))
286 :type 'boolean
287 :require 'eshell
288 :group 'eshell)
289
290;;;_* Running Eshell
291;;
292;; There are only three commands used to invoke Eshell. The first two
293;; are intended for interactive use, while the third is meant for
294;; programmers. They are:
295
296;;;###autoload
297(defun eshell (&optional arg)
298 "Create an interactive Eshell buffer.
299The buffer used for Eshell sessions is determined by the value of
300`eshell-buffer-name'. If there is already an Eshell session active in
301that buffer, Emacs will simply switch to it. Otherwise, a new session
302will begin. A new session is always created if the the prefix
303argument ARG is specified. Returns the buffer selected (or created)."
304 (interactive "P")
305 (assert eshell-buffer-name)
306 (let ((buf (if arg
307 (generate-new-buffer eshell-buffer-name)
308 (get-buffer-create eshell-buffer-name))))
309 ;; Simply calling `pop-to-buffer' will not mimic the way that
310 ;; shell-mode buffers appear, since they always reuse the same
311 ;; window that that command was invoked from. To achieve this,
312 ;; it's necessary to add `eshell-buffer-name' to the variable
313 ;; `same-window-buffer-names', which is done when Eshell is loaded
314 (assert (and buf (buffer-live-p buf)))
315 (pop-to-buffer buf)
316 (unless (fboundp 'eshell-mode)
317 (error "`eshell-auto' must be loaded before Eshell can be used"))
318 (unless (eq major-mode 'eshell-mode)
319 (eshell-mode))
320 (assert (eq major-mode 'eshell-mode))
321 buf))
322
323(defun eshell-return-exits-minibuffer ()
324 (define-key eshell-mode-map [(control ?g)] 'abort-recursive-edit)
325 (define-key eshell-mode-map [return] 'exit-minibuffer)
326 (define-key eshell-mode-map [(control ?m)] 'exit-minibuffer)
327 (define-key eshell-mode-map [(control ?j)] 'exit-minibuffer)
328 (define-key eshell-mode-map [(meta return)] 'exit-minibuffer)
329 (define-key eshell-mode-map [(meta control ?m)] 'exit-minibuffer))
330
331;;;###autoload
332(defun eshell-command (&optional command arg)
333 "Execute the Eshell command string COMMAND.
334With prefix ARG, insert output into the current buffer at point."
335 (interactive)
336 (require 'esh-cmd)
337 (setq arg current-prefix-arg)
338 (unwind-protect
339 (let ((eshell-non-interactive-p t))
340 (add-hook 'minibuffer-setup-hook 'eshell-mode)
341 (add-hook 'eshell-mode-hook 'eshell-return-exits-minibuffer)
342 (setq command (read-from-minibuffer "Emacs shell command: ")))
343 (remove-hook 'eshell-mode-hook 'eshell-return-exits-minibuffer)
344 (remove-hook 'minibuffer-setup-hook 'eshell-mode))
345 (unless command
346 (error "No command specified!"))
347 ;; redirection into the current buffer is achieved by adding an
348 ;; output redirection to the end of the command, of the form
349 ;; 'COMMAND >>> #<buffer BUFFER>'. This will not interfere with
350 ;; other redirections, since multiple redirections merely cause the
351 ;; output to be copied to multiple target locations
352 (if arg
353 (setq command
354 (concat command
355 (format " >>> #<buffer %s>"
356 (buffer-name (current-buffer))))))
357 (save-excursion
358 (require 'esh-mode)
359 (let ((buf (set-buffer (generate-new-buffer " *eshell cmd*")))
360 (eshell-non-interactive-p t))
361 (eshell-mode)
362 (let* ((proc (eshell-eval-command
363 (list 'eshell-commands
364 (eshell-parse-command command))))
365 intr
366 (bufname (if (and proc (listp proc))
367 "*EShell Async Command Output*"
368 (setq intr t)
369 "*EShell Command Output*")))
370 (if (buffer-live-p (get-buffer bufname))
371 (kill-buffer bufname))
372 (rename-buffer bufname)
373 ;; things get a little coarse here, since the desire is to
374 ;; make the output as attractive as possible, with no
375 ;; extraneous newlines
376 (when intr
377 (if (eshell-interactive-process)
378 (eshell-wait-for-process (eshell-interactive-process)))
379 (assert (not (eshell-interactive-process)))
380 (goto-char (point-max))
381 (while (and (bolp) (not (bobp)))
382 (delete-backward-char 1)))
383 (assert (and buf (buffer-live-p buf)))
384 (unless arg
385 (let ((len (if (not intr) 2
386 (count-lines (point-min) (point-max)))))
387 (cond
388 ((= len 0)
389 (message "(There was no command output)")
390 (kill-buffer buf))
391 ((= len 1)
392 (message (buffer-string))
393 (kill-buffer buf))
394 (t
395 (save-selected-window
396 (select-window (display-buffer buf))
397 (goto-char (point-min))
398 ;; cause the output buffer to take up as little screen
399 ;; real-estate as possible, if temp buffer resizing is
400 ;; enabled
401 (and intr temp-buffer-resize-mode
402 (resize-temp-buffer-window)))))))))))
403
404;;;###autoload
405(defun eshell-command-result (command &optional status-var)
406 "Execute the given Eshell COMMAND, and return the result.
407The result might be any Lisp object.
408If STATUS-VAR is a symbol, it will be set to the exit status of the
409command. This is the only way to determine whether the value returned
410corresponding to a successful execution."
411 ;; a null command produces a null, successful result
412 (if (not command)
413 (ignore
414 (if (and status-var (symbolp status-var))
415 (set status-var 0)))
416 (with-temp-buffer
417 (require 'esh-mode)
418 (let ((eshell-non-interactive-p t))
419 (eshell-mode)
420 (let ((result (eshell-do-eval
421 (list 'eshell-commands
422 (list 'eshell-command-to-value
423 (eshell-parse-command command))) t)))
424 (assert (eq (car result) 'quote))
425 (if (and status-var (symbolp status-var))
426 (set status-var eshell-last-command-status))
427 (cadr result))))))
428
429(eshell-deftest mode simple-command-result
430 "`eshell-command-result' works with a simple command."
431 (= (eshell-command-result "+ 1 2") 3))
432
433;;;_* Reporting bugs
434;;
435;; Since Eshell has not yet been in use by a wide audience, and since
436;; the number of possible configurations is quite large, it is certain
437;; that many bugs slipped past the rigors of testing it was put
438;; through. If you do encounter a bug, on any system, please report
439;; it -- in addition to any particular oddities in your configuration
440;; -- so that the problem may be corrected for the benefit of others.
441
442(defconst eshell-report-bug-address "johnw@gnu.org"
443 "E-mail address to send Eshell bug reports to.")
444
445;;;###autoload
446(defun eshell-report-bug (topic)
447 "Report a bug in Eshell.
448Prompts for the TOPIC. Leaves you in a mail buffer.
449Please include any configuration details that might be involved."
450 (interactive "sBug Subject: ")
451 (compose-mail eshell-report-bug-address topic)
452 (goto-char (point-min))
453 (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
454 (forward-line 1)
455 (let ((signature (buffer-substring (point) (point-max))))
456 ;; Discourage users from writing non-English text.
457 (set-buffer-multibyte nil)
458 (delete-region (point) (point-max))
459 (insert signature)
460 (backward-char (length signature)))
461 (insert "emacs-version: " (emacs-version))
462 (insert "\n\nThere appears to be a bug in Eshell.\n\n"
463 "Please describe exactly what actions "
464 "triggered the bug and the precise\n"
465 "symptoms of the bug:\n\n")
466 ;; This is so the user has to type something in order to send
467 ;; the report easily.
468 (use-local-map (nconc (make-sparse-keymap) (current-local-map))))
469
470;;; Code:
471
472(defun eshell-unload-all-modules ()
473 "Unload all modules that were loaded by Eshell, if possible.
474If the user has require'd in any of the modules, or customized a
475variable with a :require tag (such as `eshell-prefer-to-shell'), it
476will be impossible to unload Eshell completely without restarting
477Emacs."
478 ;; if the user set `eshell-prefer-to-shell' to t, but never loaded
479 ;; Eshell, then `eshell-subgroups' will be unbound
480 (when (fboundp 'eshell-subgroups)
481 (eshell-for module (eshell-subgroups 'eshell)
482 ;; this really only unloads as many modules as possible,
483 ;; since other `require' references (such as by customizing
484 ;; `eshell-prefer-to-shell' to a non-nil value) might make it
485 ;; impossible to unload Eshell completely
486 (if (featurep module)
487 (ignore-errors
488 (message "Unloading %s..." (symbol-name module))
489 (unload-feature module)
490 (message "Unloading %s...done" (symbol-name module)))))
491 (message "Unloading eshell...done")))
492
493(run-hooks 'eshell-load-hook)
494
495;;; eshell.el ends here
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
new file mode 100644
index 00000000000..2b66b1d45b9
--- /dev/null
+++ b/lisp/pcomplete.el
@@ -0,0 +1,1189 @@
1;;; pcomplete --- programmable completion
2
3;; Copyright (C) 1999, 2000 Free Sofware Foundation
4
5;; Author: John Wiegley <johnw@gnu.org>
6;; Keywords: processes
7;; X-URL: http://www.emacs.org/~johnw/emacs.html
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING. If not, write to the
23;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24;; Boston, MA 02111-1307, USA.
25
26;;; Commentary:
27
28;; This module provides a programmable completion facility using
29;; "completion functions". Each completion function is responsible
30;; for producing a list of possible completions relevant to the current
31;; argument position.
32;;
33;; To use pcomplete with shell-mode, for example, you will need the
34;; following in your .emacs file:
35;;
36;; (load "pcmpl-auto")
37;; (add-hook 'shell-mode-hook 'pcomplete-shell-setup)
38;;
39;; Most of the code below simply provides support mechanisms for
40;; writing completion functions. Completion functions themselves are
41;; very easy to write. They have few requirements beyond those of
42;; regular Lisp functions.
43;;
44;; Consider the following example, which will complete against
45;; filenames for the first two arguments, and directories for all
46;; remaining arguments:
47;;
48;; (defun pcomplete/my-command ()
49;; (pcomplete-here (pcomplete-entries))
50;; (pcomplete-here (pcomplete-entries))
51;; (while (pcomplete-here (pcomplete-dirs))))
52;;
53;; Here are the requirements for completion functions:
54;;
55;; @ They must be called "pcomplete/MAJOR-MODE/NAME", or
56;; "pcomplete/NAME". This is how they are looked up, using the NAME
57;; specified in the command argument (the argument in first
58;; position).
59;;
60;; @ They must be callable with no arguments.
61;;
62;; @ Their return value is ignored. If they actually return normally,
63;; it means no completions were available.
64;;
65;; @ In order to provide completions, they must throw the tag
66;; `pcomplete-completions'. The value must be the list of possible
67;; completions for the final argument.
68;;
69;; @ To simplify completion function logic, the tag `pcompleted' may
70;; be thrown with a value of nil in order to abort the function. It
71;; means that there were no completions available.
72;;
73;; When a completion function is called, the variable `pcomplete-args'
74;; is in scope, and contains all of the arguments specified on the
75;; command line. The variable `pcomplete-last' is the index of the
76;; last argument in that list.
77;;
78;; The variable `pcomplete-index' is used by the completion code to
79;; know which argument the completion function is currently examining.
80;; It always begins at 1, meaning the first argument after the command
81;; name.
82;;
83;; To facilitate writing completion logic, a special macro,
84;; `pcomplete-here', has been provided which does several things:
85;;
86;; 1. It will throw `pcompleted' (with a value of nil) whenever
87;; `pcomplete-index' exceeds `pcomplete-last'.
88;;
89;; 2. It will increment `pcomplete-index' if the final argument has
90;; not been reached yet.
91;;
92;; 3. It will evaluate the form passed to it, and throw the result
93;; using the `pcomplete-completions' tag, if it is called when
94;; `pcomplete-index' is pointing to the final argument.
95;;
96;; Sometimes a completion function will want to vary the possible
97;; completions for an argument based on the previous one. To
98;; facilitate tests like this, the function `pcomplete-test' and
99;; `pcomplete-match' are provided. Called with one argument, they
100;; test the value of the previous command argument. Otherwise, a
101;; relative index may be given as an optional second argument, where 0
102;; refers to the current argument, 1 the previous, 2 the one before
103;; that, etc. The symbols `first' and `last' specify absolute
104;; offsets.
105;;
106;; Here is an example which will only complete against directories for
107;; the second argument if the first argument is also a directory:
108;;
109;; (defun pcomplete/example ()
110;; (pcomplete-here (pcomplete-entries))
111;; (if (pcomplete-test 'file-directory-p)
112;; (pcomplete-here (pcomplete-dirs))
113;; (pcomplete-here (pcomplete-entries))))
114;;
115;; For generating completion lists based on directory contents, see
116;; the functions `pcomplete-entries', `pcomplete-dirs',
117;; `pcomplete-executables' and `pcomplete-all-entries'.
118;;
119;; Consult the documentation for `pcomplete-here' for information
120;; about its other arguments.
121
122;;; Code:
123
124(provide 'pcomplete)
125
126(defgroup pcomplete nil
127 "Programmable completion."
128 :group 'processes)
129
130;;; User Variables:
131
132(defcustom pcomplete-file-ignore nil
133 "*A regexp of filenames to be disregarded during file completion."
134 :type 'regexp
135 :group 'pcomplete)
136
137(defcustom pcomplete-dir-ignore nil
138 "*A regexp of names to be disregarded during directory completion."
139 :type 'regexp
140 :group 'pcomplete)
141
142(defcustom pcomplete-ignore-case (memq system-type '(ms-dos windows-nt))
143 "*If non-nil, ignore case when doing filename completion."
144 :type 'boolean
145 :group 'pcomplete)
146
147(defcustom pcomplete-autolist nil
148 "*If non-nil, automatically list possibilities on partial completion.
149This mirrors the optional behavior of tcsh."
150 :type 'boolean
151 :group 'pcomplete)
152
153(defcustom pcomplete-suffix-list (list directory-sep-char ?:)
154 "*A list of characters which constitute a proper suffix."
155 :type '(repeat character)
156 :group 'pcomplete)
157
158(defcustom pcomplete-recexact nil
159 "*If non-nil, use shortest completion if characters cannot be added.
160This mirrors the optional behavior of tcsh.
161
162A non-nil value is useful if `pcomplete-autolist' is non-nil too."
163 :type 'boolean
164 :group 'pcomplete)
165
166(defcustom pcomplete-arg-quote-list nil
167 "*List of characters to quote when completing an argument."
168 :type '(choice (repeat character)
169 (const :tag "Don't quote" nil))
170 :group 'pcomplete)
171
172(defcustom pcomplete-quote-arg-hook nil
173 "*A hook which is run to quote a character within a filename.
174Each function is passed both the filename to be quoted, and the index
175to be considered. If the function wishes to provide an alternate
176quoted form, it need only return the replacement string. If no
177function provides a replacement, quoting shall proceed as normal,
178using a backslash to quote any character which is a member of
179`pcomplete-arg-quote-list'."
180 :type 'hook
181 :group 'pcomplete)
182
183(defcustom pcomplete-man-function 'man
184 "*A function to that will be called to display a manual page.
185It will be passed the name of the command to document."
186 :type 'function
187 :group 'pcomplete)
188
189(defcustom pcomplete-compare-entry-function 'string-lessp
190 "*This function is used to order file entries for completion.
191The behavior of most all shells is to sort alphabetically."
192 :type '(radio (function-item string-lessp)
193 (function-item file-newer-than-file-p)
194 (function :tag "Other"))
195 :group 'pcomplete)
196
197(defcustom pcomplete-help nil
198 "*A string or function (or nil) used for context-sensitive help.
199If a string, it should name an Info node that will be jumped to.
200If non-nil, it must a sexp that will be evaluated, and whose
201result will be shown in the minibuffer.
202If nil, the function `pcomplete-man-function' will be called with the
203current command argument."
204 :type '(choice string sexp (const :tag "Use man page" nil))
205 :group 'pcomplete)
206
207(defcustom pcomplete-expand-before-complete nil
208 "*If non-nil, expand the current argument before completing it.
209This means that typing something such as '$HOME/bi' followed by
210\\[pcomplete-argument] will cause the variable reference to be
211resolved first, and the resultant value that will be completed against
212to be inserted in the buffer. Note that exactly what gets expanded
213and how is entirely up to the behavior of the
214`pcomplete-parse-arguments-function'."
215 :type 'boolean
216 :group 'pcomplete)
217
218(defcustom pcomplete-parse-arguments-function
219 'pcomplete-parse-buffer-arguments
220 "*A function to call to parse the current line's arguments.
221It should be called with no parameters, and with point at the position
222of the argument that is to be completed.
223
224It must either return nil, or a cons cell of the form:
225
226 ((ARG...) (BEG-POS...))
227
228The two lists must be identical in length. The first gives the final
229value of each command line argument (which need not match the textual
230representation of that argument), and BEG-POS gives the beginning
231position of each argument, as it is seen by the user. The establishes
232a relationship between the fully resolved value of the argument, and
233the textual representation of the argument."
234 :type 'function
235 :group 'pcomplete)
236
237(defcustom pcomplete-cycle-completions t
238 "*If non-nil, hitting the TAB key cycles through the completion list.
239Typical Emacs behavior is to complete as much as possible, then pause
240waiting for further input. Then if TAB is hit again, show a list of
241possible completions. When `pcomplete-cycle-completions' is non-nil,
242it acts more like zsh or 4nt, showing the first maximal match first,
243followed by any further matches on each subsequent pressing of the TAB
244key. \\[pcomplete-list] is the key to press if the user wants to see
245the list of possible completions."
246 :type 'boolean
247 :group 'pcomplete)
248
249(defcustom pcomplete-cycle-cutoff-length 5
250 "*If the number of completions is greater than this, don't cycle.
251This variable is a compromise between the traditional Emacs style of
252completion, and the \"cycling\" style. Basically, if there are more
253than this number of completions possible, don't automatically pick the
254first one and then expect the user to press TAB to cycle through them.
255Typically, when there are a large number of completion possibilities,
256the user wants to see them in a list buffer so that they can know what
257options are available. But if the list is small, it means the user
258has already entered enough input to disambiguate most of the
259possibilities, and therefore they are probably most interested in
260cycling through the candidates. Set this value to nil if you want
261cycling to always be enabled."
262 :type '(choice integer (const :tag "Always cycle" nil))
263 :group 'pcomplete)
264
265(defcustom pcomplete-restore-window-delay 1
266 "*The number of seconds to wait before restoring completion windows.
267Once the completion window has been displayed, if the user then goes
268on to type something else, that completion window will be removed from
269the display (actually, the original window configuration before it was
270displayed will be restored), after this many seconds of idle time. If
271set to nil, completion windows will be left on second until the user
272removes them manually. If set to 0, they will disappear immediately
273after the user enters a key other than TAB."
274 :type '(choice integer (const :tag "Never restore" nil))
275 :group 'pcomplete)
276
277(defcustom pcomplete-try-first-hook nil
278 "*A list of functions which are called before completing an argument.
279This can be used, for example, for completing things which might apply
280to all arguments, such as variable names after a $."
281 :type 'hook
282 :group 'pcomplete)
283
284(defcustom pcomplete-command-completion-function
285 (function
286 (lambda ()
287 (pcomplete-here (pcomplete-executables))))
288 "*Function called for completing the initial command argument."
289 :type 'function
290 :group 'pcomplete)
291
292(defcustom pcomplete-command-name-function 'pcomplete-command-name
293 "*Function called for determining the current command name."
294 :type 'function
295 :group 'pcomplete)
296
297(defcustom pcomplete-default-completion-function
298 (function
299 (lambda ()
300 (while (pcomplete-here (pcomplete-entries)))))
301 "*Function called when no completion rule can be found.
302This function is used to generate completions for every argument."
303 :type 'function
304 :group 'pcomplete)
305
306;;; Internal Variables:
307
308;; for cycling completion support
309(defvar pcomplete-current-completions nil)
310(defvar pcomplete-last-completion-length)
311(defvar pcomplete-last-completion-stub)
312(defvar pcomplete-last-completion-raw)
313(defvar pcomplete-last-window-config nil)
314(defvar pcomplete-window-restore-timer nil)
315
316(make-variable-buffer-local 'pcomplete-current-completions)
317(make-variable-buffer-local 'pcomplete-last-completion-length)
318(make-variable-buffer-local 'pcomplete-last-completion-stub)
319(make-variable-buffer-local 'pcomplete-last-completion-raw)
320(make-variable-buffer-local 'pcomplete-last-window-config)
321(make-variable-buffer-local 'pcomplete-window-restore-timer)
322
323;; used for altering pcomplete's behavior. These global variables
324;; should always be nil.
325(defvar pcomplete-show-help nil)
326(defvar pcomplete-show-list nil)
327(defvar pcomplete-expand-only-p nil)
328
329;;; User Functions:
330
331;;;###autoload
332(defun pcomplete ()
333 "Support extensible programmable completion.
334To use this function, just bind the TAB key to it, or add it to your
335completion functions list (it should occur fairly early in the list)."
336 (interactive)
337 (if (and (interactive-p)
338 pcomplete-cycle-completions
339 pcomplete-current-completions
340 (memq last-command '(pcomplete
341 pcomplete-expand-and-complete
342 pcomplete-reverse)))
343 (progn
344 (delete-backward-char pcomplete-last-completion-length)
345 (if (eq this-command 'pcomplete-reverse)
346 (progn
347 (setq pcomplete-current-completions
348 (cons (car (last pcomplete-current-completions))
349 pcomplete-current-completions))
350 (setcdr (last pcomplete-current-completions 2) nil))
351 (nconc pcomplete-current-completions
352 (list (car pcomplete-current-completions)))
353 (setq pcomplete-current-completions
354 (cdr pcomplete-current-completions)))
355 (pcomplete-insert-entry pcomplete-last-completion-stub
356 (car pcomplete-current-completions)
357 nil pcomplete-last-completion-raw))
358 (setq pcomplete-current-completions nil
359 pcomplete-last-completion-raw nil)
360 (catch 'pcompleted
361 (let* ((pcomplete-stub)
362 pcomplete-seen pcomplete-norm-func
363 pcomplete-args pcomplete-last pcomplete-index
364 (pcomplete-autolist pcomplete-autolist)
365 (pcomplete-suffix-list pcomplete-suffix-list)
366 (completions (pcomplete-completions))
367 (result (pcomplete-do-complete pcomplete-stub completions)))
368 (and result
369 (not (eq (car result) 'listed))
370 (cdr result)
371 (pcomplete-insert-entry pcomplete-stub (cdr result)
372 (memq (car result)
373 '(sole shortest))
374 pcomplete-last-completion-raw))))))
375
376;;;###autoload
377(defun pcomplete-reverse ()
378 "If cycling completion is in use, cycle backwards."
379 (interactive)
380 (call-interactively 'pcomplete))
381
382;;;###autoload
383(defun pcomplete-expand-and-complete ()
384 "Expand the textual value of the current argument.
385This will modify the current buffer."
386 (interactive)
387 (let ((pcomplete-expand-before-complete t))
388 (pcomplete)))
389
390;;;###autoload
391(defun pcomplete-continue ()
392 "Complete without reference to any cycling completions."
393 (interactive)
394 (setq pcomplete-current-completions nil
395 pcomplete-last-completion-raw nil)
396 (call-interactively 'pcomplete))
397
398;;;###autoload
399(defun pcomplete-expand ()
400 "Expand the textual value of the current argument.
401This will modify the current buffer."
402 (interactive)
403 (let ((pcomplete-expand-before-complete t)
404 (pcomplete-expand-only-p t))
405 (pcomplete)
406 (when (and pcomplete-current-completions
407 (> (length pcomplete-current-completions) 0))
408 (delete-backward-char pcomplete-last-completion-length)
409 (while pcomplete-current-completions
410 (unless (pcomplete-insert-entry
411 "" (car pcomplete-current-completions) t
412 pcomplete-last-completion-raw)
413 (insert-and-inherit " "))
414 (setq pcomplete-current-completions
415 (cdr pcomplete-current-completions))))))
416
417;;;###autoload
418(defun pcomplete-help ()
419 "Display any help information relative to the current argument."
420 (interactive)
421 (let ((pcomplete-show-help t))
422 (pcomplete)))
423
424;;;###autoload
425(defun pcomplete-list ()
426 "Show the list of possible completions for the current argument."
427 (interactive)
428 (when (and pcomplete-cycle-completions
429 pcomplete-current-completions
430 (eq last-command 'pcomplete-argument))
431 (delete-backward-char pcomplete-last-completion-length)
432 (setq pcomplete-current-completions nil
433 pcomplete-last-completion-raw nil))
434 (let ((pcomplete-show-list t))
435 (pcomplete)))
436
437;;; Internal Functions:
438
439;; argument handling
440
441;; for the sake of the bye-compiler, when compiling other files that
442;; contain completion functions
443(defvar pcomplete-args nil)
444(defvar pcomplete-begins nil)
445(defvar pcomplete-last nil)
446(defvar pcomplete-index nil)
447(defvar pcomplete-stub nil)
448(defvar pcomplete-seen nil)
449(defvar pcomplete-norm-func nil)
450
451(defun pcomplete-arg (&optional index offset)
452 "Return the textual content of the INDEXth argument.
453INDEX is based from the current processing position. If INDEX is
454positive, values returned are closer to the command argument; if
455negative, they are closer to the last argument. If the INDEX is
456outside of the argument list, nil is returned. The default value for
457INDEX is 0, meaning the current argument being examined.
458
459The special indices `first' and `last' may be used to access those
460parts of the list.
461
462The OFFSET argument is added to/taken away from the index that will be
463used. This is really only useful with `first' and `last', for
464accessing absolute argument positions."
465 (setq index
466 (if (eq index 'first)
467 0
468 (if (eq index 'last)
469 pcomplete-last
470 (- pcomplete-index (or index 0)))))
471 (if offset
472 (setq index (+ index offset)))
473 (nth index pcomplete-args))
474
475(defun pcomplete-begin (&optional index offset)
476 "Return the beginning position of the INDEXth argument.
477See the documentation for `pcomplete-arg'."
478 (setq index
479 (if (eq index 'first)
480 0
481 (if (eq index 'last)
482 pcomplete-last
483 (- pcomplete-index (or index 0)))))
484 (if offset
485 (setq index (+ index offset)))
486 (nth index pcomplete-begins))
487
488(defsubst pcomplete-actual-arg (&optional index offset)
489 "Return the actual text representation of the last argument.
490This different from `pcomplete-arg', which returns the textual value
491that the last argument evaluated to. This function returns what the
492user actually typed in."
493 (buffer-substring (pcomplete-begin index offset) (point)))
494
495(defsubst pcomplete-next-arg ()
496 "Move the various pointers to the next argument."
497 (setq pcomplete-index (1+ pcomplete-index)
498 pcomplete-stub (pcomplete-arg))
499 (if (> pcomplete-index pcomplete-last)
500 (progn
501 (message "No completions")
502 (throw 'pcompleted nil))))
503
504(defun pcomplete-command-name ()
505 "Return the command name of the first argument."
506 (file-name-nondirectory (pcomplete-arg 'first)))
507
508(defun pcomplete-match (regexp &optional index offset start)
509 "Like `string-match', but on the current completion argument."
510 (let ((arg (pcomplete-arg (or index 1) offset)))
511 (if arg
512 (string-match regexp arg start)
513 (throw 'pcompleted nil))))
514
515(defun pcomplete-match-string (which &optional index offset)
516 "Like `string-match', but on the current completion argument."
517 (let ((arg (pcomplete-arg (or index 1) offset)))
518 (if arg
519 (match-string which arg)
520 (throw 'pcompleted nil))))
521
522(defalias 'pcomplete-match-beginning 'match-beginning)
523(defalias 'pcomplete-match-end 'match-end)
524
525(defsubst pcomplete--test (pred arg)
526 "Perform a programmable completion predicate match."
527 (and pred
528 (cond ((eq pred t) t)
529 ((functionp pred)
530 (funcall pred arg))
531 ((stringp pred)
532 (string-match (concat "^" pred "$") arg)))
533 pred))
534
535(defun pcomplete-test (predicates &optional index offset)
536 "Predicates to test the current programmable argument with."
537 (let ((arg (pcomplete-arg (or index 1) offset)))
538 (unless (null predicates)
539 (if (not (listp predicates))
540 (pcomplete--test predicates arg)
541 (let ((pred predicates)
542 found)
543 (while (and pred (not found))
544 (setq found (pcomplete--test (car pred) arg)
545 pred (cdr pred)))
546 found)))))
547
548(defun pcomplete-parse-buffer-arguments ()
549 "Parse whitespace separated arguments in the current region."
550 (let ((begin (point-min))
551 (end (point-max))
552 begins args)
553 (save-excursion
554 (goto-char begin)
555 (while (< (point) end)
556 (skip-chars-forward " \t\n")
557 (setq begins (cons (point) begins))
558 (skip-chars-forward "^ \t\n")
559 (setq args (cons (buffer-substring-no-properties
560 (car begins) (point))
561 args)))
562 (cons (reverse args) (reverse begins)))))
563
564;;;###autoload
565(defun pcomplete-comint-setup (completef-sym)
566 "Setup a comint buffer to use pcomplete.
567COMPLETEF-SYM should be the symbol where the
568dynamic-complete-functions are kept. For comint mode itself, this is
569`comint-dynamic-complete-functions'."
570 (set (make-local-variable 'pcomplete-parse-arguments-function)
571 'pcomplete-parse-comint-arguments)
572 (make-local-variable completef-sym)
573 (let ((elem (memq 'comint-dynamic-complete-filename
574 (symbol-value completef-sym))))
575 (if elem
576 (setcar elem 'pcomplete)
577 (nconc (symbol-value completef-sym)
578 (list 'pcomplete)))))
579
580;;;###autoload
581(defun pcomplete-shell-setup ()
582 "Setup shell-mode to use pcomplete."
583 (pcomplete-comint-setup 'shell-dynamic-complete-functions))
584
585(defun pcomplete-parse-comint-arguments ()
586 "Parse whitespace separated arguments in the current region."
587 (let ((begin (save-excursion (comint-bol nil) (point)))
588 (end (point))
589 begins args)
590 (save-excursion
591 (goto-char begin)
592 (while (< (point) end)
593 (skip-chars-forward " \t\n")
594 (setq begins (cons (point) begins))
595 (let ((skip t))
596 (while skip
597 (skip-chars-forward "^ \t\n")
598 (if (eq (char-before) ?\\)
599 (skip-chars-forward " \t\n")
600 (setq skip nil))))
601 (setq args (cons (buffer-substring-no-properties
602 (car begins) (point))
603 args)))
604 (cons (reverse args) (reverse begins)))))
605
606(defun pcomplete-parse-arguments (&optional expand-p)
607 "Parse the command line arguments. Most completions need this info."
608 (let ((results (funcall pcomplete-parse-arguments-function)))
609 (when results
610 (setq pcomplete-args (or (car results) (list ""))
611 pcomplete-begins (or (cdr results) (list (point)))
612 pcomplete-last (1- (length pcomplete-args))
613 pcomplete-index 0
614 pcomplete-stub (pcomplete-arg 'last))
615 (let ((begin (pcomplete-begin 'last)))
616 (if (and pcomplete-cycle-completions
617 (listp pcomplete-stub)
618 (not pcomplete-expand-only-p))
619 (let* ((completions pcomplete-stub)
620 (common-stub (car completions))
621 (c completions)
622 (len (length common-stub)))
623 (while (and c (> len 0))
624 (while (and (> len 0)
625 (not (string=
626 (substring common-stub 0 len)
627 (substring (car c) 0
628 (min (length (car c))
629 len)))))
630 (setq len (1- len)))
631 (setq c (cdr c)))
632 (setq pcomplete-stub (substring common-stub 0 len)
633 pcomplete-autolist t)
634 (when (and begin (not pcomplete-show-list))
635 (delete-region begin (point))
636 (pcomplete-insert-entry "" pcomplete-stub))
637 (throw 'pcomplete-completions completions))
638 (when expand-p
639 (if (stringp pcomplete-stub)
640 (when begin
641 (delete-region begin (point))
642 (insert-and-inherit pcomplete-stub))
643 (if (and (listp pcomplete-stub)
644 pcomplete-expand-only-p)
645 ;; this is for the benefit of `pcomplete-expand'
646 (setq pcomplete-last-completion-length (- (point) begin)
647 pcomplete-current-completions pcomplete-stub)
648 (error "Cannot expand argument"))))
649 (if pcomplete-expand-only-p
650 (throw 'pcompleted t)
651 pcomplete-args))))))
652
653(defun pcomplete-quote-argument (filename)
654 "Return FILENAME with magic characters quoted.
655Magic characters are those in `pcomplete-arg-quote-list'."
656 (if (null pcomplete-arg-quote-list)
657 filename
658 (let ((len (length filename))
659 (index 0)
660 (result "")
661 replacement char)
662 (while (< index len)
663 (setq replacement (run-hook-with-args-until-success
664 'pcomplete-quote-arg-hook filename index))
665 (cond
666 (replacement
667 (setq result (concat result replacement)))
668 ((and (setq char (aref filename index))
669 (memq char pcomplete-arg-quote-list))
670 (setq result (concat result "\\" (char-to-string char))))
671 (t
672 (setq result (concat result (char-to-string char)))))
673 (setq index (1+ index)))
674 result)))
675
676;; file-system completion lists
677
678(defsubst pcomplete-dirs-or-entries (&optional regexp predicate)
679 "Return either directories, or qualified entries."
680 (append (let ((pcomplete-stub pcomplete-stub))
681 (pcomplete-entries regexp predicate))
682 (pcomplete-entries nil 'file-directory-p)))
683
684(defun pcomplete-entries (&optional regexp predicate)
685 "Complete against a list of directory candidates.
686This function always uses the last argument as the basis for
687completion.
688If REGEXP is non-nil, it is a regular expression used to refine the
689match (files not matching the REGEXP will be excluded).
690If PREDICATE is non-nil, it will also be used to refine the match
691\(files for which the PREDICATE returns nil will be excluded).
692If PATH is non-nil, it will be used for completion instead of
693consulting the last argument."
694 (let* ((name pcomplete-stub)
695 (default-directory (expand-file-name
696 (or (file-name-directory name)
697 default-directory)))
698 above-cutoff)
699 (setq name (file-name-nondirectory name)
700 pcomplete-stub name)
701 (let ((completions
702 (file-name-all-completions name default-directory)))
703 (if regexp
704 (setq completions
705 (pcomplete-pare-list
706 completions nil
707 (function
708 (lambda (file)
709 (not (string-match regexp file)))))))
710 (if predicate
711 (setq completions
712 (pcomplete-pare-list
713 completions nil
714 (function
715 (lambda (file)
716 (not (funcall predicate file)))))))
717 (if (or pcomplete-file-ignore pcomplete-dir-ignore)
718 (setq completions
719 (pcomplete-pare-list
720 completions nil
721 (function
722 (lambda (file)
723 (if (eq (aref file (1- (length file)))
724 directory-sep-char)
725 (and pcomplete-dir-ignore
726 (string-match pcomplete-dir-ignore file))
727 (and pcomplete-file-ignore
728 (string-match pcomplete-file-ignore file))))))))
729 (setq above-cutoff (> (length completions)
730 pcomplete-cycle-cutoff-length))
731 (sort completions
732 (function
733 (lambda (l r)
734 ;; for the purposes of comparison, remove the
735 ;; trailing slash from directory names.
736 ;; Otherwise, "foo.old/" will come before "foo/",
737 ;; since . is earlier in the ASCII alphabet than
738 ;; /
739 (let ((left (if (eq (aref l (1- (length l)))
740 directory-sep-char)
741 (substring l 0 (1- (length l)))
742 l))
743 (right (if (eq (aref r (1- (length r)))
744 directory-sep-char)
745 (substring r 0 (1- (length r)))
746 r)))
747 (if above-cutoff
748 (string-lessp left right)
749 (funcall pcomplete-compare-entry-function
750 left right)))))))))
751
752(defsubst pcomplete-all-entries (&optional regexp predicate)
753 "Like `pcomplete-entries', but doesn't ignore any entries."
754 (let (pcomplete-file-ignore
755 pcomplete-dir-ignore)
756 (pcomplete-entries regexp predicate)))
757
758(defsubst pcomplete-dirs (&optional regexp)
759 "Complete amongst a list of directories."
760 (pcomplete-entries regexp 'file-directory-p))
761
762(defsubst pcomplete-executables (&optional regexp)
763 "Complete amongst a list of directories and executables."
764 (pcomplete-entries regexp 'file-executable-p))
765
766;; generation of completion lists
767
768(defun pcomplete-find-completion-function (command)
769 "Find the completion function to call for the given COMMAND."
770 (let ((sym (intern-soft
771 (concat "pcomplete/" (symbol-name major-mode) "/" command))))
772 (unless sym
773 (setq sym (intern-soft (concat "pcomplete/" command))))
774 (and sym (fboundp sym) sym)))
775
776(defun pcomplete-completions ()
777 "Return a list of completions for the current argument position."
778 (catch 'pcomplete-completions
779 (when (pcomplete-parse-arguments pcomplete-expand-before-complete)
780 (if (= pcomplete-index pcomplete-last)
781 (funcall pcomplete-command-completion-function)
782 (let ((sym (or (pcomplete-find-completion-function
783 (funcall pcomplete-command-name-function))
784 pcomplete-default-completion-function)))
785 (ignore
786 (pcomplete-next-arg)
787 (funcall sym)))))))
788
789(defun pcomplete-opt (options &optional prefix no-ganging args-follow)
790 "Complete a set of OPTIONS, each beginning with PREFIX (?- by default).
791PREFIX may be t, in which case no PREFIX character is necessary.
792If REQUIRED is non-nil, the options must be present.
793If NO-GANGING is non-nil, each option is separate. -xy is not allowed.
794If ARGS-FOLLOW is non-nil, then options which arguments which take may
795have the argument appear after a ganged set of options. This is how
796tar behaves, for example."
797 (if (and (= pcomplete-index pcomplete-last)
798 (string= (pcomplete-arg) "-"))
799 (let ((len (length options))
800 (index 0)
801 char choices)
802 (while (< index len)
803 (setq char (aref options index))
804 (if (eq char ?\()
805 (let ((result (read-from-string options index)))
806 (setq index (cdr result)))
807 (unless (memq char '(?/ ?* ?? ?.))
808 (setq choices (cons (char-to-string char) choices)))
809 (setq index (1+ index))))
810 (throw 'pcomplete-completions
811 (mapcar
812 (function
813 (lambda (opt)
814 (concat "-" opt)))
815 (pcomplete-uniqify-list choices))))
816 (let ((arg (pcomplete-arg)))
817 (when (and (> (length arg) 1)
818 (stringp arg)
819 (eq (aref arg 0) (or prefix ?-)))
820 (pcomplete-next-arg)
821 (let ((char (aref arg 1))
822 (len (length options))
823 (index 0)
824 opt-char arg-char result)
825 (while (< (1+ index) len)
826 (setq opt-char (aref options index)
827 arg-char (aref options (1+ index)))
828 (if (eq arg-char ?\()
829 (setq result
830 (read-from-string options (1+ index))
831 index (cdr result)
832 result (car result))
833 (setq result nil))
834 (when (and (eq char opt-char)
835 (memq arg-char '(?\( ?/ ?* ?? ?.)))
836 (if (< pcomplete-index pcomplete-last)
837 (pcomplete-next-arg)
838 (throw 'pcomplete-completions
839 (cond ((eq arg-char ?/) (pcomplete-dirs))
840 ((eq arg-char ?*) (pcomplete-executables))
841 ((eq arg-char ??) nil)
842 ((eq arg-char ?.) (pcomplete-entries))
843 ((eq arg-char ?\() (eval result))))))
844 (setq index (1+ index))))))))
845
846(defun pcomplete--here (&optional form stub paring form-only)
847 "Complete aganst the current argument, if at the end.
848See the documentation for `pcomplete-here'."
849 (if (< pcomplete-index pcomplete-last)
850 (progn
851 (if (eq paring 0)
852 (setq pcomplete-seen nil)
853 (unless (eq paring t)
854 (let ((arg (pcomplete-arg)))
855 (unless (not (stringp arg))
856 (setq pcomplete-seen
857 (cons (if paring
858 (funcall paring arg)
859 (file-truename arg))
860 pcomplete-seen))))))
861 (pcomplete-next-arg)
862 t)
863 (when pcomplete-show-help
864 (pcomplete--help)
865 (throw 'pcompleted t))
866 (if stub
867 (setq pcomplete-stub stub))
868 (if (or (eq paring t) (eq paring 0))
869 (setq pcomplete-seen nil)
870 (setq pcomplete-norm-func (or paring 'file-truename)))
871 (unless form-only
872 (run-hooks 'pcomplete-try-first-hook))
873 (throw 'pcomplete-completions (eval form))))
874
875(defmacro pcomplete-here (&optional form stub paring form-only)
876 "Complete aganst the current argument, if at the end.
877If completion is to be done here, evaluate FORM to generate the list
878of strings which will be used for completion purposes. If STUB is a
879string, use it as the completion stub instead of the default (which is
880the entire text of the current argument).
881
882For an example of when you might want to use STUB: if the current
883argument text is 'long-path-name/', you don't want the completions
884list display to be cluttered by 'long-path-name/' appearing at the
885beginning of every alternative. Not only does this make things less
886intelligle, but it is also inefficient. Yet, if the completion list
887does not begin with this string for every entry, the current argument
888won't complete correctly.
889
890The solution is to specify a relative stub. It allows you to
891substitute a different argument from the current argument, almost
892always for the sake of efficiency.
893
894If PARING is nil, this argument will be pared against previous
895arguments using the function `file-truename' to normalize them.
896PARING may be a function, in which case that function is for
897normalization. If PARING is the value t, the argument dealt with by
898this call will not participate in argument paring. If it the integer
8990, all previous arguments that have been seen will be cleared.
900
901If FORM-ONLY is non-nil, only the result of FORM will be used to
902generate the completions list. This means that the hook
903`pcomplete-try-first-hook' will not be run."
904 `(pcomplete--here (quote ,form) ,stub ,paring ,form-only))
905
906(defmacro pcomplete-here* (&optional form stub form-only)
907 "An alternate form which does not participate in argument paring."
908 `(pcomplete-here ,form ,stub t ,form-only))
909
910;; display support
911
912(defun pcomplete-restore-windows ()
913 "If the only window change was due to Completions, restore things."
914 (if pcomplete-last-window-config
915 (let* ((cbuf (get-buffer "*Completions*"))
916 (cwin (and cbuf (get-buffer-window cbuf))))
917 (when (and cwin (window-live-p cwin))
918 (bury-buffer cbuf)
919 (set-window-configuration pcomplete-last-window-config))))
920 (setq pcomplete-last-window-config nil
921 pcomplete-window-restore-timer nil))
922
923;; Abstractions so that the code below will work for both Emacs 20 and
924;; XEmacs 21
925
926(unless (fboundp 'event-matches-key-specifier-p)
927 (defalias 'event-matches-key-specifier-p 'eq))
928
929(unless (fboundp 'read-event)
930 (defsubst read-event (&optional prompt)
931 (aref (read-key-sequence prompt) 0)))
932
933(unless (fboundp 'event-basic-type)
934 (defalias 'event-basic-type 'event-key))
935
936(defun pcomplete-show-completions (completions)
937 "List in help buffer sorted COMPLETIONS.
938Typing SPC flushes the help buffer."
939 (let* ((curbuf (current-buffer)))
940 (when pcomplete-window-restore-timer
941 (cancel-timer pcomplete-window-restore-timer)
942 (setq pcomplete-window-restore-timer nil))
943 (unless pcomplete-last-window-config
944 (setq pcomplete-last-window-config (current-window-configuration)))
945 (with-output-to-temp-buffer "*Completions*"
946 (display-completion-list completions))
947 (message "Hit space to flush")
948 (let (event)
949 (prog1
950 (catch 'done
951 (while (with-current-buffer (get-buffer "*Completions*")
952 (setq event (read-event)))
953 (cond
954 ((event-matches-key-specifier-p event ? )
955 (set-window-configuration pcomplete-last-window-config)
956 (setq pcomplete-last-window-config nil)
957 (throw 'done nil))
958 ((event-matches-key-specifier-p event 'tab)
959 (save-selected-window
960 (select-window (get-buffer-window "*Completions*"))
961 (if (pos-visible-in-window-p (point-max))
962 (goto-char (point-min))
963 (scroll-up)))
964 (message ""))
965 (t
966 (setq unread-command-events (list event))
967 (throw 'done nil)))))
968 (if (and pcomplete-last-window-config
969 pcomplete-restore-window-delay)
970 (setq pcomplete-window-restore-timer
971 (run-with-timer pcomplete-restore-window-delay nil
972 'pcomplete-restore-windows)))))))
973
974;; insert completion at point
975
976(defun pcomplete-insert-entry (stub entry &optional addsuffix raw-p)
977 "Insert a completion entry at point.
978Returns non-nil if a space was appended at the end."
979 (let ((here (point)))
980 (if (not pcomplete-ignore-case)
981 (insert-and-inherit (if raw-p
982 (substring entry (length stub))
983 (pcomplete-quote-argument
984 (substring entry (length stub)))))
985 ;; the stub is not quoted at this time, so to determine the
986 ;; length of what should be in the buffer, we must quote it
987 (delete-backward-char (length (pcomplete-quote-argument stub)))
988 ;; if there is already a backslash present to handle the first
989 ;; character, don't bother quoting it
990 (when (eq (char-before) ?\\)
991 (insert-and-inherit (substring entry 0 1))
992 (setq entry (substring entry 1)))
993 (insert-and-inherit (if raw-p
994 entry
995 (pcomplete-quote-argument entry))))
996 (let (space-added)
997 (when (and (not (memq (char-before) pcomplete-suffix-list))
998 addsuffix)
999 (insert-and-inherit " ")
1000 (setq space-added t))
1001 (setq pcomplete-last-completion-length (- (point) here)
1002 pcomplete-last-completion-stub stub)
1003 space-added)))
1004
1005;; selection of completions
1006
1007(defun pcomplete-do-complete (stub completions)
1008 "Dynamically complete at point using STUB and COMPLETIONS.
1009This is basically just a wrapper for `pcomplete-stub' which does some
1010extra checking, and munging of the COMPLETIONS list."
1011 (unless (stringp stub)
1012 (message "Cannot complete argument")
1013 (throw 'pcompleted nil))
1014 (if (null completions)
1015 (ignore
1016 (if (and stub (> (length stub) 0))
1017 (message "No completions of %s" stub)
1018 (message "No completions")))
1019 ;; pare it down, if applicable
1020 (if pcomplete-seen
1021 (let* ((arg (pcomplete-arg))
1022 (prefix
1023 (file-name-as-directory
1024 (funcall pcomplete-norm-func
1025 (substring arg 0 (- (length arg)
1026 (length pcomplete-stub)))))))
1027 (setq pcomplete-seen
1028 (mapcar 'directory-file-name pcomplete-seen))
1029 (let ((p pcomplete-seen))
1030 (while p
1031 (add-to-list 'pcomplete-seen
1032 (funcall pcomplete-norm-func (car p)))
1033 (setq p (cdr p))))
1034 (setq completions
1035 (mapcar
1036 (function
1037 (lambda (elem)
1038 (file-relative-name elem prefix)))
1039 (pcomplete-pare-list
1040 (mapcar
1041 (function
1042 (lambda (elem)
1043 (expand-file-name elem prefix)))
1044 completions)
1045 pcomplete-seen
1046 (function
1047 (lambda (elem)
1048 (member (directory-file-name
1049 (funcall pcomplete-norm-func elem))
1050 pcomplete-seen))))))))
1051 ;; OK, we've got a list of completions.
1052 (if pcomplete-show-list
1053 (pcomplete-show-completions completions)
1054 (pcomplete-stub stub completions))))
1055
1056(defun pcomplete-stub (stub candidates &optional cycle-p)
1057 "Dynamically complete STUB from CANDIDATES list.
1058This function inserts completion characters at point by completing
1059STUB from the strings in CANDIDATES. A completions listing may be
1060shown in a help buffer if completion is ambiguous.
1061
1062Returns nil if no completion was inserted.
1063Returns `sole' if completed with the only completion match.
1064Returns `shortest' if completed with the shortest of the matches.
1065Returns `partial' if completed as far as possible with the matches.
1066Returns `listed' if a completion listing was shown.
1067
1068See also `pcomplete-filename'."
1069 (let* ((completion-ignore-case pcomplete-ignore-case)
1070 (candidates (mapcar 'list candidates))
1071 (completions (all-completions stub candidates)))
1072 (let (result entry)
1073 (cond
1074 ((null completions)
1075 (if (and stub (> (length stub) 0))
1076 (message "No completions of %s" stub)
1077 (message "No completions")))
1078 ((= 1 (length completions))
1079 (setq entry (car completions))
1080 (if (string-equal entry stub)
1081 (message "Sole completion"))
1082 (setq result 'sole))
1083 ((and pcomplete-cycle-completions
1084 (or cycle-p
1085 (not pcomplete-cycle-cutoff-length)
1086 (<= (length completions)
1087 pcomplete-cycle-cutoff-length)))
1088 (setq entry (car completions)
1089 pcomplete-current-completions completions))
1090 (t ; There's no unique completion; use longest substring
1091 (setq entry (try-completion stub candidates))
1092 (cond ((and pcomplete-recexact
1093 (string-equal stub entry)
1094 (member entry completions))
1095 ;; It's not unique, but user wants shortest match.
1096 (message "Completed shortest")
1097 (setq result 'shortest))
1098 ((or pcomplete-autolist
1099 (string-equal stub entry))
1100 ;; It's not unique, list possible completions.
1101 (pcomplete-show-completions completions)
1102 (setq result 'listed))
1103 (t
1104 (message "Partially completed")
1105 (setq result 'partial)))))
1106 (cons result entry))))
1107
1108;; context sensitive help
1109
1110(defun pcomplete--help ()
1111 "Produce context-sensitive help for the current argument.
1112If specific documentation can't be given, be generic.
1113INFODOC specifies the Info node to goto. DOCUMENTATION is a sexp
1114which will produce documentation for the argument (it is responsible
1115for displaying in its own buffer)."
1116 (if (and pcomplete-help
1117 (or (and (stringp pcomplete-help)
1118 (fboundp 'Info-goto-node))
1119 (listp pcomplete-help)))
1120 (if (listp pcomplete-help)
1121 (message (eval pcomplete-help))
1122 (save-window-excursion (info))
1123 (switch-to-buffer-other-window "*info*")
1124 (funcall (symbol-function 'Info-goto-node) pcomplete-help))
1125 (if pcomplete-man-function
1126 (let ((cmd (funcall pcomplete-command-name-function)))
1127 (if (and cmd (> (length cmd) 0))
1128 (funcall pcomplete-man-function cmd)))
1129 (message "No context-sensitive help available"))))
1130
1131;; general utilities
1132
1133(defsubst pcomplete-time-less-p (t1 t2)
1134 "Say whether time T1 is less than time T2."
1135 (or (< (car t1) (car t2))
1136 (and (= (car t1) (car t2))
1137 (< (nth 1 t1) (nth 1 t2)))))
1138
1139(defun pcomplete-pare-list (l r &optional pred)
1140 "Destructively remove from list L all elements matching any in list R.
1141Test is done using `equal'.
1142If PRED is non-nil, it is a function used for further removal.
1143Returns the resultant list."
1144 (while (and l (or (and r (member (car l) r))
1145 (and pred
1146 (funcall pred (car l)))))
1147 (setq l (cdr l)))
1148 (let ((m l))
1149 (while m
1150 (while (and (cdr m)
1151 (or (and r (member (cadr m) r))
1152 (and pred
1153 (funcall pred (cadr m)))))
1154 (setcdr m (cddr m)))
1155 (setq m (cdr m))))
1156 l)
1157
1158(defun pcomplete-uniqify-list (l)
1159 "Sort and remove multiples in L."
1160 (setq l (sort l 'string-lessp))
1161 (let ((m l))
1162 (while m
1163 (while (and (cdr m)
1164 (string= (car m)
1165 (cadr m)))
1166 (setcdr m (cddr m)))
1167 (setq m (cdr m))))
1168 l)
1169
1170(defun pcomplete-process-result (cmd &rest args)
1171 "Call CMD using `call-process' and return the simplest result."
1172 (with-temp-buffer
1173 (apply 'call-process cmd nil t nil args)
1174 (skip-chars-backward "\n")
1175 (buffer-substring (point-min) (point))))
1176
1177;; create a set of aliases which allow completion functions to be not
1178;; quite so verbose
1179
1180;; jww (1999-10-20): are these a good idea?
1181; (defalias 'pc-here 'pcomplete-here)
1182; (defalias 'pc-test 'pcomplete-test)
1183; (defalias 'pc-opt 'pcomplete-opt)
1184; (defalias 'pc-match 'pcomplete-match)
1185; (defalias 'pc-match-string 'pcomplete-match-string)
1186; (defalias 'pc-match-beginning 'pcomplete-match-beginning)
1187; (defalias 'pc-match-end 'pcomplete-match-end)
1188
1189;;; pcomplete.el ends here