diff options
| author | Gerd Moellmann | 2000-06-23 05:24:10 +0000 |
|---|---|---|
| committer | Gerd Moellmann | 2000-06-23 05:24:10 +0000 |
| commit | affbf6477576c38d98111b55fbb1eb5b13d1a735 (patch) | |
| tree | e7cccedd38944fc20cf2d20a3949246d8d558bf7 | |
| parent | 022499fab948938bb763c2a33a8c5ba0c5969fcd (diff) | |
| download | emacs-affbf6477576c38d98111b55fbb1eb5b13d1a735.tar.gz emacs-affbf6477576c38d98111b55fbb1eb5b13d1a735.zip | |
*** empty log message ***
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 @@ | |||
| 1 | 2000-06-23 Gerd Moellmann <gerd@gnu.org> | 1 | 2000-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. | ||
| 65 | Whenever an alias is defined by the user, using the `alias' command, | ||
| 66 | it will be written to this file. Thus, alias definitions (and | ||
| 67 | deletions) are always permanent. This approach was chosen for the | ||
| 68 | sake of simplicity, since that's pretty much the only benefit to be | ||
| 69 | gained 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. | ||
| 128 | Each element of this alias is a list of the form: | ||
| 129 | |||
| 130 | (NAME DEFINITION) | ||
| 131 | |||
| 132 | Where NAME is the textual name of the alias, and DEFINITION is the | ||
| 133 | command string to replace that command with. | ||
| 134 | |||
| 135 | Note: this list should not be modified in your '.emacs' file. Rather, | ||
| 136 | any desired alias definitions should be declared using the `alias' | ||
| 137 | command, 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. | ||
| 234 | These 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. | ||
| 28 | It exists so that others wishing to create their own Eshell extension | ||
| 29 | modules 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. | ||
| 55 | This 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 | ||
| 28 | are traditionally considered shell builtins. Since all of the | ||
| 29 | functionality provided by them is accessible through Lisp, they are | ||
| 30 | not really builtins at all, but offer a command-oriented way to do the | ||
| 31 | same 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. | ||
| 50 | This comes at some detriment to Lisp functionality. However, the Lisp | ||
| 51 | equivalent 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'. | ||
| 89 | It returns a formatted value that should be passed to `eshell-print' | ||
| 90 | or `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 | ||
| 28 | the TAB key, which allows for completing command names, file names, | ||
| 29 | variable 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. | ||
| 90 | If this variable is nil, Lisp completion can still be done in command | ||
| 91 | position 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. | ||
| 97 | Setting this variable means nothing if `eshell-show-lisp-completions' | ||
| 98 | is 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. | ||
| 124 | This is provided for common commands, as a simplistic alternative | ||
| 125 | to 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 | ||
| 28 | current directory, maintaining a directory stack, and also keeping | ||
| 29 | track of a history of the last directory locations the user was in. | ||
| 30 | Emacs does provide standard Lisp definitions of `pwd' and `cd', but | ||
| 31 | they 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'. | ||
| 70 | The value returned by `pwd' is also used when recording the | ||
| 71 | last-visited directory in the last-dir-ring, so it will affect the | ||
| 72 | form 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. | ||
| 81 | The last-dir-ring is always preserved when exiting an Eshell buffer. | ||
| 82 | However, when Emacs is being shut down, this variable determines | ||
| 83 | whether to prompt the user, or just save the ring. | ||
| 84 | If set to nil, it means never ask whether to save the last-dir-ring. | ||
| 85 | If set to t, always ask if any Eshell buffers are open at exit time. | ||
| 86 | If 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. | ||
| 109 | This is provided for convenience, since the same effect is easily | ||
| 110 | achieved by adding a function to `eshell-directory-change-hook' that | ||
| 111 | calls \"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'). | ||
| 117 | This 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. | ||
| 123 | This 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. | ||
| 129 | This 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. | ||
| 135 | This 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. | ||
| 142 | See also `eshell-read-last-dir-ring' and `eshell-write-last-dir-ring'. | ||
| 143 | If 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. | ||
| 149 | This ring is added to every time `cd' or `pushd' is used. It simply | ||
| 150 | stores the most recent directory locations Eshell has been in. To | ||
| 151 | return to the most recent entry, use 'cd -' (equivalent to 'cd -0'). | ||
| 152 | To return to an older entry, use 'cd -N', where N is an integer less | ||
| 153 | than `eshell-last-dir-ring-size'. To return to the last directory | ||
| 154 | matching a particular regexp, use 'cd =REGEXP'. To display the | ||
| 155 | directory history list, use 'cd ='. | ||
| 156 | |||
| 157 | This mechanism is very similar to that provided by `pushd', except | ||
| 158 | it's far more automatic. `pushd' allows the user to decide which | ||
| 159 | directories gets pushed, and its size is unlimited. | ||
| 160 | |||
| 161 | `eshell-last-dir-ring' is meant for users who don't use `pushd' | ||
| 162 | explicity very much, but every once in a while would like to return to | ||
| 163 | a previously visited directory without having to type in the whole | ||
| 164 | thing 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. | ||
| 177 | Thus, 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 | |||
| 314 | With the following piece of advice, you can make this functionality | ||
| 315 | available in most of Emacs, with the exception of filename completion | ||
| 316 | in 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 | ||
| 28 | by 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. | ||
| 161 | The character is not advanced for ordinary globbing characters, so | ||
| 162 | that other function may have a chance to override the globbing | ||
| 163 | interpretation." | ||
| 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. | ||
| 184 | The 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 | |||
| 197 | If any characters in PATTERN have the text property `eshell-escaped' | ||
| 198 | set to true, then these characters will match themselves in the | ||
| 199 | resulting 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. | ||
| 89 | See also `eshell-read-history' and `eshell-write-history'. | ||
| 90 | If 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. | ||
| 101 | This 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. | ||
| 107 | History is always preserved after sanely exiting an Eshell buffer. | ||
| 108 | However, when Emacs is being shut down, this variable determines | ||
| 109 | whether to prompt the user. | ||
| 110 | If set to nil, it means never ask whether history should be saved. | ||
| 111 | If set to t, always ask if any Eshell buffers are open at exit time. | ||
| 112 | If 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. | ||
| 123 | Takes one argument, the input. If non-nil, the input may be saved on | ||
| 124 | the input history list. Default is to save anything that isn't all | ||
| 125 | whitespace." | ||
| 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. | ||
| 133 | Otherwise, typing <M-p> and <M-n> will always go to the next history | ||
| 134 | element, 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'. | ||
| 317 | This is also the location where history info will be saved by this command, | ||
| 318 | unless 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. | ||
| 367 | The input is entered into the input history ring, if the value of | ||
| 368 | variable `eshell-input-filter' returns non-nil when called on the | ||
| 369 | input." | ||
| 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. | ||
| 384 | The 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 | |||
| 389 | If the optional argument SILENT is non-nil, we say nothing about a | ||
| 390 | failure to read the history file. | ||
| 391 | |||
| 392 | This function is useful for major mode commands and mode hooks. | ||
| 393 | |||
| 394 | The structure of the history file should be one input command per | ||
| 395 | line, 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. | ||
| 429 | The name of the file is given by the variable | ||
| 430 | `eshell-history-file-name'. The original contents of the file are | ||
| 431 | lost if `eshell-history-ring' is not empty. If | ||
| 432 | `eshell-history-file-name' is nil this function does nothing. | ||
| 433 | |||
| 434 | Useful within process sentinels. | ||
| 435 | |||
| 436 | See 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. | ||
| 594 | The syntax used here was taken from the Bash info manual. | ||
| 595 | Returns the resultant reference, or the same string REFERENCE if none | ||
| 596 | matched." | ||
| 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. | ||
| 714 | In other words, this recalls the input line after the line you | ||
| 715 | recalled 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. | ||
| 754 | Moves 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. | ||
| 772 | Moves 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. | ||
| 779 | Moves 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.) | ||
| 809 | With prefix argument N, search for Nth previous match. | ||
| 810 | If 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.) | ||
| 826 | With prefix argument N, search for Nth following match. | ||
| 827 | If 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.) | ||
| 834 | With prefix argument N, search for Nth previous match. | ||
| 835 | If 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.) | ||
| 851 | With prefix argument N, search for Nth following match. | ||
| 852 | If 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 | ||
| 28 | passed any unrecognized command switches, it will revert to the | ||
| 29 | operating system's version. This version of \"ls\" uses text | ||
| 30 | properties 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. | ||
| 135 | This typically includes both traditional archives and compressed | ||
| 136 | files." | ||
| 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. | ||
| 161 | Products are files that get generated from a source file, and hence | ||
| 162 | ought 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. | ||
| 175 | These are mainly files that get created for various reasons, but don't | ||
| 176 | really 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. | ||
| 193 | This is really just for efficiency, to avoid having to stat the file | ||
| 194 | yet 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. | ||
| 201 | The format of the members of this alist is | ||
| 202 | |||
| 203 | (TEST-SEXP . FACE) | ||
| 204 | |||
| 205 | If TEST-SEXP evals to non-nil, that face will be used to highlight the | ||
| 206 | name of the file. The first match wins. `file' and `attrs' are in | ||
| 207 | scope 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. | ||
| 216 | Leaves point after the inserted text. | ||
| 217 | SWITCHES may be a string of options, or a list of strings. | ||
| 218 | Optional third arg WILDCARD means treat FILE as shell wildcard. | ||
| 219 | Optional fourth arg FULL-DIRECTORY-P means file is a directory and | ||
| 220 | switches do not contain `d', so that a full listing is expected. | ||
| 221 | |||
| 222 | This version of the function uses `eshell/ls'. If any of the switches | ||
| 223 | passed are not recognized, the operating system's version will be used | ||
| 224 | instead." | ||
| 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]... | ||
| 322 | List information about the FILEs (the current directory by default). | ||
| 323 | Sort 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. | ||
| 370 | This means resolving any symbolic links, determining what face the | ||
| 371 | name 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. | ||
| 403 | FILE may be a string, or a cons cell whose car is the filename and | ||
| 404 | whose 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. | ||
| 463 | If INSERT-NAME is non-nil, the name of DIRINFO will be output. If | ||
| 464 | ROOT-DIR is also non-nil, and a directory name, DIRINFO will be output | ||
| 465 | relative 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. | ||
| 531 | In 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. | ||
| 574 | Each 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. | ||
| 647 | Each member of ENTRIES may either be a string or a cons cell, the car | ||
| 648 | of which is the file name, and the cdr of which is the list of | ||
| 649 | attributes. | ||
| 650 | If SEPARATE is non-nil, directories name will be entirely separated | ||
| 651 | from the filenames. This is the normal behavior, except when doing a | ||
| 652 | recursive listing. | ||
| 653 | ROOT-DIR, if non-nil, specifies the root directory of the listing, to | ||
| 654 | which non-absolute directory names will be made relative if ever they | ||
| 655 | need 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. | ||
| 693 | It will be returned as a vector, whose length is the number of columns | ||
| 694 | to 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. | ||
| 740 | It will be returned as a vector, whose length is the number of columns | ||
| 741 | to 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. | ||
| 807 | Use 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 | ||
| 28 | patterns (similar to zsh), in addition to string modifiers which can | ||
| 29 | be applied either to globbing results, variable references, or just | ||
| 30 | ordinary 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. | ||
| 103 | The 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. | ||
| 152 | The 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 | |||
| 166 | FILE 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 | |||
| 173 | PERMISSION 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 | |||
| 178 | OWNERSHIP: | ||
| 179 | U owned by effective uid | ||
| 180 | u(UID|'user') owned by UID/user | ||
| 181 | g(GID|'group') owned by GID/group | ||
| 182 | |||
| 183 | FILE 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 | |||
| 193 | EXAMPLES: | ||
| 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 | |||
| 205 | FOR 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 | |||
| 219 | FOR 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 | |||
| 233 | EXAMPLES: | ||
| 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. | ||
| 278 | This 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. | ||
| 305 | If ALLOW-PREDS is non-nil, predicates will be parsed as well. | ||
| 306 | Return a cons cell of the form | ||
| 307 | |||
| 308 | (PRED-FUNC-LIST . MOD-FUNC-LIST) | ||
| 309 | |||
| 310 | NEW-STRING is STRING minus any modifiers. PRED-FUNC-LIST is a list of | ||
| 311 | predicate functions. MOD-FUNC-LIST is a list of result modifier | ||
| 312 | functions. PRED-FUNCS take a filename and return t if the test | ||
| 313 | succeeds; MOD-FUNCS take any string and preform a modification, | ||
| 314 | returning 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. | ||
| 459 | TYPE must be a character, and should be one of the possible options | ||
| 460 | that '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, | ||
| 28 | as 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. | ||
| 50 | Make sure to update `eshell-prompt-regexp' so that it will match your | ||
| 51 | prompt." | ||
| 52 | :type 'function | ||
| 53 | :group 'eshell-prompt) | ||
| 54 | |||
| 55 | (defcustom eshell-prompt-regexp "^[^#$\n]* [#$] " | ||
| 56 | "*A regexp which fully matches your eshell prompt. | ||
| 57 | This setting is important, since it affects how eshell will interpret | ||
| 58 | the lines that are passed to it. | ||
| 59 | If this variable is changed, all Eshell buffers must be exited and | ||
| 60 | re-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. | ||
| 74 | For highlighting other kinds of strings -- similar to shell mode's | ||
| 75 | behavior -- 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. | ||
| 86 | Note that if `eshell-scroll-show-maximum-output' is non-nil, then | ||
| 87 | setting `eshell-show-maximum-output' here won't do much. It depends | ||
| 88 | on whether the user wants the resizing to happen while output is | ||
| 89 | arriving, 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. | ||
| 129 | Matches are searched for on lines that match `eshell-prompt-regexp'. | ||
| 130 | With prefix argument N, search for Nth previous match. | ||
| 131 | If 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. | ||
| 145 | Matches are searched for on lines that match `eshell-prompt-regexp'. | ||
| 146 | With prefix argument N, search for Nth following match. | ||
| 147 | If 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. | ||
| 153 | See `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. | ||
| 160 | See `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'. | ||
| 166 | If 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 | ||
| 28 | while the point is in a region of input text. By default, it binds | ||
| 29 | C-a to move to the beginning of the input text (rather than just the | ||
| 30 | beginning of the line), and C-p and C-n to move through the input | ||
| 31 | history, C-u kills the current input text, etc. It also, if | ||
| 32 | `eshell-confine-point-to-input' is non-nil, does not allow certain | ||
| 33 | commands to cause the point to leave the input area, such as | ||
| 34 | `backward-word', `previous-line', etc. This module intends to mimic | ||
| 35 | the 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. | ||
| 64 | This is more difficult to do nicely in Emacs than one might think. | ||
| 65 | Basically, the `point-left' attribute is added to the input text, and | ||
| 66 | a 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 | ||
| 68 | since 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 | ||
| 71 | from this rule. However, this list is by no means as complete as it | ||
| 72 | probably should be, so basically all one can hope for is that other | ||
| 73 | people 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. | ||
| 79 | This 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. | ||
| 162 | Within a prefix arg, set the local keymap to its normal value, and | ||
| 163 | lock 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. | ||
| 232 | Sends an EOF only if point is at the end of the buffer and there is no | ||
| 233 | input." | ||
| 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 | ||
| 28 | commands, 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. | ||
| 43 | This file should be a file containing Eshell commands, where comment | ||
| 44 | lines 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. | ||
| 50 | This 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. | ||
| 84 | Comments 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] | ||
| 113 | Invoke 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] | ||
| 124 | Invoke the Eshell commands in FILE within the current shell | ||
| 125 | environment, 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 | ||
| 28 | some of the edit/review concepts inherent in the design of Plan 9's | ||
| 29 | 9term. See the docs for more details. | ||
| 30 | |||
| 31 | Most likely you will have to turn this option on and play around with | ||
| 32 | it 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. | ||
| 98 | A quick command is one that produces no output, and exits | ||
| 99 | successfully." | ||
| 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. | ||
| 116 | That is, if a command is running and the user presses SPACE at a time | ||
| 117 | when the end of the buffer is visible, point will go to the end of the | ||
| 118 | buffer and smart-display will be turned off (that is, subsequently | ||
| 119 | pressing backspace will not cause the buffer to scroll down). | ||
| 120 | |||
| 121 | This feature is provided to make it very easy to watch the output of a | ||
| 122 | long-running command, such as make, where it's more desirable to see | ||
| 123 | the output go by than to review it afterward. | ||
| 124 | |||
| 125 | Setting this variable to nil means that space and backspace will | ||
| 126 | always have a consistent behavior, which is to move back and forth | ||
| 127 | through displayed output. But it also means that enabling output | ||
| 128 | tracking requires the user to manually move point to the end of the | ||
| 129 | buffer 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. | ||
| 135 | The 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. | ||
| 236 | This is done whenever a command exits sucessfully that displayed no | ||
| 237 | output." | ||
| 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 | ||
| 28 | the `term' package, which comes with Emacs. This package handles most | ||
| 29 | of the ANSI control codes, allowing curses-based applications to run | ||
| 30 | within an Emacs window. The variable `eshell-visual-commands' defines | ||
| 31 | which 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. | ||
| 66 | See `term-term-name' in term.el for more information on how this is | ||
| 67 | used." | ||
| 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. | ||
| 73 | See the variable `eshell-visual-commands'. If this variable is set to | ||
| 74 | nil, <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. | ||
| 97 | ARGS are passed to the program. At the moment, no piping of input is | ||
| 98 | allowed." | ||
| 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 | ||
| 28 | aliases implemented in Lisp. These include mv, ln, cp, rm, etc. If | ||
| 29 | the user passes arguments which are too complex, or are unrecognized | ||
| 30 | by the Lisp variant, the external version will be called (if | ||
| 31 | available). The only reason not to use them would be because they are | ||
| 32 | usually much slower. But in several cases their tight integration | ||
| 33 | with Eshell makes them more versatile than their traditional cousins | ||
| 34 | \(such as being able to use `kill' to kill Eshell background processes | ||
| 35 | by 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. | ||
| 60 | Standalone in this context means not redirected, and not on the | ||
| 61 | receiving 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. | ||
| 72 | Standalone in this context means not redirected, and not on the | ||
| 73 | receiving 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. | ||
| 79 | Standalone in this context means not redirected, and not on the | ||
| 80 | receiving 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. | ||
| 86 | Otherwise, `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. | ||
| 189 | This is implemented to call either `delete-file', `kill-buffer', | ||
| 190 | `kill-process', or `unintern', depending on the nature of the | ||
| 191 | argument." | ||
| 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... | ||
| 207 | Remove (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... | ||
| 268 | Create 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... | ||
| 282 | Remove 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 | ||
| 450 | Rename 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 | ||
| 482 | Copy 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 | ||
| 505 | Create a link to the specified TARGET with optional LINK_NAME. If there is | ||
| 506 | more than one TARGET, the last argument must be a directory; create links | ||
| 507 | in DIRECTORY to each TARGET. Create hard links by default, symbolic links | ||
| 508 | with '--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... | ||
| 537 | Concatenate 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'. | ||
| 594 | This eats up memory, since it leaves the buffers open (to speed future | ||
| 595 | searches), and it's very slow. But, if your system has no grep | ||
| 596 | available..." | ||
| 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. | ||
| 636 | It calls Emacs' grep utility if the command is not redirecting output, | ||
| 637 | and if it's not part of a command pipeline. Otherwise, it calls the | ||
| 638 | external 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... | ||
| 805 | Summarize 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... | ||
| 858 | Show 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 | ||
| 28 | optional. They can be viewed as samples for how to write Eshell alias | ||
| 29 | functions, or as aliases which make some of Emacs' behavior more | ||
| 30 | naturally 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 | ||
| 28 | command line into equivalent Lisp forms that, when evaluated, will | ||
| 29 | yield 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. | ||
| 101 | When each function on this hook is called, point will be at the | ||
| 102 | current position within the argument list. The function should either | ||
| 103 | return nil, meaning that it did no argument parsing, or it should | ||
| 104 | return the result of the parse as a sexp. It is also responsible for | ||
| 105 | moving the point forward to reflect the amount of input text that was | ||
| 106 | parsed. | ||
| 107 | |||
| 108 | If no function handles the current character at point, it will be | ||
| 109 | treated 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. | ||
| 135 | Without 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. | ||
| 196 | If 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. | ||
| 205 | Returns the list of arguments in their raw form. | ||
| 206 | Point 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. | ||
| 279 | If 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. | ||
| 288 | It only means escape if the character immediately following is a | ||
| 289 | special 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 | ||
| 28 | loaded 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. | ||
| 59 | This can be useful on systems like Windows, where the operating system | ||
| 60 | doesn't happen to honor the permission bits in certain cases; or in | ||
| 61 | cases where you want to associate an interpreter with a particular | ||
| 62 | kind of script file, but the language won't let you but a '#!' | ||
| 63 | interpreter line in the file, and you don't want to make it executable | ||
| 64 | since 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. | ||
| 97 | This defaults to nil on non-Windows systems, where this variable is | ||
| 98 | wholly 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. | ||
| 116 | Each member is a cons cell of the form: | ||
| 117 | |||
| 118 | (MATCH . INTERPRETER) | ||
| 119 | |||
| 120 | MATCH should be a regexp, which is matched against the command name, | ||
| 121 | or a function. If either returns a non-nil value, then INTERPRETER | ||
| 122 | will be used for that command. | ||
| 123 | |||
| 124 | If INTERPRETER is a string, it will be called as the command name, | ||
| 125 | with the original command name passed as the first argument, with all | ||
| 126 | subsequent arguments following. If INTERPRETER is a function, it will | ||
| 127 | be called with all of those arguments. Note that interpreter | ||
| 128 | functions should throw `eshell-replace-command' with the alternate | ||
| 129 | command form, or they should return a value compatible with the | ||
| 130 | possible 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. | ||
| 137 | If a functions wishes to provide an alternate command, they must throw | ||
| 138 | it using the tag `eshell-replace-command'. This is done because the | ||
| 139 | substituted command need not be external at all, and therefore must be | ||
| 140 | passed up to a higher level for re-evaluation. | ||
| 141 | |||
| 142 | Or, if the function returns a filename, that filename will be invoked | ||
| 143 | with the current command arguments rather than the command specified | ||
| 144 | by 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. | ||
| 162 | This 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. | ||
| 174 | A remote command is something that executes on a different machine. | ||
| 175 | An external command simply means external to Emacs. | ||
| 176 | |||
| 177 | Note that this function is very crude at the moment. It gathers up | ||
| 178 | all the output from the remote command, and sends it all at once, | ||
| 179 | causing 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 | ||
| 224 | Adds 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. | ||
| 244 | Return 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. | ||
| 262 | If NO-EXAMINE-P is non-nil, FILE will not be inspected for a script | ||
| 263 | line 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. | ||
| 11 | It exists so that others wishing to create their own Eshell extension | ||
| 12 | modules 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 | ||
| 19 | are traditionally considered shell builtins. Since all of the | ||
| 20 | functionality provided by them is accessible through Lisp, they are | ||
| 21 | not really builtins at all, but offer a command-oriented way to do the | ||
| 22 | same 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 | ||
| 28 | the TAB key, which allows for completing command names, file names, | ||
| 29 | variable 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 | ||
| 35 | current directory, maintaining a directory stack, and also keeping | ||
| 36 | track of a history of the last directory locations the user was in. | ||
| 37 | Emacs does provide standard Lisp definitions of `pwd' and `cd', but | ||
| 38 | they 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 | ||
| 44 | by 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 | ||
| 55 | passed any unrecognized command switches, it will revert to the | ||
| 56 | operating system's version. This version of \"ls\" uses text | ||
| 57 | properties 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 | ||
| 64 | patterns (similar to zsh), in addition to string modifiers which can | ||
| 65 | be applied either to globbing results, variable references, or just | ||
| 66 | ordinary 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, | ||
| 72 | as 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 | ||
| 78 | while the point is in a region of input text. By default, it binds | ||
| 79 | C-a to move to the beginning of the input text (rather than just the | ||
| 80 | beginning of the line), and C-p and C-n to move through the input | ||
| 81 | history, C-u kills the current input text, etc. It also, if | ||
| 82 | `eshell-confine-point-to-input' is non-nil, does not allow certain | ||
| 83 | commands to cause the point to leave the input area, such as | ||
| 84 | `backward-word', `previous-line', etc. This module intends to mimic | ||
| 85 | the 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 | ||
| 91 | commands, 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 | ||
| 97 | some of the edit/review concepts inherent in the design of Plan 9's | ||
| 98 | 9term. See the docs for more details. | ||
| 99 | |||
| 100 | Most likely you will have to turn this option on and play around with | ||
| 101 | it 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 | ||
| 108 | the `term' package, which comes with Emacs. This package handles most | ||
| 109 | of the ANSI control codes, allowing curses-based applications to run | ||
| 110 | within an Emacs window. The variable `eshell-visual-commands' defines | ||
| 111 | which 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 | ||
| 117 | aliases implemented in Lisp. These include mv, ln, cp, rm, etc. If | ||
| 118 | the user passes arguments which are too complex, or are unrecognized | ||
| 119 | by the Lisp variant, the external version will be called (if | ||
| 120 | available). The only reason not to use them would be because they are | ||
| 121 | usually much slower. But in several cases their tight integration | ||
| 122 | with Eshell makes them more versatile than their traditional cousins | ||
| 123 | \(such as being able to use `kill' to kill Eshell background processes | ||
| 124 | by 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 | ||
| 130 | optional. They can be viewed as samples for how to write Eshell alias | ||
| 131 | functions, or as aliases which make some of Emacs' behavior more | ||
| 132 | naturally 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 | ||
| 28 | different kinds of objects -- symbols, files, buffers, etc. -- as | ||
| 29 | though 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. | ||
| 77 | Currently this is standard input, output and error. But even all of | ||
| 78 | these Emacs does not currently support with asynchronous processes | ||
| 79 | \(which is what eshell uses so that you can continue doing work in | ||
| 80 | other 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. | ||
| 96 | If nil, redirecting to a buffer requires buffer name syntax. If this | ||
| 97 | variable is set, redirection directly to Lisp symbols will be | ||
| 98 | impossible. | ||
| 99 | |||
| 100 | Example: | ||
| 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. | ||
| 109 | This is basically a speed enhancement, to avoid blocking the Lisp code | ||
| 110 | from 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. | ||
| 126 | If the user specifies any of the filenames above as a redirection | ||
| 127 | target, the function in the second element will be called. | ||
| 128 | |||
| 129 | If the third element is non-nil, the redirection mode is passed as an | ||
| 130 | argument (which is the symbol `overwrite', `append' or `insert'), and | ||
| 131 | the function is expected to return another function -- which is the | ||
| 132 | output function. Otherwise, the second element itself is the output | ||
| 133 | function. | ||
| 134 | |||
| 135 | The output function is then called repeatedly with a single strings, | ||
| 136 | with represents success pieces of the output of the command, until nil | ||
| 137 | is passed, meaning EOF. | ||
| 138 | |||
| 139 | NOTE: /dev/null is handled specially as a virtual target, and should | ||
| 140 | not 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. | ||
| 233 | The default location for standard output and standard error will go to | ||
| 234 | STANDARD-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. | ||
| 256 | STATUS 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. | ||
| 292 | EXIT-CODE is the process exit code; mainly, it is zero, if the command | ||
| 293 | completed successfully. RESULT is the quoted value of the last | ||
| 294 | command. If nil, then the meta variables for keeping track of the | ||
| 295 | last 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. | ||
| 329 | MODE 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. | ||
| 414 | Must be called before printing begins with -1 as its argument, and | ||
| 415 | after 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. | ||
| 460 | Returns 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 | ||
| 28 | provide optional behavior which the user can enable or disable by | ||
| 29 | customizing 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. | ||
| 102 | Changes 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. | ||
| 126 | The MODULE should be a symbol corresponding to that module's | ||
| 127 | customization 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 | ||
| 28 | Eshell 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. | ||
| 39 | After doing so, settings will be stored in local symbols as declared | ||
| 40 | by OPTIONS; FORMS will then be evaluated -- assuming all was OK. | ||
| 41 | |||
| 42 | The 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 | ||
| 53 | BODY-FORMS. If instead an external command is run, the tag | ||
| 54 | `eshell-external' will be thrown with the new process for its value. | ||
| 55 | |||
| 56 | Lastly, any remaining arguments will be available in a locally | ||
| 57 | interned 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'. | ||
| 82 | This 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 " | ||
| 146 | This command is implemented in Lisp. If an unrecognized option is | ||
| 147 | passed to this command, the external version '%s' | ||
| 148 | will 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. | ||
| 153 | If the option consumes an argument for its value, the argument list | ||
| 154 | will 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. | ||
| 168 | The SWITCH will be looked up in the set of OPTIONS. | ||
| 169 | |||
| 170 | SWITCH should be either a string or character. KIND should be the | ||
| 171 | integer 0 if it's a character, or 1 if it's a string. | ||
| 172 | |||
| 173 | The SWITCH is then be matched against OPTIONS. If no matching handler | ||
| 174 | is found, and an :external command is defined (and available), it will | ||
| 175 | be called; otherwise, an error will be triggered to say that the | ||
| 176 | switch 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. | ||
| 201 | This 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 | ||
| 28 | asynchronously, so that Emacs isn't tied up waiting for the process to | ||
| 29 | finish." | ||
| 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. | ||
| 59 | This variable sets the buffer-local value of `delete-exited-processes' | ||
| 60 | in Eshell buffers. | ||
| 61 | |||
| 62 | This variable causes Eshell to mimic the behavior of bash when set to | ||
| 63 | nil. It allows the user to view the exit status of a completed subjob | ||
| 64 | \(process) at their leisure, because the process entry remains in | ||
| 65 | memory until the user examines it using \\[list-processes]. | ||
| 66 | |||
| 67 | Otherwise, if `eshell-done-messages-in-minibuffer' is nil, and this | ||
| 68 | variable is set to t, the only indication the user will have that a | ||
| 69 | subjob is done is that it will no longer appear in the | ||
| 70 | \\[list-processes\\] display. | ||
| 71 | |||
| 72 | Note that Eshell will have to be restarted for a change in this | ||
| 73 | variable'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'. | ||
| 85 | It is passed one argument, which is the process that was just started. | ||
| 86 | It is useful for things that must be done each time a process is | ||
| 87 | executed in a eshell mode buffer (e.g., `process-kill-without-query'). | ||
| 88 | In contrast, `eshell-mode-hook' is only executed once when the buffer | ||
| 89 | is 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. | ||
| 95 | It is passed two arguments: the process that was just ended, and the | ||
| 96 | termination status (as a string). Note that the first argument may be | ||
| 97 | nil, in which case the user attempted to send a signal, but there was | ||
| 98 | no relevant process. This can be used for displaying help | ||
| 99 | information, 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. | ||
| 126 | The 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. | ||
| 192 | The 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. | ||
| 275 | PROC is the process for which we're inserting output. STRING is the | ||
| 276 | output." | ||
| 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. | ||
| 293 | PROC 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. | ||
| 314 | If ALL is non-nil, background processes will be interacted with as well. | ||
| 315 | If 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. | ||
| 342 | Eshell calls each of these signals in order when an Eshell buffer is | ||
| 343 | killed; if the process is still alive afterwards, Eshell waits a | ||
| 344 | number of seconds defined by `eshell-kill-process-wait-time', and | ||
| 345 | tries 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. | ||
| 351 | Emacs will only kill processes owned by that Eshell buffer. | ||
| 352 | |||
| 353 | If nil, ownership of background and foreground processes reverts to | ||
| 354 | Emacs itself, and will die only if the user exits Emacs, calls | ||
| 355 | `kill-process', or terminates the processes externally. | ||
| 356 | |||
| 357 | If `ask', Emacs prompts the user before killing any processes. | ||
| 358 | |||
| 359 | If `every', it prompts once for every process. | ||
| 360 | |||
| 361 | If t, it kills all buffer-owned processes without asking. | ||
| 362 | |||
| 363 | Processes are first sent SIGHUP, then SIGINT, then SIGQUIT, then | ||
| 364 | SIGKILL. The variable `eshell-kill-process-wait-time' specifies how | ||
| 365 | long 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. | ||
| 374 | See 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. | ||
| 63 | When `eshell-toggle-cd' is called the point is always moved to the | ||
| 64 | end 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. | ||
| 68 | If nil `eshell-toggle-cd' will only insert the \"cd\" command in the | ||
| 69 | eshell-buffer. Leaving it to the user to press RET to send the | ||
| 70 | command to the eshell.") | ||
| 71 | |||
| 72 | ;;; User Functions: | ||
| 73 | |||
| 74 | ;;;###autoload | ||
| 75 | (defun eshell-toggle-cd () | ||
| 76 | "Calls `eshell-toggle' with a prefix argument. | ||
| 77 | See 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. | ||
| 84 | With a prefix ARG also insert a \"cd DIR\" command into the eshell, | ||
| 85 | where DIR is the directory of the current buffer. | ||
| 86 | |||
| 87 | Call twice in a row to get a full screen window for the *eshell* | ||
| 88 | buffer. | ||
| 89 | |||
| 90 | When called in the *eshell* buffer returns you to the buffer you were | ||
| 91 | editing before caling the first time. | ||
| 92 | |||
| 93 | Options: `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. | ||
| 116 | If 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. | ||
| 126 | If no *eshell* buffer exists start a new eshell and switch to it in | ||
| 127 | other window. If argument MAKE-CD is non-nil, insert a \"cd DIR\" | ||
| 128 | command into the eshell, where DIR is the directory of the current | ||
| 129 | buffer. | ||
| 130 | Stores 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. | ||
| 165 | If the current window is the only window in the current frame, create | ||
| 166 | a new window and switch to it. (This is less intrusive to the current | ||
| 167 | window 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 | ||
| 28 | appears unquoted in any argument (except when that argument is | ||
| 29 | surrounded by single quotes) . It may be used to interpolate a | ||
| 30 | variable 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. | ||
| 140 | Note that this only applies for '$NAME'. If the syntax '$<NAME>' is | ||
| 141 | used, then NAME can contain any character, including angle brackets, | ||
| 142 | if 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. | ||
| 175 | It is very similar in concept to what `eshell-user-aliases-list' does | ||
| 176 | for commands. Each member of this defines defines the name of a | ||
| 177 | command, and the Lisp value to return for that variable if it is | ||
| 178 | accessed via the syntax '$NAME'. | ||
| 179 | |||
| 180 | If the value is a function, that function will be called with two | ||
| 181 | arguments: the list of the indices that was used in the reference, and | ||
| 182 | whether the user is requesting the length of the ultimate element. | ||
| 183 | For example, a reference of '$NAME[10][20]' would result in the | ||
| 184 | function for alias `NAME' being called (assuming it were aliased to a | ||
| 185 | function), 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. | ||
| 265 | This 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. | ||
| 352 | This involves setting any variable aliases which affect the | ||
| 353 | environment, 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. | ||
| 364 | The variable name could refer to either an environment variable, or a | ||
| 365 | Lisp variable. The priority order depends on the setting of | ||
| 366 | `eshell-prefer-lisp-variables'. | ||
| 367 | |||
| 368 | Its purpose is to call `eshell-parse-variable-ref', and then to | ||
| 369 | process 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. | ||
| 387 | Returns a Lisp form which, if evaluated, will return the value of the | ||
| 388 | variable. | ||
| 389 | |||
| 390 | Possible 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. | ||
| 521 | The format of INDICES is: | ||
| 522 | |||
| 523 | ((INT-OR-NAME-OR-OTHER INT-OR-NAME INT-OR-NAME ...) | ||
| 524 | ...) | ||
| 525 | |||
| 526 | Each member of INDICES represents a level of nesting. If the first | ||
| 527 | member of a sublist is not an integer or name, and the value it's | ||
| 528 | reference is a string, that will be used as the regexp with which is | ||
| 529 | to divide the string into sub-parts. The default is whitespace. | ||
| 530 | Otherwise, each INT-OR-NAME refers to an element of the list value. | ||
| 531 | Integers imply a direct index, and names, an associate lookup using | ||
| 532 | `assoc'. | ||
| 533 | |||
| 534 | For 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 | ||
| 32 | invokes no external processes beyond those requested by the user. It | ||
| 33 | is intended to be a functional replacement for command shells such as | ||
| 34 | bash, zsh, rc, 4dos; since Emacs itself is capable of handling most of | ||
| 35 | the 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. | ||
| 299 | The buffer used for Eshell sessions is determined by the value of | ||
| 300 | `eshell-buffer-name'. If there is already an Eshell session active in | ||
| 301 | that buffer, Emacs will simply switch to it. Otherwise, a new session | ||
| 302 | will begin. A new session is always created if the the prefix | ||
| 303 | argument 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. | ||
| 334 | With 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. | ||
| 407 | The result might be any Lisp object. | ||
| 408 | If STATUS-VAR is a symbol, it will be set to the exit status of the | ||
| 409 | command. This is the only way to determine whether the value returned | ||
| 410 | corresponding 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. | ||
| 448 | Prompts for the TOPIC. Leaves you in a mail buffer. | ||
| 449 | Please 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. | ||
| 474 | If the user has require'd in any of the modules, or customized a | ||
| 475 | variable with a :require tag (such as `eshell-prefer-to-shell'), it | ||
| 476 | will be impossible to unload Eshell completely without restarting | ||
| 477 | Emacs." | ||
| 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. | ||
| 149 | This 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. | ||
| 160 | This mirrors the optional behavior of tcsh. | ||
| 161 | |||
| 162 | A 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. | ||
| 174 | Each function is passed both the filename to be quoted, and the index | ||
| 175 | to be considered. If the function wishes to provide an alternate | ||
| 176 | quoted form, it need only return the replacement string. If no | ||
| 177 | function provides a replacement, quoting shall proceed as normal, | ||
| 178 | using 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. | ||
| 185 | It 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. | ||
| 191 | The 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. | ||
| 199 | If a string, it should name an Info node that will be jumped to. | ||
| 200 | If non-nil, it must a sexp that will be evaluated, and whose | ||
| 201 | result will be shown in the minibuffer. | ||
| 202 | If nil, the function `pcomplete-man-function' will be called with the | ||
| 203 | current 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. | ||
| 209 | This means that typing something such as '$HOME/bi' followed by | ||
| 210 | \\[pcomplete-argument] will cause the variable reference to be | ||
| 211 | resolved first, and the resultant value that will be completed against | ||
| 212 | to be inserted in the buffer. Note that exactly what gets expanded | ||
| 213 | and 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. | ||
| 221 | It should be called with no parameters, and with point at the position | ||
| 222 | of the argument that is to be completed. | ||
| 223 | |||
| 224 | It must either return nil, or a cons cell of the form: | ||
| 225 | |||
| 226 | ((ARG...) (BEG-POS...)) | ||
| 227 | |||
| 228 | The two lists must be identical in length. The first gives the final | ||
| 229 | value of each command line argument (which need not match the textual | ||
| 230 | representation of that argument), and BEG-POS gives the beginning | ||
| 231 | position of each argument, as it is seen by the user. The establishes | ||
| 232 | a relationship between the fully resolved value of the argument, and | ||
| 233 | the 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. | ||
| 239 | Typical Emacs behavior is to complete as much as possible, then pause | ||
| 240 | waiting for further input. Then if TAB is hit again, show a list of | ||
| 241 | possible completions. When `pcomplete-cycle-completions' is non-nil, | ||
| 242 | it acts more like zsh or 4nt, showing the first maximal match first, | ||
| 243 | followed by any further matches on each subsequent pressing of the TAB | ||
| 244 | key. \\[pcomplete-list] is the key to press if the user wants to see | ||
| 245 | the 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. | ||
| 251 | This variable is a compromise between the traditional Emacs style of | ||
| 252 | completion, and the \"cycling\" style. Basically, if there are more | ||
| 253 | than this number of completions possible, don't automatically pick the | ||
| 254 | first one and then expect the user to press TAB to cycle through them. | ||
| 255 | Typically, when there are a large number of completion possibilities, | ||
| 256 | the user wants to see them in a list buffer so that they can know what | ||
| 257 | options are available. But if the list is small, it means the user | ||
| 258 | has already entered enough input to disambiguate most of the | ||
| 259 | possibilities, and therefore they are probably most interested in | ||
| 260 | cycling through the candidates. Set this value to nil if you want | ||
| 261 | cycling 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. | ||
| 267 | Once the completion window has been displayed, if the user then goes | ||
| 268 | on to type something else, that completion window will be removed from | ||
| 269 | the display (actually, the original window configuration before it was | ||
| 270 | displayed will be restored), after this many seconds of idle time. If | ||
| 271 | set to nil, completion windows will be left on second until the user | ||
| 272 | removes them manually. If set to 0, they will disappear immediately | ||
| 273 | after 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. | ||
| 279 | This can be used, for example, for completing things which might apply | ||
| 280 | to 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. | ||
| 302 | This 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. | ||
| 334 | To use this function, just bind the TAB key to it, or add it to your | ||
| 335 | completion 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. | ||
| 385 | This 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. | ||
| 401 | This 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. | ||
| 453 | INDEX is based from the current processing position. If INDEX is | ||
| 454 | positive, values returned are closer to the command argument; if | ||
| 455 | negative, they are closer to the last argument. If the INDEX is | ||
| 456 | outside of the argument list, nil is returned. The default value for | ||
| 457 | INDEX is 0, meaning the current argument being examined. | ||
| 458 | |||
| 459 | The special indices `first' and `last' may be used to access those | ||
| 460 | parts of the list. | ||
| 461 | |||
| 462 | The OFFSET argument is added to/taken away from the index that will be | ||
| 463 | used. This is really only useful with `first' and `last', for | ||
| 464 | accessing 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. | ||
| 477 | See 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. | ||
| 490 | This different from `pcomplete-arg', which returns the textual value | ||
| 491 | that the last argument evaluated to. This function returns what the | ||
| 492 | user 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. | ||
| 567 | COMPLETEF-SYM should be the symbol where the | ||
| 568 | dynamic-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. | ||
| 655 | Magic 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. | ||
| 686 | This function always uses the last argument as the basis for | ||
| 687 | completion. | ||
| 688 | If REGEXP is non-nil, it is a regular expression used to refine the | ||
| 689 | match (files not matching the REGEXP will be excluded). | ||
| 690 | If PREDICATE is non-nil, it will also be used to refine the match | ||
| 691 | \(files for which the PREDICATE returns nil will be excluded). | ||
| 692 | If PATH is non-nil, it will be used for completion instead of | ||
| 693 | consulting 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). | ||
| 791 | PREFIX may be t, in which case no PREFIX character is necessary. | ||
| 792 | If REQUIRED is non-nil, the options must be present. | ||
| 793 | If NO-GANGING is non-nil, each option is separate. -xy is not allowed. | ||
| 794 | If ARGS-FOLLOW is non-nil, then options which arguments which take may | ||
| 795 | have the argument appear after a ganged set of options. This is how | ||
| 796 | tar 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. | ||
| 848 | See 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. | ||
| 877 | If completion is to be done here, evaluate FORM to generate the list | ||
| 878 | of strings which will be used for completion purposes. If STUB is a | ||
| 879 | string, use it as the completion stub instead of the default (which is | ||
| 880 | the entire text of the current argument). | ||
| 881 | |||
| 882 | For an example of when you might want to use STUB: if the current | ||
| 883 | argument text is 'long-path-name/', you don't want the completions | ||
| 884 | list display to be cluttered by 'long-path-name/' appearing at the | ||
| 885 | beginning of every alternative. Not only does this make things less | ||
| 886 | intelligle, but it is also inefficient. Yet, if the completion list | ||
| 887 | does not begin with this string for every entry, the current argument | ||
| 888 | won't complete correctly. | ||
| 889 | |||
| 890 | The solution is to specify a relative stub. It allows you to | ||
| 891 | substitute a different argument from the current argument, almost | ||
| 892 | always for the sake of efficiency. | ||
| 893 | |||
| 894 | If PARING is nil, this argument will be pared against previous | ||
| 895 | arguments using the function `file-truename' to normalize them. | ||
| 896 | PARING may be a function, in which case that function is for | ||
| 897 | normalization. If PARING is the value t, the argument dealt with by | ||
| 898 | this call will not participate in argument paring. If it the integer | ||
| 899 | 0, all previous arguments that have been seen will be cleared. | ||
| 900 | |||
| 901 | If FORM-ONLY is non-nil, only the result of FORM will be used to | ||
| 902 | generate 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. | ||
| 938 | Typing 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. | ||
| 978 | Returns 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. | ||
| 1009 | This is basically just a wrapper for `pcomplete-stub' which does some | ||
| 1010 | extra 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. | ||
| 1058 | This function inserts completion characters at point by completing | ||
| 1059 | STUB from the strings in CANDIDATES. A completions listing may be | ||
| 1060 | shown in a help buffer if completion is ambiguous. | ||
| 1061 | |||
| 1062 | Returns nil if no completion was inserted. | ||
| 1063 | Returns `sole' if completed with the only completion match. | ||
| 1064 | Returns `shortest' if completed with the shortest of the matches. | ||
| 1065 | Returns `partial' if completed as far as possible with the matches. | ||
| 1066 | Returns `listed' if a completion listing was shown. | ||
| 1067 | |||
| 1068 | See 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. | ||
| 1112 | If specific documentation can't be given, be generic. | ||
| 1113 | INFODOC specifies the Info node to goto. DOCUMENTATION is a sexp | ||
| 1114 | which will produce documentation for the argument (it is responsible | ||
| 1115 | for 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. | ||
| 1141 | Test is done using `equal'. | ||
| 1142 | If PRED is non-nil, it is a function used for further removal. | ||
| 1143 | Returns 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 | ||