mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-28 10:56:36 +00:00
Code Issues Releases Activity

*** empty log message ***

Browse Source
This commit is contained in:
Gerd Moellmann 2000-06-23 05:24:10 +00:00
parent 022499fab9
commit affbf64775
30 changed files with 11543 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lisp/ChangeLog
View File

@ -1,5 +1,10 @@
2000-06-23 Gerd Moellmann <gerd@gnu.org>
* Makefile.in (DONTCOMPILE): Add eshell/esh-maint.el.
* eshell/esh-cmd.el (eshell-rewrite-for-command): Use cdr and
cddr instead of cdddr.
* eshell/esh-util.el (eshell-sublist): Use eshell-copy-list
instead of copy-list.

270
lisp/eshell/em-alias.el Normal file
View File

@ -0,0 +1,270 @@
;;; em-alias --- creation and management of command aliases
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'em-alias)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-alias nil
"Command aliases allow for easy definition of alternate commands."
:tag "Command aliases"
:link '(info-link "(eshell.info)Command aliases")
:group 'eshell-module)
;;; Commentary:
;; Command aliases greatly simplify the definition of new commands.
;; They exist as an alternative to alias functions, which are
;; otherwise quite superior, being more flexible and natural to the
;; Emacs Lisp environment (if somewhat trickier to define; [Alias
;; functions]).
;;
;;;_* Creating aliases
;;
;; The user interface is simple: type 'alias' followed by the command
;; name followed by the definition. Argument references are made
;; using '$1', '$2', etc., or '$*'. For example:
;;
;; alias ll 'ls -l $*'
;;
;; This will cause the command 'll NEWS' to be replaced by 'ls -l
;; NEWS'. This is then passed back to the command parser for
;; reparsing.{Only the command text specified in the alias definition
;; will be reparsed. Argument references (such as '$*') are handled
;; using variable values, which means that the expansion will not be
;; reparsed, but used directly.}
;;
;; To delete an alias, specify its name without a definition:
;;
;; alias ll
;;
;; Aliases are written to disk immediately after being defined or
;; deleted. The filename in which they are kept is defined by the
;; following variable:
(defcustom eshell-aliases-file (concat eshell-directory-name "alias")
"*The file in which aliases are kept.
Whenever an alias is defined by the user, using the `alias' command,
it will be written to this file. Thus, alias definitions (and
deletions) are always permanent. This approach was chosen for the
sake of simplicity, since that's pretty much the only benefit to be
gained by using this module."
:type 'file
:group 'eshell-alias)
;;;
;; The format of this file is quite basic. It specifies the alias
;; definitions in almost exactly the same way that the user entered
;; them, minus any argument quoting (since interpolation is not done
;; when the file is read). Hence, it is possible to add new aliases
;; to the alias file directly, using a text editor rather than the
;; `alias' command. Or, this method can be used for editing aliases
;; that have already defined.
;;
;; Here is an example of a few different aliases, and they would
;; appear in the aliases file:
;;
;; alias clean rm -fr **/.#*~
;; alias commit cvs commit -m changes $*
;; alias ll ls -l $*
;; alias info (info)
;; alias reindex glimpseindex -o ~/Mail
;; alias compact for i in ~/Mail/**/*~*.bz2(Lk+50) { bzip2 -9v $i }
;;
;;;_* Auto-correction of bad commands
;;
;; When a user enters the same unknown command many times during a
;; session, it is likely that they are experiencing a spelling
;; difficulty associated with a certain command. To combat this,
;; Eshell will offer to automatically define an alias for that
;; mispelled command, once a given tolerance threshold has been
;; reached.
(defcustom eshell-bad-command-tolerance 3
"*The number of failed commands to ignore before creating an alias."
:type 'integer
:link '(custom-manual "(eshell.info)Auto-correction of bad commands")
:group 'eshell-alias)
;;;
;; Whenever the same bad command name is encountered this many times,
;; the user will be prompted in the minibuffer to provide an alias
;; name. An alias definition will then be created which will result
;; in an equal call to the correct name. In this way, Eshell
;; gradually learns about the commands that the user mistypes
;; frequently, and will automatically correct them!
;;
;; Note that a '$*' is automatically appended at the end of the alias
;; definition, so that entering it is unnecessary when specifying the
;; corrected command name.
;;; Code:
(defcustom eshell-alias-load-hook '(eshell-alias-initialize)
"*A hook that gets run when `eshell-alias' is loaded."
:type 'hook
:group 'eshell-alias)
(defvar eshell-command-aliases-list nil
"A list of command aliases currently defined by the user.
Each element of this alias is a list of the form:
(NAME DEFINITION)
Where NAME is the textual name of the alias, and DEFINITION is the
command string to replace that command with.
Note: this list should not be modified in your '.emacs' file. Rather,
any desired alias definitions should be declared using the `alias'
command, which will automatically write them to the file named by
`eshell-aliases-file'.")
(put 'eshell-command-aliases-list 'risky-local-variable t)
(defvar eshell-failed-commands-alist nil
"An alist of command name failures.")
(defun eshell-alias-initialize ()
"Initialize the alias handling code."
(make-local-variable 'eshell-failed-commands-alist)
(make-local-hook 'eshell-alternate-command-hook)
(add-hook 'eshell-alternate-command-hook 'eshell-fix-bad-commands t t)
(eshell-read-aliases-list)
(make-local-hook 'eshell-named-command-hook)
(add-hook 'eshell-named-command-hook 'eshell-maybe-replace-by-alias t t))
(defun eshell/alias (&optional alias &rest definition)
"Define an ALIAS in the user's alias list using DEFINITION."
(if (not alias)
(eshell-for alias eshell-command-aliases-list
(eshell-print (apply 'format "alias %s %s\n" alias)))
(if (not definition)
(setq eshell-command-aliases-list
(delq (assoc alias eshell-command-aliases-list)
eshell-command-aliases-list))
(and (stringp definition)
(set-text-properties 0 (length definition) nil definition))
(let ((def (assoc alias eshell-command-aliases-list))
(alias-def (list alias
(eshell-flatten-and-stringify definition))))
(if def
(setq eshell-command-aliases-list
(delq def eshell-command-aliases-list)))
(setq eshell-command-aliases-list
(cons alias-def eshell-command-aliases-list))))
(eshell-write-aliases-list))
nil)
(defun pcomplete/eshell-mode/alias ()
"Completion function for Eshell's `alias' command."
(pcomplete-here (eshell-alias-completions pcomplete-stub)))
(defun eshell-read-aliases-list ()
"Read in an aliases list from `eshell-aliases-file'."
(let ((file eshell-aliases-file))
(when (file-readable-p file)
(setq eshell-command-aliases-list
(with-temp-buffer
(let (eshell-command-aliases-list)
(insert-file-contents file)
(while (not (eobp))
(if (re-search-forward
"^alias\\s-+\\(\\S-+\\)\\s-+\\(.+\\)")
(setq eshell-command-aliases-list
(cons (list (match-string 1)
(match-string 2))
eshell-command-aliases-list)))
(forward-line 1))
eshell-command-aliases-list))))))
(defun eshell-write-aliases-list ()
"Write out the current aliases into `eshell-aliases-file'."
(if (file-writable-p (file-name-directory eshell-aliases-file))
(let ((eshell-current-handles
(eshell-create-handles eshell-aliases-file 'overwrite)))
(eshell/alias)
(eshell-close-handles 0))))
(defsubst eshell-lookup-alias (name)
"Check whether NAME is aliased. Return the alias if there is one."
(assoc name eshell-command-aliases-list))
(defvar eshell-prevent-alias-expansion nil)
(defun eshell-maybe-replace-by-alias (command args)
"If COMMAND has an alias definition, call that instead using RAGS."
(unless (and eshell-prevent-alias-expansion
(member command eshell-prevent-alias-expansion))
(let ((alias (eshell-lookup-alias command)))
(if alias
(throw 'eshell-replace-command
(list
'let
(list
(list 'eshell-command-name
(list 'quote eshell-last-command-name))
(list 'eshell-command-arguments
(list 'quote eshell-last-arguments))
(list 'eshell-prevent-alias-expansion
(list 'quote
(cons command
eshell-prevent-alias-expansion))))
(eshell-parse-command (nth 1 alias))))))))
(defun eshell-alias-completions (name)
"Find all possible completions for NAME.
These are all the command aliases which begin with NAME."
(let (completions)
(eshell-for alias eshell-command-aliases-list
(if (string-match (concat "^" name) (car alias))
(setq completions (cons (car alias) completions))))
completions))
(defun eshell-fix-bad-commands (name)
"If the user repeatedly a bad command NAME, make an alias for them."
(ignore
(unless (file-name-directory name)
(let ((entry (assoc name eshell-failed-commands-alist)))
(if (not entry)
(setq eshell-failed-commands-alist
(cons (cons name 1) eshell-failed-commands-alist))
(if (< (cdr entry) eshell-bad-command-tolerance)
(setcdr entry (1+ (cdr entry)))
(let ((alias (concat
(read-string
(format "Define alias for \"%s\": " name))
" $*")))
(eshell/alias name alias)
(throw 'eshell-replace-command
(list
'let
(list
(list 'eshell-command-name
(list 'quote name))
(list 'eshell-command-arguments
(list 'quote eshell-last-arguments))
(list 'eshell-prevent-alias-expansion
(list 'quote
(cons name
eshell-prevent-alias-expansion))))
(eshell-parse-command alias))))))))))
;;; em-alias.el ends here

90
lisp/eshell/em-banner.el Normal file
View File

@ -0,0 +1,90 @@
;;; em-banner --- sample module that displays a login banner
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'em-banner)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-banner nil
"This sample module displays a welcome banner at login.
It exists so that others wishing to create their own Eshell extension
modules may have a simple template to begin with."
:tag "Login banner"
:link '(info-link "(eshell.info)Login banner")
:group 'eshell-module)
;;; Commentary:
;; There is nothing to be done or configured in order to use this
;; module, other than to select it by customizing the variable
;; `eshell-modules-list'. It will then display a version information
;; message whenever Eshell is loaded.
;;
;; This code is only an example of a how to write a well-formed
;; extension module for Eshell. The better way to display login text
;; is to use the `eshell-script' module, and to echo the desired
;; strings from the user's `eshell-login-script' file.
;;
;; There is one configuration variable, which demonstrates how to
;; properly define a customization variable in an extension module.
;; In this case, it allows the user to change the string which
;; displays at login time.
;;; User Variables:
(defcustom eshell-banner-message "Welcome to the Emacs shell\n\n"
"*The banner message to be displayed when Eshell is loaded.
This can be any sexp, and should end with at least two newlines."
:type 'sexp
:group 'eshell-banner)
(put 'eshell-banner-message 'risky-local-variable t)
;;; Code:
(require 'esh-util)
(defcustom eshell-banner-load-hook '(eshell-banner-initialize)
"*A list of functions to run when `eshell-banner' is loaded."
:type 'hook
:group 'eshell-banner)
(defun eshell-banner-initialize ()
"Output a welcome banner on initialization."
;; it's important to use `eshell-interactive-print' rather than
;; `insert', because `insert' doesn't know how to interact with the
;; I/O code used by Eshell
(unless eshell-non-interactive-p
(assert eshell-mode)
(assert eshell-banner-message)
(let ((msg (eval eshell-banner-message)))
(assert msg)
(eshell-interactive-print msg))))
(eshell-deftest banner banner-displayed
"Startup banner is displayed at point-min"
(assert eshell-banner-message)
(let ((msg (eval eshell-banner-message)))
(assert msg)
(goto-char (point-min))
(looking-at msg)))
;;; em-banner.el ends here

183
lisp/eshell/em-basic.el Normal file
View File

@ -0,0 +1,183 @@
;;; em-basic --- basic shell builtin commands
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'em-basic)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-basic nil
"The \"basic\" code provides a set of convenience functions which
are traditionally considered shell builtins. Since all of the
functionality provided by them is accessible through Lisp, they are
not really builtins at all, but offer a command-oriented way to do the
same thing."
:tag "Basic shell commands"
:group 'eshell-module)
;;; Commentary:
;; There are very few basic Eshell commands -- so-called builtins.
;; They are: echo, umask, and version.
;;
;;;_* `echo'
;;
;; The `echo' command repeats its arguments to the screen. It is
;; optional whether this is done in a Lisp-friendly fashion (so that
;; the value of echo is useful to a Lisp command using the result of
;; echo as an argument), or whether it should try to act like a normal
;; shell echo, and always result in a flat string being returned.
(defcustom eshell-plain-echo-behavior nil
"*If non-nil, `echo' tries to behave like an ordinary shell echo.
This comes at some detriment to Lisp functionality. However, the Lisp
equivalent of `echo' can always be achieved by using `identity'."
:type 'boolean
:group 'eshell-basic)
;;;
;; An example of the difference is the following:
;;
;; echo Hello world
;;
;; If `eshell-plain-echo-behavior' is non-nil, this will yield the
;; string "Hello world". If Lisp behavior is enabled, however, it
;; will yield a list whose two elements are the strings "Hello" and
;; "world". The way to write an equivalent expression for both would
;; be:
;;
;; echo "Hello world"
;;
;; This always returns a single string.
;;
;;;_* `umask'
;;
;; The umask command changes the default file permissions for newly
;; created files. It uses the same syntax as bash.
;;
;;;_* `version'
;;
;; This command reports the version number for Eshell and all its
;; dependent module, including the date when those modules were last
;; modified.
;;; Code:
(require 'esh-opt)
;;; Functions:
(defun eshell-echo (args &optional output-newline)
"Implementation code for a Lisp version of `echo'.
It returns a formatted value that should be passed to `eshell-print'
or `eshell-printn' for display."
(if eshell-plain-echo-behavior
(concat (apply 'eshell-flatten-and-stringify args) "\n")
(let ((value
(cond
((= (length args) 0) "")
((= (length args) 1)
(car args))
(t
(mapcar
(function
(lambda (arg)
(if (stringp arg)
(set-text-properties 0 (length arg) nil arg))
arg))
args)))))
(if output-newline
(cond
((stringp value)
(concat value "\n"))
((listp value)
(append value (list "\n")))
(t
(concat (eshell-stringify value) "\n")))
value))))
(defun eshell/echo (&rest args)
"Implementation of `echo'. See `eshell-plain-echo-behavior'."
(eshell-eval-using-options
"echo" args
'((?n nil nil output-newline "terminate with a newline")
(?h "help" nil nil "output this help screen")
:preserve-args
:usage "[-n] [object]")
(eshell-echo args output-newline)))
(defun eshell/printnl (&rest args)
"Print out each of the argument, separated by newlines."
(let ((elems (eshell-flatten-list args)))
(while elems
(eshell-printn (eshell-echo (list (car elems))))
(setq elems (cdr elems)))))
(defun eshell/listify (&rest args)
"Return the argument(s) as a single list."
(if (> (length args) 1)
args
(if (listp (car args))
(car args)
(list (car args)))))
(defun eshell/umask (&rest args)
"Shell-like implementation of `umask'."
(eshell-eval-using-options
"umask" args
'((?S "symbolic" nil symbolic-p "display umask symbolically")
(?h "help" nil nil "display this usage message")
:usage "[-S] [mode]")
(if (or (not args) symbolic-p)
(let ((modstr
(concat "000"
(format "%o"
(logand (lognot (default-file-modes))
511)))))
(setq modstr (substring modstr (- (length modstr) 3)))
(when symbolic-p
(let ((mode (default-file-modes)))
(setq modstr
(format
"u=%s,g=%s,o=%s"
(concat (and (= (logand mode 64) 64) "r")
(and (= (logand mode 128) 128) "w")
(and (= (logand mode 256) 256) "x"))
(concat (and (= (logand mode 8) 8) "r")
(and (= (logand mode 16) 16) "w")
(and (= (logand mode 32) 32) "x"))
(concat (and (= (logand mode 1) 1) "r")
(and (= (logand mode 2) 2) "w")
(and (= (logand mode 4) 4) "x"))))))
(eshell-printn modstr))
(setcar args (eshell-convert (car args)))
(if (numberp (car args))
(set-default-file-modes
(- 511 (car (read-from-string
(concat "?\\" (number-to-string (car args)))))))
(error "setting umask symbolically is not yet implemented"))
(eshell-print
"Warning: umask changed for all new files created by Emacs.\n"))
nil))
(eval-when-compile
(defvar print-func))
;;; em-basic.el ends here

443
lisp/eshell/em-cmpl.el Normal file
View File

@ -0,0 +1,443 @@
;;; em-cmpl --- completion using the TAB key
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'em-cmpl)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-cmpl nil
"This module provides a programmable completion function bound to
the TAB key, which allows for completing command names, file names,
variable names, arguments, etc."
:tag "Argument completion"
:group 'eshell-module)
;;; Commentary:
;; Eshell, by using the pcomplete package, provides a full
;; programmable completion facility that is comparable to shells like
;; tcsh or zsh.
;;
;; Completions are context-sensitive, which means that pressing <TAB>
;; after the command 'rmdir' will result in a list of directories,
;; while doing so after 'rm' will result in a list of all file
;; entries.
;;
;; Many builtin completion rules are provided, for commands such as
;; `cvs', or RedHat's `rpm' utility. Adding new completion rules is
;; no more difficult than writing a plain Lisp functions, and they can
;; be debugged, profiled, and compiled using exactly the same
;; facilities (since in fact, they *are* just Lisp functions). See
;; the definition of the function `pcomplete/make' for an example of
;; how to write a completion function.
;;
;; The completion facility is very easy to use. Just press TAB. If
;; there are a large number of possible completions, a buffer will
;; appearing showing a list of them. Completions may be selected from
;; that buffer using the mouse. If no completion is selected, and the
;; user starts doing something else, the display buffer will
;; automatically disappear.
;;
;; If the list of possible completions is very small, Eshell will
;; "cycle" through them, selecting a different entry each time <TAB>
;; is pressed. <S-TAB> may be used to cycle in the opposite
;; direction.
;;
;; Glob patterns can also be cycled. For example, entering 'echo
;; x*<tab>' will cycle through all the filenames beginning with 'x'.
;; This is done because the glob list is treated as though it were a
;; list of possible completions. Pressing <C-c SPC> will insert all
;; of the matching glob patterns at point.
;;
;; If a Lisp form is being entered, <TAB> will complete the Lisp
;; symbol name, in exactly the same way that <M-TAB> does in Emacs
;; Lisp mode.
;;
;; The list of possible completions can be viewed at any point by
;; pressing <M-?>.
;;
;; Finally, context-related help can be accessed by pressing <C-c i>.
;; This only works well if the completion function has provided Eshell
;; with sufficient pointers to locate the relevant help text.
;;; User Variables:
(defcustom eshell-cmpl-load-hook '(eshell-cmpl-initialize)
"*A list of functions to run when `eshell-cmpl' is loaded."
:type 'hook
:group 'eshell-cmpl)
(defcustom eshell-show-lisp-completions nil
"*If non-nil, include Lisp functions in the command completion list.
If this variable is nil, Lisp completion can still be done in command
position by using M-TAB instead of TAB."
:type 'boolean
:group 'eshell-cmpl)
(defcustom eshell-show-lisp-alternatives t
"*If non-nil, and no other completions found, show Lisp functions.
Setting this variable means nothing if `eshell-show-lisp-completions'
is non-nil."
:type 'boolean
:group 'eshell-cmpl)
(defcustom eshell-no-completion-during-jobs t
"*If non-nil, don't allow completion while a process is running."
:type 'boolean
:group 'eshell-cmpl)
(defcustom eshell-command-completions-alist
'(("acroread" . "\\.pdf\\'")
("xpdf" . "\\.pdf\\'")
("ar" . "\\.[ao]\\'")
("gcc" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
("g++" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
("cc" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
("CC" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
("acc" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
("bcc" . "\\.[Cc]\\([Cc]\\|[Pp][Pp]\\)?\\'")
("objdump" . "\\(\\`[^.]*\\|\\.[ao]\\)\\'")
("nm" . "\\(\\`[^.]*\\|\\.[ao]\\)\\'")
("gdb" . "\\`\\([^.]*\\|a\\.out\\)\\'")
("dbx" . "\\`\\([^.]*\\|a\\.out\\)\\'")
("sdb" . "\\`\\([^.]*\\|a\\.out\\)\\'")
("adb" . "\\`\\([^.]*\\|a\\.out\\)\\'"))
"*An alist that defines simple argument type correlations.
This is provided for common commands, as a simplistic alternative
to writing a completion function."
:type '(repeat (cons string regexp))
:group 'eshell-cmpl)
(defcustom eshell-cmpl-file-ignore "~\\'"
(documentation-property 'pcomplete-file-ignore
'variable-documentation)
:type (get 'pcomplete-file-ignore 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-dir-ignore
(format "\\`\\(\\.\\.?\\|CVS\\)%c\\'" directory-sep-char)
(documentation-property 'pcomplete-dir-ignore
'variable-documentation)
:type (get 'pcomplete-dir-ignore 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-ignore-case (eshell-under-windows-p)
(documentation-property 'pcomplete-ignore-case
'variable-documentation)
:type (get 'pcomplete-ignore-case 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-autolist nil
(documentation-property 'pcomplete-autolist
'variable-documentation)
:type (get 'pcomplete-autolist 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-suffix-list (list directory-sep-char ?:)
(documentation-property 'pcomplete-suffix-list
'variable-documentation)
:type (get 'pcomplete-suffix-list 'custom-type)
:group 'pcomplete)
(defcustom eshell-cmpl-recexact nil
(documentation-property 'pcomplete-recexact
'variable-documentation)
:type (get 'pcomplete-recexact 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-man-function 'man
(documentation-property 'pcomplete-man-function
'variable-documentation)
:type (get 'pcomplete-man-function 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-compare-entry-function 'file-newer-than-file-p
(documentation-property 'pcomplete-compare-entry-function
'variable-documentation)
:type (get 'pcomplete-compare-entry-function 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-expand-before-complete nil
(documentation-property 'pcomplete-expand-before-complete
'variable-documentation)
:type (get 'pcomplete-expand-before-complete 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-cycle-completions t
(documentation-property 'pcomplete-cycle-completions
'variable-documentation)
:type (get 'pcomplete-cycle-completions 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-cycle-cutoff-length 5
(documentation-property 'pcomplete-cycle-cutoff-length
'variable-documentation)
:type (get 'pcomplete-cycle-cutoff-length 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-restore-window-delay 1
(documentation-property 'pcomplete-restore-window-delay
'variable-documentation)
:type (get 'pcomplete-restore-window-delay 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-command-completion-function
(function
(lambda ()
(pcomplete-here (eshell-complete-commands-list))))
(documentation-property 'pcomplete-command-completion-function
'variable-documentation)
:type (get 'pcomplete-command-completion-function 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-command-name-function
'eshell-completion-command-name
(documentation-property 'pcomplete-command-name-function
'variable-documentation)
:type (get 'pcomplete-command-name-function 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-default-completion-function
(function
(lambda ()
(while (pcomplete-here
(pcomplete-dirs-or-entries
(cdr (assoc (funcall eshell-cmpl-command-name-function)
eshell-command-completions-alist)))))))
(documentation-property 'pcomplete-default-completion-function
'variable-documentation)
:type (get 'pcomplete-default-completion-function 'custom-type)
:group 'pcomplete)
;;; Functions:
(defun eshell-cmpl-initialize ()
"Initialize the completions module."
(unless (fboundp 'pcomplete)
(load "pcmpl-auto" t t))
(set (make-local-variable 'pcomplete-command-completion-function)
eshell-command-completion-function)
(set (make-local-variable 'pcomplete-command-name-function)
eshell-cmpl-command-name-function)
(set (make-local-variable 'pcomplete-default-completion-function)
eshell-default-completion-function)
(set (make-local-variable 'pcomplete-parse-arguments-function)
'eshell-complete-parse-arguments)
(set (make-local-variable 'pcomplete-file-ignore)
eshell-cmpl-file-ignore)
(set (make-local-variable 'pcomplete-dir-ignore)
eshell-cmpl-dir-ignore)
(set (make-local-variable 'pcomplete-ignore-case)
eshell-cmpl-ignore-case)
(set (make-local-variable 'pcomplete-autolist)
eshell-cmpl-autolist)
(set (make-local-variable 'pcomplete-suffix-list)
eshell-cmpl-suffix-list)
(set (make-local-variable 'pcomplete-recexact)
eshell-cmpl-recexact)
(set (make-local-variable 'pcomplete-man-function)
eshell-cmpl-man-function)
(set (make-local-variable 'pcomplete-compare-entry-function)
eshell-cmpl-compare-entry-function)
(set (make-local-variable 'pcomplete-expand-before-complete)
eshell-cmpl-expand-before-complete)
(set (make-local-variable 'pcomplete-cycle-completions)
eshell-cmpl-cycle-completions)
(set (make-local-variable 'pcomplete-cycle-cutoff-length)
eshell-cmpl-cycle-cutoff-length)
(set (make-local-variable 'pcomplete-restore-window-delay)
eshell-cmpl-restore-window-delay)
;; `pcomplete-arg-quote-list' should only be set after all the
;; load-hooks for any other extension modules have been run, which
;; is true at the time `eshell-mode-hook' is run
(make-local-hook 'eshell-mode-hook)
(add-hook 'eshell-mode-hook
(function
(lambda ()
(set (make-local-variable 'pcomplete-arg-quote-list)
eshell-special-chars-outside-quoting))) nil t)
(make-local-hook 'pcomplete-quote-arg-hook)
(add-hook 'pcomplete-quote-arg-hook 'eshell-quote-backslash nil t)
(define-key eshell-mode-map [(meta tab)] 'lisp-complete-symbol)
(define-key eshell-mode-map [(meta control ?i)] 'lisp-complete-symbol)
(define-key eshell-command-map [(meta ?h)] 'eshell-completion-help)
(define-key eshell-command-map [tab] 'pcomplete-expand-and-complete)
(define-key eshell-command-map [(control ?i)]
'pcomplete-expand-and-complete)
(define-key eshell-command-map [space] 'pcomplete-expand)
(define-key eshell-command-map [? ] 'pcomplete-expand)
(define-key eshell-mode-map [tab] 'pcomplete)
(define-key eshell-mode-map [(control ?i)] 'pcomplete)
;; jww (1999-10-19): Will this work on anything but X?
(if (eshell-under-xemacs-p)
(define-key eshell-mode-map [iso-left-tab] 'pcomplete-reverse)
(define-key eshell-mode-map [(shift iso-lefttab)] 'pcomplete-reverse)
(define-key eshell-mode-map [(shift control ?i)] 'pcomplete-reverse))
(define-key eshell-mode-map [(meta ??)] 'pcomplete-list))
(defun eshell-completion-command-name ()
"Return the command name, possibly sans globbing."
(let ((cmd (file-name-nondirectory (pcomplete-arg 'first))))
(setq cmd (if (and (> (length cmd) 0)
(eq (aref cmd 0) ?*))
(substring cmd 1)
cmd))
(if (eshell-under-windows-p)
(file-name-sans-extension cmd)
cmd)))
(defun eshell-completion-help ()
(interactive)
(if (= (point) eshell-last-output-end)
(describe-prefix-bindings)
(call-interactively 'pcomplete-help)))
(defun eshell-complete-parse-arguments ()
"Parse the command line arguments for `pcomplete-argument'."
(when (and eshell-no-completion-during-jobs
(eshell-interactive-process))
(insert-and-inherit "\t")
(throw 'pcompleted t))
(let ((end (point-marker))
(begin (save-excursion (eshell-bol) (point)))
(posns (list t))
args delim)
(when (memq this-command '(pcomplete-expand
pcomplete-expand-and-complete))
(run-hook-with-args 'eshell-expand-input-functions begin end)
(if (= begin end)
(end-of-line))
(setq end (point-marker)))
(if (setq delim
(catch 'eshell-incomplete
(ignore
(setq args (eshell-parse-arguments begin end)))))
(cond ((memq (car delim) '(?\{ ?\<))
(setq begin (1+ (cadr delim))
args (eshell-parse-arguments begin end)))
((eq (car delim) ?\()
(lisp-complete-symbol)
(throw 'pcompleted t))
(t
(insert-and-inherit "\t")
(throw 'pcompleted t))))
(when (get-text-property (1- end) 'comment)
(insert-and-inherit "\t")
(throw 'pcompleted t))
(let ((pos begin))
(while (< pos end)
(if (get-text-property pos 'arg-begin)
(nconc posns (list pos)))
(setq pos (1+ pos))))
(setq posns (cdr posns))
(assert (= (length args) (length posns)))
(let ((a args)
(i 0)
l final)
(while a
(if (and (consp (car a))
(eq (caar a) 'eshell-operator))
(setq l i))
(setq a (cdr a) i (1+ i)))
(and l
(setq args (nthcdr (1+ l) args)
posns (nthcdr (1+ l) posns))))
(assert (= (length args) (length posns)))
(when (and args (eq (char-syntax (char-before end)) ? ))
(nconc args (list ""))
(nconc posns (list (point))))
(cons (mapcar
(function
(lambda (arg)
(let ((val
(if (listp arg)
(let ((result
(eshell-do-eval
(list 'eshell-commands arg) t)))
(assert (eq (car result) 'quote))
(cadr result))
arg)))
(if (numberp val)
(setq val (number-to-string val)))
(or val ""))))
args)
posns)))
(defun eshell-complete-commands-list ()
"Generate list of applicable, visible commands."
(let ((filename (pcomplete-arg)) glob-name)
(if (file-name-directory filename)
(pcomplete-executables)
(if (and (> (length filename) 0)
(eq (aref filename 0) ?*))
(setq filename (substring filename 1)
pcomplete-stub filename
glob-name t))
(let* ((paths (split-string (getenv "PATH") path-separator))
(cwd (file-name-as-directory
(expand-file-name default-directory)))
(path "") (comps-in-path ())
(file "") (filepath "") (completions ()))
;; Go thru each path in the search path, finding completions.
(while paths
(setq path (file-name-as-directory
(expand-file-name (or (car paths) ".")))
comps-in-path
(and (file-accessible-directory-p path)
(file-name-all-completions filename path)))
;; Go thru each completion found, to see whether it should
;; be used.
(while comps-in-path
(setq file (car comps-in-path)
filepath (concat path file))
(if (and (not (member file completions)) ;
(or (string-equal path cwd)
(not (file-directory-p filepath)))
(file-executable-p filepath))
(setq completions (cons file completions)))
(setq comps-in-path (cdr comps-in-path)))
(setq paths (cdr paths)))
;; Add aliases which are currently visible, and Lisp functions.
(pcomplete-uniqify-list
(if glob-name
completions
(setq completions
(append (and (eshell-using-module 'eshell-alias)
(funcall (symbol-function 'eshell-alias-completions)
filename))
(eshell-winnow-list
(mapcar
(function
(lambda (name)
(substring name 7)))
(all-completions (concat "eshell/" filename)
obarray 'functionp))
nil '(eshell-find-alias-function))
completions))
(append (and (or eshell-show-lisp-completions
(and eshell-show-lisp-alternatives
(null completions)))
(all-completions filename obarray 'functionp))
completions)))))))
;;; Code:
;;; em-cmpl.el ends here

563
lisp/eshell/em-dirs.el Normal file
View File

@ -0,0 +1,563 @@
;;; em-dirs --- directory navigation commands
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'em-dirs)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-dirs nil
"Directory navigation involves changing directories, examining the
current directory, maintaining a directory stack, and also keeping
track of a history of the last directory locations the user was in.
Emacs does provide standard Lisp definitions of `pwd' and `cd', but
they lack somewhat in feel from the typical shell equivalents."
:tag "Directory navigation"
:group 'eshell-module)
;;; Commentary:
;; The only special feature that Eshell offers in the last-dir-ring.
;; To view the ring, enter:
;;
;; cd =
;;
;; Changing to an index within the ring is done using:
;;
;; cd - ; same as cd -0
;; cd -4
;;
;; Or, it is possible to change the first member in the ring which
;; matches a regexp:
;;
;; cd =bcc ; change to the last directory visited containing "bcc"
;;
;; This ring is maintained automatically, and is persisted across
;; Eshell sessions. It is a separate mechanism from `pushd' and
;; `popd', and the two may be used at the same time.
(require 'ring)
(require 'esh-opt)
;;; User Variables:
(defcustom eshell-dirs-load-hook '(eshell-dirs-initialize)
"*A hook that gets run when `eshell-dirs' is loaded."
:type 'hook
:group 'eshell-dirs)
(defcustom eshell-pwd-convert-function (if (eshell-under-windows-p)
'expand-file-name
'identity)
"*The function used to normalize the value of Eshell's `pwd'.
The value returned by `pwd' is also used when recording the
last-visited directory in the last-dir-ring, so it will affect the
form of the list used by 'cd ='."
:type '(radio (function-item file-truename)
(function-item expand-file-name)
(function-item identity)
(function :tag "Other"))
:group 'eshell-dirs)
(defcustom eshell-ask-to-save-last-dir 'always
"*Determine if the last-dir-ring should be automatically saved.
The last-dir-ring is always preserved when exiting an Eshell buffer.
However, when Emacs is being shut down, this variable determines
whether to prompt the user, or just save the ring.
If set to nil, it means never ask whether to save the last-dir-ring.
If set to t, always ask if any Eshell buffers are open at exit time.
If set to `always', the list-dir-ring will always be saved, silently."
:type '(choice (const :tag "Never" nil)
(const :tag "Ask" t)
(const :tag "Always save" always))
:group 'eshell-dirs)
(defcustom eshell-cd-shows-directory nil
"*If non-nil, using `cd' will report the directory it changes to."
:type 'boolean
:group 'eshell-dirs)
(defcustom eshell-cd-on-directory t
"*If non-nil, do a cd if a directory is in command position."
:type 'boolean
:group 'eshell-dirs)
(defcustom eshell-directory-change-hook nil
"*A hook to run when the current directory changes."
:type 'hook
:group 'eshell-dirs)
(defcustom eshell-list-files-after-cd nil
"*If non-nil, call \"ls\" with any remaining args after doing a cd.
This is provided for convenience, since the same effect is easily
achieved by adding a function to `eshell-directory-change-hook' that
calls \"ls\" and references `eshell-last-arguments'."
:type 'boolean
:group 'eshell-dirs)
(defcustom eshell-pushd-tohome nil
"*If non-nil, make pushd with no arg behave as 'pushd ~' (like `cd').
This mirrors the optional behavior of tcsh."
:type 'boolean
:group 'eshell-dirs)
(defcustom eshell-pushd-dextract nil
"*If non-nil, make \"pushd +n\" pop the nth dir to the stack top.
This mirrors the optional behavior of tcsh."
:type 'boolean
:group 'eshell-dirs)
(defcustom eshell-pushd-dunique nil
"*If non-nil, make pushd only add unique directories to the stack.
This mirrors the optional behavior of tcsh."
:type 'boolean
:group 'eshell-dirs)
(defcustom eshell-dirtrack-verbose t
"*If non-nil, show the directory stack following directory change.
This is effective only if directory tracking is enabled."
:type 'boolean
:group 'eshell-dirs)
(defcustom eshell-last-dir-ring-file-name
(concat eshell-directory-name "lastdir")
"*If non-nil, name of the file to read/write the last-dir-ring.
See also `eshell-read-last-dir-ring' and `eshell-write-last-dir-ring'.
If it is nil, the last-dir-ring will not be written to disk."
:type 'file
:group 'eshell-dirs)
(defcustom eshell-last-dir-ring-size 32
"*If non-nil, the size of the directory history ring.
This ring is added to every time `cd' or `pushd' is used. It simply
stores the most recent directory locations Eshell has been in. To
return to the most recent entry, use 'cd -' (equivalent to 'cd -0').
To return to an older entry, use 'cd -N', where N is an integer less
than `eshell-last-dir-ring-size'. To return to the last directory
matching a particular regexp, use 'cd =REGEXP'. To display the
directory history list, use 'cd ='.
This mechanism is very similar to that provided by `pushd', except
it's far more automatic. `pushd' allows the user to decide which
directories gets pushed, and its size is unlimited.
`eshell-last-dir-ring' is meant for users who don't use `pushd'
explicity very much, but every once in a while would like to return to
a previously visited directory without having to type in the whole
thing again."
:type 'integer
:group 'eshell-dirs)
(defcustom eshell-last-dir-unique t
"*If non-nil, `eshell-last-dir-ring' contains only unique entries."
:type 'boolean
:group 'eshell-dirs)
;;; Internal Variables:
(defvar eshell-dirstack nil
"List of directories saved by pushd in the Eshell buffer.
Thus, this does not include the current directory.")
(defvar eshell-last-dir-ring nil
"The last directory that eshell was in.")
;;; Functions:
(defun eshell-dirs-initialize ()
"Initialize the builtin functions for Eshell."
(make-local-variable 'eshell-variable-aliases-list)
(setq eshell-variable-aliases-list
(append
eshell-variable-aliases-list
'(("-" (lambda (indices)
(if (not indices)
(unless (ring-empty-p eshell-last-dir-ring)
(expand-file-name
(ring-ref eshell-last-dir-ring 0)))
(expand-file-name
(eshell-apply-indices eshell-last-dir-ring indices)))))
("+" "PWD")
("PWD" (lambda (indices)
(expand-file-name (eshell/pwd))) t)
("OLDPWD" (lambda (indices)
(unless (ring-empty-p eshell-last-dir-ring)
(expand-file-name
(ring-ref eshell-last-dir-ring 0)))) t))))
(when eshell-cd-on-directory
(make-local-variable 'eshell-interpreter-alist)
(setq eshell-interpreter-alist
(cons (cons 'eshell-lone-directory-p
'eshell-dirs-substitute-cd)
eshell-interpreter-alist)))
(make-local-hook 'eshell-parse-argument-hook)
(add-hook 'eshell-parse-argument-hook
'eshell-parse-user-reference nil t)
(if (eshell-under-windows-p)
(add-hook 'eshell-parse-argument-hook
'eshell-parse-drive-letter nil t))
(when (eshell-using-module 'eshell-cmpl)
(make-local-hook 'pcomplete-try-first-hook)
(add-hook 'pcomplete-try-first-hook
'eshell-complete-user-reference nil t))
(make-local-variable 'eshell-dirstack)
(make-local-variable 'eshell-last-dir-ring)
(if eshell-last-dir-ring-file-name
(eshell-read-last-dir-ring))
(unless eshell-last-dir-ring
(setq eshell-last-dir-ring (make-ring eshell-last-dir-ring-size)))
(make-local-hook 'eshell-exit-hook)
(add-hook 'eshell-exit-hook 'eshell-write-last-dir-ring nil t)
(add-hook 'kill-emacs-hook 'eshell-save-some-last-dir))
(defun eshell-save-some-last-dir ()
"Save the list-dir-ring for any open Eshell buffers."
(eshell-for buf (buffer-list)
(if (buffer-live-p buf)
(with-current-buffer buf
(if (and eshell-mode
eshell-ask-to-save-last-dir
(or (eq eshell-ask-to-save-last-dir 'always)
(y-or-n-p
(format "Save last dir ring for Eshell buffer `%s'? "
(buffer-name buf)))))
(eshell-write-last-dir-ring))))))
(defun eshell-lone-directory-p (file)
"Test whether FILE is just a directory name, and not a command name."
(and (file-directory-p file)
(or (file-name-directory file)
(not (eshell-search-path file)))))
(defun eshell-dirs-substitute-cd (&rest args)
"Substitute the given command for a call to `cd' on that name."
(if (> (length args) 1)
(error "%s: command not found" (car args))
(throw 'eshell-replace-command
(eshell-parse-command "cd" args))))
(defun eshell-parse-user-reference ()
"An argument beginning with ~ is a filename to be expanded."
(when (and (not eshell-current-argument)
(eq (char-after) ?~))
(add-to-list 'eshell-current-modifiers 'expand-file-name)
(forward-char)
(char-to-string (char-before))))
(defun eshell-parse-drive-letter ()
"An argument beginning X:[^/] is a drive letter reference."
(when (and (not eshell-current-argument)
(looking-at "\\([A-Za-z]:\\)\\([^/\\\\]\\|\\'\\)"))
(goto-char (match-end 1))
(let* ((letter (match-string 1))
(regexp (concat "\\`" letter))
(path (eshell-find-previous-directory regexp)))
(concat (or path letter)
(char-to-string directory-sep-char)))))
(defun eshell-complete-user-reference ()
"If there is a user reference, complete it."
(let ((arg (pcomplete-actual-arg)))
(when (string-match "\\`~[a-z]*\\'" arg)
(setq pcomplete-stub (substring arg 1)
pcomplete-last-completion-raw t)
(throw 'pcomplete-completions
(progn
(eshell-read-user-names)
(pcomplete-uniqify-list
(mapcar
(function
(lambda (user)
(file-name-as-directory (cdr user))))
eshell-user-names)))))))
(defun eshell/pwd (&rest args) ; ignored
"Change output from `pwd` to be cleaner."
(let* ((path default-directory)
(len (length path)))
(if (and (> len 1)
(eq (aref path (1- len)) directory-sep-char)
(not (and (eshell-under-windows-p)
(string-match "\\`[A-Za-z]:[\\\\/]\\'" path))))
(setq path (substring path 0 (1- (length path)))))
(if eshell-pwd-convert-function
(setq path (funcall eshell-pwd-convert-function path)))
path))
(defun eshell-expand-multiple-dots (path)
"Convert '...' to '../..', '....' to '../../..', etc..
With the following piece of advice, you can make this functionality
available in most of Emacs, with the exception of filename completion
in the minibuffer:
(defadvice expand-file-name
(before translate-multiple-dots
(filename &optional directory) activate)
(setq filename (eshell-expand-multiple-dots filename)))"
(while (string-match "\\.\\.\\(\\.+\\)" path)
(let* ((extra-dots (match-string 1 path))
(len (length extra-dots))
replace-text)
(while (> len 0)
(setq replace-text
(concat replace-text
(char-to-string directory-sep-char) "..")
len (1- len)))
(setq path
(replace-match replace-text t t path 1))))
path)
(defun eshell-find-previous-directory (regexp)
"Find the most recent last-dir matching REGEXP."
(let ((index 0)
(len (ring-length eshell-last-dir-ring))
oldpath)
(if (> (length regexp) 0)
(while (< index len)
(setq oldpath (ring-ref eshell-last-dir-ring index))
(if (string-match regexp oldpath)
(setq index len)
(setq oldpath nil
index (1+ index)))))
oldpath))
(eval-when-compile
(defvar dired-directory))
(defun eshell/cd (&rest args) ; all but first ignored
"Alias to extend the behavior of `cd'."
(let ((path (car args))
(subpath (car (cdr args)))
handled)
(if (numberp path)
(setq path (number-to-string path)))
(if (numberp subpath)
(setq subpath (number-to-string subpath)))
(cond
(subpath
(let ((curdir (eshell/pwd)))
(if (string-match path curdir)
(setq path (replace-match subpath nil nil curdir))
(error "Path substring '%s' not found" path))))
((and path (string-match "^-\\([0-9]*\\)$" path))
(let ((index (match-string 1 path)))
(setq path
(ring-remove eshell-last-dir-ring
(if index
(string-to-int index)
0)))))
((and path (string-match "^=\\(.*\\)$" path))
(let ((oldpath (eshell-find-previous-directory
(match-string 1 path))))
(if oldpath
(setq path oldpath)
(let ((len (ring-length eshell-last-dir-ring))
(index 0))
(if (= len 0)
(error "Directory ring empty"))
(while (< index len)
(eshell-printn
(concat (number-to-string index) ": "
(ring-ref eshell-last-dir-ring index)))
(setq index (1+ index)))
(setq handled t)))))
(path
(setq path (eshell-expand-multiple-dots path))))
(unless handled
(setq dired-directory (or path "~"))
(let ((curdir (eshell/pwd)))
(unless (equal curdir dired-directory)
(eshell-add-to-dir-ring curdir))
(let ((result (cd dired-directory)))
(and eshell-cd-shows-directory
(eshell-printn result)))
(run-hooks 'eshell-directory-change-hook)
(if eshell-list-files-after-cd
(throw 'eshell-replace-command
(eshell-parse-command "ls" (cdr args))))
nil))))
(defun eshell-add-to-dir-ring (path)
"Add PATH to the last-dir-ring, if applicable."
(unless (and (not (ring-empty-p eshell-last-dir-ring))
(equal path (ring-ref eshell-last-dir-ring 0)))
(if eshell-last-dir-unique
(let ((index 0)
(len (ring-length eshell-last-dir-ring)))
(while (< index len)
(if (equal (ring-ref eshell-last-dir-ring index) path)
(ring-remove eshell-last-dir-ring index)
(setq index (1+ index))))))
(ring-insert eshell-last-dir-ring path)))
;;; pushd [+n | dir]
(defun eshell/pushd (&rest args) ; all but first ignored
"Implementation of pushd in Lisp."
(let ((path (car args)))
(cond
((null path)
;; no arg -- swap pwd and car of stack unless eshell-pushd-tohome
(cond (eshell-pushd-tohome
(eshell/pushd "~"))
(eshell-dirstack
(let ((old (eshell/pwd)))
(eshell/cd (car eshell-dirstack))
(setq eshell-dirstack (cons old (cdr eshell-dirstack)))
(eshell/dirs t)))
(t
(error "pushd: No other directory"))))
((string-match "^\\+\\([0-9]\\)" path)
;; pushd +n
(setq path (string-to-number (match-string 1 path)))
(cond ((> path (length eshell-dirstack))
(error "Directory stack not that deep"))
((= path 0)
(error "Couldn't cd"))
(eshell-pushd-dextract
(let ((dir (nth (1- path) eshell-dirstack)))
(eshell/popd path)
(eshell/pushd (eshell/pwd))
(eshell/cd dir)
(eshell/dirs t)))
(t
(let* ((ds (cons (eshell/pwd) eshell-dirstack))
(dslen (length ds))
(front (nthcdr path ds))
(back (nreverse (nthcdr (- dslen path) (reverse ds))))
(new-ds (append front back)))
(eshell/cd (car new-ds))
(setq eshell-dirstack (cdr new-ds))
(eshell/dirs t)))))
(t
;; pushd <dir>
(let ((old-wd (eshell/pwd)))
(eshell/cd path)
(if (or (null eshell-pushd-dunique)
(not (member old-wd eshell-dirstack)))
(setq eshell-dirstack (cons old-wd eshell-dirstack)))
(eshell/dirs t)))))
nil)
;;; popd [+n]
(defun eshell/popd (&rest args)
"Implementation of popd in Lisp."
(let ((ref (or (car args) "+0")))
(unless (and (stringp ref)
(string-match "\\`\\([+-][0-9]+\\)\\'" ref))
(error "popd: bad arg `%s'" ref))
(setq ref (string-to-number (match-string 1 ref)))
(cond ((= ref 0)
(unless eshell-dirstack
(error "popd: Directory stack empty"))
(eshell/cd (car eshell-dirstack))
(setq eshell-dirstack (cdr eshell-dirstack))
(eshell/dirs t))
((<= (abs ref) (length eshell-dirstack))
(let* ((ds (cons nil eshell-dirstack))
(cell (nthcdr (if (> ref 0)
(1- ref)
(+ (length eshell-dirstack) ref)) ds))
(dir (cadr cell)))
(eshell/cd dir)
(setcdr cell (cdr (cdr cell)))
(setq eshell-dirstack (cdr ds))
(eshell/dirs t)))
(t
(error "Couldn't popd"))))
nil)
(defun eshell/dirs (&optional if-verbose)
"Implementation of dirs in Lisp."
(when (or (not if-verbose) eshell-dirtrack-verbose)
(let* ((msg "")
(ds (cons (eshell/pwd) eshell-dirstack))
(home (expand-file-name "~/"))
(homelen (length home)))
(while ds
(let ((dir (car ds)))
(and (>= (length dir) homelen)
(string= home (substring dir 0 homelen))
(setq dir (concat "~/" (substring dir homelen))))
(setq msg (concat msg (directory-file-name dir) " "))
(setq ds (cdr ds))))
msg)))
(defun eshell-read-last-dir-ring ()
"Sets the buffer's `eshell-last-dir-ring' from a history file."
(let ((file eshell-last-dir-ring-file-name))
(cond
((or (null file)
(equal file "")
(not (file-readable-p file)))
nil)
(t
(let* ((count 0)
(size eshell-last-dir-ring-size)
(ring (make-ring size)))
(with-temp-buffer
(insert-file-contents file)
;; Save restriction in case file is already visited...
;; Watch for those date stamps in history files!
(goto-char (point-max))
(while (and (< count size)
(re-search-backward "^\\([^\n].*\\)$" nil t))
(ring-insert-at-beginning ring (match-string 1))
(setq count (1+ count)))
;; never allow the top element to equal the current
;; directory
(while (and (not (ring-empty-p ring))
(equal (ring-ref ring 0) (eshell/pwd)))
(ring-remove ring 0)))
(setq eshell-last-dir-ring ring))))))
(defun eshell-write-last-dir-ring ()
"Writes the buffer's `eshell-last-dir-ring' to a history file."
(let ((file eshell-last-dir-ring-file-name))
(cond
((or (null file)
(equal file "")
(null eshell-last-dir-ring)
(ring-empty-p eshell-last-dir-ring))
nil)
((not (file-writable-p file))
(message "Cannot write last-dir-ring file %s" file))
(t
(let* ((ring eshell-last-dir-ring)
(index (ring-length ring)))
(with-temp-buffer
(while (> index 0)
(setq index (1- index))
(insert (ring-ref ring index) ?\n))
(insert (eshell/pwd) ?\n)
(eshell-with-private-file-modes
(write-region (point-min) (point-max) file nil
'no-message))))))))
;;; Code:
;;; em-dirs.el ends here

357
lisp/eshell/em-glob.el Normal file
View File

@ -0,0 +1,357 @@
;;; em-glob --- extended file name globbing
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'em-glob)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-glob nil
"This module provides extended globbing syntax, similar what is used
by zsh for filename generation."
:tag "Extended filename globbing"
:group 'eshell-module)
;;; Commentary:
;; The globbing code used by Eshell closely follows the syntax used by
;; zsh. Basically, here is a summary of examples:
;;
;; echo a* ; anything starting with 'a'
;; echo a#b ; zero or more 'a's, then 'b'
;; echo a##b ; one or more 'a's, then 'b'
;; echo a? ; a followed by any character
;; echo a*~ab ; 'a', then anything, but not 'ab'
;; echo c*~*~ ; all files beginning with 'c', except backups (*~)
;;
;; Recursive globbing is also supported:
;;
;; echo **/*.c ; all '.c' files at or under current directory
;; echo ***/*.c ; same as above, but traverse symbolic links
;;
;; Using argument predication, the recursive globbing syntax is
;; sufficient to replace the use of 'find <expr> | xargs <cmd>' in
;; most cases. For example, to change the readership of all files
;; belonging to 'johnw' in the '/tmp' directory or lower, use:
;;
;; chmod go-r /tmp/**/*(u'johnw')
;;
;; The glob above matches all of the files beneath '/tmp' that are
;; owned by the user 'johnw'. See [Value modifiers and predicates],
;; for more information about argument predication.
;;; User Variables:
(defcustom eshell-glob-load-hook '(eshell-glob-initialize)
"*A list of functions to run when `eshell-glob' is loaded."
:type 'hook
:group 'eshell-glob)
(defcustom eshell-glob-include-dot-files nil
"*If non-nil, glob patterns will match files beginning with a dot."
:type 'boolean
:group 'eshell-glob)
(defcustom eshell-glob-include-dot-dot t
"*If non-nil, glob patterns that match dots will match . and .."
:type 'boolean
:group 'eshell-glob)
(defcustom eshell-glob-case-insensitive (eshell-under-windows-p)
"*If non-nil, glob pattern matching will ignore case."
:type 'boolean
:group 'eshell-glob)
(defcustom eshell-glob-show-progress t
"*If non-nil, display progress messages during a recursive glob."
:type 'boolean
:group 'eshell-glob)
(defcustom eshell-error-if-no-glob nil
"*If non-nil, it is an error for a glob pattern not to match.
This mimcs the behavior of zsh if non-nil, but bash if nil."
:type 'boolean
:group 'eshell-glob)
(defcustom eshell-glob-chars-list '(?\] ?\[ ?* ?? ?~ ?\( ?\) ?| ?#)
"*List of additional characters used in extended globbing."
:type '(repeat character)
:group 'eshell-glob)
(defcustom eshell-glob-translate-alist
'((?\] . "]")
(?\[ . "[")
(?? . ".")
(?* . ".*")
(?~ . "~")
(?\( . "\\(")
(?\) . "\\)")
(?\| . "\\|")
(?# . (lambda (str pos)
(if (and (< (1+ pos) (length str))
(memq (aref str (1+ pos)) '(?* ?# ?+ ??)))
(cons (if (eq (aref str (1+ pos)) ??)
"?"
(if (eq (aref str (1+ pos)) ?*)
"*" "+")) (+ pos 2))
(cons "*" (1+ pos))))))
"*An alist for translation of extended globbing characters."
:type '(repeat (cons character (choice regexp function)))
:group 'eshell-glob)
;;; Internal Variables:
(defvar eshell-glob-chars-regexp nil)
;;; Functions:
(defun eshell-glob-initialize ()
"Initialize the extended globbing code."
;; it's important that `eshell-glob-chars-list' come first
(set (make-local-variable 'eshell-special-chars-outside-quoting)
(append eshell-glob-chars-list eshell-special-chars-outside-quoting))
(set (make-local-variable 'eshell-glob-chars-regexp)
(format "[%s]+" (apply 'string eshell-glob-chars-list)))
(make-local-hook 'eshell-parse-argument-hook)
(add-hook 'eshell-parse-argument-hook 'eshell-parse-glob-chars t t)
(make-local-hook 'eshell-pre-rewrite-command-hook)
(add-hook 'eshell-pre-rewrite-command-hook
'eshell-no-command-globbing nil t))
(defun eshell-no-command-globbing (terms)
"Don't glob the command argument. Reflect this by modifying TERMS."
(ignore
(when (and (listp (car terms))
(eq (caar terms) 'eshell-extended-glob))
(setcar terms (cadr (car terms))))))
(defun eshell-add-glob-modifier ()
"Add `eshell-extended-glob' to the argument modifier list."
(when (memq 'expand-file-name eshell-current-modifiers)
(setq eshell-current-modifiers
(delq 'expand-file-name eshell-current-modifiers))
;; if this is a glob pattern than needs to be expanded, then it
;; will need to expand each member of the resulting glob list
(add-to-list 'eshell-current-modifiers
'(lambda (list)
(if (listp list)
(mapcar 'expand-file-name list)
(expand-file-name list)))))
(add-to-list 'eshell-current-modifiers 'eshell-extended-glob))
(defun eshell-parse-glob-chars ()
"Parse a globbing delimiter.
The character is not advanced for ordinary globbing characters, so
that other function may have a chance to override the globbing
interpretation."
(when (memq (char-after) eshell-glob-chars-list)
(if (not (memq (char-after) '(?\( ?\[)))
(ignore (eshell-add-glob-modifier))
(let ((here (point)))
(forward-char)
(let* ((delim (char-before))
(end (eshell-find-delimiter
delim (if (eq delim ?\[) ?\] ?\)))))
(if (not end)
(throw 'eshell-incomplete delim)
(if (and (eshell-using-module 'eshell-pred)
(eshell-arg-delimiter (1+ end)))
(ignore (goto-char here))
(eshell-add-glob-modifier)
(prog1
(buffer-substring-no-properties (1- (point)) (1+ end))
(goto-char (1+ end))))))))))
(defun eshell-glob-regexp (pattern)
"Convert glob-pattern PATTERN to a regular expression.
The basic syntax is:
glob regexp meaning
---- ------ -------
? . matches any single character
* .* matches any group of characters (or none)
# * matches zero or more occurrences of preceding
## + matches one or more occurrences of preceding
(x) \(x\) makes 'x' a regular expression group
| \| boolean OR within an expression group
[a-b] [a-b] matches a character or range
[^a] [^a] excludes a character or range
If any characters in PATTERN have the text property `eshell-escaped'
set to true, then these characters will match themselves in the
resulting regular expression."
(let ((matched-in-pattern 0) ; How much of PATTERN handled
regexp)
(while (string-match eshell-glob-chars-regexp
pattern matched-in-pattern)
(let* ((op-begin (match-beginning 0))
(op-char (aref pattern op-begin)))
(setq regexp
(concat regexp
(regexp-quote
(substring pattern matched-in-pattern op-begin))))
(if (get-text-property op-begin 'escaped pattern)
(setq regexp (concat regexp
(regexp-quote (char-to-string op-char)))
matched-in-pattern (1+ op-begin))
(let ((xlat (assq op-char eshell-glob-translate-alist)))
(if (not xlat)
(error "Unrecognized globbing character '%c'" op-char)
(if (stringp (cdr xlat))
(setq regexp (concat regexp (cdr xlat))
matched-in-pattern (1+ op-begin))
(let ((result (funcall (cdr xlat) pattern op-begin)))
(setq regexp (concat regexp (car result))
matched-in-pattern (cdr result)))))))))
(concat "\\`"
regexp
(regexp-quote (substring pattern matched-in-pattern))
"\\'")))
(defun eshell-extended-glob (glob)
"Return a list of files generated from GLOB, perhaps looking for DIRS-ONLY.
This function almost fully supports zsh style filename generation
syntax. Things that are not supported are:
^foo for matching everything but foo
(foo~bar) tilde within a parenthesis group
foo<1-10> numeric ranges
foo~x(a|b) (a|b) will be interpreted as a predicate/modifier list
Mainly they are not supported because file matching is done with Emacs
regular expressions, and these cannot support the above constructs.
If this routine fails, it returns nil. Otherwise, it returns a list
the form:
(INCLUDE-REGEXP EXCLUDE-REGEXP (PRED-FUNC-LIST) (MOD-FUNC-LIST))"
(let ((paths (eshell-split-path glob))
matches message-shown)
(unwind-protect
(if (and (cdr paths)
(file-name-absolute-p (car paths)))
(eshell-glob-entries (file-name-as-directory (car paths))
(cdr paths))
(eshell-glob-entries (file-name-as-directory ".") paths))
(if message-shown
(message nil)))
(or (and matches (nreverse matches))
(if eshell-error-if-no-glob
(error "No matches found: %s" glob)
glob))))
(eval-when-compile
(defvar matches)
(defvar message-shown))
;; jww (1999-11-18): this function assumes that directory-sep-char is
;; a forward slash (/)
(defun eshell-glob-entries (path globs &optional recurse-p)
"Glob the entries in PATHS, possibly recursing if RECURSE-P is non-nil."
(let* ((entries (ignore-errors
(file-name-all-completions "" path)))
(case-fold-search eshell-glob-case-insensitive)
(glob (car globs))
(len (length glob))
dirs rdirs
incl excl
name isdir pathname)
(while (cond
((and (= len 3) (equal glob "**/"))
(setq recurse-p 2
globs (cdr globs)
glob (car globs)
len (length glob)))
((and (= len 4) (equal glob "***/"))
(setq recurse-p 3
globs (cdr globs)
glob (car globs)
len (length glob)))))
(if (and recurse-p (not glob))
(error "'**' cannot end a globbing pattern"))
(let ((index 1))
(setq incl glob)
(while (and (eq incl glob)
(setq index (string-match "~" glob index)))
(if (or (get-text-property index 'escaped glob)
(or (= (1+ index) len)))
(setq index (1+ index))
(setq incl (substring glob 0 index)
excl (substring glob (1+ index))))))
;; can't use `directory-file-name' because it strips away text
;; properties in the string
(let ((len (1- (length incl))))
(if (eq (aref incl len) directory-sep-char)
(setq incl (substring incl 0 len)))
(when excl
(setq len (1- (length excl)))
(if (eq (aref excl len) directory-sep-char)
(setq excl (substring excl 0 len)))))
(setq incl (eshell-glob-regexp incl)
excl (and excl (eshell-glob-regexp excl)))
(if (or eshell-glob-include-dot-files
(eq (aref glob 0) ?.))
(unless (or eshell-glob-include-dot-dot
(cdr globs))
(setq excl (if excl
(concat "\\(\\`\\.\\.?\\'\\|" excl "\\)")
"\\`\\.\\.?\\'")))
(setq excl (if excl
(concat "\\(\\`\\.\\|" excl "\\)")
"\\`\\.")))
(when (and recurse-p eshell-glob-show-progress)
(message "Building file list...%d so far: %s"
(length matches) path)
(setq message-shown t))
(if (equal path "./") (setq path ""))
(while entries
(setq name (car entries)
len (length name)
isdir (eq (aref name (1- len)) directory-sep-char))
(if (let ((fname (directory-file-name name)))
(and (not (and excl (string-match excl fname)))
(string-match incl fname)))
(if (cdr globs)
(if isdir
(setq dirs (cons (concat path name) dirs)))
(setq matches (cons (concat path name) matches))))
(if (and recurse-p isdir
(or (> len 3)
(not (or (and (= len 2) (equal name "./"))
(and (= len 3) (equal name "../")))))
(setq pathname (concat path name))
(not (and (= recurse-p 2)
(file-symlink-p
(directory-file-name pathname)))))
(setq rdirs (cons pathname rdirs)))
(setq entries (cdr entries)))
(setq dirs (nreverse dirs)
rdirs (nreverse rdirs))
(while dirs
(eshell-glob-entries (car dirs) (cdr globs))
(setq dirs (cdr dirs)))
(while rdirs
(eshell-glob-entries (car rdirs) globs recurse-p)
(setq rdirs (cdr rdirs)))))
;;; Code:
;;; em-glob.el ends here

966
lisp/eshell/em-hist.el Normal file
View File

@ -0,0 +1,966 @@
;;; em-hist --- history list management
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'em-hist)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-hist nil
"This module provides command history management."
:tag "History list management"
:group 'eshell-module)
;;; Commentary:
;; Eshell's history facility imitates the syntax used by bash
;; ([(bash)History Interaction]). Thus:
;;
;; !ls ; repeat the last command beginning with 'ls'
;; !?ls ; repeat the last command containing ls
;; echo !ls:2 ; echo the second arg of the last 'ls' command
;; !ls<tab> ; complete against all possible words in this
;; ; position, by looking at the history list
;; !ls<C-c SPC> ; expand any matching history input at point
;;
;; Also, most of `comint-mode's keybindings are accepted:
;;
;; M-r ; search backward for a previous command by regexp
;; M-s ; search forward for a previous command by regexp
;; M-p ; access the last command entered, repeatable
;; M-n ; access the first command entered, repeatable
;;
;; C-c M-r ; using current input, find a matching command thus, with
;; ; 'ls' as the current input, it will go back to the same
;; ; command that '!ls' would have selected
;; C-c M-s ; same, but in reverse order
;;
;; Note that some of these keybindings are only available if the
;; `eshell-rebind' is not in use, in which case M-p does what C-c M-r
;; normally would do, and C-p is used instead of M-p. It may seem
;; confusing, but the intention is to make the most useful
;; functionality the most easily accessible. If `eshell-rebind' is
;; not being used, history navigation will use comint's keybindings;
;; if it is, history navigation tries to use similar keybindings to
;; bash. This is all configurable, of course.
;;; Code:
(require 'ring)
(require 'esh-opt)
(require 'em-pred)
;;; User Variables:
(defcustom eshell-hist-load-hook '(eshell-hist-initialize)
"*A list of functions to call when loading `eshell-hist'."
:type 'hook
:group 'eshell-hist)
(defcustom eshell-hist-unload-hook
(list
(function
(lambda ()
(remove-hook 'kill-emacs-hook 'eshell-save-some-history))))
"*A hook that gets run when `eshell-hist' is unloaded."
:type 'hook
:group 'eshell-hist)
(defcustom eshell-history-file-name
(concat eshell-directory-name "history")
"*If non-nil, name of the file to read/write input history.
See also `eshell-read-history' and `eshell-write-history'.
If it is nil, Eshell will use the value of HISTFILE."
:type 'file
:group 'eshell-hist)
(defcustom eshell-history-size 128
"*Size of the input history ring. If nil, use envvar HISTSIZE."
:type 'integer
:group 'eshell-hist)
(defcustom eshell-hist-ignoredups nil
"*If non-nil, don't add input matching the last on the input ring.
This mirrors the optional behavior of bash."
:type 'boolean
:group 'eshell-hist)
(defcustom eshell-ask-to-save-history t
"*Determine if history should be automatically saved.
History is always preserved after sanely exiting an Eshell buffer.
However, when Emacs is being shut down, this variable determines
whether to prompt the user.
If set to nil, it means never ask whether history should be saved.
If set to t, always ask if any Eshell buffers are open at exit time.
If set to `always', history will always be saved, silently."
:type '(choice (const :tag "Never" nil)
(const :tag "Ask" t)
(const :tag "Always save" always))
:group 'eshell-hist)
(defcustom eshell-input-filter
(function
(lambda (str)
(not (string-match "\\`\\s-*\\'" str))))
"*Predicate for filtering additions to input history.
Takes one argument, the input. If non-nil, the input may be saved on
the input history list. Default is to save anything that isn't all
whitespace."
:type 'function
:group 'eshell-hist)
(put 'eshell-input-filter 'risky-local-variable t)
(defcustom eshell-hist-match-partial t
"*If non-nil, movement through history is constrained by current input.
Otherwise, typing <M-p> and <M-n> will always go to the next history
element, regardless of any text on the command line. In that case,
<C-c M-r> and <C-c M-s> still offer that functionality."
:type 'boolean
:group 'eshell-hist)
(defcustom eshell-hist-move-to-end t
"*If non-nil, move to the end of the buffer before cycling history."
:type 'boolean
:group 'eshell-hist)
(defcustom eshell-hist-event-designator
"^!\\(!\\|-?[0-9]+\\|\\??[^:^$%*?]+\\??\\|#\\)"
"*The regexp used to identifier history event designators."
:type 'regexp
:group 'eshell-hist)
(defcustom eshell-hist-word-designator
"^:?\\([0-9]+\\|[$^%*]\\)?\\(\\*\\|-[0-9]*\\|[$^%*]\\)?"
"*The regexp used to identify history word designators."
:type 'regexp
:group 'eshell-hist)
(defcustom eshell-hist-modifier
"^\\(:\\([hretpqx&g]\\|s/\\([^/]*\\)/\\([^/]*\\)/\\)\\)*"
"*The regexp used to identity history modifiers."
:type 'regexp
:group 'eshell-hist)
(defcustom eshell-hist-rebind-keys-alist
'(([(control ?p)] . eshell-previous-input)
([(control ?n)] . eshell-next-input)
([(control up)] . eshell-previous-input)
([(control down)] . eshell-next-input)
([(control ?r)] . eshell-isearch-backward)
([(control ?s)] . eshell-isearch-forward)
([(meta ?r)] . eshell-previous-matching-input)
([(meta ?s)] . eshell-next-matching-input)
([(meta ?p)] . eshell-previous-matching-input-from-input)
([(meta ?n)] . eshell-next-matching-input-from-input)
([up] . eshell-previous-matching-input-from-input)
([down] . eshell-next-matching-input-from-input))
"*History keys to bind differently if point is in input text."
:type '(repeat (cons (vector :tag "Keys to bind"
(repeat :inline t sexp))
(function :tag "Command")))
:group 'eshell-hist)
;;; Internal Variables:
(defvar eshell-history-ring nil)
(defvar eshell-history-index nil)
(defvar eshell-matching-input-from-input-string "")
(defvar eshell-save-history-index nil)
(defvar eshell-isearch-map nil)
(unless eshell-isearch-map
(setq eshell-isearch-map (copy-keymap isearch-mode-map))
(define-key eshell-isearch-map [(control ?m)] 'eshell-isearch-return)
(define-key eshell-isearch-map [return] 'eshell-isearch-return)
(define-key eshell-isearch-map [(control ?r)] 'eshell-isearch-repeat-backward)
(define-key eshell-isearch-map [(control ?s)] 'eshell-isearch-repeat-forward)
(define-key eshell-isearch-map [(control ?g)] 'eshell-isearch-abort)
(define-key eshell-isearch-map [backspace] 'eshell-isearch-delete-char)
(define-key eshell-isearch-map [delete] 'eshell-isearch-delete-char)
(defvar eshell-isearch-cancel-map)
(define-prefix-command 'eshell-isearch-cancel-map)
(define-key eshell-isearch-map [(control ?c)] 'eshell-isearch-cancel-map)
(define-key eshell-isearch-cancel-map [(control ?c)] 'eshell-isearch-cancel))
;;; Functions:
(defun eshell-hist-initialize ()
"Initialize the history management code for one Eshell buffer."
(make-local-hook 'eshell-expand-input-functions)
(add-hook 'eshell-expand-input-functions
'eshell-expand-history-references nil t)
(when (eshell-using-module 'eshell-cmpl)
(make-local-hook 'pcomplete-try-first-hook)
(add-hook 'pcomplete-try-first-hook
'eshell-complete-history-reference nil t))
(if (eshell-using-module 'eshell-rebind)
(let ((rebind-alist (symbol-value 'eshell-rebind-keys-alist)))
(make-local-variable 'eshell-rebind-keys-alist)
(set 'eshell-rebind-keys-alist
(append rebind-alist eshell-hist-rebind-keys-alist))
(set (make-local-variable 'search-invisible) t)
(set (make-local-variable 'search-exit-option) t)
(make-local-hook 'isearch-mode-hook)
(add-hook 'isearch-mode-hook
(function
(lambda ()
(if (>= (point) eshell-last-output-end)
(setq overriding-terminal-local-map
eshell-isearch-map)))) nil t)
(make-local-hook 'isearch-mode-end-hook)
(add-hook 'isearch-mode-end-hook
(function
(lambda ()
(setq overriding-terminal-local-map nil))) nil t))
(define-key eshell-mode-map [up] 'eshell-previous-matching-input-from-input)
(define-key eshell-mode-map [down] 'eshell-next-matching-input-from-input)
(define-key eshell-mode-map [(control up)] 'eshell-previous-input)
(define-key eshell-mode-map [(control down)] 'eshell-next-input)
(define-key eshell-mode-map [(meta ?r)] 'eshell-previous-matching-input)
(define-key eshell-mode-map [(meta ?s)] 'eshell-next-matching-input)
(define-key eshell-command-map [(meta ?r)]
'eshell-previous-matching-input-from-input)
(define-key eshell-command-map [(meta ?s)]
'eshell-next-matching-input-from-input)
(if eshell-hist-match-partial
(progn
(define-key eshell-mode-map [(meta ?p)]
'eshell-previous-matching-input-from-input)
(define-key eshell-mode-map [(meta ?n)]
'eshell-next-matching-input-from-input)
(define-key eshell-command-map [(meta ?p)] 'eshell-previous-input)
(define-key eshell-command-map [(meta ?n)] 'eshell-next-input))
(define-key eshell-mode-map [(meta ?p)] 'eshell-previous-input)
(define-key eshell-mode-map [(meta ?n)] 'eshell-next-input)
(define-key eshell-command-map [(meta ?p)]
'eshell-previous-matching-input-from-input)
(define-key eshell-command-map [(meta ?n)]
'eshell-next-matching-input-from-input)))
(make-local-variable 'eshell-history-size)
(or eshell-history-size
(setq eshell-history-size (getenv "HISTSIZE")))
(make-local-variable 'eshell-history-file-name)
(or eshell-history-file-name
(setq eshell-history-file-name (getenv "HISTFILE")))
(make-local-variable 'eshell-history-index)
(make-local-variable 'eshell-save-history-index)
(make-local-variable 'eshell-history-ring)
(if eshell-history-file-name
(eshell-read-history nil t))
(unless eshell-history-ring
(setq eshell-history-ring (make-ring eshell-history-size)))
(make-local-hook 'eshell-exit-hook)
(add-hook 'eshell-exit-hook 'eshell-write-history nil t)
(add-hook 'kill-emacs-hook 'eshell-save-some-history)
(make-local-variable 'eshell-input-filter-functions)
(add-hook 'eshell-input-filter-functions 'eshell-add-to-history nil t)
(define-key eshell-command-map [(control ?l)] 'eshell-list-history)
(define-key eshell-command-map [(control ?x)] 'eshell-get-next-from-history))
(defun eshell-save-some-history ()
"Save the history for any open Eshell buffers."
(eshell-for buf (buffer-list)
(if (buffer-live-p buf)
(with-current-buffer buf
(if (and eshell-mode
eshell-history-file-name
eshell-ask-to-save-history
(or (eq eshell-ask-to-save-history 'always)
(y-or-n-p
(format "Save input history for Eshell buffer `%s'? "
(buffer-name buf)))))
(eshell-write-history))))))
(defun eshell/history (&rest args)
"List in help buffer the buffer's input history."
(eshell-init-print-buffer)
(eshell-eval-using-options
"history" args
'((?r "read" nil read-history
"read from history file to current history list")
(?w "write" nil write-history
"write current history list to history file")
(?a "append" nil append-history
"append current history list to history file")
(?h "help" nil nil "display this usage message")
:usage "[n] [-rwa [filename]]"
:post-usage
"When Eshell is started, history is read from `eshell-history-file-name'.
This is also the location where history info will be saved by this command,
unless a different file is specified on the command line.")
(and (or (not (ring-p eshell-history-ring))
(ring-empty-p eshell-history-ring))
(error "No history"))
(let (length command file)
(when (and args (string-match "^[0-9]+$" (car args)))
(setq length (min (eshell-convert (car args))
(ring-length eshell-history-ring))
args (cdr args)))
(and length
(or read-history write-history append-history)
(error "history: extra arguments"))
(when (and args (stringp (car args)))
(setq file (car args)
args (cdr args)))
(cond
(read-history (eshell-read-history file))
(write-history (eshell-write-history file))
(append-history (eshell-write-history file t))
(t
(let* ((history nil)
(index (1- (or length (ring-length eshell-history-ring))))
(ref (- (ring-length eshell-history-ring) index)))
;; We have to build up a list ourselves from the ring vector.
(while (>= index 0)
(eshell-buffered-print
(format "%5d %s\n" ref (eshell-get-history index)))
(setq index (1- index)
ref (1+ ref)))))))
(eshell-flush)
nil))
(defun eshell-put-history (input &optional ring at-beginning)
"Put a new input line into the history ring."
(unless ring (setq ring eshell-history-ring))
(subst-char-in-string ?\n ?\177 input t)
(if at-beginning
(ring-insert-at-beginning ring input)
(ring-insert ring input)))
(defun eshell-get-history (index &optional ring)
"Get an input line from the history ring."
(unless ring (setq ring eshell-history-ring))
(let ((input (concat (ring-ref ring index))))
(subst-char-in-string ?\177 ?\n input t)
input))
(defun eshell-add-to-history ()
"Add INPUT to the history ring.
The input is entered into the input history ring, if the value of
variable `eshell-input-filter' returns non-nil when called on the
input."
(when (> (1- eshell-last-input-end) eshell-last-input-start)
(let ((input (buffer-substring eshell-last-input-start
(1- eshell-last-input-end))))
(if (and (funcall eshell-input-filter input)
(or (null eshell-hist-ignoredups)
(not (ring-p eshell-history-ring))
(ring-empty-p eshell-history-ring)
(not (string-equal (eshell-get-history 0) input))))
(eshell-put-history input))
(setq eshell-save-history-index eshell-history-ring)
(setq eshell-history-index nil))))
(defun eshell-read-history (&optional filename silent)
"Sets the buffer's `eshell-history-ring' from a history file.
The name of the file is given by the variable
`eshell-history-file-name'. The history ring is of size
`eshell-history-size', regardless of file size. If
`eshell-history-file-name' is nil this function does nothing.
If the optional argument SILENT is non-nil, we say nothing about a
failure to read the history file.
This function is useful for major mode commands and mode hooks.
The structure of the history file should be one input command per
line, with the most recent command last. See also
`eshell-hist-ignoredups' and `eshell-write-history'."
(let ((file (or filename eshell-history-file-name)))
(cond
((or (null file)
(equal file ""))
nil)
((not (file-readable-p file))
(or silent
(message "Cannot read history file %s" file)))
(t
(let* ((count 0)
(size eshell-history-size)
(ring (make-ring size))
(ignore-dups eshell-hist-ignoredups))
(with-temp-buffer
(insert-file-contents file)
;; Save restriction in case file is already visited...
;; Watch for those date stamps in history files!
(goto-char (point-max))
(while (and (< count size)
(re-search-backward "^[ \t]*\\([^#\n].*\\)[ \t]*$"
nil t))
(let ((history (match-string 1)))
(if (or (null ignore-dups)
(ring-empty-p ring)
(not (string-equal (ring-ref ring 0) history)))
(ring-insert-at-beginning ring history)))
(setq count (1+ count))))
(setq eshell-history-ring ring
eshell-history-index nil))))))
(defun eshell-write-history (&optional filename append)
"Writes the buffer's `eshell-history-ring' to a history file.
The name of the file is given by the variable
`eshell-history-file-name'. The original contents of the file are
lost if `eshell-history-ring' is not empty. If
`eshell-history-file-name' is nil this function does nothing.
Useful within process sentinels.
See also `eshell-read-history'."
(let ((file (or filename eshell-history-file-name)))
(cond
((or (null file)
(equal file "")
(null eshell-history-ring)
(ring-empty-p eshell-history-ring))
nil)
((not (file-writable-p file))
(message "Cannot write history file %s" file))
(t
(let* ((ring eshell-history-ring)
(index (ring-length ring)))
;; Write it all out into a buffer first. Much faster, but
;; messier, than writing it one line at a time.
(with-temp-buffer
(while (> index 0)
(setq index (1- index))
(insert (ring-ref ring index) ?\n))
(eshell-with-private-file-modes
(write-region (point-min) (point-max) file append
'no-message))))))))
(defun eshell-list-history ()
"List in help buffer the buffer's input history."
(interactive)
(let (prefix prelen)
(save-excursion
(if (re-search-backward "!\\(.+\\)" (line-beginning-position) t)
(setq prefix (match-string 1)
prelen (length prefix))))
(if (or (not (ring-p eshell-history-ring))
(ring-empty-p eshell-history-ring))
(message "No history")
(let ((history nil)
(history-buffer " *Input History*")
(index (1- (ring-length eshell-history-ring)))
(conf (current-window-configuration)))
;; We have to build up a list ourselves from the ring vector.
(while (>= index 0)
(let ((hist (eshell-get-history index)))
(if (or (not prefix)
(and (>= (length hist) prelen)
(string= (substring hist 0 prelen) prefix)))
(setq history (cons hist history))))
(setq index (1- index)))
;; Change "completion" to "history reference"
;; to make the display accurate.
(with-output-to-temp-buffer history-buffer
(display-completion-list history)
(set-buffer history-buffer)
(forward-line 3)
(while (search-backward "completion" nil 'move)
(replace-match "history reference")))
(eshell-redisplay)
(message "Hit space to flush")
(let ((ch (read-event)))
(if (eq ch ?\ )
(set-window-configuration conf)
(setq unread-command-events (list ch))))))))
(defun eshell-hist-word-reference (ref)
"Return the word designator index referred to by REF."
(cond
((string-match "^[0-9]+$" ref)
(string-to-number ref))
((string= "^" ref) 1)
((string= "$" ref) nil)
((string= "%" ref)
(error "`%' history word designator not yet implemented"))))
(defun eshell-hist-parse-arguments (&optional silent b e)
"Parse current command arguments in a history-code-friendly way."
(let ((end (or e (point)))
(begin (or b (save-excursion (eshell-bol) (point))))
(posb (list t))
(pose (list t))
(textargs (list t))
hist args)
(unless (catch 'eshell-incomplete
(ignore
(setq args (eshell-parse-arguments begin end))))
(save-excursion
(goto-char begin)
(while (< (point) end)
(if (get-text-property (point) 'arg-begin)
(nconc posb (list (point))))
(if (get-text-property (point) 'arg-end)
(nconc pose
(list (if (= (1+ (point)) end)
(1+ (point))
(point)))))
(forward-char))
(setq posb (cdr posb)
pose (cdr pose))
(assert (= (length posb) (length args)))
(assert (<= (length posb) (length pose))))
(setq hist (buffer-substring-no-properties begin end))
(let ((b posb) (e pose))
(while b
(nconc textargs
(list (substring hist (- (car b) begin)
(- (car e) begin))))
(setq b (cdr b)
e (cdr e))))
(setq textargs (cdr textargs))
(assert (= (length textargs) (length args)))
(list textargs posb pose))))
(defun eshell-expand-history-references (beg end)
"Parse and expand any history references in current input."
(let ((result (eshell-hist-parse-arguments t beg end)))
(when result
(let ((textargs (nreverse (nth 0 result)))
(posb (nreverse (nth 1 result)))
(pose (nreverse (nth 2 result))))
(save-excursion
(while textargs
(let ((str (eshell-history-reference (car textargs))))
(unless (eq str (car textargs))
(goto-char (car posb))
(insert-and-inherit str)
(delete-char (- (car pose) (car posb)))))
(setq textargs (cdr textargs)
posb (cdr posb)
pose (cdr pose))))))))
(defun eshell-complete-history-reference ()
"Complete a history reference, by completing the event designator."
(let ((arg (pcomplete-actual-arg)))
(when (string-match "\\`![^:^$*%]*\\'" arg)
(setq pcomplete-stub (substring arg 1)
pcomplete-last-completion-raw t)
(throw 'pcomplete-completions
(let ((history nil)
(index (1- (ring-length eshell-history-ring)))
(stublen (length pcomplete-stub)))
;; We have to build up a list ourselves from the ring
;; vector.
(while (>= index 0)
(let ((hist (eshell-get-history index)))
(if (and (>= (length hist) stublen)
(string= (substring hist 0 stublen)
pcomplete-stub)
(string-match "^\\([^:^$*% \t\n]+\\)" hist))
(setq history (cons (match-string 1 hist)
history))))
(setq index (1- index)))
(let ((fhist (list t)))
;; uniqify the list, but preserve the order
(while history
(unless (member (car history) fhist)
(nconc fhist (list (car history))))
(setq history (cdr history)))
(cdr fhist)))))))
(defun eshell-history-reference (reference)
"Expand directory stack REFERENCE.
The syntax used here was taken from the Bash info manual.
Returns the resultant reference, or the same string REFERENCE if none
matched."
;; `^string1^string2^'
;; Quick Substitution. Repeat the last command, replacing
;; STRING1 with STRING2. Equivalent to `!!:s/string1/string2/'
(if (and (eshell-using-module 'eshell-pred)
(string-match "\\^\\([^^]+\\)\\^\\([^^]+\\)\\^?\\s-*$"
reference))
(setq reference (format "!!:s/%s/%s/"
(match-string 1 reference)
(match-string 2 reference))))
;; `!'
;; Start a history substitution, except when followed by a
;; space, tab, the end of the line, = or (.
(if (not (string-match "^![^ \t\n=\(]" reference))
reference
(setq eshell-history-index nil)
(let ((event (eshell-hist-parse-event-designator reference)))
(unless event
(error "Could not find history event `%s'" reference))
(setq eshell-history-index (car event)
reference (substring reference (cdr event))
event (eshell-get-history eshell-history-index))
(if (not (string-match "^[:^$*%]" reference))
event
(let ((word (eshell-hist-parse-word-designator
event reference)))
(unless word
(error "Unable to honor word designator `%s'" reference))
(unless (string-match "^[:^$*%][[$^*%0-9-]" reference)
(setcdr word 0))
(setq event (car word)
reference (substring reference (cdr word)))
(if (not (and (eshell-using-module 'eshell-pred)
(string-match "^:" reference)))
event
(eshell-hist-parse-modifier event reference)))))))
(defun eshell-hist-parse-event-designator (reference)
"Parse a history event designator beginning in REFERENCE."
(let* ((index (string-match eshell-hist-event-designator reference))
(end (and index (match-end 0))))
(unless index
(error "Invalid history event designator `%s'" reference))
(let* ((event (match-string 1 reference))
(pos
(cond
((string= event "!") (ring-length eshell-history-ring))
((string= event "#") (error "!# not yet implemented"))
((string-match "^-?[0-9]+$" event)
(let ((num (string-to-number event)))
(if (>= num 0)
(- (ring-length eshell-history-ring) num)
(1- (abs num)))))
((string-match "^\\(\\??\\)\\([^?]+\\)\\??$" event)
(let ((pref (if (> (length (match-string 1 event)) 0)
"" "^"))
(str (match-string 2 event)))
(save-match-data
(eshell-previous-matching-input-string-position
(concat pref (regexp-quote str)) 1))))
(t
(error "Failed to parse event designator `%s'" event)))))
(and pos (cons pos end)))))
(defun eshell-hist-parse-word-designator (hist reference)
"Parse a history word designator beginning for HIST in REFERENCE."
(let* ((index (string-match eshell-hist-word-designator reference))
(end (and index (match-end 0))))
(unless (memq (aref reference 0) '(?: ?^ ?$ ?* ?%))
(error "Invalid history word designator `%s'" reference))
(let ((nth (match-string 1 reference))
(mth (match-string 2 reference))
(here (point))
textargs)
(insert hist)
(setq textargs (car (eshell-hist-parse-arguments nil here (point))))
(delete-region here (point))
(if (string= nth "*")
(if mth
(error "Invalid history word designator `%s'"
reference)
(setq nth 1 mth "-$")))
(if (not mth)
(if nth
(setq mth nth)
(setq nth 0 mth "$"))
(if (string= mth "-")
(setq mth (- (length textargs) 2))
(if (string= mth "*")
(setq mth "$")
(if (not (and (> (length mth) 1)
(eq (aref mth 0) ?-)))
(error "Invalid history word designator `%s'"
reference)
(setq mth (substring mth 1))))))
(unless (numberp nth)
(setq nth (eshell-hist-word-reference nth)))
(unless (numberp mth)
(setq mth (eshell-hist-word-reference mth)))
(cons (mapconcat 'identity (eshell-sublist textargs nth mth) "")
end))))
(defun eshell-hist-parse-modifier (hist reference)
"Parse a history modifier beginning for HIST in REFERENCE."
(let ((here (point)))
(insert reference)
(prog1
(save-restriction
(narrow-to-region here (point))
(goto-char (point-min))
(let ((modifiers (cdr (eshell-parse-modifiers))))
(eshell-for mod modifiers
(setq hist (funcall mod hist)))
hist))
(delete-region here (point)))))
(defun eshell-get-next-from-history ()
"After fetching a line from input history, this fetches the next.
In other words, this recalls the input line after the line you
recalled last. You can use this to repeat a sequence of input lines."
(interactive)
(if eshell-save-history-index
(progn
(setq eshell-history-index (1+ eshell-save-history-index))
(eshell-next-input 1))
(message "No previous history command")))
(defun eshell-search-arg (arg)
;; First make sure there is a ring and that we are after the process
;; mark
(if (and eshell-hist-move-to-end
(< (point) eshell-last-output-end))
(goto-char eshell-last-output-end))
(cond ((or (null eshell-history-ring)
(ring-empty-p eshell-history-ring))
(error "Empty input ring"))
((zerop arg)
;; arg of zero resets search from beginning, and uses arg of
;; 1
(setq eshell-history-index nil)
1)
(t
arg)))
(defun eshell-search-start (arg)
"Index to start a directional search, starting at `eshell-history-index'."
(if eshell-history-index
;; If a search is running, offset by 1 in direction of arg
(mod (+ eshell-history-index (if (> arg 0) 1 -1))
(ring-length eshell-history-ring))
;; For a new search, start from beginning or end, as appropriate
(if (>= arg 0)
0 ; First elt for forward search
;; Last elt for backward search
(1- (ring-length eshell-history-ring)))))
(defun eshell-previous-input-string (arg)
"Return the string ARG places along the input ring.
Moves relative to `eshell-history-index'."
(eshell-get-history (if eshell-history-index
(mod (+ arg eshell-history-index)
(ring-length eshell-history-ring))
arg)))
(defun eshell-previous-input (arg)
"Cycle backwards through input history."
(interactive "*p")
(eshell-previous-matching-input "." arg))
(defun eshell-next-input (arg)
"Cycle forwards through input history."
(interactive "*p")
(eshell-previous-input (- arg)))
(defun eshell-previous-matching-input-string (regexp arg)
"Return the string matching REGEXP ARG places along the input ring.
Moves relative to `eshell-history-index'."
(let* ((pos (eshell-previous-matching-input-string-position regexp arg)))
(if pos (eshell-get-history pos))))
(defun eshell-previous-matching-input-string-position
(regexp arg &optional start)
"Return the index matching REGEXP ARG places along the input ring.
Moves relative to START, or `eshell-history-index'."
(if (or (not (ring-p eshell-history-ring))
(ring-empty-p eshell-history-ring))
(error "No history"))
(let* ((len (ring-length eshell-history-ring))
(motion (if (> arg 0) 1 -1))
(n (mod (- (or start (eshell-search-start arg)) motion) len))
(tried-each-ring-item nil)
(case-fold-search (eshell-under-windows-p))
(prev nil))
;; Do the whole search as many times as the argument says.
(while (and (/= arg 0) (not tried-each-ring-item))
;; Step once.
(setq prev n
n (mod (+ n motion) len))
;; If we haven't reached a match, step some more.
(while (and (< n len) (not tried-each-ring-item)
(not (string-match regexp (eshell-get-history n))))
(setq n (mod (+ n motion) len)
;; If we have gone all the way around in this search.
tried-each-ring-item (= n prev)))
(setq arg (if (> arg 0) (1- arg) (1+ arg))))
;; Now that we know which ring element to use, if we found it,
;; return that.
(if (string-match regexp (eshell-get-history n))
n)))
(defun eshell-previous-matching-input (regexp arg)
"Search backwards through input history for match for REGEXP.
\(Previous history elements are earlier commands.)
With prefix argument N, search for Nth previous match.
If N is negative, find the next or Nth next match."
(interactive (eshell-regexp-arg "Previous input matching (regexp): "))
(setq arg (eshell-search-arg arg))
(let ((pos (eshell-previous-matching-input-string-position regexp arg)))
;; Has a match been found?
(if (null pos)
(error "Not found")
(setq eshell-history-index pos)
(message "History item: %d" (- (ring-length eshell-history-ring) pos))
;; Can't use kill-region as it sets this-command
(delete-region (save-excursion (eshell-bol) (point)) (point))
(insert-and-inherit (eshell-get-history pos)))))
(defun eshell-next-matching-input (regexp arg)
"Search forwards through input history for match for REGEXP.
\(Later history elements are more recent commands.)
With prefix argument N, search for Nth following match.
If N is negative, find the previous or Nth previous match."
(interactive (eshell-regexp-arg "Next input matching (regexp): "))
(eshell-previous-matching-input regexp (- arg)))
(defun eshell-previous-matching-input-from-input (arg)
"Search backwards through input history for match for current input.
\(Previous history elements are earlier commands.)
With prefix argument N, search for Nth previous match.
If N is negative, search forwards for the -Nth following match."
(interactive "p")
(if (not (memq last-command '(eshell-previous-matching-input-from-input
eshell-next-matching-input-from-input)))
;; Starting a new search
(setq eshell-matching-input-from-input-string
(buffer-substring (save-excursion (eshell-bol) (point))
(point))
eshell-history-index nil))
(eshell-previous-matching-input
(concat "^" (regexp-quote eshell-matching-input-from-input-string))
arg))
(defun eshell-next-matching-input-from-input (arg)
"Search forwards through input history for match for current input.
\(Following history elements are more recent commands.)
With prefix argument N, search for Nth following match.
If N is negative, search backwards for the -Nth previous match."
(interactive "p")
(eshell-previous-matching-input-from-input (- arg)))
(defun eshell-test-imatch ()
"If isearch match good, put point at the beginning and return non-nil."
(if (get-text-property (point) 'history)
(progn (beginning-of-line) t)
(let ((before (point)))
(eshell-bol)
(if (and (not (bolp))
(<= (point) before))
t
(if isearch-forward
(progn
(end-of-line)
(forward-char))
(beginning-of-line)
(backward-char))))))
(defun eshell-return-to-prompt ()
"Once a search string matches, insert it at the end and go there."
(setq isearch-other-end nil)
(let ((found (eshell-test-imatch)) before)
(while (and (not found)
(setq before
(funcall (if isearch-forward
're-search-forward
're-search-backward)
isearch-string nil t)))
(setq found (eshell-test-imatch)))
(if (not found)
(progn
(goto-char eshell-last-output-end)
(delete-region (point) (point-max)))
(setq before (point))
(let ((text (buffer-substring-no-properties
(point) (line-end-position)))
(orig (marker-position eshell-last-output-end)))
(goto-char eshell-last-output-end)
(delete-region (point) (point-max))
(when (and text (> (length text) 0))
(subst-char-in-string ?\177 ?\n text t)
(insert text)
(put-text-property (1- (point)) (point)
'last-search-pos before)
(set-marker eshell-last-output-end orig)
(goto-char eshell-last-output-end))))))
(defun eshell-prepare-for-search ()
"Make sure the old history file is at the beginning of the buffer."
(unless (get-text-property (point-min) 'history)
(save-excursion
(goto-char (point-min))
(let ((end (copy-marker (point) t)))
(insert-file-contents eshell-history-file-name)
(set-text-properties (point-min) end
'(history t invisible t))))))
(defun eshell-isearch-backward (&optional invert)
"Do incremental regexp search backward through past commands."
(interactive)
(let ((inhibit-read-only t) end)
(eshell-prepare-for-search)
(goto-char (point-max))
(set-marker eshell-last-output-end (point))
(delete-region (point) (point-max)))
(isearch-mode invert t 'eshell-return-to-prompt))
(defun eshell-isearch-repeat-backward (&optional invert)
"Do incremental regexp search backward through past commands."
(interactive)
(let ((old-pos (get-text-property (1- (point-max))
'last-search-pos)))
(when old-pos
(goto-char old-pos)
(if invert
(end-of-line)
(backward-char)))
(setq isearch-forward invert)
(isearch-search-and-update)))
(defun eshell-isearch-forward ()
"Do incremental regexp search backward through past commands."
(interactive)
(eshell-isearch-backward t))
(defun eshell-isearch-repeat-forward ()
"Do incremental regexp search backward through past commands."
(interactive)
(eshell-isearch-repeat-backward t))
(defun eshell-isearch-cancel ()
(interactive)
(goto-char eshell-last-output-end)
(delete-region (point) (point-max))
(call-interactively 'isearch-cancel))
(defun eshell-isearch-abort ()
(interactive)
(goto-char eshell-last-output-end)
(delete-region (point) (point-max))
(call-interactively 'isearch-abort))
(defun eshell-isearch-delete-char ()
(interactive)
(save-excursion
(isearch-delete-char)))
(defun eshell-isearch-return ()
(interactive)
(isearch-done)
(eshell-send-input))
;;; em-hist.el ends here

863
lisp/eshell/em-ls.el Normal file
View File

@ -0,0 +1,863 @@
;;; em-ls --- implementation of ls in Lisp
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'em-ls)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-ls nil
"This module implements the \"ls\" utility fully in Lisp. If it is
passed any unrecognized command switches, it will revert to the
operating system's version. This version of \"ls\" uses text
properties to colorize its output based on the setting of
`eshell-ls-use-colors'."
:tag "Implementation of `ls' in Lisp"
:group 'eshell-module)
;;; Commentary:
;; Most of the command switches recognized by GNU's ls utility are
;; supported ([(fileutils)ls invocation]).
(require 'esh-util)
(require 'esh-opt)
;;; User Variables:
(defvar eshell-ls-orig-insert-directory
(symbol-function 'insert-directory)
"Preserve the original definition of `insert-directory'.")
(defcustom eshell-ls-unload-hook
(list
(function
(lambda ()
(fset 'insert-directory eshell-ls-orig-insert-directory))))
"*When unloading `eshell-ls', restore the definition of `insert-directory'."
:type 'hook
:group 'eshell-ls)
(defcustom eshell-ls-use-in-dired nil
"*If non-nil, use `eshell-ls' to read directories in dired."
:set (lambda (symbol value)
(if value
(unless (and (boundp 'eshell-ls-use-in-dired)
eshell-ls-use-in-dired)
(fset 'insert-directory 'eshell-ls-insert-directory))
(when (and (boundp 'eshell-ls-insert-directory)
eshell-ls-use-in-dired)
(fset 'insert-directory eshell-ls-orig-insert-directory)))
(setq eshell-ls-use-in-dired value))
:type 'boolean
:require 'em-ls
:group 'eshell-ls)
(defcustom eshell-ls-default-blocksize 1024
"*The default blocksize to use when display file sizes with -s."
:type 'integer
:group 'eshell-ls)
(defcustom eshell-ls-exclude-regexp "\\`\\."
"*Unless -a is specified, files matching this regexp will not be shown."
:type 'regexp
:group 'eshell-ls)
(defcustom eshell-ls-use-colors t
"*If non-nil, use colors in file listings."
:type 'boolean
:group 'eshell-ls)
(defface eshell-ls-directory-face
'((((class color) (background light)) (:foreground "Blue" :bold t))
(((class color) (background dark)) (:foreground "SkyBlue" :bold t))
(t (:bold t)))
"*The face used for highlight directories."
:group 'eshell-ls)
(defface eshell-ls-symlink-face
'((((class color) (background light)) (:foreground "Dark Cyan" :bold t))
(((class color) (background dark)) (:foreground "Cyan" :bold t)))
"*The face used for highlight symbolic links."
:group 'eshell-ls)
(defface eshell-ls-executable-face
'((((class color) (background light)) (:foreground "ForestGreen" :bold t))
(((class color) (background dark)) (:foreground "Green" :bold t)))
"*The face used for highlighting executables (not directories, though)."
:group 'eshell-ls)
(defface eshell-ls-readonly-face
'((((class color) (background light)) (:foreground "Brown"))
(((class color) (background dark)) (:foreground "Pink")))
"*The face used for highlighting read-only files."
:group 'eshell-ls)
(defface eshell-ls-unreadable-face
'((((class color) (background light)) (:foreground "Grey30"))
(((class color) (background dark)) (:foreground "DarkGrey")))
"*The face used for highlighting unreadable files."
:group 'eshell-ls)
(defface eshell-ls-special-face
'((((class color) (background light)) (:foreground "Magenta" :bold t))
(((class color) (background dark)) (:foreground "Magenta" :bold t)))
"*The face used for highlighting non-regular files."
:group 'eshell-ls)
(defface eshell-ls-missing-face
'((((class color) (background light)) (:foreground "Red" :bold t))
(((class color) (background dark)) (:foreground "Red" :bold t)))
"*The face used for highlighting non-existant file names."
:group 'eshell-ls)
(defcustom eshell-ls-archive-regexp
(concat "\\.\\(t\\(a[rz]\\|gz\\)\\|arj\\|lzh\\|"
"zip\\|[zZ]\\|gz\\|bz2\\|deb\\|rpm\\)\\'")
"*A regular expression that matches names of file archives.
This typically includes both traditional archives and compressed
files."
:type 'regexp
:group 'eshell-ls)
(defface eshell-ls-archive-face
'((((class color) (background light)) (:foreground "Orchid" :bold t))
(((class color) (background dark)) (:foreground "Orchid" :bold t)))
"*The face used for highlighting archived and compressed file names."
:group 'eshell-ls)
(defcustom eshell-ls-backup-regexp
"\\(\\`\\.?#\\|\\(\\.bak\\|~\\)\\'\\)"
"*A regular expression that matches names of backup files."
:type 'regexp
:group 'eshell-ls)
(defface eshell-ls-backup-face
'((((class color) (background light)) (:foreground "OrangeRed"))
(((class color) (background dark)) (:foreground "LightSalmon")))
"*The face used for highlighting backup file names."
:group 'eshell-ls)
(defcustom eshell-ls-product-regexp
"\\.\\(elc\\|o\\(bj\\)?\\|a\\||lib\\|res\\)\\'"
"*A regular expression that matches names of product files.
Products are files that get generated from a source file, and hence
ought to be recreatable if they are deleted."
:type 'regexp
:group 'eshell-ls)
(defface eshell-ls-product-face
'((((class color) (background light)) (:foreground "OrangeRed"))
(((class color) (background dark)) (:foreground "LightSalmon")))
"*The face used for highlighting files that are build products."
:group 'eshell-ls)
(defcustom eshell-ls-clutter-regexp
"\\(^texput\\.log\\|^core\\)\\'"
"*A regular expression that matches names of junk files.
These are mainly files that get created for various reasons, but don't
really need to stick around for very long."
:type 'regexp
:group 'eshell-ls)
(defface eshell-ls-clutter-face
'((((class color) (background light)) (:foreground "OrangeRed" :bold t))
(((class color) (background dark)) (:foreground "OrangeRed" :bold t)))
"*The face used for highlighting junk file names."
:group 'eshell-ls)
(defsubst eshell-ls-filetype-p (attrs type)
"Test whether ATTRS specifies a directory."
(if (nth 8 attrs)
(eq (aref (nth 8 attrs) 0) type)))
(defmacro eshell-ls-applicable (attrs index func file)
"Test whether, for ATTRS, the user UID can do what corresponds to INDEX.
This is really just for efficiency, to avoid having to stat the file
yet again."
`(if (= (user-uid) (nth 2 ,attrs))
(not (eq (aref (nth 8 ,attrs) ,index) ?-))
(,(eval func) ,file)))
(defcustom eshell-ls-highlight-alist nil
"*This alist correlates test functions to color.
The format of the members of this alist is
(TEST-SEXP . FACE)
If TEST-SEXP evals to non-nil, that face will be used to highlight the
name of the file. The first match wins. `file' and `attrs' are in
scope during the evaluation of TEST-SEXP."
:type '(repeat (cons function face))
:group 'eshell-ls)
;;; Functions:
(defun eshell-ls-insert-directory
(file switches &optional wildcard full-directory-p)
"Insert directory listing for FILE, formatted according to SWITCHES.
Leaves point after the inserted text.
SWITCHES may be a string of options, or a list of strings.
Optional third arg WILDCARD means treat FILE as shell wildcard.
Optional fourth arg FULL-DIRECTORY-P means file is a directory and
switches do not contain `d', so that a full listing is expected.
This version of the function uses `eshell/ls'. If any of the switches
passed are not recognized, the operating system's version will be used
instead."
(let ((handler (find-file-name-handler file 'insert-directory)))
(if handler
(funcall handler 'insert-directory file switches
wildcard full-directory-p)
(if (stringp switches)
(setq switches (split-string switches)))
(let (eshell-current-handles
eshell-current-subjob-p)
;; use the fancy highlighting in `eshell-ls' rather than font-lock
(when (and eshell-ls-use-colors
(featurep 'font-lock))
(font-lock-mode -1)
(if (boundp 'font-lock-buffers)
(set 'font-lock-buffers
(delq (current-buffer)
(symbol-value 'font-lock-buffers)))))
(let ((insert-func 'insert)
(error-func 'insert)
(flush-func 'ignore))
(eshell-do-ls (append switches (list file))))))))
(defsubst eshell/ls (&rest args)
"An alias version of `eshell-do-ls'."
(let ((insert-func 'eshell-buffered-print)
(error-func 'eshell-error)
(flush-func 'eshell-flush))
(eshell-do-ls args)))
(eval-when-compile
(defvar block-size)
(defvar dereference-links)
(defvar dir-literal)
(defvar error-func)
(defvar flush-func)
(defvar human-readable)
(defvar ignore-pattern)
(defvar insert-func)
(defvar listing-style)
(defvar numeric-uid-gid)
(defvar reverse-list)
(defvar show-all)
(defvar show-recursive)
(defvar show-size)
(defvar sort-method))
(defun eshell-do-ls (&rest args)
"Implementation of \"ls\" in Lisp, passing ARGS."
(funcall flush-func -1)
;; process the command arguments, and begin listing files
(eshell-eval-using-options
"ls" args
`((?a "all" nil show-all
"show all files in directory")
(?c nil by-ctime sort-method
"sort by modification time")
(?d "directory" nil dir-literal
"list directory entries instead of contents")
(?k "kilobytes" 1024 block-size
"using 1024 as the block size")
(?h "human-readable" 1024 human-readable
"print sizes in human readable format")
(?H "si" 1000 human-readable
"likewise, but use powers of 1000 not 1024")
(?I "ignore" t ignore-pattern
"do not list implied entries matching pattern")
(?l nil long-listing listing-style
"use a long listing format")
(?n "numeric-uid-gid" nil numeric-uid-gid
"list numeric UIDs and GIDs instead of names")
(?r "reverse" nil reverse-list
"reverse order while sorting")
(?s "size" nil show-size
"print size of each file, in blocks")
(?t nil by-mtime sort-method
"sort by modification time")
(?u nil by-atime sort-method
"sort by last access time")
(?x nil by-lines listing-style
"list entries by lines instead of by columns")
(?C nil by-columns listing-style
"list entries by columns")
(?L "deference" nil dereference-links
"list entries pointed to by symbolic links")
(?R "recursive" nil show-recursive
"list subdirectories recursively")
(?S nil by-size sort-method
"sort by file size")
(?U nil unsorted sort-method
"do not sort; list entries in directory order")
(?X nil by-extension sort-method
"sort alphabetically by entry extension")
(?1 nil single-column listing-style
"list one file per line")
(nil "help" nil nil
"show this usage display")
:external "ls"
:usage "[OPTION]... [FILE]...
List information about the FILEs (the current directory by default).
Sort entries alphabetically across.")
;; setup some defaults, based on what the user selected
(unless block-size
(setq block-size eshell-ls-default-blocksize))
(unless listing-style
(setq listing-style 'by-columns))
(unless args
(setq args (list ".")))
(let ((eshell-ls-exclude-regexp eshell-ls-exclude-regexp))
(when ignore-pattern
(unless (eshell-using-module 'eshell-glob)
(error (concat "-I option requires that `eshell-glob'"
" be a member of `eshell-modules-list'")))
(set-text-properties 0 (length ignore-pattern) nil ignore-pattern)
(if eshell-ls-exclude-regexp
(setq eshell-ls-exclude-regexp
(concat "\\(" eshell-ls-exclude-regexp "\\|"
(eshell-glob-regexp ignore-pattern) "\\)"))
(setq eshell-ls-exclude-regexp (eshell-glob-regexp ignore-pattern))))
;; list the files!
(eshell-ls-entries
(mapcar (function
(lambda (arg)
(cons (if (and (eshell-under-windows-p)
(file-name-absolute-p arg))
(expand-file-name arg)
arg)
(file-attributes arg)))) args)
t (expand-file-name default-directory)))
(funcall flush-func)))
(defsubst eshell-ls-printable-size (filesize &optional by-blocksize)
"Return a printable FILESIZE."
(eshell-printable-size filesize human-readable
(and by-blocksize block-size)
eshell-ls-use-colors))
(defsubst eshell-ls-size-string (attrs size-width)
"Return the size string for ATTRS length, using SIZE-WIDTH."
(let* ((str (eshell-ls-printable-size (nth 7 attrs) t))
(len (length str)))
(if (< len size-width)
(concat (make-string (- size-width len) ? ) str)
str)))
(defun eshell-ls-annotate (fileinfo)
"Given a FILEINFO object, return a resolved, decorated FILEINFO.
This means resolving any symbolic links, determining what face the
name should be displayed as, etc. Think of it as cooking a FILEINFO."
(if (not (and (stringp (cadr fileinfo))
(or dereference-links
(eq listing-style 'long-listing))))
(setcar fileinfo (eshell-ls-decorated-name fileinfo))
(let (dir attr)
(unless (file-name-absolute-p (cadr fileinfo))
(setq dir (file-truename
(file-name-directory
(expand-file-name (car fileinfo))))))
(setq attr
(file-attributes
(let ((target (if dir
(expand-file-name (cadr fileinfo) dir)
(cadr fileinfo))))
(if dereference-links
(file-truename target)
target))))
(if (or dereference-links
(string-match "^\\.\\.?$" (car fileinfo)))
(progn
(setcdr fileinfo attr)
(setcar fileinfo (eshell-ls-decorated-name fileinfo)))
(assert (eq listing-style 'long-listing))
(setcar fileinfo
(concat (eshell-ls-decorated-name fileinfo) " -> "
(eshell-ls-decorated-name
(cons (cadr fileinfo) attr)))))))
fileinfo)
(defun eshell-ls-file (fileinfo &optional size-width copy-fileinfo)
"Output FILE in long format.
FILE may be a string, or a cons cell whose car is the filename and
whose cdr is the list of file attributes."
(if (not (cdr fileinfo))
(funcall error-func (format "%s: No such file or directory\n"
(car fileinfo)))
(setq fileinfo
(eshell-ls-annotate (if copy-fileinfo
(cons (car fileinfo)
(cdr fileinfo))
fileinfo)))
(let ((file (car fileinfo))
(attrs (cdr fileinfo)))
(if (not (eq listing-style 'long-listing))
(if show-size
(funcall insert-func (eshell-ls-size-string attrs size-width)
" " file "\n")
(funcall insert-func file "\n"))
(let ((line
(concat
(if show-size
(concat (eshell-ls-size-string attrs size-width) " "))
(format
"%s%4d %-8s %-8s "
(or (nth 8 attrs) "??????????")
(or (nth 1 attrs) 0)
(or (and (not numeric-uid-gid)
(nth 2 attrs)
(eshell-substring
(user-login-name (nth 2 attrs)) 8))
(nth 2 attrs)
"")
(or (and (not numeric-uid-gid)
(nth 3 attrs)
(eshell-substring
(eshell-group-name (nth 3 attrs)) 8))
(nth 3 attrs)
""))
(let* ((str (eshell-ls-printable-size (nth 7 attrs)))
(len (length str)))
(if (< len 8)
(concat (make-string (- 8 len) ? ) str)
str))
" " (format-time-string
(concat
"%b %e "
(if (= (nth 5 (decode-time (current-time)))
(nth 5 (decode-time
(nth (cond
((eq sort-method 'by-atime) 4)
((eq sort-method 'by-ctime) 6)
(t 5)) attrs))))
"%H:%M"
" %Y")) (nth (cond
((eq sort-method 'by-atime) 4)
((eq sort-method 'by-ctime) 6)
(t 5)) attrs)) " ")))
(funcall insert-func line file "\n"))))))
(defun eshell-ls-dir (dirinfo &optional insert-name root-dir size-width)
"Output the entries in DIRINFO.
If INSERT-NAME is non-nil, the name of DIRINFO will be output. If
ROOT-DIR is also non-nil, and a directory name, DIRINFO will be output
relative to that directory."
(let ((dir (car dirinfo)))
(if (not (cdr dirinfo))
(funcall error-func (format "%s: No such file or directory\n" dir))
(if dir-literal
(eshell-ls-file dirinfo size-width)
(if insert-name
(funcall insert-func
(eshell-ls-decorated-name
(cons (concat
(if root-dir
(file-relative-name dir root-dir)
(expand-file-name dir)))
(cdr dirinfo))) ":\n"))
(let ((entries
(eshell-directory-files-and-attributes dir nil nil t)))
(unless show-all
(while (and entries
(string-match eshell-ls-exclude-regexp
(caar entries)))
(setq entries (cdr entries)))
(let ((e entries))
(while (cdr e)
(if (string-match eshell-ls-exclude-regexp (car (cadr e)))
(setcdr e (cddr e))
(setq e (cdr e))))))
(when (or (eq listing-style 'long-listing) show-size)
(let ((total 0.0))
(setq size-width 0)
(eshell-for e entries
(if (nth 7 (cdr e))
(setq total (+ total (nth 7 (cdr e)))
size-width
(max size-width
(length (eshell-ls-printable-size
(nth 7 (cdr e)) t))))))
(funcall insert-func "total "
(eshell-ls-printable-size total t) "\n")))
(let ((default-directory (expand-file-name dir)))
(if show-recursive
(eshell-ls-entries
(let ((e entries) (good-entries (list t)))
(while e
(unless (let ((len (length (caar e))))
(and (eq (aref (caar e) 0) ?.)
(or (= len 1)
(and (= len 2)
(eq (aref (caar e) 1) ?.)))))
(nconc good-entries (list (car e))))
(setq e (cdr e)))
(cdr good-entries))
nil root-dir)
(eshell-ls-files (eshell-ls-sort-entries entries)
size-width))))))))
(defsubst eshell-ls-compare-entries (l r inx func)
"Compare the time of two files, L and R, the attribute indexed by INX."
(let ((lt (nth inx (cdr l)))
(rt (nth inx (cdr r))))
(if (equal lt rt)
(string-lessp (directory-file-name (car l))
(directory-file-name (car r)))
(funcall func rt lt))))
(defun eshell-ls-sort-entries (entries)
"Sort the given ENTRIES, which may be files, directories or both.
In Eshell's implementation of ls, ENTRIES is always reversed."
(if (eq sort-method 'unsorted)
(nreverse entries)
(sort entries
(function
(lambda (l r)
(let ((result
(cond
((eq sort-method 'by-atime)
(eshell-ls-compare-entries
l r 4 'eshell-time-less-p))
((eq sort-method 'by-mtime)
(eshell-ls-compare-entries
l r 5 'eshell-time-less-p))
((eq sort-method 'by-ctime)
(eshell-ls-compare-entries
l r 6 'eshell-time-less-p))
((eq sort-method 'by-size)
(eshell-ls-compare-entries
l r 7 '<))
((eq sort-method 'by-extension)
(let ((lx (file-name-extension
(directory-file-name (car l))))
(rx (file-name-extension
(directory-file-name (car r)))))
(cond
((or (and (not lx) (not rx))
(equal lx rx))
(string-lessp (directory-file-name (car l))
(directory-file-name (car r))))
((not lx) t)
((not rx) nil)
(t
(string-lessp lx rx)))))
(t
(string-lessp (directory-file-name (car l))
(directory-file-name (car r)))))))
(if reverse-list
(not result)
result)))))))
(defun eshell-ls-files (files &optional size-width copy-fileinfo)
"Output a list of FILES.
Each member of FILES is either a string or a cons cell of the form
\(FILE . ATTRS)."
(if (memq listing-style '(long-listing single-column))
(eshell-for file files
(if file
(eshell-ls-file file size-width copy-fileinfo)))
(let ((f files)
last-f
display-files
ignore)
(while f
(if (cdar f)
(setq last-f f
f (cdr f))
(unless ignore
(funcall error-func
(format "%s: No such file or directory\n" (caar f))))
(if (eq f files)
(setq files (cdr files)
f files)
(if (not (cdr f))
(progn
(setcdr last-f nil)
(setq f nil))
(setcar f (cadr f))
(setcdr f (cddr f))))))
(if (not show-size)
(setq display-files (mapcar 'eshell-ls-annotate files))
(eshell-for file files
(let* ((str (eshell-ls-printable-size (nth 7 (cdr file)) t))
(len (length str)))
(if (< len size-width)
(setq str (concat (make-string (- size-width len) ? ) str)))
(setq file (eshell-ls-annotate file)
display-files (cons (cons (concat str " " (car file))
(cdr file))
display-files))))
(setq display-files (nreverse display-files)))
(let* ((col-vals
(if (eq listing-style 'by-columns)
(eshell-ls-find-column-lengths display-files)
(assert (eq listing-style 'by-lines))
(eshell-ls-find-column-widths display-files)))
(col-widths (car col-vals))
(display-files (cdr col-vals))
(columns (length col-widths))
(col-index 1)
need-return)
(eshell-for file display-files
(let ((name
(if (car file)
(if show-size
(concat (substring (car file) 0 size-width)
(eshell-ls-decorated-name
(cons (substring (car file) size-width)
(cdr file))))
(eshell-ls-decorated-name file))
"")))
(if (< col-index columns)
(setq need-return
(concat need-return name
(make-string
(max 0 (- (aref col-widths
(1- col-index))
(length name))) ? ))
col-index (1+ col-index))
(funcall insert-func need-return name "\n")
(setq col-index 1 need-return nil))))
(if need-return
(funcall insert-func need-return "\n"))))))
(defun eshell-ls-entries (entries &optional separate root-dir)
"Output PATH's directory ENTRIES, formatted according to OPTIONS.
Each member of ENTRIES may either be a string or a cons cell, the car
of which is the file name, and the cdr of which is the list of
attributes.
If SEPARATE is non-nil, directories name will be entirely separated
from the filenames. This is the normal behavior, except when doing a
recursive listing.
ROOT-DIR, if non-nil, specifies the root directory of the listing, to
which non-absolute directory names will be made relative if ever they
need to be printed."
(let (dirs files show-names need-return (size-width 0))
(eshell-for entry entries
(if (and (not dir-literal)
(or (eshell-ls-filetype-p (cdr entry) ?d)
(and (eshell-ls-filetype-p (cdr entry) ?l)
(file-directory-p (car entry)))))
(progn
(unless separate
(setq files (cons entry files)
size-width
(if show-size
(max size-width
(length (eshell-ls-printable-size
(nth 7 (cdr entry)) t))))))
(setq dirs (cons entry dirs)))
(setq files (cons entry files)
size-width
(if show-size
(max size-width
(length (eshell-ls-printable-size
(nth 7 (cdr entry)) t)))))))
(when files
(eshell-ls-files (eshell-ls-sort-entries files)
size-width show-recursive)
(setq need-return t))
(setq show-names (or show-recursive
(> (+ (length files) (length dirs)) 1)))
(eshell-for dir (eshell-ls-sort-entries dirs)
(if (and need-return (not dir-literal))
(funcall insert-func "\n"))
(eshell-ls-dir dir show-names
(unless (file-name-absolute-p (car dir))
root-dir) size-width)
(setq need-return t))))
(defun eshell-ls-find-column-widths (files)
"Find the best fitting column widths for FILES.
It will be returned as a vector, whose length is the number of columns
to use, and each member of which is the width of that column
\(including spacing)."
(let* ((numcols 0)
(width 0)
(widths
(mapcar
(function
(lambda (file)
(+ 2 (length (car file)))))
files))
;; must account for the added space...
(max-width (+ (window-width) 2))
(best-width 0)
col-widths)
;; determine the largest number of columns in the first row
(let ((w widths))
(while (and w (< width max-width))
(setq width (+ width (car w))
numcols (1+ numcols)
w (cdr w))))
;; refine it based on the following rows
(while (> numcols 0)
(let ((i 0)
(colw (make-vector numcols 0))
(w widths))
(while w
(if (= i numcols)
(setq i 0))
(aset colw i (max (aref colw i) (car w)))
(setq w (cdr w) i (1+ i)))
(setq i 0 width 0)
(while (< i numcols)
(setq width (+ width (aref colw i))
i (1+ i)))
(if (and (< width max-width)
(> width best-width))
(setq col-widths colw
best-width width)))
(setq numcols (1- numcols)))
(cons (or col-widths (vector max-width)) files)))
(defun eshell-ls-find-column-lengths (files)
"Find the best fitting column lengths for FILES.
It will be returned as a vector, whose length is the number of columns
to use, and each member of which is the width of that column
\(including spacing)."
(let* ((numcols 1)
(width 0)
(widths
(mapcar
(function
(lambda (file)
(+ 2 (length (car file)))))
files))
(max-width (+ (window-width) 2))
col-widths
colw)
;; refine it based on the following rows
(while numcols
(let* ((rows (ceiling (/ (length widths)
(float numcols))))
(w widths)
(len (* rows numcols))
(index 0)
(i 0))
(setq width 0)
(unless (or (= rows 0)
(<= (/ (length widths) (float rows))
(float (1- numcols))))
(setq colw (make-vector numcols 0))
(while (> len 0)
(if (= i numcols)
(setq i 0 index (1+ index)))
(aset colw i
(max (aref colw i)
(or (nth (+ (* i rows) index) w) 0)))
(setq len (1- len) i (1+ i)))
(setq i 0)
(while (< i numcols)
(setq width (+ width (aref colw i))
i (1+ i))))
(if (>= width max-width)
(setq numcols nil)
(if colw
(setq col-widths colw))
(if (>= numcols (length widths))
(setq numcols nil)
(setq numcols (1+ numcols))))))
(if (not col-widths)
(cons (vector max-width) files)
(setq numcols (length col-widths))
(let* ((rows (ceiling (/ (length widths)
(float numcols))))
(len (* rows numcols))
(newfiles (make-list len nil))
(index 0)
(i 0)
(j 0))
(while (< j len)
(if (= i numcols)
(setq i 0 index (1+ index)))
(setcar (nthcdr j newfiles)
(nth (+ (* i rows) index) files))
(setq j (1+ j) i (1+ i)))
(cons col-widths newfiles)))))
(defun eshell-ls-decorated-name (file)
"Return FILE, possibly decorated.
Use TRUENAME for predicate tests, if passed."
(if eshell-ls-use-colors
(let ((face
(cond
((not (cdr file))
'eshell-ls-missing-face)
((stringp (cadr file))
'eshell-ls-symlink-face)
((eq (cadr file) t)
'eshell-ls-directory-face)
((not (eshell-ls-filetype-p (cdr file) ?-))
'eshell-ls-special-face)
((and (not (= (user-uid) 0)) ; root can execute anything
(eshell-ls-applicable (cdr file) 3
'file-executable-p (car file)))
'eshell-ls-executable-face)
((not (eshell-ls-applicable (cdr file) 1
'file-readable-p (car file)))
'eshell-ls-unreadable-face)
((string-match eshell-ls-archive-regexp (car file))
'eshell-ls-archive-face)
((string-match eshell-ls-backup-regexp (car file))
'eshell-ls-backup-face)
((string-match eshell-ls-product-regexp (car file))
'eshell-ls-product-face)
((string-match eshell-ls-clutter-regexp (car file))
'eshell-ls-clutter-face)
((not (eshell-ls-applicable (cdr file) 2
'file-writable-p (car file)))
'eshell-ls-readonly-face)
(eshell-ls-highlight-alist
(let ((tests eshell-ls-highlight-alist)
value)
(while tests
(if (funcall (caar tests) (car file) (cdr file))
(setq value (cdar tests) tests nil)
(setq tests (cdr tests))))
value)))))
(if face
(add-text-properties 0 (length (car file))
(list 'face face)
(car file)))))
(car file))
;;; Code:
;;; em-ls.el ends here

602
lisp/eshell/em-pred.el Normal file
View File

@ -0,0 +1,602 @@
;;; em-pred --- argument predicates and modifiers (ala zsh)
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'em-pred)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-pred nil
"This module allows for predicates to be applied to globbing
patterns (similar to zsh), in addition to string modifiers which can
be applied either to globbing results, variable references, or just
ordinary strings."
:tag "Value modifiers and predicates"
:group 'eshell-module)
;;; Commentary:
;; Argument predication is used to affect which members of a list are
;; selected for use as argument. This is most useful with globbing,
;; but can be used on any list argument, to select certain members.
;;
;; Argument modifiers are used to manipulate argument values. For
;; example, sorting lists, upcasing words, substituting characters,
;; etc.
;;
;; Here are some examples of how to use argument predication. Most of
;; the predicates and modifiers are modeled after those provided by
;; zsh.
;;
;; ls -ld *(/) ; list all directories
;; ls -l *(@u'johnw') ; list all symlinks owned by 'johnw'
;; bzip2 -9v **/*(a+30) ; compress everything which hasn't been
;; accessed in 30 days
;; echo *.c(:o:R) ; a reversed, sorted list of C files
;; *(^@:U^u0) ; all non-symlinks not owned by 'root', upcased
;; chmod u-x *(U*) : remove exec bit on all executables owned by user
;;
;; See the zsh docs for more on the syntax ([(zsh.info)Filename
;; Generation]).
;;; User Variables:
(defcustom eshell-pred-load-hook '(eshell-pred-initialize)
"*A list of functions to run when `eshell-pred' is loaded."
:type 'hook
:group 'eshell-pred)
(defcustom eshell-predicate-alist
'((?/ . (eshell-pred-file-type ?d)) ; directories
(?. . (eshell-pred-file-type ?-)) ; regular files
(?s . (eshell-pred-file-type ?s)) ; sockets
(?p . (eshell-pred-file-type ?p)) ; named pipes
(?@ . (eshell-pred-file-type ?l)) ; symbolic links
(?% . (eshell-pred-file-type ?%)) ; allow user to specify (c def.)
(?r . (eshell-pred-file-mode 0400)) ; owner-readable
(?w . (eshell-pred-file-mode 0200)) ; owner-writable
(?x . (eshell-pred-file-mode 0100)) ; owner-executable
(?A . (eshell-pred-file-mode 0040)) ; group-readable
(?I . (eshell-pred-file-mode 0020)) ; group-writable
(?E . (eshell-pred-file-mode 0010)) ; group-executable
(?R . (eshell-pred-file-mode 0004)) ; world-readable
(?W . (eshell-pred-file-mode 0002)) ; world-writable
(?X . (eshell-pred-file-mode 0001)) ; world-executable
(?s . (eshell-pred-file-mode 4000)) ; setuid
(?S . (eshell-pred-file-mode 2000)) ; setgid
(?t . (eshell-pred-file-mode 1000)) ; sticky bit
(?U . '(lambda (file) ; owned by effective uid
(if (file-exists-p file)
(= (nth 2 (file-attributes file)) (user-uid)))))
;;; (?G . '(lambda (file) ; owned by effective gid
;;; (if (file-exists-p file)
;;; (= (nth 2 (file-attributes file)) (user-uid)))))
(?* . '(lambda (file)
(and (file-regular-p file)
(not (file-symlink-p file))
(file-executable-p file))))
(?l . (eshell-pred-file-links))
(?u . (eshell-pred-user-or-group ?u "user" 2 'eshell-user-id))
(?g . (eshell-pred-user-or-group ?g "group" 3 'eshell-group-id))
(?a . (eshell-pred-file-time ?a "access" 4))
(?m . (eshell-pred-file-time ?m "modification" 5))
(?c . (eshell-pred-file-time ?c "change" 6))
(?L . (eshell-pred-file-size)))
"*A list of predicates than can be applied to a globbing pattern.
The format of each entry is
(CHAR . PREDICATE-FUNC-SEXP)"
:type '(repeat (cons character sexp))
:group 'eshell-pred)
(put 'eshell-predicate-alist 'risky-local-variable t)
(defcustom eshell-modifier-alist
'((?e . '(lambda (lst)
(mapcar
(function
(lambda (str)
(eshell-stringify
(car (eshell-parse-argument str))))) lst)))
(?L . '(lambda (lst)
(mapcar 'downcase lst)))
(?U . '(lambda (lst)
(mapcar 'upcase lst)))
(?C . '(lambda (lst)
(mapcar 'capitalize lst)))
(?h . '(lambda (lst)
(mapcar 'file-name-directory lst)))
(?i . (eshell-include-members))
(?x . (eshell-include-members t))
(?r . '(lambda (lst)
(mapcar 'file-name-sans-extension lst)))
(?e . '(lambda (lst)
(mapcar 'file-name-extension lst)))
(?t . '(lambda (lst)
(mapcar 'file-name-nondirectory lst)))
(?q . '(lambda (lst)
(mapcar 'eshell-escape-arg lst)))
(?u . '(lambda (lst)
(eshell-uniqify-list lst)))
(?o . '(lambda (lst)
(sort lst 'string-lessp)))
(?O . '(lambda (lst)
(nreverse (sort lst 'string-lessp))))
(?j . (eshell-join-members))
(?S . (eshell-split-members))
(?R . 'reverse)
(?g . (progn
(forward-char)
(if (eq (char-before) ?s)
(eshell-pred-substitute t)
(error "`g' modifier cannot be used alone"))))
(?s . (eshell-pred-substitute)))
"*A list of modifiers than can be applied to an argument expansion.
The format of each entry is
(CHAR ENTRYWISE-P MODIFIER-FUNC-SEXP)"
:type '(repeat (cons character sexp))
:group 'eshell-pred)
(put 'eshell-modifier-alist 'risky-local-variable t)
(defvar eshell-predicate-help-string
"Eshell predicate quick reference:
- follow symbolic references for predicates after the `-'
^ invert sense of predicates after the `^'
FILE TYPE:
/ directories s sockets
. regular files p named pipes
* executable (files only) @ symbolic links
%x file type == `x' (as by ls -l; so `c' = char device, etc.)
PERMISSION BITS (for owner/group/world):
r/A/R readable s setuid
w/I/W writable S setgid
x/E/X executable t sticky bit
OWNERSHIP:
U owned by effective uid
u(UID|'user') owned by UID/user
g(GID|'group') owned by GID/group
FILE ATTRIBUTES:
l[+-]N +/-/= N links
a[Mwhm][+-](N|'FILE') access time +/-/= N mnths/weeks/days/mins
if FILE specified, use as comparison basis;
so a+'file.c' shows files accessed before
file.c was last accessed
m[Mwhm][+-](N|'FILE') modification time...
c[Mwhm][+-](N|'FILE') change time...
L[kmp][+-]N file size +/-/= N Kb/Mb/blocks
EXAMPLES:
*(^@) all non-dot files which are not symlinks
.#*(^@) all files which are not symbolic links
**/.#*(*) all executable files, searched recursively
***/*~f*(-/) recursively (though not traversing symlinks),
find all directories (or symlinks referring to
directories) whose names do not begin with f.
e*(*Lk+50) executables 50k or larger beginning with 'e'")
(defvar eshell-modifier-help-string
"Eshell modifier quick reference:
FOR SINGLE ARGUMENTS, or each argument of a list of strings:
e evaluate again
L lowercase
U uppercase
C capitalize
h dirname
t basename
e file extension
r strip file extension
q escape special characters
S split string at any whitespace character
S/PAT/ split string at each occurance of PAT
FOR LISTS OF ARGUMENTS:
o sort alphabetically
O reverse sort alphabetically
u uniq list (typically used after :o or :O)
R reverse list
j join list members, separated by a space
j/PAT/ join list members, separated by PAT
i/PAT/ exclude all members not matching PAT
x/PAT/ exclude all members matching PAT
s/pat/match/ substitute PAT with MATCH
g/pat/match/ substitute PAT with MATCH for all occurances
EXAMPLES:
*.c(:o) sorted list of .c files")
;;; Functions:
(defun eshell-display-predicate-help ()
(interactive)
(with-electric-help
(function
(lambda ()
(insert eshell-predicate-help-string)))))
(defun eshell-display-modifier-help ()
(interactive)
(with-electric-help
(function
(lambda ()
(insert eshell-modifier-help-string)))))
(defun eshell-pred-initialize ()
"Initialize the predicate/modifier code."
(make-local-hook 'eshell-parse-argument-hook)
(add-hook 'eshell-parse-argument-hook
'eshell-parse-arg-modifier t t)
(define-key eshell-command-map [(meta ?q)] 'eshell-display-predicate-help)
(define-key eshell-command-map [(meta ?m)] 'eshell-display-modifier-help))
(defun eshell-apply-modifiers (lst predicates modifiers)
"Apply to LIST a series of PREDICATES and MODIFIERS."
(let (stringified)
(if (stringp lst)
(setq lst (list lst)
stringified t))
(when (listp lst)
(setq lst (eshell-winnow-list lst nil predicates))
(while modifiers
(setq lst (funcall (car modifiers) lst)
modifiers (cdr modifiers)))
(if (and stringified
(= (length lst) 1))
(car lst)
lst))))
(defun eshell-parse-arg-modifier ()
"Parse a modifier that has been specified after an argument.
This function is specially for adding onto `eshell-parse-argument-hook'."
(when (eq (char-after) ?\()
(forward-char)
(let ((end (eshell-find-delimiter ?\( ?\))))
(if (not end)
(throw 'eshell-incomplete ?\()
(when (eshell-arg-delimiter (1+ end))
(save-restriction
(narrow-to-region (point) end)
(let* ((modifiers (eshell-parse-modifiers))
(preds (car modifiers))
(mods (cdr modifiers)))
(if (or preds mods)
;; has to go at the end, which is only natural since
;; syntactically it can only occur at the end
(setq eshell-current-modifiers
(append
eshell-current-modifiers
(list
`(lambda (lst)
(eshell-apply-modifiers
lst (quote ,preds) (quote ,mods)))))))))
(goto-char (1+ end))
(eshell-finish-arg))))))
(defun eshell-parse-modifiers ()
"Parse value modifiers and predicates at point.
If ALLOW-PREDS is non-nil, predicates will be parsed as well.
Return a cons cell of the form
(PRED-FUNC-LIST . MOD-FUNC-LIST)
NEW-STRING is STRING minus any modifiers. PRED-FUNC-LIST is a list of
predicate functions. MOD-FUNC-LIST is a list of result modifier
functions. PRED-FUNCS take a filename and return t if the test
succeeds; MOD-FUNCS take any string and preform a modification,
returning the resultant string."
(let (result negate follow preds mods)
(condition-case err
(while (not (eobp))
(let ((char (char-after)))
(cond
((eq char ?')
(forward-char)
(if (looking-at "[^|':]")
(let ((func (read (current-buffer))))
(if (and func (functionp func))
(setq preds (eshell-add-pred-func func preds
negate follow))
(error "Invalid function predicate '%s'"
(eshell-stringify func))))
(error "Invalid function predicate")))
((eq char ?^)
(forward-char)
(setq negate (not negate)))
((eq char ?-)
(forward-char)
(setq follow (not follow)))
((eq char ?|)
(forward-char)
(if (looking-at "[^|':]")
(let ((func (read (current-buffer))))
(if (and func (functionp func))
(setq mods
(cons `(lambda (lst)
(mapcar (function ,func) lst))
mods))
(error "Invalid function modifier '%s'"
(eshell-stringify func))))
(error "Invalid function modifier")))
((eq char ?:)
(forward-char)
(let ((mod (assq (char-after) eshell-modifier-alist)))
(if (not mod)
(error "Unknown modifier character '%c'" (char-after))
(forward-char)
(setq mods (cons (eval (cdr mod)) mods)))))
(t
(let ((pred (assq char eshell-predicate-alist)))
(if (not pred)
(error "Unknown predicate character '%c'" char)
(forward-char)
(setq preds
(eshell-add-pred-func (eval (cdr pred)) preds
negate follow))))))))
(end-of-buffer
(error "Predicate or modifier ended prematurely")))
(cons (nreverse preds) (nreverse mods))))
(defun eshell-add-pred-func (pred funcs negate follow)
"Add the predicate function PRED to FUNCS."
(if negate
(setq pred `(lambda (file)
(not (funcall ,pred file)))))
(if follow
(setq pred `(lambda (file)
(funcall ,pred (file-truename file)))))
(cons pred funcs))
(defun eshell-pred-user-or-group (mod-char mod-type attr-index get-id-func)
"Return a predicate to test whether a file match a given user/group id."
(let (ugid open close end)
(if (looking-at "[0-9]+")
(progn
(setq ugid (string-to-number (match-string 0)))
(goto-char (match-end 0)))
(setq open (char-after))
(if (setq close (memq open '(?\( ?\[ ?\< ?\{)))
(setq close (car (last '(?\) ?\] ?\> ?\})
(length close))))
(setq close open))
(forward-char)
(setq end (eshell-find-delimiter open close))
(unless end
(error "Malformed %s name string for modifier `%c'"
mod-type mod-char))
(setq ugid
(funcall get-id-func (buffer-substring (point) end)))
(goto-char (1+ end)))
(unless ugid
(error "Unknown %s name specified for modifier `%c'"
mod-type mod-char))
`(lambda (file)
(let ((attrs (file-attributes file)))
(if attrs
(= (nth ,attr-index attrs) ,ugid))))))
(defun eshell-pred-file-time (mod-char mod-type attr-index)
"Return a predicate to test whether a file matches a certain time."
(let* ((quantum 86400)
qual amount when open close end)
(when (memq (char-after) '(?M ?w ?h ?m))
(setq quantum (char-after))
(cond
((eq quantum ?M)
(setq quantum (* 60 60 24 30)))
((eq quantum ?w)
(setq quantum (* 60 60 24 7)))
((eq quantum ?h)
(setq quantum (* 60 60)))
((eq quantum ?m)
(setq quantum 60))
((eq quantum ?s)
(setq quantum 1)))
(forward-char))
(when (memq (char-after) '(?+ ?-))
(setq qual (char-after))
(forward-char))
(if (looking-at "[0-9]+")
(progn
(setq when (- (eshell-time-to-seconds (current-time))
(* (string-to-number (match-string 0))
quantum)))
(goto-char (match-end 0)))
(setq open (char-after))
(if (setq close (memq open '(?\( ?\[ ?\< ?\{)))
(setq close (car (last '(?\) ?\] ?\> ?\})
(length close))))
(setq close open))
(forward-char)
(setq end (eshell-find-delimiter open close))
(unless end
(error "Malformed %s time modifier `%c'" mod-type mod-char))
(let* ((file (buffer-substring (point) end))
(attrs (file-attributes file)))
(unless attrs
(error "Cannot stat file `%s'" file))
(setq when (eshell-time-to-seconds (nth attr-index attrs))))
(goto-char (1+ end)))
`(lambda (file)
(let ((attrs (file-attributes file)))
(if attrs
(,(if (eq qual ?-)
'<
(if (eq qual ?+)
'>
'=)) ,when (eshell-time-to-seconds
(nth ,attr-index attrs))))))))
(defun eshell-pred-file-type (type)
"Return a test which tests that the file is of a certain TYPE.
TYPE must be a character, and should be one of the possible options
that 'ls -l' will show in the first column of its display. "
(when (eq type ?%)
(setq type (char-after))
(if (memq type '(?b ?c))
(forward-char)
(setq type ?%)))
`(lambda (file)
(let ((attrs (file-attributes (directory-file-name file))))
(if attrs
(memq (aref (nth 8 attrs) 0)
,(if (eq type ?%)
'(?b ?c)
(list 'quote (list type))))))))
(defsubst eshell-pred-file-mode (mode)
"Return a test which tests that MODE pertains to the file."
`(lambda (file)
(let ((modes (file-modes file)))
(if modes
(logand ,mode modes)))))
(defun eshell-pred-file-links ()
"Return a predicate to test whether a file has a given number of links."
(let (qual amount)
(when (memq (char-after) '(?- ?+))
(setq qual (char-after))
(forward-char))
(unless (looking-at "[0-9]+")
(error "Invalid file link count modifier `l'"))
(setq amount (string-to-number (match-string 0)))
(goto-char (match-end 0))
`(lambda (file)
(let ((attrs (file-attributes file)))
(if attrs
(,(if (eq qual ?-)
'<
(if (eq qual ?+)
'>
'=)) (nth 1 attrs) ,amount))))))
(defun eshell-pred-file-size ()
"Return a predicate to test whether a file is of a given size."
(let ((quantum 1) qual amount)
(when (memq (downcase (char-after)) '(?k ?m ?p))
(setq qual (downcase (char-after)))
(cond
((eq qual ?k)
(setq quantum 1024))
((eq qual ?m)
(setq quantum (* 1024 1024)))
((eq qual ?p)
(setq quantum 512)))
(forward-char))
(when (memq (char-after) '(?- ?+))
(setq qual (char-after))
(forward-char))
(unless (looking-at "[0-9]+")
(error "Invalid file size modifier `L'"))
(setq amount (* (string-to-number (match-string 0)) quantum))
(goto-char (match-end 0))
`(lambda (file)
(let ((attrs (file-attributes file)))
(if attrs
(,(if (eq qual ?-)
'<
(if (eq qual ?+)
'>
'=)) (nth 7 attrs) ,amount))))))
(defun eshell-pred-substitute (&optional repeat)
"Return a modifier function that will substitute matches."
(let ((delim (char-after))
match replace end)
(forward-char)
(setq end (eshell-find-delimiter delim delim nil nil t)
match (buffer-substring-no-properties (point) end))
(goto-char (1+ end))
(setq end (eshell-find-delimiter delim delim nil nil t)
replace (buffer-substring-no-properties (point) end))
(goto-char (1+ end))
(if repeat
`(lambda (lst)
(mapcar
(function
(lambda (str)
(let ((i 0))
(while (setq i (string-match ,match str i))
(setq str (replace-match ,replace t nil str))))
str)) lst))
`(lambda (lst)
(mapcar
(function
(lambda (str)
(if (string-match ,match str)
(setq str (replace-match ,replace t nil str)))
str)) lst)))))
(defun eshell-include-members (&optional invert-p)
"Include only lisp members matching a regexp."
(let ((delim (char-after))
regexp end)
(forward-char)
(setq end (eshell-find-delimiter delim delim nil nil t)
regexp (buffer-substring-no-properties (point) end))
(goto-char (1+ end))
`(lambda (lst)
(eshell-winnow-list
lst nil '((lambda (elem)
,(if invert-p
`(not (string-match ,regexp elem))
`(string-match ,regexp elem))))))))
(defun eshell-join-members ()
"Return a modifier function that join matches."
(let ((delim (char-after))
str end)
(if (not (memq delim '(?' ?/)))
(setq delim " ")
(forward-char)
(setq end (eshell-find-delimiter delim delim nil nil t)
str (buffer-substring-no-properties (point) end))
(goto-char (1+ end)))
`(lambda (lst)
(mapconcat 'identity lst ,str))))
(defun eshell-split-members ()
"Return a modifier function that splits members."
(let ((delim (char-after))
sep end)
(when (memq delim '(?' ?/))
(forward-char)
(setq end (eshell-find-delimiter delim delim nil nil t)
sep (buffer-substring-no-properties (point) end))
(goto-char (1+ end)))
`(lambda (lst)
(mapcar
(function
(lambda (str)
(split-string str ,sep))) lst))))
;;; Code:
;;; em-pred.el ends here

174
lisp/eshell/em-prompt.el Normal file
View File

@ -0,0 +1,174 @@
;;; em-prompt --- command prompts
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'em-prompt)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-prompt nil
"This module provides command prompts, and navigation between them,
as is common with most shells."
:tag "Command prompts"
:group 'eshell-module)
;;; Commentary:
;; Most of the prompt navigation commands of `comint-mode' are
;; supported, such as C-c C-n, C-c C-p, etc.
;;; User Variables:
(defcustom eshell-prompt-load-hook '(eshell-prompt-initialize)
"*A list of functions to call when loading `eshell-prompt'."
:type 'hook
:group 'eshell-prompt)
(defcustom eshell-prompt-function
(function
(lambda ()
(concat (eshell/pwd)
(if (= (user-uid) 0) " # " " $ "))))
"*A function that returns the Eshell prompt string.
Make sure to update `eshell-prompt-regexp' so that it will match your
prompt."
:type 'function
:group 'eshell-prompt)
(defcustom eshell-prompt-regexp "^[^#$\n]* [#$] "
"*A regexp which fully matches your eshell prompt.
This setting is important, since it affects how eshell will interpret
the lines that are passed to it.
If this variable is changed, all Eshell buffers must be exited and
re-entered for it to take effect."
:type 'regexp
:group 'eshell-prompt)
(defcustom eshell-highlight-prompt t
"*If non-nil, Eshell should highlight the prompt."
:type 'boolean
:group 'eshell-prompt)
(defface eshell-prompt-face
'((((class color) (background light)) (:foreground "Red" :bold t))
(((class color) (background dark)) (:foreground "Pink" :bold t))
(t (:bold t)))
"*The face used to highlight prompt strings.
For highlighting other kinds of strings -- similar to shell mode's
behavior -- simply use an output filer which changes text properties."
:group 'eshell-prompt)
(defcustom eshell-before-prompt-hook nil
"*A list of functions to call before outputting the prompt."
:type 'hook
:options '(eshell-begin-on-new-line)
:group 'eshell-prompt)
(defcustom eshell-after-prompt-hook nil
"*A list of functions to call after outputting the prompt.
Note that if `eshell-scroll-show-maximum-output' is non-nil, then
setting `eshell-show-maximum-output' here won't do much. It depends
on whether the user wants the resizing to happen while output is
arriving, or after."
:type 'hook
:options '(eshell-show-maximum-output)
:group 'eshell-prompt)
;;; Functions:
(defun eshell-prompt-initialize ()
"Initialize the prompting code."
(unless eshell-non-interactive-p
(make-local-hook 'eshell-post-command-hook)
(add-hook 'eshell-post-command-hook 'eshell-emit-prompt nil t)
(make-local-variable 'eshell-prompt-regexp)
(if eshell-prompt-regexp
(set (make-local-variable 'paragraph-start) eshell-prompt-regexp))
(set (make-local-variable 'eshell-skip-prompt-function)
'eshell-skip-prompt)
(define-key eshell-command-map [(control ?n)] 'eshell-next-prompt)
(define-key eshell-command-map [(control ?p)] 'eshell-previous-prompt)))
(defun eshell-emit-prompt ()
"Emit a prompt if eshell is being used interactively."
(run-hooks 'eshell-before-prompt-hook)
(if (not eshell-prompt-function)
(set-marker eshell-last-output-end (point))
(let ((prompt (funcall eshell-prompt-function)))
(and eshell-highlight-prompt
(add-text-properties 0 (length prompt)
'(read-only t
face eshell-prompt-face
rear-nonsticky (face read-only))
prompt))
(eshell-interactive-print prompt)))
(run-hooks 'eshell-after-prompt-hook))
(defun eshell-backward-matching-input (regexp arg)
"Search backward through buffer for match for REGEXP.
Matches are searched for on lines that match `eshell-prompt-regexp'.
With prefix argument N, search for Nth previous match.
If N is negative, find the next or Nth next match."
(interactive (eshell-regexp-arg "Backward input matching (regexp): "))
(let* ((re (concat eshell-prompt-regexp ".*" regexp))
(pos (save-excursion (end-of-line (if (> arg 0) 0 1))
(if (re-search-backward re nil t arg)
(point)))))
(if (null pos)
(progn (message "Not found")
(ding))
(goto-char pos)
(eshell-bol))))
(defun eshell-forward-matching-input (regexp arg)
"Search forward through buffer for match for REGEXP.
Matches are searched for on lines that match `eshell-prompt-regexp'.
With prefix argument N, search for Nth following match.
If N is negative, find the previous or Nth previous match."
(interactive (eshell-regexp-arg "Forward input matching (regexp): "))
(eshell-backward-matching-input regexp (- arg)))
(defun eshell-next-prompt (n)
"Move to end of Nth next prompt in the buffer.
See `eshell-prompt-regexp'."
(interactive "p")
(forward-paragraph n)
(eshell-skip-prompt))
(defun eshell-previous-prompt (n)
"Move to end of Nth previous prompt in the buffer.
See `eshell-prompt-regexp'."
(interactive "p")
(eshell-next-prompt (- (1+ n))))
(defun eshell-skip-prompt ()
"Skip past the text matching regexp `eshell-prompt-regexp'.
If this takes us past the end of the current line, don't skip at all."
(let ((eol (line-end-position)))
(if (and (looking-at eshell-prompt-regexp)
(<= (match-end 0) eol))
(goto-char (match-end 0)))))
;;; Code:
;;; em-prompt.el ends here

248
lisp/eshell/em-rebind.el Normal file
View File

@ -0,0 +1,248 @@
;;; em-rebind --- rebind keys when point is at current input
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'em-rebind)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-rebind nil
"This module allows for special keybindings that only take effect
while the point is in a region of input text. By default, it binds
C-a to move to the beginning of the input text (rather than just the
beginning of the line), and C-p and C-n to move through the input
history, C-u kills the current input text, etc. It also, if
`eshell-confine-point-to-input' is non-nil, does not allow certain
commands to cause the point to leave the input area, such as
`backward-word', `previous-line', etc. This module intends to mimic
the behavior of normal shells while the user editing new input text."
:tag "Rebind keys at input"
:group 'eshell-module)
;;; Commentary:
;;; User Variables:
(defcustom eshell-rebind-load-hook '(eshell-rebind-initialize)
"*A list of functions to call when loading `eshell-rebind'."
:type 'hook
:group 'eshell-rebind)
(defcustom eshell-rebind-keys-alist
'(([(control ?a)] . eshell-bol)
([home] . eshell-bol)
([(control ?d)] . eshell-delchar-or-maybe-eof)
([backspace] . eshell-delete-backward-char)
([delete] . eshell-delete-backward-char)
([(control ?w)] . backward-kill-word)
([(control ?u)] . eshell-kill-input))
"*Bind some keys differently if point is in input text."
:type '(repeat (cons (vector :tag "Keys to bind"
(repeat :inline t sexp))
(function :tag "Command")))
:group 'eshell-rebind)
(defcustom eshell-confine-point-to-input t
"*If non-nil, do not allow the point to leave the current input.
This is more difficult to do nicely in Emacs than one might think.
Basically, the `point-left' attribute is added to the input text, and
a function is placed on that hook to take the point back to
`eshell-last-output-end' every time the user tries to move away. But
since there are many cases in which the point _ought_ to move away
\(for programmatic reasons), the variable
`eshell-cannot-leave-input-list' defines commands which are affected
from this rule. However, this list is by no means as complete as it
probably should be, so basically all one can hope for is that other
people will left the point alone in the Eshell buffer. Sigh."
:type 'boolean
:group 'eshell-rebind)
(defcustom eshell-error-if-move-away t
"*If non-nil, consider it an error to try to move outside current input.
This is default behavior of shells like bash."
:type 'boolean
:group 'eshell-rebind)
(defcustom eshell-remap-previous-input t
"*If non-nil, remap input keybindings on previous prompts as well."
:type 'boolean
:group 'eshell-rebind)
(defcustom eshell-cannot-leave-input-list
'(beginning-of-line-text
beginning-of-line
move-to-column
move-to-column-force
move-to-left-margin
move-to-tab-stop
forward-char
backward-char
delete-char
delete-backward-char
backward-delete-char
backward-delete-char-untabify
kill-paragraph
backward-kill-paragraph
kill-sentence
backward-kill-sentence
kill-sexp
backward-kill-sexp
kill-word
backward-kill-word
kill-region
forward-list
backward-list
forward-page
backward-page
forward-point
forward-paragraph
backward-paragraph
backward-prefix-chars
forward-sentence
backward-sentence
forward-sexp
backward-sexp
forward-to-indentation
backward-to-indentation
backward-up-list
forward-word
backward-word
forward-line
backward-line
previous-line
next-line
forward-visible-line
forward-comment
forward-thing)
"*A list of commands that cannot leave the input area."
:type '(repeat function)
:group 'eshell-rebind)
;; Internal Variables:
(defvar eshell-input-keymap)
(defvar eshell-previous-point)
(defvar eshell-lock-keymap)
;;; Functions:
(defun eshell-rebind-initialize ()
"Initialize the inputing code."
(unless eshell-non-interactive-p
(make-local-hook 'eshell-mode-hook)
(add-hook 'eshell-mode-hook 'eshell-setup-input-keymap nil t)
(make-local-hook 'pre-command-hook)
(make-local-variable 'eshell-previous-point)
(add-hook 'pre-command-hook 'eshell-save-previous-point nil t)
(make-local-hook 'post-command-hook)
(make-local-variable 'overriding-local-map)
(add-hook 'post-command-hook 'eshell-rebind-input-map nil t)
(set (make-local-variable 'eshell-lock-keymap) nil)
(define-key eshell-command-map [(meta ?l)] 'eshell-lock-local-map)))
(defun eshell-lock-local-map (&optional arg)
"Lock or unlock the current local keymap.
Within a prefix arg, set the local keymap to its normal value, and
lock it at that."
(interactive "P")
(if (or arg (not eshell-lock-keymap))
(progn
(use-local-map eshell-mode-map)
(setq eshell-lock-keymap t)
(message "Local keymap locked in normal mode"))
(use-local-map eshell-input-keymap)
(setq eshell-lock-keymap nil)
(message "Local keymap unlocked: obey context")))
(defun eshell-save-previous-point ()
"Save the location of point before the next command is run."
(setq eshell-previous-point (point)))
(defsubst eshell-point-within-input-p (pos)
"Test whether POS is within an input range."
(let (begin)
(or (and (>= pos eshell-last-output-end)
eshell-last-output-end)
(and eshell-remap-previous-input
(setq begin
(save-excursion
(eshell-bol)
(and (not (bolp)) (point))))
(>= pos begin)
(<= pos (line-end-position))
begin))))
(defun eshell-rebind-input-map ()
"Rebind the input keymap based on the location of the cursor."
(ignore-errors
(unless eshell-lock-keymap
(if (eshell-point-within-input-p (point))
(use-local-map eshell-input-keymap)
(let (begin)
(if (and eshell-confine-point-to-input
(setq begin
(eshell-point-within-input-p eshell-previous-point))
(memq this-command eshell-cannot-leave-input-list))
(progn
(use-local-map eshell-input-keymap)
(goto-char begin)
(if (and eshell-error-if-move-away
(not (eq this-command 'kill-region)))
(beep)))
(use-local-map eshell-mode-map)))))))
(defun eshell-setup-input-keymap ()
"Setup the input keymap to be used during input editing."
(make-local-variable 'eshell-input-keymap)
(setq eshell-input-keymap (make-sparse-keymap))
(set-keymap-parent eshell-input-keymap eshell-mode-map)
(let ((bindings eshell-rebind-keys-alist))
(while bindings
(define-key eshell-input-keymap (caar bindings)
(cdar bindings))
(setq bindings (cdr bindings)))))
(defun eshell-delete-backward-char (n &optional killflag)
"Delete the last character, unless it's part of the output."
(interactive "P")
(let ((count (prefix-numeric-value n)))
(if (eshell-point-within-input-p (- (point) count))
(delete-backward-char count n)
(beep))))
(defun eshell-delchar-or-maybe-eof (arg)
"Delete ARG characters forward or send an EOF to subprocess.
Sends an EOF only if point is at the end of the buffer and there is no
input."
(interactive "p")
(let ((proc (get-buffer-process (current-buffer))))
(if (eobp)
(cond
((not (= (point) eshell-last-output-end))
(beep))
(proc
(process-send-eof))
(t
(eshell-life-is-too-much)))
(eshell-delete-backward-char (- arg)))))
;;; Code:
;;; em-rebind.el ends here

130
lisp/eshell/em-script.el Normal file
View File

@ -0,0 +1,130 @@
;;; em-script --- Eshell script files
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'em-script)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-script nil
"This module allows for the execution of files containing Eshell
commands, as a script file."
:tag "Running script files."
:group 'eshell-module)
;;; Commentary:
;;; User Variables:
(defcustom eshell-script-load-hook '(eshell-script-initialize)
"*A list of functions to call when loading `eshell-script'."
:type 'hook
:group 'eshell-script)
(defcustom eshell-login-script (concat eshell-directory-name "login")
"*If non-nil, a file to invoke when starting up Eshell interactively.
This file should be a file containing Eshell commands, where comment
lines begin with '#'."
:type 'file
:group 'eshell-script)
(defcustom eshell-rc-script (concat eshell-directory-name "profile")
"*If non-nil, a file to invoke whenever Eshell is started.
This includes when running `eshell-command'."
:type 'file
:group 'eshell-script)
;;; Functions:
(defun eshell-script-initialize ()
"Initialize the script parsing code."
(make-local-variable 'eshell-interpreter-alist)
(setq eshell-interpreter-alist
(cons '((lambda (file)
(string= (file-name-nondirectory file)
"eshell")) . eshell/source)
eshell-interpreter-alist))
;; these two variables are changed through usage, but we don't want
;; to ruin it for other modules
(let (eshell-inside-quote-regexp
eshell-outside-quote-regexp)
(and (not eshell-non-interactive-p)
eshell-login-script
(file-readable-p eshell-login-script)
(eshell-do-eval
(list 'eshell-commands
(catch 'eshell-replace-command
(eshell-source-file eshell-login-script))) t))
(and eshell-rc-script
(file-readable-p eshell-rc-script)
(eshell-do-eval
(list 'eshell-commands
(catch 'eshell-replace-command
(eshell-source-file eshell-rc-script))) t))))
(defun eshell-source-file (file &optional args subcommand-p)
"Execute a series of Eshell commands in FILE, passing ARGS.
Comments begin with '#'."
(interactive "f")
(let ((orig (point))
(here (point-max))
(inhibit-point-motion-hooks t)
after-change-functions)
(goto-char (point-max))
(insert-file-contents file)
(goto-char (point-max))
(throw 'eshell-replace-command
(prog1
(list 'let
(list (list 'eshell-command-name (list 'quote file))
(list 'eshell-command-arguments
(list 'quote args)))
(let ((cmd (eshell-parse-command (cons here (point)))))
(if subcommand-p
(setq cmd (list 'eshell-as-subcommand cmd)))
cmd))
(delete-region here (point))
(goto-char orig)))))
(defun eshell/source (&rest args)
"Source a file in a subshell environment."
(eshell-eval-using-options
"source" args
'((?h "help" nil nil "show this usage screen")
:show-usage
:usage "FILE [ARGS]
Invoke the Eshell commands in FILE in a subshell, binding ARGS to $1,
$2, etc.")
(eshell-source-file (car args) (cdr args) t)))
(defun eshell/. (&rest args)
"Source a file in the current environment."
(eshell-eval-using-options
"." args
'((?h "help" nil nil "show this usage screen")
:show-usage
:usage "FILE [ARGS]
Invoke the Eshell commands in FILE within the current shell
environment, binding ARGS to $1, $2, etc.")
(eshell-source-file (car args) (cdr args))))
;;; Code:
;;; em-script.el ends here

305
lisp/eshell/em-smart.el Normal file
View File

@ -0,0 +1,305 @@
;;; em-smart --- smart display of output
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'em-smart)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-smart nil
"This module combines the facility of normal, modern shells with
some of the edit/review concepts inherent in the design of Plan 9's
9term. See the docs for more details.
Most likely you will have to turn this option on and play around with
it to get a real sense of how it works."
:tag "Smart display of output"
:link '(info-link "(eshell.info)Smart display of output")
:group 'eshell-module)
;;; Commentary:
;; The best way to get a sense of what this code is trying to do is by
;; using it. Basically, the philosophy represents a blend between the
;; ease of use of modern day shells, and the review-before-you-proceed
;; mentality of Plan 9's 9term.
;;
;; @ When you invoke a command, it is assumed that you want to read
;; the output of that command.
;;
;; @ If the output is not what you wanted, it is assumed that you will
;; want to edit, and then resubmit a refined version of that
;; command.
;;
;; @ If the output is valid, pressing any self-inserting character key
;; will jump to end of the buffer and insert that character, in
;; order to begin entry of a new command.
;;
;; @ If you show an intention to edit the previous command -- by
;; moving around within it -- then the next self-inserting
;; characters will insert *there*, instead of at the bottom of the
;; buffer.
;;
;; @ If you show an intention to review old commands, such as M-p or
;; M-r, point will jump to the bottom of the buffer before invoking
;; that command.
;;
;; @ If none of the above has happened yet (i.e., your point is just
;; sitting on the previous command), you can use SPACE and BACKSPACE
;; (or DELETE) to page forward and backward *through the output of
;; the last command only*. It will constrain the movement of the
;; point and window so that the maximum amount of output is always
;; displayed at all times.
;;
;; @ While output is being generated from a command, the window will
;; be constantly reconfigured (until it would otherwise make no
;; difference) in order to always show you the most output from the
;; command possible. This happens if you change window sizes,
;; scroll, etc.
;;
;; @ Like I said, it's not really comprehensible until you try it! ;)
;;; User Variables:
(defcustom eshell-smart-load-hook '(eshell-smart-initialize)
"*A list of functions to call when loading `eshell-smart'."
:type 'hook
:group 'eshell-smart)
(defcustom eshell-smart-unload-hook
(list
(function
(lambda ()
(remove-hook 'window-configuration-change-hook
'eshell-refresh-windows))))
"*A hook that gets run when `eshell-smart' is unloaded."
:type 'hook
:group 'eshell-smart)
(defcustom eshell-review-quick-commands nil
"*If nil, point does not stay on quick commands.
A quick command is one that produces no output, and exits
successfully."
:type 'boolean
:group 'eshell-smart)
(defcustom eshell-smart-display-navigate-list
'(insert-parentheses
mouse-yank-at-click
mouse-yank-secondary
yank-pop
yank-rectangle
yank)
"*A list of commands which cause Eshell to jump to the end of buffer."
:type '(repeat function)
:group 'eshell-smart)
(defcustom eshell-smart-space-goes-to-end t
"*If non-nil, space will go to end of buffer when point-max is visible.
That is, if a command is running and the user presses SPACE at a time
when the end of the buffer is visible, point will go to the end of the
buffer and smart-display will be turned off (that is, subsequently
pressing backspace will not cause the buffer to scroll down).
This feature is provided to make it very easy to watch the output of a
long-running command, such as make, where it's more desirable to see
the output go by than to review it afterward.
Setting this variable to nil means that space and backspace will
always have a consistent behavior, which is to move back and forth
through displayed output. But it also means that enabling output
tracking requires the user to manually move point to the end of the
buffer using \\[end-of-buffer]."
:type 'boolean
:group 'eshell-smart)
(defcustom eshell-where-to-jump 'begin
"*This variable indicates where point should jump to after a command.
The options are `begin', `after' or `end'."
:type '(radio (const :tag "Beginning of command" begin)
(const :tag "After command word" after)
(const :tag "End of command" end))
:group 'eshell-smart)
;;; Internal Variables:
(defvar eshell-smart-displayed nil)
(defvar eshell-smart-command-done nil)
;;; Functions:
(defun eshell-smart-initialize ()
"Setup Eshell smart display."
(unless eshell-non-interactive-p
;; override a few variables, since they would interfere with the
;; smart display functionality.
(set (make-local-variable 'eshell-scroll-to-bottom-on-output) nil)
(set (make-local-variable 'eshell-scroll-to-bottom-on-input) nil)
(set (make-local-variable 'eshell-scroll-show-maximum-output) t)
(make-local-hook 'window-scroll-functions)
(add-hook 'window-scroll-functions 'eshell-smart-scroll-window nil t)
(add-hook 'window-configuration-change-hook 'eshell-refresh-windows)
(make-local-hook 'eshell-output-filter-functions)
(add-hook 'eshell-output-filter-functions 'eshell-refresh-windows t t)
(make-local-hook 'pre-command-hook)
(make-local-hook 'after-change-functions)
(add-hook 'after-change-functions
'eshell-disable-after-change nil t)
(make-local-hook 'eshell-input-filter-functions)
(add-hook 'eshell-input-filter-functions
'eshell-smart-display-setup nil t)
(make-local-variable 'eshell-smart-command-done)
(make-local-hook 'eshell-post-command-hook)
(add-hook 'eshell-post-command-hook
(function
(lambda ()
(setq eshell-smart-command-done t))) t t)
(unless eshell-review-quick-commands
(add-hook 'eshell-post-command-hook
'eshell-smart-maybe-jump-to-end nil t))))
(defun eshell-smart-scroll-window (wind start)
"Scroll the given Eshell window accordingly."
(unless eshell-currently-handling-window
(let ((inhibit-point-motion-hooks t)
(eshell-currently-handling-window t))
(save-current-buffer
(save-selected-window
(select-window wind)
(eshell-smart-redisplay))))))
(defun eshell-refresh-windows (&optional frame)
"Refresh all visible Eshell buffers."
(let (affected)
(walk-windows
(function
(lambda (wind)
(with-current-buffer (window-buffer wind)
(when eshell-mode
(let (window-scroll-functions)
(eshell-smart-scroll-window wind (window-start))
(setq affected t))))))
0 frame)
(if affected
(let (window-scroll-functions)
(eshell-redisplay)))))
(defun eshell-smart-display-setup ()
"Set the point to somewhere in the beginning of the last command."
(cond
((eq eshell-where-to-jump 'begin)
(goto-char eshell-last-input-start))
((eq eshell-where-to-jump 'after)
(goto-char (next-single-property-change
eshell-last-input-start 'arg-end))
(if (= (point) (- eshell-last-input-end 2))
(forward-char)))
((eq eshell-where-to-jump 'end)
(goto-char (1- eshell-last-input-end)))
(t
(error "Invalid value for `eshell-where-to-jump'")))
(setq eshell-smart-command-done nil)
(add-hook 'pre-command-hook 'eshell-smart-display-move nil t)
(eshell-refresh-windows))
(defun eshell-disable-after-change (b e l)
"Disable smart display mode if the buffer changes in any way."
(when eshell-smart-command-done
(remove-hook 'pre-command-hook 'eshell-smart-display-move t)
(setq eshell-smart-command-done nil)))
(defun eshell-smart-maybe-jump-to-end ()
"Jump to the end of the input buffer.
This is done whenever a command exits sucessfully that displayed no
output."
(when (and (= eshell-last-command-status 0)
(= (count-lines eshell-last-input-end
eshell-last-output-end) 0))
(goto-char (point-max))
(remove-hook 'pre-command-hook 'eshell-smart-display-move t)))
(defun eshell-smart-redisplay ()
"Display as much output as possible, smartly."
(if (eobp)
(recenter -1)
(and (memq 'eshell-smart-display-move pre-command-hook)
(>= (point) eshell-last-input-start)
(< (point) eshell-last-input-end)
(set-window-start (selected-window)
(line-beginning-position) t))
(if (pos-visible-in-window-p (point-max))
(save-excursion
(goto-char (point-max))
(recenter -1)))))
(defun eshell-smart-goto-end ()
"Like `end-of-buffer', but do not push a mark."
(interactive)
(goto-char (point-max)))
(defun eshell-smart-display-move ()
"Handle self-inserting or movement commands intelligently."
(let (clear)
(if (or current-prefix-arg
(and (> (point) eshell-last-input-start)
(< (point) eshell-last-input-end))
(>= (point) eshell-last-output-end))
(setq clear t)
(cond
((eq this-command 'self-insert-command)
(if (eq last-command-char ? )
(if (and eshell-smart-space-goes-to-end
eshell-current-command)
(if (not (pos-visible-in-window-p (point-max)))
(setq this-command 'scroll-up)
(setq this-command 'eshell-smart-goto-end))
(setq this-command 'scroll-up))
(setq clear t)
(goto-char (point-max))))
((eq this-command 'delete-backward-char)
(setq this-command 'ignore)
(if (< (point) eshell-last-input-start)
(eshell-show-output)
(if (pos-visible-in-window-p eshell-last-input-start)
(progn
(ignore-errors
(scroll-down))
(eshell-show-output))
(scroll-down)
(if (pos-visible-in-window-p eshell-last-input-end)
(eshell-show-output)))))
((or (memq this-command eshell-smart-display-navigate-list)
(and (eq this-command 'eshell-send-input)
(not (and (>= (point) eshell-last-input-start)
(< (point) eshell-last-input-end)))))
(setq clear t)
(goto-char (point-max)))))
(if clear
(remove-hook 'pre-command-hook 'eshell-smart-display-move t))))
;;; Code:
;;; em-smart.el ends here

266
lisp/eshell/em-term.el Normal file
View File

@ -0,0 +1,266 @@
;;; em-term --- running visual commands
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'em-term)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-term nil
"This module causes visual commands (e.g., 'vi') to be executed by
the `term' package, which comes with Emacs. This package handles most
of the ANSI control codes, allowing curses-based applications to run
within an Emacs window. The variable `eshell-visual-commands' defines
which commands are considered visual in nature."
:tag "Running visual commands"
:group 'eshell-module)
;;; Commentary:
;; At the moment, eshell is stream-based in its interactive input and
;; output. This means that full-screen commands, such as "vi" or
;; "lynx", will not display correctly. These are therefore thought of
;; as "visual" programs. In order to run these progrem under Emacs,
;; Eshell uses the term.el package, and invokes them in a separate
;; buffer, giving the illusion that Eshell itself is allowing these
;; visual processes to execute.
(require 'term)
;;; User Variables:
(defcustom eshell-term-load-hook '(eshell-term-initialize)
"*A list of functions to call when loading `eshell-term'."
:type 'hook
:group 'eshell-term)
(defcustom eshell-visual-commands
'("vi" ; what is going on??
"screen" "top" ; ok, a valid program...
"less" "more" ; M-x view-file
"lynx" "ncftp" ; w3.el, ange-ftp
"pine" "tin" "trn" "elm") ; GNUS!!
"*A list of commands that present their output in a visual fashion."
:type '(repeat string)
:group 'eshell-term)
(defcustom eshell-term-name "eterm"
"*Name to use for the TERM variable when running visual commands.
See `term-term-name' in term.el for more information on how this is
used."
:type 'string
:group 'eshell-term)
(defcustom eshell-escape-control-x t
"*If non-nil, allow <C-x> to be handled by Emacs key in visual buffers.
See the variable `eshell-visual-commands'. If this variable is set to
nil, <C-x> will send that control character to the invoked process."
:type 'boolean
:group 'eshell-term)
;;; Internal Variables:
(defvar eshell-parent-buffer)
;;; Functions:
(defun eshell-term-initialize ()
"Initialize the `term' interface code."
(make-local-variable 'eshell-interpreter-alist)
(setq eshell-interpreter-alist
(cons (cons (function
(lambda (command)
(member (file-name-nondirectory command)
eshell-visual-commands)))
'eshell-exec-visual)
eshell-interpreter-alist)))
(defun eshell-exec-visual (&rest args)
"Run the specified PROGRAM in a terminal emulation buffer.
ARGS are passed to the program. At the moment, no piping of input is
allowed."
(let* (eshell-interpreter-alist
(interp (eshell-find-interpreter (car args)))
(program (car interp))
(args (eshell-flatten-list
(eshell-stringify-list (append (cdr interp)
(cdr args)))))
(term-buf
(generate-new-buffer
(concat "*" (file-name-nondirectory program) "*")))
(eshell-buf (current-buffer)))
(save-current-buffer
(switch-to-buffer term-buf)
(term-mode)
(set (make-local-variable 'term-term-name) eshell-term-name)
(make-local-variable 'eshell-parent-buffer)
(setq eshell-parent-buffer eshell-buf)
(term-exec term-buf program program nil args)
(let ((proc (get-buffer-process term-buf)))
(if (and proc (eq 'run (process-status proc)))
(set-process-sentinel proc 'eshell-term-sentinel)
(error "Failed to invoke visual command")))
(term-char-mode)
(if eshell-escape-control-x
(term-set-escape-char ?\C-x))))
nil)
(defun eshell-term-sentinel (proc string)
"Destroy the buffer visiting PROC."
(let ((proc-buf (process-buffer proc)))
(when (and proc-buf (buffer-live-p proc-buf)
(not (eq 'run (process-status proc)))
(= (process-exit-status proc) 0))
(if (eq (current-buffer) proc-buf)
(let ((buf (and (boundp 'eshell-parent-buffer)
eshell-parent-buffer
(buffer-live-p eshell-parent-buffer)
eshell-parent-buffer)))
(if buf
(switch-to-buffer buf))))
(kill-buffer proc-buf))))
;; jww (1999-09-17): The code below will allow Eshell to send input
;; characters directly to the currently running interactive process.
;; However, since this would introduce other problems that would need
;; solutions, I'm going to let it wait until after 2.1.
; (defvar eshell-term-raw-map nil
; "Keyboard map for sending characters directly to the inferior process.")
; (defvar eshell-term-escape-char nil
; "Escape character for char-sub-mode of term mode.
; Do not change it directly; use term-set-escape-char instead.")
; (defvar eshell-term-raw-escape-map nil)
; (defun eshell-term-send-raw-string (chars)
; (goto-char eshell-last-output-end)
; (process-send-string (eshell-interactive-process) chars))
; (defun eshell-term-send-raw ()
; "Send the last character typed through the terminal-emulator
; without any interpretation."
; (interactive)
; ;; Convert `return' to C-m, etc.
; (if (and (symbolp last-input-char)
; (get last-input-char 'ascii-character))
; (setq last-input-char (get last-input-char 'ascii-character)))
; (eshell-term-send-raw-string (make-string 1 last-input-char)))
; (defun eshell-term-send-raw-meta ()
; (interactive)
; (if (symbolp last-input-char)
; ;; Convert `return' to C-m, etc.
; (let ((tmp (get last-input-char 'event-symbol-elements)))
; (if tmp
; (setq last-input-char (car tmp)))
; (if (symbolp last-input-char)
; (progn
; (setq tmp (get last-input-char 'ascii-character))
; (if tmp (setq last-input-char tmp))))))
; (eshell-term-send-raw-string (if (and (numberp last-input-char)
; (> last-input-char 127)
; (< last-input-char 256))
; (make-string 1 last-input-char)
; (format "\e%c" last-input-char))))
; (defun eshell-term-mouse-paste (click arg)
; "Insert the last stretch of killed text at the position clicked on."
; (interactive "e\nP")
; (if (boundp 'xemacs-logo)
; (eshell-term-send-raw-string
; (or (condition-case () (x-get-selection) (error ()))
; (x-get-cutbuffer)
; (error "No selection or cut buffer available")))
; ;; Give temporary modes such as isearch a chance to turn off.
; (run-hooks 'mouse-leave-buffer-hook)
; (setq this-command 'yank)
; (eshell-term-send-raw-string
; (current-kill (cond ((listp arg) 0)
; ((eq arg '-) -1)
; (t (1- arg)))))))
; ;; Which would be better: "\e[A" or "\eOA"? readline accepts either.
; ;; For my configuration it's definitely better \eOA but YMMV. -mm
; ;; For example: vi works with \eOA while elm wants \e[A ...
; (defun eshell-term-send-up () (interactive) (eshell-term-send-raw-string "\eOA"))
; (defun eshell-term-send-down () (interactive) (eshell-term-send-raw-string "\eOB"))
; (defun eshell-term-send-right () (interactive) (eshell-term-send-raw-string "\eOC"))
; (defun eshell-term-send-left () (interactive) (eshell-term-send-raw-string "\eOD"))
; (defun eshell-term-send-home () (interactive) (eshell-term-send-raw-string "\e[1~"))
; (defun eshell-term-send-end () (interactive) (eshell-term-send-raw-string "\e[4~"))
; (defun eshell-term-send-prior () (interactive) (eshell-term-send-raw-string "\e[5~"))
; (defun eshell-term-send-next () (interactive) (eshell-term-send-raw-string "\e[6~"))
; (defun eshell-term-send-del () (interactive) (eshell-term-send-raw-string "\C-?"))
; (defun eshell-term-send-backspace () (interactive) (eshell-term-send-raw-string "\C-H"))
; (defun eshell-term-set-escape-char (c)
; "Change term-escape-char and keymaps that depend on it."
; (if eshell-term-escape-char
; (define-key eshell-term-raw-map eshell-term-escape-char 'eshell-term-send-raw))
; (setq c (make-string 1 c))
; (define-key eshell-term-raw-map c eshell-term-raw-escape-map)
; ;; Define standard bindings in eshell-term-raw-escape-map
; (define-key eshell-term-raw-escape-map "\C-x"
; (lookup-key (current-global-map) "\C-x"))
; (define-key eshell-term-raw-escape-map "\C-v"
; (lookup-key (current-global-map) "\C-v"))
; (define-key eshell-term-raw-escape-map "\C-u"
; (lookup-key (current-global-map) "\C-u"))
; (define-key eshell-term-raw-escape-map c 'eshell-term-send-raw))
; (defun eshell-term-char-mode ()
; "Switch to char (\"raw\") sub-mode of term mode.
; Each character you type is sent directly to the inferior without
; intervention from Emacs, except for the escape character (usually C-c)."
; (interactive)
; (if (not eshell-term-raw-map)
; (let* ((map (make-keymap))
; (esc-map (make-keymap))
; (i 0))
; (while (< i 128)
; (define-key map (make-string 1 i) 'eshell-term-send-raw)
; (define-key esc-map (make-string 1 i) 'eshell-term-send-raw-meta)
; (setq i (1+ i)))
; (define-key map "\e" esc-map)
; (setq eshell-term-raw-map map)
; (setq eshell-term-raw-escape-map
; (copy-keymap (lookup-key (current-global-map) "\C-x")))
; (if (boundp 'xemacs-logo)
; (define-key eshell-term-raw-map [button2] 'eshell-term-mouse-paste)
; (define-key eshell-term-raw-map [mouse-2] 'eshell-term-mouse-paste))
; (define-key eshell-term-raw-map [up] 'eshell-term-send-up)
; (define-key eshell-term-raw-map [down] 'eshell-term-send-down)
; (define-key eshell-term-raw-map [right] 'eshell-term-send-right)
; (define-key eshell-term-raw-map [left] 'eshell-term-send-left)
; (define-key eshell-term-raw-map [delete] 'eshell-term-send-del)
; (define-key eshell-term-raw-map [backspace] 'eshell-term-send-backspace)
; (define-key eshell-term-raw-map [home] 'eshell-term-send-home)
; (define-key eshell-term-raw-map [end] 'eshell-term-send-end)
; (define-key eshell-term-raw-map [prior] 'eshell-term-send-prior)
; (define-key eshell-term-raw-map [next] 'eshell-term-send-next)
; (eshell-term-set-escape-char ?\C-c))))
; (defun eshell-term-line-mode ()
; "Switch to line (\"cooked\") sub-mode of eshell-term mode."
; (use-local-map term-old-mode-map))
;;; Code:
;;; em-term.el ends here

927
lisp/eshell/em-unix.el Normal file
View File

@ -0,0 +1,927 @@
;;; em-unix --- UNIX command aliases
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'em-unix)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-unix nil
"This module defines many of the more common UNIX utilities as
aliases implemented in Lisp. These include mv, ln, cp, rm, etc. If
the user passes arguments which are too complex, or are unrecognized
by the Lisp variant, the external version will be called (if
available). The only reason not to use them would be because they are
usually much slower. But in several cases their tight integration
with Eshell makes them more versatile than their traditional cousins
\(such as being able to use `kill' to kill Eshell background processes
by name)."
:tag "UNIX commands in Lisp"
:group 'eshell-module)
;;; Commentary:
;; This file contains implementations of several UNIX command in Emacs
;; Lisp, for several reasons:
;;
;; 1) it makes them available on all platforms where the Lisp
;; functions used are available
;;
;; 2) it makes their functionality accessible and modified by the
;; Lisp programmer.
;;
;; 3) it allows Eshell to refrain from having to invoke external
;; processes for common operations.
(defcustom eshell-unix-load-hook '(eshell-unix-initialize)
"*A list of functions to run when `eshell-unix' is loaded."
:type 'hook
:group 'eshell-unix)
(defcustom eshell-plain-grep-behavior nil
"*If non-nil, standalone \"grep\" commands will behave normally.
Standalone in this context means not redirected, and not on the
receiving side of a command pipeline."
:type 'boolean
:group 'eshell-unix)
(defcustom eshell-no-grep-available (not (eshell-search-path "grep"))
"*If non-nil, no grep is available on the current machine."
:type 'boolean
:group 'eshell-unix)
(defcustom eshell-plain-diff-behavior nil
"*If non-nil, standalone \"diff\" commands will behave normally.
Standalone in this context means not redirected, and not on the
receiving side of a command pipeline."
:type 'boolean
:group 'eshell-unix)
(defcustom eshell-plain-locate-behavior nil
"*If non-nil, standalone \"locate\" commands will behave normally.
Standalone in this context means not redirected, and not on the
receiving side of a command pipeline."
:type 'boolean
:group 'eshell-unix)
(defcustom eshell-rm-removes-directories nil
"*If non-nil, `rm' will remove directory entries.
Otherwise, `rmdir' is required."
:type 'boolean
:group 'eshell-unix)
(defcustom eshell-rm-interactive-query (= (user-uid) 0)
"*If non-nil, `rm' will query before removing anything."
:type 'boolean
:group 'eshell-unix)
(defcustom eshell-mv-interactive-query (= (user-uid) 0)
"*If non-nil, `mv' will query before overwriting anything."
:type 'boolean
:group 'eshell-unix)
(defcustom eshell-mv-overwrite-files t
"*If non-nil, `mv' will overwrite files without warning."
:type 'boolean
:group 'eshell-unix)
(defcustom eshell-cp-interactive-query (= (user-uid) 0)
"*If non-nil, `cp' will query before overwriting anything."
:type 'boolean
:group 'eshell-unix)
(defcustom eshell-cp-overwrite-files t
"*If non-nil, `cp' will overwrite files without warning."
:type 'boolean
:group 'eshell-unix)
(defcustom eshell-ln-interactive-query (= (user-uid) 0)
"*If non-nil, `ln' will query before overwriting anything."
:type 'boolean
:group 'eshell-unix)
(defcustom eshell-ln-overwrite-files t
"*If non-nil, `ln' will overwrite files without warning."
:type 'boolean
:group 'eshell-unix)
(require 'esh-opt)
;;; Functions:
(defun eshell-unix-initialize ()
"Initialize the UNIX support/emulation code."
(make-local-hook 'eshell-post-command-hook)
(when (eshell-using-module 'eshell-cmpl)
(make-local-hook 'pcomplete-try-first-hook)
(add-hook 'pcomplete-try-first-hook
'eshell-complete-host-reference nil t)))
(defalias 'eshell/date 'current-time-string)
(defalias 'eshell/basename 'file-name-nondirectory)
(defalias 'eshell/dirname 'file-name-directory)
(eval-when-compile
(defvar interactive)
(defvar preview)
(defvar recursive)
(defvar verbose))
(defun eshell/man (&rest args)
"Invoke man, flattening the arguments appropriately."
(funcall 'man (apply 'eshell-flatten-and-stringify args)))
(defun eshell-remove-entries (path files &optional top-level)
(while files
(if (string-match "\\`\\.\\.?\\'"
(file-name-nondirectory (car files)))
(if top-level
(eshell-error "rm: cannot remove `.' or `..'\n"))
(if (and (file-directory-p (car files))
(not (file-symlink-p (car files))))
(let ((dir (file-name-as-directory (car files))))
(eshell-remove-entries dir
(mapcar
(function
(lambda (file)
(concat dir file)))
(directory-files dir)))
(if verbose
(eshell-printn (format "rm: removing directory `%s'"
(car files))))
(unless
(or preview
(and interactive
(not (y-or-n-p
(format "rm: remove directory `%s'? "
(car files))))))
(eshell-funcalln 'delete-directory (car files))))
(if verbose
(eshell-printn (format "rm: removing file `%s'"
(car files))))
(unless (or preview
(and interactive
(not (y-or-n-p
(format "rm: remove `%s'? "
(car files))))))
(eshell-funcalln 'delete-file (car files)))))
(setq files (cdr files))))
(defun eshell/rm (&rest args)
"Implementation of rm in Lisp.
This is implemented to call either `delete-file', `kill-buffer',
`kill-process', or `unintern', depending on the nature of the
argument."
(setq args (eshell-flatten-list args))
(eshell-eval-using-options
"rm" args
'((?h "help" nil nil "show this usage screen")
(?f "force" nil force-removal "force removal")
(?i "interactive" nil interactive "prompt before any removal")
(?n "preview" nil preview "don't change anything on disk")
(?r "recursive" nil recursive
"remove the contents of directories recursively")
(?R nil nil recursive "(same)")
(?v "verbose" nil verbose "explain what is being done")
:preserve-args
:external "rm"
:show-usage
:usage "[OPTION]... FILE...
Remove (unlink) the FILE(s).")
(unless interactive
(setq interactive eshell-rm-interactive-query))
(if (and force-removal interactive)
(setq interactive nil))
(while args
(let ((entry (if (stringp (car args))
(directory-file-name (car args))
(if (numberp (car args))
(number-to-string (car args))
(car args)))))
(cond
((bufferp entry)
(if verbose
(eshell-printn (format "rm: removing buffer `%s'" entry)))
(unless (or preview
(and interactive
(not (y-or-n-p (format "rm: delete buffer `%s'? "
entry)))))
(eshell-funcalln 'kill-buffer entry)))
((processp entry)
(if verbose
(eshell-printn (format "rm: killing process `%s'" entry)))
(unless (or preview
(and interactive
(not (y-or-n-p (format "rm: kill process `%s'? "
entry)))))
(eshell-funcalln 'kill-process entry)))
((symbolp entry)
(if verbose
(eshell-printn (format "rm: uninterning symbol `%s'" entry)))
(unless
(or preview
(and interactive
(not (y-or-n-p (format "rm: unintern symbol `%s'? "
entry)))))
(eshell-funcalln 'unintern entry)))
((stringp entry)
(if (and (file-directory-p entry)
(not (file-symlink-p entry)))
(if (or recursive
eshell-rm-removes-directories)
(if (or preview
(not interactive)
(y-or-n-p
(format "rm: descend into directory `%s'? "
entry)))
(eshell-remove-entries nil (list entry) t))
(eshell-error (format "rm: %s: is a directory\n" entry)))
(eshell-remove-entries nil (list entry) t)))))
(setq args (cdr args)))
nil))
(defun eshell/mkdir (&rest args)
"Implementation of mkdir in Lisp."
(eshell-eval-using-options
"mkdir" args
'((?h "help" nil nil "show this usage screen")
:external "mkdir"
:show-usage
:usage "[OPTION] DIRECTORY...
Create the DIRECTORY(ies), if they do not already exist.")
(while args
(eshell-funcalln 'make-directory (car args))
(setq args (cdr args)))
nil))
(defun eshell/rmdir (&rest args)
"Implementation of rmdir in Lisp."
(eshell-eval-using-options
"rmdir" args
'((?h "help" nil nil "show this usage screen")
:external "rmdir"
:show-usage
:usage "[OPTION] DIRECTORY...
Remove the DIRECTORY(ies), if they are empty.")
(while args
(eshell-funcalln 'delete-directory (car args))
(setq args (cdr args)))
nil))
(eval-when-compile
(defvar no-dereference)
(defvar preview)
(defvar verbose))
(defvar eshell-warn-dot-directories t)
(defun eshell-shuffle-files (command action files target func deep &rest args)
"Shuffle around some filesystem entries, using FUNC to do the work."
(if (null target)
(error "%s: missing destination file" command))
(let ((attr-target (file-attributes target))
(is-dir (or (file-directory-p target)
(and preview (not eshell-warn-dot-directories))))
attr)
(if (and (not preview) (not is-dir)
(> (length files) 1))
(error "%s: when %s multiple files, last argument must be a directory"
command action))
(while files
(setcar files (directory-file-name (car files)))
(cond
((string-match "\\`\\.\\.?\\'"
(file-name-nondirectory (car files)))
(if eshell-warn-dot-directories
(eshell-error (format "%s: %s: omitting directory\n"
command (car files)))))
((and attr-target
(not (eshell-under-windows-p))
(setq attr (file-attributes (car files)))
(= (nth 10 attr-target) (nth 10 attr))
(= (nth 11 attr-target) (nth 11 attr)))
(eshell-error (format "%s: `%s' and `%s' are the same file\n"
command (car files) target)))
(t
(let ((source (car files))
(target (if is-dir
(expand-file-name
(file-name-nondirectory (car files)) target)
target))
link)
(if (and (file-directory-p source)
(or (not no-dereference)
(not (file-symlink-p source)))
(not (memq func '(make-symbolic-link
add-name-to-file))))
(if (and (eq func 'copy-file)
(not recursive))
(eshell-error (format "%s: %s: omitting directory\n"
command (car files)))
(let (eshell-warn-dot-directories)
(if (and (not deep)
(eq func 'rename-file)
(= (nth 11 (file-attributes
(file-name-directory
(expand-file-name source))))
(nth 11 (file-attributes
(file-name-directory
(expand-file-name target))))))
(apply 'eshell-funcalln func source target args)
(unless (file-directory-p target)
(if verbose
(eshell-printn
(format "%s: making directory %s"
command target)))
(unless preview
(eshell-funcalln 'make-directory target)))
(eshell-shuffle-files command action
(mapcar
(function
(lambda (file)
(concat source "/" file)))
(directory-files source))
target func t args)
(when (eq func 'rename-file)
(if verbose
(eshell-printn
(format "%s: deleting directory %s"
command source)))
(unless preview
(eshell-funcalln 'delete-directory source))))))
(if verbose
(eshell-printn (format "%s: %s -> %s" command
source target)))
(unless preview
(if (and no-dereference
(setq link (file-symlink-p source)))
(progn
(apply 'eshell-funcalln 'make-symbolic-link
link target args)
(if (eq func 'rename-file)
(if (and (file-directory-p source)
(not (file-symlink-p source)))
(eshell-funcalln 'delete-directory source)
(eshell-funcalln 'delete-file source))))
(apply 'eshell-funcalln func source target args)))))))
(setq files (cdr files)))))
(defun eshell-shorthand-tar-command (command args)
"Rewrite `cp -v dir a.tar.gz' to `tar cvzf a.tar.gz dir'."
(let* ((archive (car (last args)))
(tar-args
(cond ((string-match "z2" archive) "If")
((string-match "gz" archive) "zf")
((string-match "\\(az\\|Z\\)" archive) "Zf")
(t "f"))))
(if (file-exists-p archive)
(setq tar-args (concat "u" tar-args))
(setq tar-args (concat "c" tar-args)))
(if verbose
(setq tar-args (concat "v" tar-args)))
(if (equal command "mv")
(setq tar-args (concat "--remove-files -" tar-args)))
;; truncate the archive name from the arguments
(setcdr (last args 2) nil)
(throw 'eshell-replace-command
(eshell-parse-command
(format "tar %s %s" tar-args archive) args))))
;; this is to avoid duplicating code...
(defmacro eshell-mvcp-template
(command action func query-var force-var &optional preserve)
`(if (and (string-match eshell-tar-regexp (car (last args)))
(or (> (length args) 2)
(and (file-directory-p (car args))
(or (not no-dereference)
(not (file-symlink-p (car args)))))))
(eshell-shorthand-tar-command ,command args)
(let (target)
(if (> (length args) 1)
(progn
(setq target (car (last args)))
(setcdr (last args 2) nil))
(setq args nil))
(eshell-shuffle-files
,command ,action args target ,func nil
,@(append
`((if (and (or interactive
,query-var)
(not force))
1 (or force ,force-var)))
(if preserve
(list preserve)))))
nil))
(defun eshell/mv (&rest args)
"Implementation of mv in Lisp."
(eshell-eval-using-options
"mv" args
'((?f "force" nil force
"remove existing destinations, never prompt")
(?i "interactive" nil interactive
"request confirmation if target already exists")
(?n "preview" nil preview
"don't change anything on disk")
(?v "verbose" nil verbose
"explain what is being done")
(nil "help" nil nil "show this usage screen")
:external "mv"
:show-usage
:usage "[OPTION]... SOURCE DEST
or: mv [OPTION]... SOURCE... DIRECTORY
Rename SOURCE to DEST, or move SOURCE(s) to DIRECTORY.
\[OPTION] DIRECTORY...")
(let ((no-dereference t))
(eshell-mvcp-template "mv" "moving" 'rename-file
eshell-mv-interactive-query
eshell-mv-overwrite-files))))
(defun eshell/cp (&rest args)
"Implementation of cp in Lisp."
(eshell-eval-using-options
"cp" args
'((?a "archive" nil archive
"same as -dpR")
(?d "no-dereference" nil no-dereference
"preserve links")
(?f "force" nil force
"remove existing destinations, never prompt")
(?i "interactive" nil interactive
"request confirmation if target already exists")
(?n "preview" nil preview
"don't change anything on disk")
(?p "preserve" nil preserve
"preserve file attributes if possible")
(?R "recursive" nil recursive
"copy directories recursively")
(?v "verbose" nil verbose
"explain what is being done")
(nil "help" nil nil "show this usage screen")
:external "cp"
:show-usage
:usage "[OPTION]... SOURCE DEST
or: cp [OPTION]... SOURCE... DIRECTORY
Copy SOURCE to DEST, or multiple SOURCE(s) to DIRECTORY.")
(if archive
(setq preserve t no-dereference t recursive t))
(eshell-mvcp-template "cp" "copying" 'copy-file
eshell-cp-interactive-query
eshell-cp-overwrite-files preserve)))
(defun eshell/ln (&rest args)
"Implementation of ln in Lisp."
(eshell-eval-using-options
"ln" args
'((?h "help" nil nil "show this usage screen")
(?s "symbolic" nil symbolic
"make symbolic links instead of hard links")
(?i "interactive" nil interactive "request confirmation if target already exists")
(?f "force" nil force "remove existing destinations, never prompt")
(?n "preview" nil preview
"don't change anything on disk")
(?v "verbose" nil verbose "explain what is being done")
:external "ln"
:show-usage
:usage "[OPTION]... TARGET [LINK_NAME]
or: ln [OPTION]... TARGET... DIRECTORY
Create a link to the specified TARGET with optional LINK_NAME. If there is
more than one TARGET, the last argument must be a directory; create links
in DIRECTORY to each TARGET. Create hard links by default, symbolic links
with '--symbolic'. When creating hard links, each TARGET must exist.")
(let (target no-dereference)
(if (> (length args) 1)
(progn
(setq target (car (last args)))
(setcdr (last args 2) nil))
(setq args nil))
(eshell-shuffle-files "ln" "linking" args target
(if symbolic
'make-symbolic-link
'add-name-to-file) nil
(if (and (or interactive
eshell-ln-interactive-query)
(not force))
1 (or force eshell-ln-overwrite-files))))
nil))
(defun eshell/cat (&rest args)
"Implementation of cat in Lisp."
(if eshell-in-pipeline-p
(throw 'eshell-replace-command
(eshell-parse-command "*cat" args))
(eshell-init-print-buffer)
(eshell-eval-using-options
"cat" args
'((?h "help" nil nil "show this usage screen")
:external "cat"
:show-usage
:usage "[OPTION] FILE...
Concatenate FILE(s), or standard input, to standard output.")
(eshell-for file args
(if (string= file "-")
(throw 'eshell-external
(eshell-external-command "cat" args))))
(let ((curbuf (current-buffer)))
(eshell-for file args
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(while (not (eobp))
(let ((str (buffer-substring
(point) (min (1+ (line-end-position))
(point-max)))))
(with-current-buffer curbuf
(eshell-buffered-print str)))
(forward-line)))))
(eshell-flush)
;; if the file does not end in a newline, do not emit one
(setq eshell-ensure-newline-p nil))))
;; special front-end functions for compilation-mode buffers
(defun eshell/make (&rest args)
"Use `compile' to do background makes."
(if (and eshell-current-subjob-p
(eshell-interactive-output-p))
(let ((compilation-process-setup-function
(list 'lambda nil
(list 'setq 'process-environment
(list 'quote (eshell-copy-environment))))))
(compile (concat "make " (eshell-flatten-and-stringify args))))
(throw 'eshell-replace-command
(eshell-parse-command "*make" args))))
(defun eshell-occur-mode-goto-occurrence ()
"Go to the occurrence the current line describes."
(interactive)
(let ((pos (occur-mode-find-occurrence)))
(pop-to-buffer (marker-buffer pos))
(goto-char (marker-position pos))))
(defun eshell-occur-mode-mouse-goto (event)
"In Occur mode, go to the occurrence whose line you click on."
(interactive "e")
(let (buffer pos)
(save-excursion
(set-buffer (window-buffer (posn-window (event-end event))))
(save-excursion
(goto-char (posn-point (event-end event)))
(setq pos (occur-mode-find-occurrence))
(setq buffer occur-buffer)))
(pop-to-buffer (marker-buffer pos))
(goto-char (marker-position pos))))
(defun eshell-poor-mans-grep (args)
"A poor version of grep that opens every file and uses `occur'.
This eats up memory, since it leaves the buffers open (to speed future
searches), and it's very slow. But, if your system has no grep
available..."
(save-selected-window
(let ((default-dir default-directory))
(with-current-buffer (get-buffer-create "*grep*")
(let ((inhibit-read-only t)
(default-directory default-dir))
(erase-buffer)
(occur-mode)
(let ((files (eshell-flatten-list (cdr args)))
(inhibit-redisplay t)
string)
(when (car args)
(if (get-buffer "*Occur*")
(kill-buffer (get-buffer "*Occur*")))
(setq string nil)
(while files
(with-current-buffer (find-file-noselect (car files))
(save-excursion
(ignore-errors
(occur (car args))))
(if (get-buffer "*Occur*")
(with-current-buffer (get-buffer "*Occur*")
(setq string (buffer-string))
(kill-buffer (current-buffer)))))
(if string (insert string))
(setq string nil
files (cdr files)))))
(setq occur-buffer (current-buffer))
(local-set-key [mouse-2] 'eshell-occur-mode-mouse-goto)
(local-set-key [(control ?c) (control ?c)]
'eshell-occur-mode-goto-occurrence)
(local-set-key [(control ?m)]
'eshell-occur-mode-goto-occurrence)
(local-set-key [return] 'eshell-occur-mode-goto-occurrence)
(pop-to-buffer (current-buffer) t)
(goto-char (point-min))
(resize-temp-buffer-window))))))
(defun eshell-grep (command args &optional maybe-use-occur)
"Generic service function for the various grep aliases.
It calls Emacs' grep utility if the command is not redirecting output,
and if it's not part of a command pipeline. Otherwise, it calls the
external command."
(if (and maybe-use-occur eshell-no-grep-available)
(eshell-poor-mans-grep args)
(if (or eshell-plain-grep-behavior
(not (and (eshell-interactive-output-p)
(not eshell-in-pipeline-p)
(not eshell-in-subcommand-p))))
(throw 'eshell-replace-command
(eshell-parse-command (concat "*" command) args))
(let* ((compilation-process-setup-function
(list 'lambda nil
(list 'setq 'process-environment
(list 'quote (eshell-copy-environment)))))
(args (mapconcat 'identity
(mapcar 'shell-quote-argument
(eshell-flatten-list args))
" "))
(cmd (progn
(set-text-properties 0 (length args)
'(invisible t) args)
(format "%s -n %s" command args)))
compilation-scroll-output)
(grep cmd)))))
(defun eshell/grep (&rest args)
"Use Emacs grep facility instead of calling external grep."
(eshell-grep "grep" args t))
(defun eshell/egrep (&rest args)
"Use Emacs grep facility instead of calling external egrep."
(eshell-grep "egrep" args t))
(defun eshell/fgrep (&rest args)
"Use Emacs grep facility instead of calling external fgrep."
(eshell-grep "fgrep" args t))
(defun eshell/agrep (&rest args)
"Use Emacs grep facility instead of calling external agrep."
(eshell-grep "agrep" args))
(defun eshell/glimpse (&rest args)
"Use Emacs grep facility instead of calling external glimpse."
(let (null-device)
(eshell-grep "glimpse" (append '("-z" "-y") args))))
;; completions rules for some common UNIX commands
(defsubst eshell-complete-hostname ()
"Complete a command that wants a hostname for an argument."
(pcomplete-here (eshell-read-host-names)))
(defun eshell-complete-host-reference ()
"If there is a host reference, complete it."
(let ((arg (pcomplete-actual-arg))
index)
(when (setq index (string-match "@[a-z.]*\\'" arg))
(setq pcomplete-stub (substring arg (1+ index))
pcomplete-last-completion-raw t)
(throw 'pcomplete-completions (eshell-read-host-names)))))
(defalias 'pcomplete/ftp 'eshell-complete-hostname)
(defalias 'pcomplete/ncftp 'eshell-complete-hostname)
(defalias 'pcomplete/ping 'eshell-complete-hostname)
(defalias 'pcomplete/rlogin 'eshell-complete-hostname)
(defun pcomplete/telnet ()
(require 'pcmpl-unix)
(pcomplete-opt "xl(pcmpl-unix-user-names)")
(eshell-complete-hostname))
(defun pcomplete/rsh ()
"Complete `rsh', which, after the user and hostname, is like xargs."
(require 'pcmpl-unix)
(pcomplete-opt "l(pcmpl-unix-user-names)")
(eshell-complete-hostname)
(pcomplete-here (funcall pcomplete-command-completion-function))
(funcall (or (pcomplete-find-completion-function (pcomplete-arg 1))
pcomplete-default-completion-function)))
(defalias 'pcomplete/ssh 'pcomplete/rsh)
(eval-when-compile
(defvar block-size)
(defvar by-bytes)
(defvar dereference-links)
(defvar grand-total)
(defvar human-readable)
(defvar max-depth)
(defvar only-one-filesystem)
(defvar show-all))
(defsubst eshell-du-size-string (size)
(let* ((str (eshell-printable-size size human-readable block-size t))
(len (length str)))
(concat str (if (< len 8)
(make-string (- 8 len) ? )))))
(defun eshell-du-sum-directory (path depth)
"Summarize PATH, and its member directories."
(let ((entries (eshell-directory-files-and-attributes path))
(size 0.0))
(while entries
(unless (string-match "\\`\\.\\.?\\'" (caar entries))
(let* ((entry (concat path (char-to-string directory-sep-char)
(caar entries)))
(symlink (and (stringp (cadr (car entries)))
(cadr (car entries)))))
(unless (or (and symlink (not dereference-links))
(and only-one-filesystem
(not (= only-one-filesystem
(nth 12 (car entries))))))
(if symlink
(setq entry symlink))
(setq size
(+ size
(if (eq t (cadr (car entries)))
(eshell-du-sum-directory entry (1+ depth))
(let ((file-size (nth 8 (car entries))))
(prog1
file-size
(if show-all
(eshell-print
(concat (eshell-du-size-string file-size)
entry "\n")))))))))))
(setq entries (cdr entries)))
(if (or (not max-depth)
(= depth max-depth)
(= depth 0))
(eshell-print (concat (eshell-du-size-string size)
(directory-file-name path) "\n")))
size))
(defun eshell/du (&rest args)
"Implementation of \"du\" in Lisp, passing RAGS."
(if (eshell-search-path "du")
(throw 'eshell-replace-command
(eshell-parse-command "*du" args))
(eshell-eval-using-options
"du" args
'((?a "all" nil show-all
"write counts for all files, not just directories")
(nil "block-size" t block-size
"use SIZE-byte blocks (i.e., --block-size SIZE)")
(?b "bytes" nil by-bytes
"print size in bytes")
(?c "total" nil grand-total
"produce a grand total")
(?d "max-depth" t max-depth
"display data only this many levels of data")
(?h "human-readable" 1024 human-readable
"print sizes in human readable format")
(?H "is" 1000 human-readable
"likewise, but use powers of 1000 not 1024")
(?k "kilobytes" 1024 block-size
"like --block-size 1024")
(?L "dereference" nil dereference-links
"dereference all symbolic links")
(?m "megabytes" 1048576 block-size
"like --block-size 1048576")
(?s "summarize" 0 max-depth
"display only a total for each argument")
(?x "one-file-system" nil only-one-filesystem
"skip directories on different filesystems")
(nil "help" nil nil
"show this usage screen")
:external "du"
:usage "[OPTION]... FILE...
Summarize disk usage of each FILE, recursively for directories.")
(unless by-bytes
(setq block-size (or block-size 1024)))
(if (and max-depth (stringp max-depth))
(setq max-depth (string-to-int max-depth)))
;; filesystem support means nothing under Windows
(if (eshell-under-windows-p)
(setq only-one-filesystem nil))
(unless args
(setq args '(".")))
(let ((size 0.0))
(while args
(if only-one-filesystem
(setq only-one-filesystem
(nth 11 (file-attributes
(file-name-as-directory (car args))))))
(setq size (+ size (eshell-du-sum-directory
(directory-file-name (car args)) 0)))
(setq args (cdr args)))
(if grand-total
(eshell-print (concat (eshell-du-size-string size)
"total\n")))))))
(defvar eshell-time-start nil)
(defun eshell-show-elapsed-time ()
(let ((elapsed (format "%.3f secs\n"
(- (eshell-time-to-seconds (current-time))
eshell-time-start))))
(set-text-properties 0 (length elapsed) '(face bold) elapsed)
(eshell-interactive-print elapsed))
(remove-hook 'eshell-post-command-hook 'eshell-show-elapsed-time t))
(defun eshell/time (&rest args)
"Implementation of \"time\" in Lisp."
(let ((time-args (copy-alist args))
(continue t)
last-arg)
(while (and continue args)
(if (not (string-match "^-" (car args)))
(progn
(if last-arg
(setcdr last-arg nil)
(setq args '("")))
(setq continue nil))
(setq last-arg args
args (cdr args))))
(eshell-eval-using-options
"time" args
'((?h "help" nil nil "show this usage screen")
:external "time"
:show-usage
:usage "COMMAND...
Show wall-clock time elapsed during execution of COMMAND.")
(setq eshell-time-start (eshell-time-to-seconds (current-time)))
(add-hook 'eshell-post-command-hook 'eshell-show-elapsed-time nil t)
;; after setting
(throw 'eshell-replace-command
(eshell-parse-command (car time-args) (cdr time-args))))))
(defalias 'eshell/whoami 'user-login-name)
(defvar eshell-diff-window-config nil)
(defun eshell-diff-quit ()
"Restore the window configuration previous to diff'ing."
(interactive)
(if eshell-diff-window-config
(set-window-configuration eshell-diff-window-config)))
(defun eshell/diff (&rest args)
"Alias \"diff\" to call Emacs `diff' function."
(if (or eshell-plain-diff-behavior
(not (and (eshell-interactive-output-p)
(not eshell-in-pipeline-p)
(not eshell-in-subcommand-p))))
(throw 'eshell-replace-command
(eshell-parse-command "*diff" args))
(setq args (eshell-flatten-list args))
(if (< (length args) 2)
(error "diff: missing operand"))
(let ((old (car (last args 2)))
(new (car (last args)))
(config (current-window-configuration)))
(if (= (length args) 2)
(setq args nil)
(setcdr (last args 3) nil))
(with-current-buffer
(diff old new (eshell-flatten-and-stringify args))
(when (fboundp 'diff-mode)
(diff-mode)
(set (make-local-variable 'eshell-diff-window-config) config)
(local-set-key [?q] 'eshell-diff-quit)
(if (fboundp 'turn-on-font-lock-if-enabled)
(turn-on-font-lock-if-enabled))))
(other-window 1)
(goto-char (point-min))
nil)))
(defun eshell/locate (&rest args)
"Alias \"locate\" to call Emacs `locate' function."
(if (or eshell-plain-locate-behavior
(not (and (eshell-interactive-output-p)
(not eshell-in-pipeline-p)
(not eshell-in-subcommand-p)))
(and (stringp (car args))
(string-match "^-" (car args))))
(throw 'eshell-replace-command
(eshell-parse-command "*locate" args))
(save-selected-window
(let ((locate-history-list (list (car args))))
(locate-with-filter (car args) (cadr args))))))
(defun eshell/occur (&rest args)
"Alias \"occur\" to call Emacs `occur' function."
(let ((inhibit-read-only t))
(if args
(error "usage: occur: (REGEXP)")
(occur (car args)))))
;;; Code:
;;; em-unix.el ends here

119
lisp/eshell/em-xtra.el Normal file
View File

@ -0,0 +1,119 @@
;;; em-xtra --- extra alias functions
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'em-xtra)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-xtra nil
"This module defines some extra alias functions which are entirely
optional. They can be viewed as samples for how to write Eshell alias
functions, or as aliases which make some of Emacs' behavior more
naturally accessible within Emacs."
:tag "Extra alias functions"
:group 'eshell-module)
;;; Commentary:
(require 'compile)
;;; Functions:
(defun eshell/expr (&rest args)
"Implementation of expr, using the calc package."
(if (not (fboundp 'calc-eval))
(throw 'eshell-replace-command
(eshell-parse-command "*expr" args))
;; to fool the byte-compiler...
(let ((func 'calc-eval))
(funcall func (eshell-flatten-and-stringify args)))))
(defun eshell/substitute (&rest args)
"Easy front-end to `intersection', for comparing lists of strings."
(apply 'substitute (car args) (cadr args) :test 'equal
(cddr args)))
(defun eshell/count (&rest args)
"Easy front-end to `intersection', for comparing lists of strings."
(apply 'count (car args) (cadr args) :test 'equal
(cddr args)))
(defun eshell/mismatch (&rest args)
"Easy front-end to `intersection', for comparing lists of strings."
(apply 'mismatch (car args) (cadr args) :test 'equal
(cddr args)))
(defun eshell/union (&rest args)
"Easy front-end to `intersection', for comparing lists of strings."
(apply 'union (car args) (cadr args) :test 'equal
(cddr args)))
(defun eshell/intersection (&rest args)
"Easy front-end to `intersection', for comparing lists of strings."
(apply 'intersection (car args) (cadr args) :test 'equal
(cddr args)))
(defun eshell/set-difference (&rest args)
"Easy front-end to `intersection', for comparing lists of strings."
(apply 'set-difference (car args) (cadr args) :test 'equal
(cddr args)))
(defun eshell/set-exclusive-or (&rest args)
"Easy front-end to `intersection', for comparing lists of strings."
(apply 'set-exclusive-or (car args) (cadr args) :test 'equal
(cddr args)))
(defalias 'eshell/ff 'find-name-dired)
(defalias 'eshell/gf 'find-grep-dired)
(defun pcomplete/bcc32 ()
"Completion function for Borland's C++ compiler."
(let ((cur (pcomplete-arg 0)))
(cond
((string-match "\\`-w\\([^;]+;\\)*\\([^;]*\\)\\'" cur)
(pcomplete-here
'("ali" "amb" "amp" "asc" "asm" "aus" "bbf" "bei" "big" "ccc"
"cln" "cod" "com" "cpt" "csu" "def" "dig" "dpu" "dsz" "dup"
"eas" "eff" "ext" "hch" "hid" "ias" "ibc" "ifr" "ill" "nil"
"lin" "lvc" "mcs" "mes" "mpc" "mpd" "msg" "nak" "ncf" "nci"
"ncl" "nfd" "ngu" "nin" "nma" "nmu" "nod" "nop" "npp" "nsf"
"nst" "ntd" "nto" "nvf" "obi" "obs" "ofp" "osh" "ovf" "par"
"pch" "pck" "pia" "pin" "pow" "prc" "pre" "pro" "rch" "ret"
"rng" "rpt" "rvl" "sig" "spa" "stl" "stu" "stv" "sus" "tai"
"tes" "thr" "ucp" "use" "voi" "zdi") (match-string 2 cur)))
((string-match "\\`-[LIn]\\([^;]+;\\)*\\([^;]*\\)\\'" cur)
(pcomplete-here (pcomplete-dirs) (match-string 2 cur)))
((string-match "\\`-[Ee]\\(.*\\)\\'" cur)
(pcomplete-here (pcomplete-dirs-or-entries "\\.[Ee][Xx][Ee]\\'")
(match-string 1 cur)))
((string-match "\\`-o\\(.*\\)\\'" cur)
(pcomplete-here (pcomplete-dirs-or-entries "\\.[Oo][Bb][Jj]\\'")
(match-string 1 cur)))
(t
(pcomplete-opt "3456ABCDEHIKLMNOPRSTUVXabcdefgijklnoptuvwxyz"))))
(while (pcomplete-here
(pcomplete-dirs-or-entries "\\.[iCc]\\([Pp][Pp]\\)?\\'"))))
(defalias 'pcomplete/bcc 'pcomplete/bcc32)
;;; Code:
;;; em-xtra.el ends here

383
lisp/eshell/esh-arg.el Normal file
View File

@ -0,0 +1,383 @@
;;; esh-arg --- argument processing
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'esh-arg)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-arg nil
"Argument parsing involves transforming the arguments passed on the
command line into equivalent Lisp forms that, when evaluated, will
yield the values intended."
:tag "Argument parsing"
:group 'eshell)
;;; Commentary:
;; Parsing of arguments can be extended by adding functions to the
;; hook `eshell-parse-argument-hook'. For a good example of this, see
;; `eshell-parse-drive-letter', defined in eshell-dirs.el.
(defcustom eshell-parse-argument-hook
(list
;; a term such as #<buffer NAME>, or #<process NAME> is a buffer
;; or process reference
'eshell-parse-special-reference
;; numbers convert to numbers if they stand alone
(function
(lambda ()
(when (and (not eshell-current-argument)
(not eshell-current-quoted)
(looking-at eshell-number-regexp)
(eshell-arg-delimiter (match-end 0)))
(goto-char (match-end 0))
(string-to-number (match-string 0)))))
;; parse any non-special characters, based on the current context
(function
(lambda ()
(unless eshell-inside-quote-regexp
(setq eshell-inside-quote-regexp
(format "[^%s]+"
(apply 'string eshell-special-chars-inside-quoting))))
(unless eshell-outside-quote-regexp
(setq eshell-outside-quote-regexp
(format "[^%s]+"
(apply 'string eshell-special-chars-outside-quoting))))
(when (looking-at (if eshell-current-quoted
eshell-inside-quote-regexp
eshell-outside-quote-regexp))
(goto-char (match-end 0))
(let ((str (match-string 0)))
(if str
(set-text-properties 0 (length str) nil str))
str))))
;; whitespace or a comment is an argument delimiter
(function
(lambda ()
(let (comment-p)
(when (or (looking-at "[ \t]+")
(and (not eshell-current-argument)
(looking-at "#\\([^<'].*\\|$\\)")
(setq comment-p t)))
(if comment-p
(add-text-properties (match-beginning 0) (match-end 0)
'(comment t)))
(goto-char (match-end 0))
(eshell-finish-arg)))))
;; backslash before a special character means escape it
'eshell-parse-backslash
;; text beginning with ' is a literally quoted
'eshell-parse-literal-quote
;; text beginning with " is interpolably quoted
'eshell-parse-double-quote
;; argument delimiter
'eshell-parse-delimiter)
"*Define how to process Eshell command line arguments.
When each function on this hook is called, point will be at the
current position within the argument list. The function should either
return nil, meaning that it did no argument parsing, or it should
return the result of the parse as a sexp. It is also responsible for
moving the point forward to reflect the amount of input text that was
parsed.
If no function handles the current character at point, it will be
treated as a literal character."
:type 'hook
:group 'eshell-arg)
;;; Code:
;;; User Variables:
(defcustom eshell-arg-load-hook '(eshell-arg-initialize)
"*A hook that gets run when `eshell-arg' is loaded."
:type 'hook
:group 'eshell-arg)
(defcustom eshell-delimiter-argument-list '(?\; ?& ?\| ?\> ? ?\t ?\n)
"List of characters to recognize as argument separators."
:type '(repeat character)
:group 'eshell-arg)
(defcustom eshell-special-chars-inside-quoting '(?\\ ?\")
"*Characters which are still special inside double quotes."
:type '(repeat character)
:group 'eshell-arg)
(defcustom eshell-special-chars-outside-quoting
(append eshell-delimiter-argument-list '(?# ?! ?\\ ?\" ?\'))
"*Characters that require escaping outside of double quotes.
Without escaping them, they will introduce a change in the argument."
:type '(repeat character)
:group 'eshell-arg)
;;; Internal Variables:
(defvar eshell-current-argument nil)
(defvar eshell-current-modifiers nil)
(defvar eshell-arg-listified nil)
(defvar eshell-nested-argument nil)
(defvar eshell-current-quoted nil)
(defvar eshell-inside-quote-regexp nil)
(defvar eshell-outside-quote-regexp nil)
;;; Functions:
(defun eshell-arg-initialize ()
"Initialize the argument parsing code."
(define-key eshell-command-map [(meta ?b)] 'eshell-insert-buffer-name)
(set (make-local-variable 'eshell-inside-quote-regexp) nil)
(set (make-local-variable 'eshell-outside-quote-regexp) nil))
(defun eshell-insert-buffer-name (buffer-name)
"Insert BUFFER-NAME into the current buffer at point."
(interactive "BName of buffer: ")
(insert-and-inherit "#<buffer " buffer-name ">"))
(defsubst eshell-escape-arg (string)
"Return STRING with the `escaped' property on it."
(if (stringp string)
(add-text-properties 0 (length string) '(escaped t) string))
string)
(defun eshell-resolve-current-argument ()
"If there are pending modifications to be made, make them now."
(when eshell-current-argument
(when eshell-arg-listified
(let ((parts eshell-current-argument))
(while parts
(unless (stringp (car parts))
(setcar parts
(list 'eshell-to-flat-string (car parts))))
(setq parts (cdr parts)))
(setq eshell-current-argument
(list 'eshell-convert
(append (list 'concat) eshell-current-argument))))
(setq eshell-arg-listified nil))
(while eshell-current-modifiers
(setq eshell-current-argument
(list (car eshell-current-modifiers) eshell-current-argument)
eshell-current-modifiers (cdr eshell-current-modifiers))))
(setq eshell-current-modifiers nil))
(defun eshell-finish-arg (&optional argument)
"Finish the current argument being processed."
(if argument
(setq eshell-current-argument argument))
(throw 'eshell-arg-done t))
(defsubst eshell-arg-delimiter (&optional pos)
"Return non-nil if POS is an argument delimiter.
If POS is nil, the location of point is checked."
(let ((pos (or pos (point))))
(or (= pos (point-max))
(memq (char-after pos) eshell-delimiter-argument-list))))
;; Argument parsing
(defun eshell-parse-arguments (beg end)
"Parse all of the arguments at point from BEG to END.
Returns the list of arguments in their raw form.
Point is left at the end of the arguments."
(save-excursion
(save-restriction
(goto-char beg)
(narrow-to-region beg end)
(let ((inhibit-point-motion-hooks t)
(args (list t))
after-change-functions
delim)
(remove-text-properties (point-min) (point-max)
'(arg-begin nil arg-end nil))
(if (setq
delim
(catch 'eshell-incomplete
(while (not (eobp))
(let* ((here (point))
(arg (eshell-parse-argument)))
(if (= (point) here)
(error "Failed to parse argument '%s'"
(buffer-substring here (point-max))))
(and arg (nconc args (list arg)))))))
(if (listp delim)
(throw 'eshell-incomplete delim)
(throw 'eshell-incomplete
(list delim (point) (cdr args)))))
(cdr args)))))
(defun eshell-parse-argument ()
"Get the next argument. Leave point after it."
(let* ((outer (null eshell-nested-argument))
(arg-begin (and outer (point)))
(eshell-nested-argument t)
eshell-current-argument
eshell-current-modifiers
eshell-arg-listified)
(catch 'eshell-arg-done
(while (not (eobp))
(let ((result
(or (run-hook-with-args-until-success
'eshell-parse-argument-hook)
(prog1
(char-to-string (char-after))
(forward-char)))))
(if (not eshell-current-argument)
(setq eshell-current-argument result)
(unless eshell-arg-listified
(setq eshell-current-argument
(list eshell-current-argument)
eshell-arg-listified t))
(nconc eshell-current-argument (list result))))))
(when (and outer eshell-current-argument)
(add-text-properties arg-begin (1+ arg-begin)
'(arg-begin t rear-nonsticky
(arg-begin arg-end)))
(add-text-properties (1- (point)) (point)
'(arg-end t rear-nonsticky
(arg-end arg-begin))))
(eshell-resolve-current-argument)
eshell-current-argument))
(defsubst eshell-operator (&rest args)
"A stub function that generates an error if a floating operator is found."
(error "Unhandled operator in input text"))
(defsubst eshell-looking-at-backslash-return (pos)
"Test whether a backslash-return sequence occurs at POS."
(and (eq (char-after pos) ?\\)
(or (= (1+ pos) (point-max))
(and (eq (char-after (1+ pos)) ?\n)
(= (+ pos 2) (point-max))))))
(defun eshell-quote-backslash (string &optional index)
"Intelligently backslash the character occuring in STRING at INDEX.
If the character is itself a backslash, it needs no escaping."
(let ((char (aref string index)))
(if (eq char ?\\)
(char-to-string char)
(if (memq char eshell-special-chars-outside-quoting)
(string ?\\ char)))))
(defun eshell-parse-backslash ()
"Parse a single backslash (\) character, which might mean escape.
It only means escape if the character immediately following is a
special character that is not itself a backslash."
(when (eq (char-after) ?\\)
(if (eshell-looking-at-backslash-return (point))
(throw 'eshell-incomplete ?\\)
(if (and (not (eq (char-after (1+ (point))) ?\\))
(if eshell-current-quoted
(memq (char-after (1+ (point)))
eshell-special-chars-inside-quoting)
(memq (char-after (1+ (point)))
eshell-special-chars-outside-quoting)))
(progn
(forward-char 2)
(list 'eshell-escape-arg
(char-to-string (char-before))))
;; allow \\<RET> to mean a literal "\" character followed by a
;; normal return, rather than a backslash followed by a line
;; continuator (i.e., "\\ + \n" rather than "\ + \\n"). This
;; is necessary because backslashes in Eshell are not special
;; unless they either precede something special, or precede a
;; backslash that precedes something special. (Mainly this is
;; done to make using backslash on Windows systems more
;; natural-feeling).
(if (eshell-looking-at-backslash-return (1+ (point)))
(forward-char))
(forward-char)
"\\"))))
(defun eshell-parse-literal-quote ()
"Parse a literally quoted string. Nothing has special meaning!"
(if (eq (char-after) ?\')
(let ((end (eshell-find-delimiter ?\' ?\')))
(if (not end)
(throw 'eshell-incomplete ?\')
(let ((string (buffer-substring-no-properties (1+ (point)) end)))
(goto-char (1+ end))
(while (string-match "''" string)
(setq string (replace-match "'" t t string)))
(list 'eshell-escape-arg string))))))
(defun eshell-parse-double-quote ()
"Parse a double quoted string, which allows for variable interpolation."
(when (eq (char-after) ?\")
(forward-char)
(let* ((end (eshell-find-delimiter ?\" ?\" nil nil t))
(eshell-current-quoted t))
(if (not end)
(throw 'eshell-incomplete ?\")
(prog1
(save-restriction
(narrow-to-region (point) end)
(list 'eshell-escape-arg
(eshell-parse-argument)))
(goto-char (1+ end)))))))
(defun eshell-parse-special-reference ()
"Parse a special syntax reference, of the form '#<type arg>'."
(if (and (not eshell-current-argument)
(not eshell-current-quoted)
(looking-at "#<\\(buffer\\|process\\)\\s-"))
(let ((here (point)))
(goto-char (match-end 0))
(let* ((buffer-p (string= (match-string 1) "buffer"))
(end (eshell-find-delimiter ?\< ?\>)))
(if (not end)
(throw 'eshell-incomplete ?\<)
(if (eshell-arg-delimiter (1+ end))
(prog1
(list (if buffer-p 'get-buffer-create 'get-process)
(buffer-substring-no-properties (point) end))
(goto-char (1+ end)))
(ignore (goto-char here))))))))
(defun eshell-parse-delimiter ()
"Parse an argument delimiter, which is essentially a command operator."
;; this `eshell-operator' keyword gets parsed out by
;; `eshell-separate-commands'. Right now the only possibility for
;; error is an incorrect output redirection specifier.
(when (looking-at "[&|;\n]\\s-*")
(let ((end (match-end 0)))
(if eshell-current-argument
(eshell-finish-arg)
(eshell-finish-arg
(prog1
(list 'eshell-operator
(cond
((eq (char-after end) ?\&)
(setq end (1+ end)) "&&")
((eq (char-after end) ?\|)
(setq end (1+ end)) "||")
((eq (char-after) ?\n) ";")
(t
(char-to-string (char-after)))))
(goto-char end)))))))
;;; esh-arg.el ends here

311
lisp/eshell/esh-ext.el Normal file
View File

@ -0,0 +1,311 @@
;;; esh-ext --- commands external to Eshell
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'esh-ext)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-ext nil
"External commands are invoked when operating system executables are
loaded into memory, thus beginning a new process."
:tag "External commands"
:group 'eshell)
;;; Commentary:
;; To force a command to invoked external, either provide an explicit
;; pathname for the command argument, or prefix the command name with
;; an asterix character. Example:
;;
;; grep ; make invoke `grep' Lisp function, or `eshell/grep'
;; /bin/grep ; will definitely invoke /bin/grep
;; *grep ; will also invoke /bin/grep
;;; User Variables:
(defcustom eshell-ext-load-hook '(eshell-ext-initialize)
"*A hook that gets run when `eshell-ext' is loaded."
:type 'hook
:group 'eshell-ext)
(defcustom eshell-binary-suffixes
(if (eshell-under-windows-p)
'(".exe" ".com" ".bat" ".cmd" "")
'(""))
"*A list of suffixes used when searching for executable files."
:type '(repeat string)
:group 'eshell-ext)
(defcustom eshell-force-execution nil
"*If non-nil, try to execute binary files regardless of permissions.
This can be useful on systems like Windows, where the operating system
doesn't happen to honor the permission bits in certain cases; or in
cases where you want to associate an interpreter with a particular
kind of script file, but the language won't let you but a '#!'
interpreter line in the file, and you don't want to make it executable
since nothing else but Eshell will be able to understand
`eshell-interpreter-alist'."
:type 'boolean
:group 'eshell-ext)
(defun eshell-search-path (name)
"Search the environment path for NAME."
(if (file-name-absolute-p name)
name
(let ((list (parse-colon-path (getenv "PATH")))
suffixes n1 n2 file)
(while list
(setq n1 (concat (car list) name))
(setq suffixes eshell-binary-suffixes)
(while suffixes
(setq n2 (concat n1 (car suffixes)))
(if (and (or (file-executable-p n2)
(and eshell-force-execution
(file-readable-p n2)))
(not (file-directory-p n2)))
(setq file n2 suffixes nil list nil))
(setq suffixes (cdr suffixes)))
(setq list (cdr list)))
file)))
(defcustom eshell-windows-shell-file
(if (eshell-under-windows-p)
(if (string-match "\\(\\`cmdproxy\\|sh\\)\\.\\(com\\|exe\\)"
shell-file-name)
(or (eshell-search-path "cmd.exe")
(eshell-search-path "command.exe"))
shell-file-name))
"*The name of the shell command to use for DOS/Windows batch files.
This defaults to nil on non-Windows systems, where this variable is
wholly ignored."
:type 'file
:group 'eshell-ext)
(defsubst eshell-invoke-batch-file (&rest args)
"Invoke a .BAT or .CMD file on DOS/Windows systems."
;; since CMD.EXE can't handle forward slashes in the initial
;; argument...
(setcar args (subst-char-in-string directory-sep-char
?\\ (car args)))
(throw 'eshell-replace-command
(eshell-parse-command eshell-windows-shell-file
(cons "/c" args))))
(defcustom eshell-interpreter-alist
(if (eshell-under-windows-p)
'(("\\.\\(bat\\|cmd\\)\\'" . eshell-invoke-batch-file)))
"*An alist defining interpreter substitutions.
Each member is a cons cell of the form:
(MATCH . INTERPRETER)
MATCH should be a regexp, which is matched against the command name,
or a function. If either returns a non-nil value, then INTERPRETER
will be used for that command.
If INTERPRETER is a string, it will be called as the command name,
with the original command name passed as the first argument, with all
subsequent arguments following. If INTERPRETER is a function, it will
be called with all of those arguments. Note that interpreter
functions should throw `eshell-replace-command' with the alternate
command form, or they should return a value compatible with the
possible return values of `eshell-external-command', which see."
:type '(repeat (cons (choice regexp (function :tag "Predicate"))
(choice string (function :tag "Interpreter"))))
:group 'eshell-ext)
(defcustom eshell-alternate-command-hook nil
"*A hook run whenever external command lookup fails.
If a functions wishes to provide an alternate command, they must throw
it using the tag `eshell-replace-command'. This is done because the
substituted command need not be external at all, and therefore must be
passed up to a higher level for re-evaluation.
Or, if the function returns a filename, that filename will be invoked
with the current command arguments rather than the command specified
by the user on the command line."
:type 'hook
:group 'eshell-ext)
(defcustom eshell-command-interpreter-max-length 256
"*The maximum length of any command interpreter string, plus args."
:type 'integer
:group 'eshell-ext)
;;; Functions:
(defun eshell-ext-initialize ()
"Initialize the external command handling code."
(make-local-hook 'eshell-named-command-hook)
(add-hook 'eshell-named-command-hook 'eshell-explicit-command nil t))
(defun eshell-explicit-command (command args)
"If a command name begins with `*', call it externally always.
This bypasses all Lisp functions and aliases."
(when (and (> (length command) 1)
(eq (aref command 0) ?*))
(let ((cmd (eshell-search-path (substring command 1))))
(if cmd
(or (eshell-external-command cmd args)
(error "%s: external command failed" cmd))
(error "%s: external command not found"
(substring command 1))))))
(defun eshell-remote-command (handler command args)
"Insert output from a remote COMMAND, using ARGS.
A remote command is something that executes on a different machine.
An external command simply means external to Emacs.
Note that this function is very crude at the moment. It gathers up
all the output from the remote command, and sends it all at once,
causing the user to wonder if anything's really going on..."
(let ((outbuf (generate-new-buffer " *eshell remote output*"))
(errbuf (generate-new-buffer " *eshell remote error*"))
(exitcode 1))
(unwind-protect
(progn
(setq exitcode
(funcall handler 'shell-command
(mapconcat 'shell-quote-argument
(append (list command) args) " ")
outbuf errbuf))
(eshell-print (save-excursion (set-buffer outbuf)
(buffer-string)))
(eshell-error (save-excursion (set-buffer errbuf)
(buffer-string))))
(eshell-close-handles exitcode 'nil)
(kill-buffer outbuf)
(kill-buffer errbuf))))
(defun eshell-external-command (command args)
"Insert output from an external COMMAND, using ARGS."
(setq args (eshell-stringify-list (eshell-flatten-list args)))
(let ((handler
(unless (or (equal default-directory "/")
(and (eshell-under-windows-p)
(string-match "\\`[A-Za-z]:[/\\\\]\\'"
default-directory)))
(find-file-name-handler default-directory
'shell-command))))
(if handler
(eshell-remote-command handler command args))
(let ((interp (eshell-find-interpreter command)))
(assert interp)
(if (functionp (car interp))
(apply (car interp) (append (cdr interp) args))
(eshell-gather-process-output
(car interp) (append (cdr interp) args))))))
(defun eshell/addpath (&rest args)
"Add a set of paths to PATH."
(eshell-eval-using-options
"addpath" args
'((?b "begin" nil prepend "add path element at beginning")
(?h "help" nil nil "display this usage message")
:usage "[-b] PATH
Adds the given PATH to $PATH.")
(if args
(progn
(if prepend
(setq args (nreverse args)))
(while args
(setenv "PATH"
(if prepend
(concat (car args) path-separator
(getenv "PATH"))
(concat (getenv "PATH") path-separator
(car args))))
(setq args (cdr args))))
(let ((paths (parse-colon-path (getenv "PATH"))))
(while paths
(eshell-printn (car paths))
(setq paths (cdr paths)))))))
(defun eshell-script-interpreter (file)
"Extract the script to run from FILE, if it has #!<interp> in it.
Return nil, or a list of the form:
(INTERPRETER [ARGS] FILE)"
(let ((maxlen eshell-command-interpreter-max-length))
(if (and (file-readable-p file)
(file-regular-p file))
(with-temp-buffer
(insert-file-contents-literally file nil 0 maxlen)
(if (looking-at "#!\\([^ \t\n]+\\)\\([ \t]+\\(.+\\)\\)?")
(if (match-string 3)
(list (match-string 1)
(match-string 3)
file)
(list (match-string 1)
file)))))))
(defun eshell-find-interpreter (file &optional no-examine-p)
"Find the command interpreter with which to execute FILE.
If NO-EXAMINE-P is non-nil, FILE will not be inspected for a script
line of the form #!<interp>."
(let ((finterp
(catch 'found
(ignore
(eshell-for possible eshell-interpreter-alist
(cond
((functionp (car possible))
(and (funcall (car possible) file)
(throw 'found (cdr possible))))
((stringp (car possible))
(and (string-match (car possible) file)
(throw 'found (cdr possible))))
(t
(error "Invalid interpreter-alist test"))))))))
(if finterp ; first check
(list finterp file)
(let ((fullname (if (file-name-directory file) file
(eshell-search-path file)))
(suffixes eshell-binary-suffixes))
(if (and fullname (not (or eshell-force-execution
(file-executable-p fullname))))
(while suffixes
(let ((try (concat fullname (car suffixes))))
(if (or (file-executable-p try)
(and eshell-force-execution
(file-readable-p try)))
(setq fullname try suffixes nil)
(setq suffixes (cdr suffixes))))))
(cond ((not (and fullname (file-exists-p fullname)))
(let ((name (or fullname file)))
(unless (setq fullname
(run-hook-with-args-until-success
'eshell-alternate-command-hook file))
(error "%s: command not found" name))))
((not (or eshell-force-execution
(file-executable-p fullname)))
(error "%s: Permission denied" fullname)))
(let (interp)
(unless no-examine-p
(setq interp (eshell-script-interpreter fullname))
(if interp
(setq interp
(cons (car (eshell-find-interpreter (car interp) t))
(cdr interp)))))
(or interp (list fullname)))))))
;;; Code:
;;; esh-ext.el ends here

135
lisp/eshell/esh-groups.el Normal file
View File

@ -0,0 +1,135 @@
;;; do not modify this file; it is auto-generated
(defgroup eshell-alias nil
"Command aliases allow for easy definition of alternate commands."
:tag "Command aliases"
:link '(info-link "(eshell.info)Command aliases")
:group 'eshell-module)
(defgroup eshell-banner nil
"This sample module displays a welcome banner at login.
It exists so that others wishing to create their own Eshell extension
modules may have a simple template to begin with."
:tag "Login banner"
:link '(info-link "(eshell.info)Login banner")
:group 'eshell-module)
(defgroup eshell-basic nil
"The \"basic\" code provides a set of convenience functions which
are traditionally considered shell builtins. Since all of the
functionality provided by them is accessible through Lisp, they are
not really builtins at all, but offer a command-oriented way to do the
same thing."
:tag "Basic shell commands"
:group 'eshell-module)
(defgroup eshell-cmpl nil
"This module provides a programmable completion function bound to
the TAB key, which allows for completing command names, file names,
variable names, arguments, etc."
:tag "Argument completion"
:group 'eshell-module)
(defgroup eshell-dirs nil
"Directory navigation involves changing directories, examining the
current directory, maintaining a directory stack, and also keeping
track of a history of the last directory locations the user was in.
Emacs does provide standard Lisp definitions of `pwd' and `cd', but
they lack somewhat in feel from the typical shell equivalents."
:tag "Directory navigation"
:group 'eshell-module)
(defgroup eshell-glob nil
"This module provides extended globbing syntax, similar what is used
by zsh for filename generation."
:tag "Extended filename globbing"
:group 'eshell-module)
(defgroup eshell-hist nil
"This module provides command history management."
:tag "History list management"
:group 'eshell-module)
(defgroup eshell-ls nil
"This module implements the \"ls\" utility fully in Lisp. If it is
passed any unrecognized command switches, it will revert to the
operating system's version. This version of \"ls\" uses text
properties to colorize its output based on the setting of
`eshell-ls-use-colors'."
:tag "Implementation of `ls' in Lisp"
:group 'eshell-module)
(defgroup eshell-pred nil
"This module allows for predicates to be applied to globbing
patterns (similar to zsh), in addition to string modifiers which can
be applied either to globbing results, variable references, or just
ordinary strings."
:tag "Value modifiers and predicates"
:group 'eshell-module)
(defgroup eshell-prompt nil
"This module provides command prompts, and navigation between them,
as is common with most shells."
:tag "Command prompts"
:group 'eshell-module)
(defgroup eshell-rebind nil
"This module allows for special keybindings that only take effect
while the point is in a region of input text. By default, it binds
C-a to move to the beginning of the input text (rather than just the
beginning of the line), and C-p and C-n to move through the input
history, C-u kills the current input text, etc. It also, if
`eshell-confine-point-to-input' is non-nil, does not allow certain
commands to cause the point to leave the input area, such as
`backward-word', `previous-line', etc. This module intends to mimic
the behavior of normal shells while the user editing new input text."
:tag "Rebind keys at input"
:group 'eshell-module)
(defgroup eshell-script nil
"This module allows for the execution of files containing Eshell
commands, as a script file."
:tag "Running script files."
:group 'eshell-module)
(defgroup eshell-smart nil
"This module combines the facility of normal, modern shells with
some of the edit/review concepts inherent in the design of Plan 9's
9term. See the docs for more details.
Most likely you will have to turn this option on and play around with
it to get a real sense of how it works."
:tag "Smart display of output"
:link '(info-link "(eshell.info)Smart display of output")
:group 'eshell-module)
(defgroup eshell-term nil
"This module causes visual commands (e.g., 'vi') to be executed by
the `term' package, which comes with Emacs. This package handles most
of the ANSI control codes, allowing curses-based applications to run
within an Emacs window. The variable `eshell-visual-commands' defines
which commands are considered visual in nature."
:tag "Running visual commands"
:group 'eshell-module)
(defgroup eshell-unix nil
"This module defines many of the more common UNIX utilities as
aliases implemented in Lisp. These include mv, ln, cp, rm, etc. If
the user passes arguments which are too complex, or are unrecognized
by the Lisp variant, the external version will be called (if
available). The only reason not to use them would be because they are
usually much slower. But in several cases their tight integration
with Eshell makes them more versatile than their traditional cousins
\(such as being able to use `kill' to kill Eshell background processes
by name)."
:tag "UNIX commands in Lisp"
:group 'eshell-module)
(defgroup eshell-xtra nil
"This module defines some extra alias functions which are entirely
optional. They can be viewed as samples for how to write Eshell alias
functions, or as aliases which make some of Emacs' behavior more
naturally accessible within Emacs."
:tag "Extra alias functions"
:group 'eshell-module)

509
lisp/eshell/esh-io.el Normal file
View File

@ -0,0 +1,509 @@
;;; esh-io --- I/O management
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'esh-io)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-io nil
"Eshell's I/O management code provides a scheme for treating many
different kinds of objects -- symbols, files, buffers, etc. -- as
though they were files."
:tag "I/O management"
:group 'eshell)
;;; Commentary:
;; At the moment, only output redirection is supported in Eshell. To
;; use input redirection, the following syntax will work, assuming
;; that the command after the pipe is always an external command:
;;
;; cat <file> | <command>
;;
;; Otherwise, output redirection and piping are provided in a manner
;; consistent with most shells. Therefore, only unique features are
;; mentioned here.
;;
;;;_* Insertion
;;
;; To insert at the location of point in a buffer, use '>>>':
;;
;; echo alpha >>> #<buffer *scratch*>;
;;
;;;_* Pseudo-devices
;;
;; A few pseudo-devices are provided, since Emacs cannot write
;; directly to a UNIX device file:
;;
;; echo alpha > /dev/null ; the bit bucket
;; echo alpha > /dev/kill ; set the kill ring
;; echo alpha >> /dev/clip ; append to the clipboard
;;
;;;_* Multiple output targets
;;
;; Eshell can write to multiple output targets, including pipes.
;; Example:
;;
;; (+ 1 2) > a > b > c ; prints number to all three files
;; (+ 1 2) > a | wc ; prints to 'a', and pipes to 'wc'
;;; User Variables:
(defcustom eshell-io-load-hook '(eshell-io-initialize)
"*A hook that gets run when `eshell-io' is loaded."
:type 'hook
:group 'eshell-io)
(defcustom eshell-number-of-handles 3
"*The number of file handles that eshell supports.
Currently this is standard input, output and error. But even all of
these Emacs does not currently support with asynchronous processes
\(which is what eshell uses so that you can continue doing work in
other buffers) ."
:type 'integer
:group 'eshell-io)
(defcustom eshell-output-handle 1
"*The index of the standard output handle."
:type 'integer
:group 'eshell-io)
(defcustom eshell-error-handle 2
"*The index of the standard error handle."
:type 'integer
:group 'eshell-io)
(defcustom eshell-buffer-shorthand nil
"*If non-nil, a symbol name can be used for a buffer in redirection.
If nil, redirecting to a buffer requires buffer name syntax. If this
variable is set, redirection directly to Lisp symbols will be
impossible.
Example:
echo hello > '*scratch* ; works if `eshell-buffer-shorthand' is t
echo hello > #<buffer *scratch*> ; always works"
:type 'boolean
:group 'eshell-io)
(defcustom eshell-print-queue-size 5
"*The size of the print queue, for doing buffered printing.
This is basically a speed enhancement, to avoid blocking the Lisp code
from executing while Emacs is redisplaying."
:type 'integer
:group 'eshell-io)
(defcustom eshell-virtual-targets
'(("/dev/eshell" eshell-interactive-print nil)
("/dev/kill" (lambda (mode)
(if (eq mode 'overwrite)
(kill-new ""))
'eshell-kill-append) t)
("/dev/clip" (lambda (mode)
(if (eq mode 'overwrite)
(let ((x-select-enable-clipboard t))
(kill-new "")))
'eshell-clipboard-append) t))
"*Map virtual devices name to Emacs Lisp functions.
If the user specifies any of the filenames above as a redirection
target, the function in the second element will be called.
If the third element is non-nil, the redirection mode is passed as an
argument (which is the symbol `overwrite', `append' or `insert'), and
the function is expected to return another function -- which is the
output function. Otherwise, the second element itself is the output
function.
The output function is then called repeatedly with a single strings,
with represents success pieces of the output of the command, until nil
is passed, meaning EOF.
NOTE: /dev/null is handled specially as a virtual target, and should
not be added to this variable."
:type '(repeat
(list (string :tag "Target")
function
(choice (const :tag "Func returns output-func" t)
(const :tag "Func is output-func" nil))))
:group 'eshell-io)
(put 'eshell-virtual-targets 'risky-local-variable t)
;;; Internal Variables:
(defvar eshell-current-handles nil)
(defvar eshell-last-command-status 0
"The exit code from the last command. 0 if successful.")
(defvar eshell-last-command-result nil
"The result of the last command. Not related to success.")
(defvar eshell-output-file-buffer nil
"If non-nil, the current buffer is a file output buffer.")
(defvar eshell-print-count)
(defvar eshell-current-redirections)
;;; Functions:
(defun eshell-io-initialize ()
"Initialize the I/O subsystem code."
(make-local-hook 'eshell-parse-argument-hook)
(add-hook 'eshell-parse-argument-hook
'eshell-parse-redirection nil t)
(make-local-variable 'eshell-current-redirections)
(make-local-hook 'eshell-pre-rewrite-command-hook)
(add-hook 'eshell-pre-rewrite-command-hook
'eshell-strip-redirections nil t)
(make-local-hook 'eshell-post-rewrite-command-hook)
(add-hook 'eshell-post-rewrite-command-hook
'eshell-apply-redirections nil t))
(defun eshell-parse-redirection ()
"Parse an output redirection, such as '2>'."
(if (and (not eshell-current-quoted)
(looking-at "\\([0-9]\\)?\\(<\\|>+\\)&?\\([0-9]\\)?\\s-*"))
(if eshell-current-argument
(eshell-finish-arg)
(let ((sh (match-string 1))
(oper (match-string 2))
; (th (match-string 3))
)
(if (string= oper "<")
(error "Eshell does not support input redirection"))
(eshell-finish-arg
(prog1
(list 'eshell-set-output-handle
(or (and sh (string-to-int sh)) 1)
(list 'quote
(aref [overwrite append insert]
(1- (length oper)))))
(goto-char (match-end 0))))))))
(defun eshell-strip-redirections (terms)
"Rewrite any output redirections in TERMS."
(setq eshell-current-redirections (list t))
(let ((tl terms)
(tt (cdr terms)))
(while tt
(if (not (and (consp (car tt))
(eq (caar tt) 'eshell-set-output-handle)))
(setq tt (cdr tt)
tl (cdr tl))
(unless (cdr tt)
(error "Missing redirection target"))
(nconc eshell-current-redirections
(list (list 'ignore
(append (car tt) (list (cadr tt))))))
(setcdr tl (cddr tt))
(setq tt (cddr tt))))
(setq eshell-current-redirections
(cdr eshell-current-redirections))))
(defun eshell-apply-redirections (cmdsym)
"Apply any redirection which were specified for COMMAND."
(if eshell-current-redirections
(set cmdsym
(append (list 'progn)
eshell-current-redirections
(list (symbol-value cmdsym))))))
(defun eshell-create-handles
(standard-output output-mode &optional standard-error error-mode)
"Create a new set of file handles for a command.
The default location for standard output and standard error will go to
STANDARD-OUTPUT and STANDARD-ERROR, respectively."
(let ((handles (make-vector eshell-number-of-handles nil))
(output-target (eshell-get-target standard-output output-mode))
(error-target (eshell-get-target standard-error error-mode)))
(aset handles eshell-output-handle (cons output-target 1))
(if standard-error
(aset handles eshell-error-handle (cons error-target 1))
(aset handles eshell-error-handle (cons output-target 1)))
handles))
(defun eshell-protect-handles (handles)
"Protect the handles in HANDLES from a being closed."
(let ((idx 0))
(while (< idx eshell-number-of-handles)
(if (aref handles idx)
(setcdr (aref handles idx)
(1+ (cdr (aref handles idx)))))
(setq idx (1+ idx))))
handles)
(defun eshell-close-target (target status)
"Close an output TARGET, passing STATUS as the result.
STATUS should be non-nil on successful termination of the output."
(cond
((symbolp target) nil)
;; If we were redirecting to a file, save the file and close the
;; buffer.
((markerp target)
(let ((buf (marker-buffer target)))
(when buf ; somebody's already killed it!
(save-current-buffer
(set-buffer buf)
(when eshell-output-file-buffer
(save-buffer)
(when (eq eshell-output-file-buffer t)
(or status (set-buffer-modified-p nil))
(kill-buffer buf)))))))
;; If we're redirecting to a process (via a pipe, or process
;; redirection), send it EOF so that it knows we're finished.
((processp target)
(if (eq (process-status target) 'run)
(process-send-eof target)))
;; A plain function redirection needs no additional arguments
;; passed.
((functionp target)
(funcall target status))
;; But a more complicated function redirection (which can only
;; happen with aliases at the moment) has arguments that need to be
;; passed along with it.
((consp target)
(apply (car target) status (cdr target)))))
(defun eshell-close-handles (exit-code &optional result handles)
"Close all of the current handles, taking refcounts into account.
EXIT-CODE is the process exit code; mainly, it is zero, if the command
completed successfully. RESULT is the quoted value of the last
command. If nil, then the meta variables for keeping track of the
last execution result should not be changed."
(let ((idx 0))
(assert (or (not result) (eq (car result) 'quote)))
(setq eshell-last-command-status exit-code
eshell-last-command-result (cadr result))
(while (< idx eshell-number-of-handles)
(let ((handles (or handles eshell-current-handles)))
(when (aref handles idx)
(setcdr (aref handles idx)
(1- (cdr (aref handles idx))))
(when (= (cdr (aref handles idx)) 0)
(let ((target (car (aref handles idx))))
(if (not (listp target))
(eshell-close-target target (= exit-code 0))
(while target
(eshell-close-target (car target) (= exit-code 0))
(setq target (cdr target)))))
(setcar (aref handles idx) nil))))
(setq idx (1+ idx)))
nil))
(defun eshell-kill-append (string)
"Call `kill-append' with STRING, if it is indeed a string."
(if (stringp string)
(kill-append string nil)))
(defun eshell-clipboard-append (string)
"Call `kill-append' with STRING, if it is indeed a string."
(if (stringp string)
(let ((x-select-enable-clipboard t))
(kill-append string nil))))
(defun eshell-get-target (target &optional mode)
"Convert TARGET, which is a raw argument, into a valid output target.
MODE is either `overwrite', `append' or `insert'."
(setq mode (or mode 'insert))
(cond
((stringp target)
(let ((redir (assoc target eshell-virtual-targets)))
(if redir
(if (nth 2 redir)
(funcall (nth 1 redir) mode)
(nth 1 redir))
(let* ((exists (get-file-buffer target))
(buf (find-file-noselect target t)))
(with-current-buffer buf
(if buffer-read-only
(error "Cannot write to read-only file `%s'" target))
(set (make-local-variable 'eshell-output-file-buffer)
(if (eq exists buf) 0 t))
(cond ((eq mode 'overwrite)
(erase-buffer))
((eq mode 'append)
(goto-char (point-max))))
(point-marker))))))
((or (bufferp target)
(and (boundp 'eshell-buffer-shorthand)
(symbol-value 'eshell-buffer-shorthand)
(symbolp target)))
(let ((buf (if (bufferp target)
target
(get-buffer-create
(symbol-name target)))))
(with-current-buffer buf
(cond ((eq mode 'overwrite)
(erase-buffer))
((eq mode 'append)
(goto-char (point-max))))
(point-marker))))
((functionp target)
nil)
((symbolp target)
(if (eq mode 'overwrite)
(set target nil))
target)
((or (processp target)
(markerp target))
target)
(t
(error "Illegal redirection target: %s"
(eshell-stringify target)))))
(eval-when-compile
(defvar grep-null-device))
(defun eshell-set-output-handle (index mode &optional target)
"Set handle INDEX, using MODE, to point to TARGET."
(when target
(if (and (stringp target)
(or (cond
((boundp 'null-device)
(string= target null-device))
((boundp 'grep-null-device)
(string= target grep-null-device))
(t nil))
(string= target "/dev/null")))
(aset eshell-current-handles index nil)
(let ((where (eshell-get-target target mode))
(current (car (aref eshell-current-handles index))))
(if (and (listp current)
(not (member where current)))
(setq current (append current (list where)))
(setq current (list where)))
(if (not (aref eshell-current-handles index))
(aset eshell-current-handles index (cons nil 1)))
(setcar (aref eshell-current-handles index) current)))))
(defun eshell-interactive-output-p ()
"Return non-nil if current handles are bound for interactive display."
(and (eq (car (aref eshell-current-handles
eshell-output-handle)) t)
(eq (car (aref eshell-current-handles
eshell-error-handle)) t)))
(defvar eshell-print-queue nil)
(defvar eshell-print-queue-count -1)
(defun eshell-flush (&optional reset-p)
"Flush out any lines that have been queued for printing.
Must be called before printing begins with -1 as its argument, and
after all printing is over with no argument."
(ignore
(if reset-p
(setq eshell-print-queue nil
eshell-print-queue-count reset-p)
(if eshell-print-queue
(eshell-print eshell-print-queue))
(eshell-flush 0))))
(defun eshell-init-print-buffer ()
"Initialize the buffered printing queue."
(eshell-flush -1))
(defun eshell-buffered-print (&rest strings)
"A buffered print -- *for strings only*."
(if (< eshell-print-queue-count 0)
(progn
(eshell-print (apply 'concat strings))
(setq eshell-print-queue-count 0))
(if (= eshell-print-queue-count eshell-print-queue-size)
(eshell-flush))
(setq eshell-print-queue
(concat eshell-print-queue (apply 'concat strings))
eshell-print-queue-count (1+ eshell-print-queue-count))))
(defsubst eshell-print (object)
"Output OBJECT to the error handle."
(eshell-output-object object eshell-output-handle))
(defsubst eshell-error (object)
"Output OBJECT to the error handle."
(eshell-output-object object eshell-error-handle))
(defsubst eshell-errorn (object)
"Output OBJECT to the error handle."
(eshell-error object)
(eshell-error "\n"))
(defsubst eshell-printn (object)
"Output OBJECT to the error handle."
(eshell-print object)
(eshell-print "\n"))
(defun eshell-output-object-to-target (object target)
"Insert OBJECT into TARGET.
Returns what was actually sent, or nil if nothing was sent."
(cond
((functionp target)
(funcall target object))
((symbolp target)
(if (eq target t) ; means "print to display"
(eshell-output-filter nil (eshell-stringify object))
(if (not (symbol-value target))
(set target object)
(setq object (eshell-stringify object))
(if (not (stringp (symbol-value target)))
(set target (eshell-stringify
(symbol-value target))))
(set target (concat (symbol-value target) object)))))
((markerp target)
(if (buffer-live-p (marker-buffer target))
(with-current-buffer (marker-buffer target)
(let ((moving (= (point) target)))
(save-excursion
(goto-char target)
(setq object (eshell-stringify object))
(insert-and-inherit object)
(set-marker target (point-marker)))
(if moving
(goto-char target))))))
((processp target)
(when (eq (process-status target) 'run)
(setq object (eshell-stringify object))
(process-send-string target object)))
((consp target)
(apply (car target) object (cdr target))))
object)
(defun eshell-output-object (object &optional handle-index handles)
"Insert OBJECT, using HANDLE-INDEX specifically)."
(let ((target (car (aref (or handles eshell-current-handles)
(or handle-index eshell-output-handle)))))
(if (and target (not (listp target)))
(eshell-output-object-to-target object target)
(while target
(eshell-output-object-to-target object (car target))
(setq target (cdr target))))))
;;; Code:
;;; esh-io.el ends here

142
lisp/eshell/esh-maint.el Normal file
View File

@ -0,0 +1,142 @@
;;; esh-maint --- init code for building eshell
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;; Code:
(provide 'esh-maint)
(and (fboundp 'font-lock-add-keywords)
(font-lock-add-keywords
'emacs-lisp-mode
'(("(eshell-for\\>" . font-lock-keyword-face)
("(eshell-deftest\\>" . font-lock-keyword-face)
("(eshell-condition-case\\>" . font-lock-keyword-face))))
(if (file-directory-p "../pcomplete")
(add-to-list 'load-path "../pcomplete"))
(if (locate-library "pcomplete")
(require 'pcomplete))
(eval-when-compile
(require 'cl)
(setq cl-optimize-speed 9))
;; (defun eshell-generate-autoloads ()
;; (interactive)
;; (require 'autoload)
;; (setq generated-autoload-file
;; (expand-file-name (car command-line-args-left)))
;; (setq command-line-args-left (cdr command-line-args-left))
;; (batch-update-autoloads))
(require 'eshell)
(require 'esh-mode) ; brings in eshell-util
(require 'esh-opt)
(require 'esh-test)
;; (defun eshell-generate-main-menu ()
;; "Create the main menu for the eshell documentation."
;; (insert "@menu
;; * The Emacs shell:: eshell.
;; Core Functionality\n")
;; (eshell-for module
;; (sort (eshell-subgroups 'eshell)
;; (function
;; (lambda (a b)
;; (string-lessp (symbol-name a)
;; (symbol-name b)))))
;; (insert (format "* %-34s"
;; (concat (get module 'custom-tag) "::"))
;; (symbol-name module) ".\n"))
;; (insert "\nOptional Functionality\n")
;; (eshell-for module
;; (sort (eshell-subgroups 'eshell-module)
;; (function
;; (lambda (a b)
;; (string-lessp (symbol-name a)
;; (symbol-name b)))))
;; (insert (format "* %-34s"
;; (concat (get module 'custom-tag) "::"))
;; (symbol-name module) ".\n"))
;; (insert "@end menu\n"))
;; (defun eshell-make-texi ()
;; "Make the eshell.texi file."
;; (interactive)
;; (require 'eshell-auto)
;; (require 'texidoc)
;; (require 'pcomplete)
;; (apply 'texidoc-files 'eshell-generate-main-menu "eshell.doci"
;; (append
;; (list "eshell.el")
;; (sort (mapcar
;; (function
;; (lambda (sym)
;; (let ((name (symbol-name sym)))
;; (if (string-match "\\`eshell-\\(.*\\)" name)
;; (setq name (concat "esh-" (match-string 1 name))))
;; (concat name ".el"))))
;; (eshell-subgroups 'eshell))
;; 'string-lessp)
;; (sort (mapcar
;; (function
;; (lambda (sym)
;; (let ((name (symbol-name sym)))
;; (if (string-match "\\`eshell-\\(.*\\)" name)
;; (setq name (concat "em-" (match-string 1 name))))
;; (concat name ".el"))))
;; (eshell-subgroups 'eshell-module))
;; 'string-lessp)
;; (list "eshell.texi"))))
;; (defun eshell-make-readme ()
;; "Make the README file from eshell.el."
;; (interactive)
;; (require 'eshell-auto)
;; (require 'texidoc)
;; (require 'pcomplete)
;; (texidoc-files nil "eshell.doci" "eshell.el" "README.texi")
;; (set-buffer (get-buffer "README.texi"))
;; (goto-char (point-min))
;; (search-forward "@chapter")
;; (beginning-of-line)
;; (forward-line -1)
;; (kill-line 2)
;; (re-search-forward "^@section User Options")
;; (beginning-of-line)
;; (delete-region (point) (point-max))
;; (insert "@bye\n")
;; (save-buffer)
;; (with-temp-buffer
;; (call-process "makeinfo" nil t nil "--no-headers" "README.texi")
;; (goto-char (point-min))
;; (search-forward "The Emacs Shell")
;; (beginning-of-line)
;; (delete-region (point-min) (point))
;; (write-file "README"))
;; (delete-file "README.texi")
;; (kill-buffer "README.texi"))
;;; esh-maint.el ends here

139
lisp/eshell/esh-module.el Normal file
View File

@ -0,0 +1,139 @@
;;; esh-module --- Eshell modules
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'esh-module)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-module nil
"The `eshell-module' group is for Eshell extension modules, which
provide optional behavior which the user can enable or disable by
customizing the variable `eshell-modules-list'."
:tag "Extension modules"
:group 'eshell)
;;; Commentary:
(require 'esh-util)
(defun eshell-load-defgroups (&optional directory)
"Load `defgroup' statements from Eshell's module files."
(with-current-buffer
(find-file-noselect (expand-file-name "esh-groups.el" directory))
(erase-buffer)
(insert ";;; do not modify this file; it is auto-generated\n\n")
(let ((files (directory-files (or directory
(car command-line-args-left))
nil "\\`em-.*\\.el\\'")))
(while files
(message "Loading defgroup from `%s'" (car files))
(let (defgroup)
(catch 'handled
(with-current-buffer (find-file-noselect (car files))
(goto-char (point-min))
(while t
(forward-sexp)
(if (eobp) (throw 'handled t))
(backward-sexp)
(let ((begin (point))
(defg (looking-at "(defgroup")))
(forward-sexp)
(if defg
(setq defgroup (buffer-substring begin (point))))))))
(if defgroup
(insert defgroup "\n\n")))
(setq files (cdr files))))
(save-buffer)))
;; load the defgroup's for the standard extension modules, so that
;; documentation can be provided when the user customize's
;; `eshell-modules-list'.
(eval-when-compile
(when (equal (file-name-nondirectory byte-compile-current-file)
"esh-module.el")
(let* ((directory (file-name-directory byte-compile-current-file))
(elc-file (expand-file-name "esh-groups.elc" directory)))
(eshell-load-defgroups directory)
(if (file-exists-p elc-file) (delete-file elc-file)))))
(load "esh-groups" t t)
;;; User Variables:
(defcustom eshell-module-unload-hook
'(eshell-unload-extension-modules)
"*A hook run when `eshell-module' is unloaded."
:type 'hook
:group 'eshell-module)
(defcustom eshell-modules-list
'(eshell-alias
eshell-banner
eshell-basic
eshell-cmpl
eshell-dirs
eshell-glob
eshell-hist
eshell-ls
eshell-pred
eshell-prompt
eshell-script
eshell-term
eshell-unix)
"*A list of optional add-on modules to be loaded by Eshell.
Changes will only take effect in future Eshell buffers."
:type (append
(list 'set ':tag "Supported modules")
(mapcar
(function
(lambda (modname)
(let ((modsym (intern modname)))
(list 'const
':tag (format "%s -- %s" modname
(get modsym 'custom-tag))
':link (caar (get modsym 'custom-links))
':doc (concat "\n" (get modsym 'group-documentation)
"\n ")
modsym))))
(sort (mapcar 'symbol-name
(eshell-subgroups 'eshell-module))
'string-lessp))
'((repeat :inline t :tag "Other modules" symbol)))
:group 'eshell-module)
;;; Code:
(defsubst eshell-using-module (module)
"Return non-nil if a certain Eshell MODULE is in use.
The MODULE should be a symbol corresponding to that module's
customization group. Example: `eshell-cmpl' for that module."
(memq module eshell-modules-list))
(defun eshell-unload-extension-modules ()
"Unload any memory resident extension modules."
(eshell-for module (eshell-subgroups 'eshell-module)
(if (featurep module)
(ignore-errors
(message "Unloading %s..." (symbol-name module))
(unload-feature module)
(message "Unloading %s...done" (symbol-name module))))))
;;; esh-module.el ends here

226
lisp/eshell/esh-opt.el Normal file
View File

@ -0,0 +1,226 @@
;;; esh-opt --- command options processing
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'esh-opt)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-opt nil
"The options processing code handles command argument parsing for
Eshell commands implemented in Lisp."
:tag "Command options processing"
:group 'eshell)
;;; Commentary:
;;; User Functions:
(defmacro eshell-eval-using-options (name macro-args
options &rest body-forms)
"Process NAME's MACRO-ARGS using a set of command line OPTIONS.
After doing so, settings will be stored in local symbols as declared
by OPTIONS; FORMS will then be evaluated -- assuming all was OK.
The syntax of OPTIONS is:
'((?C nil nil multi-column \"multi-column display\")
(nil \"help\" nil nil \"show this usage display\")
(?r \"reverse\" nil reverse-list \"reverse order while sorting\")
:external \"ls\"
:usage \"[OPTION]... [FILE]...
List information about the FILEs (the current directory by default).
Sort entries alphabetically across.\")
`eshell-eval-using-options' returns the value of the last form in
BODY-FORMS. If instead an external command is run, the tag
`eshell-external' will be thrown with the new process for its value.
Lastly, any remaining arguments will be available in a locally
interned variable `args' (created using a `let' form)."
`(let ((temp-args
,(if (memq ':preserve-args (cadr options))
macro-args
(list 'eshell-stringify-list
(list 'eshell-flatten-list macro-args)))))
(let ,(append (mapcar (function
(lambda (opt)
(or (and (listp opt) (nth 3 opt))
'eshell-option-stub)))
(cadr options))
'(usage-msg last-value ext-command args))
(eshell-do-opt ,name ,options (quote ,body-forms)))))
;;; Internal Functions:
(eval-when-compile
(defvar temp-args)
(defvar last-value)
(defvar usage-msg)
(defvar ext-command)
(defvar args))
(defun eshell-do-opt (name options body-forms)
"Helper function for `eshell-eval-using-options'.
This code doesn't really need to be macro expanded everywhere."
(setq args temp-args)
(if (setq
ext-command
(catch 'eshell-ext-command
(when (setq
usage-msg
(catch 'eshell-usage
(setq last-value nil)
(if (and (= (length args) 0)
(memq ':show-usage options))
(throw 'eshell-usage
(eshell-show-usage name options)))
(setq args (eshell-process-args name args options)
last-value (eval (append (list 'progn)
body-forms)))
nil))
(error usage-msg))))
(throw 'eshell-external
(eshell-external-command ext-command args))
last-value))
(defun eshell-show-usage (name options)
"Display the usage message for NAME, using OPTIONS."
(let ((usage (format "usage: %s %s\n\n" name
(cadr (memq ':usage options))))
(extcmd (memq ':external options))
(post-usage (memq ':post-usage options))
had-option)
(while options
(when (listp (car options))
(let ((opt (car options)))
(setq had-option t)
(cond ((and (nth 0 opt)
(nth 1 opt))
(setq usage
(concat usage
(format " %-20s %s\n"
(format "-%c, --%s" (nth 0 opt)
(nth 1 opt))
(nth 4 opt)))))
((nth 0 opt)
(setq usage
(concat usage
(format " %-20s %s\n"
(format "-%c" (nth 0 opt))
(nth 4 opt)))))
((nth 1 opt)
(setq usage
(concat usage
(format " %-20s %s\n"
(format " --%s" (nth 1 opt))
(nth 4 opt)))))
(t (setq had-option nil)))))
(setq options (cdr options)))
(if post-usage
(setq usage (concat usage (and had-option "\n")
(cadr post-usage))))
(when extcmd
(setq extcmd (eshell-search-path (cadr extcmd)))
(if extcmd
(setq usage
(concat usage
(format "
This command is implemented in Lisp. If an unrecognized option is
passed to this command, the external version '%s'
will be called instead." extcmd)))))
(throw 'eshell-usage usage)))
(defun eshell-set-option (name ai opt options)
"Using NAME's remaining args (index AI), set the OPT within OPTIONS.
If the option consumes an argument for its value, the argument list
will be modified."
(if (not (nth 3 opt))
(eshell-show-usage name options)
(if (eq (nth 2 opt) t)
(if (> ai (length args))
(error "%s: missing option argument" name)
(set (nth 3 opt) (nth ai args))
(if (> ai 0)
(setcdr (nthcdr (1- ai) args) (nthcdr (1+ ai) args))
(setq args (cdr args))))
(set (nth 3 opt) (or (nth 2 opt) t)))))
(defun eshell-process-option (name switch kind ai options)
"For NAME, process SWITCH (of type KIND), from args at index AI.
The SWITCH will be looked up in the set of OPTIONS.
SWITCH should be either a string or character. KIND should be the
integer 0 if it's a character, or 1 if it's a string.
The SWITCH is then be matched against OPTIONS. If no matching handler
is found, and an :external command is defined (and available), it will
be called; otherwise, an error will be triggered to say that the
switch is unrecognized."
(let* ((opts options)
found)
(while opts
(if (and (listp (car opts))
(nth kind (car opts))
(if (= kind 0)
(eq switch (nth kind (car opts)))
(string= switch (nth kind (car opts)))))
(progn
(eshell-set-option name ai (car opts) options)
(setq found t opts nil))
(setq opts (cdr opts))))
(unless found
(let ((extcmd (memq ':external options)))
(when extcmd
(setq extcmd (eshell-search-path (cadr extcmd)))
(if extcmd
(throw 'eshell-ext-command extcmd)
(if (char-valid-p switch)
(error "%s: unrecognized option -%c" name switch)
(error "%s: unrecognized option --%s" name switch))))))))
(defun eshell-process-args (name args options)
"Process the given ARGS using OPTIONS.
This assumes that symbols have been intern'd by `eshell-with-options'."
(let ((ai 0) arg)
(while (< ai (length args))
(setq arg (nth ai args))
(if (not (and (stringp arg)
(string-match "^-\\(-\\)?\\(.*\\)" arg)))
(setq ai (1+ ai))
(let* ((dash (match-string 1 arg))
(switch (match-string 2 arg)))
(if (= ai 0)
(setq args (cdr args))
(setcdr (nthcdr (1- ai) args) (nthcdr (1+ ai) args)))
(if dash
(if (> (length switch) 0)
(eshell-process-option name switch 1 ai options)
(setq ai (length args)))
(let ((len (length switch))
(index 0))
(while (< index len)
(eshell-process-option name (aref switch index) 0 ai options)
(setq index (1+ index)))))))))
args)
;;; Code:
;;; esh-opt.el ends here

447
lisp/eshell/esh-proc.el Normal file
View File

@ -0,0 +1,447 @@
;;; esh-proc --- process management
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'esh-proc)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-proc nil
"When Eshell invokes external commands, it always does so
asynchronously, so that Emacs isn't tied up waiting for the process to
finish."
:tag "Process management"
:group 'eshell)
;;; Commentary:
;;; User Variables:
(defcustom eshell-proc-load-hook '(eshell-proc-initialize)
"*A hook that gets run when `eshell-proc' is loaded."
:type 'hook
:group 'eshell-proc)
(defcustom eshell-process-wait-seconds 0
"*The number of seconds to delay waiting for a synchronous process."
:type 'integer
:group 'eshell-proc)
(defcustom eshell-process-wait-milliseconds 50
"*The number of milliseconds to delay waiting for a synchronous process."
:type 'integer
:group 'eshell-proc)
(defcustom eshell-done-messages-in-minibuffer t
"*If non-nil, subjob \"Done\" messages will display in minibuffer."
:type 'boolean
:group 'eshell-proc)
(defcustom eshell-delete-exited-processes t
"*If nil, process entries will stick around until `jobs' is run.
This variable sets the buffer-local value of `delete-exited-processes'
in Eshell buffers.
This variable causes Eshell to mimic the behavior of bash when set to
nil. It allows the user to view the exit status of a completed subjob
\(process) at their leisure, because the process entry remains in
memory until the user examines it using \\[list-processes].
Otherwise, if `eshell-done-messages-in-minibuffer' is nil, and this
variable is set to t, the only indication the user will have that a
subjob is done is that it will no longer appear in the
\\[list-processes\\] display.
Note that Eshell will have to be restarted for a change in this
variable's value to take effect."
:type 'boolean
:group 'eshell-proc)
(defcustom eshell-reset-signals
"^\\(interrupt\\|killed\\|quit\\|stopped\\)"
"*If a termination signal matches this regexp, the terminal will be reset."
:type 'regexp
:group 'eshell-proc)
(defcustom eshell-exec-hook nil
"*Called each time a process is exec'd by `eshell-gather-process-output'.
It is passed one argument, which is the process that was just started.
It is useful for things that must be done each time a process is
executed in a eshell mode buffer (e.g., `process-kill-without-query').
In contrast, `eshell-mode-hook' is only executed once when the buffer
is created."
:type 'hook
:group 'eshell-proc)
(defcustom eshell-kill-hook '(eshell-reset-after-proc)
"*Called when a process run by `eshell-gather-process-output' has ended.
It is passed two arguments: the process that was just ended, and the
termination status (as a string). Note that the first argument may be
nil, in which case the user attempted to send a signal, but there was
no relevant process. This can be used for displaying help
information, for example."
:type 'hook
:group 'eshell-proc)
;;; Internal Variables:
(defvar eshell-current-subjob-p nil)
(defvar eshell-process-list nil
"A list of the current status of subprocesses.")
;;; Functions:
(defun eshell-proc-initialize ()
"Initialize the process handling code."
(make-local-variable 'eshell-process-list)
(define-key eshell-command-map [(meta ?i)] 'eshell-insert-process)
(define-key eshell-command-map [(control ?c)] 'eshell-interrupt-process)
(define-key eshell-command-map [(control ?k)] 'eshell-kill-process)
(define-key eshell-command-map [(control ?d)] 'eshell-send-eof-to-process)
(define-key eshell-command-map [(control ?q)] 'eshell-continue-process)
(define-key eshell-command-map [(control ?s)] 'list-processes)
(define-key eshell-command-map [(control ?z)] 'eshell-stop-process)
(define-key eshell-command-map [(control ?\\)] 'eshell-quit-process))
(defun eshell-reset-after-proc (proc status)
"Reset the command input location after a process terminates.
The signals which will cause this to happen are matched by
`eshell-reset-signals'."
(if (string-match eshell-reset-signals status)
(eshell-reset)))
(defun eshell-wait-for-process (&rest procs)
"Wait until PROC has successfully completed."
(while procs
(let ((proc (car procs)))
(when (processp proc)
;; NYI: If the process gets stopped here, that's bad.
(while (assq proc eshell-process-list)
(if (input-pending-p)
(discard-input))
(sit-for eshell-process-wait-seconds
eshell-process-wait-milliseconds))))
(setq procs (cdr procs))))
(defalias 'eshell/wait 'eshell-wait-for-process)
(defun eshell/jobs (&rest args)
"List processes, if there are any."
(and (process-list)
(list-processes)))
(defun eshell/kill (&rest args)
"Kill processes, buffers, symbol or files."
(let ((ptr args)
(signum 'SIGINT))
(while ptr
(if (or (processp (car ptr))
(and (stringp (car ptr))
(string-match "^[A-Za-z/][A-Za-z0-9<>/]+$"
(car ptr))))
;; What about when $lisp-variable is possible here?
;; It could very well name a process.
(setcar ptr (get-process (car ptr))))
(setq ptr (cdr ptr)))
(while args
(let ((id (if (processp (car args))
(process-id (car args))
(car args))))
(when id
(cond
((null id)
(error "kill: bad signal spec"))
((and (numberp id) (= id 0))
(error "kill: bad signal spec `%d'" id))
((and (stringp id)
(string-match "^-?[0-9]+$" id))
(setq signum (abs (string-to-number id))))
((stringp id)
(let (case-fold-search)
(if (string-match "^-\\([A-Z]+\\)$" id)
(setq signum
(intern (concat "SIG" (match-string 1 id))))
(error "kill: bad signal spec `%s'" id))))
((< id 0)
(setq signum (abs id)))
(t
(signal-process id signum)))))
(setq args (cdr args)))
nil))
(defun eshell-read-process-name (prompt)
"Read the name of a process from the minibuffer, using completion.
The prompt will be set to PROMPT."
(completing-read prompt
(mapcar
(function
(lambda (proc)
(cons (process-name proc) t)))
(process-list)) nil t))
(defun eshell-insert-process (process)
"Insert the name of PROCESS into the current buffer at point."
(interactive
(list (get-process
(eshell-read-process-name "Name of process: "))))
(insert-and-inherit "#<process " (process-name process) ">"))
(defsubst eshell-record-process-object (object)
"Record OBJECT as now running."
(if (and (processp object)
eshell-current-subjob-p)
(eshell-interactive-print
(format "[%s] %d\n" (process-name object) (process-id object))))
(setq eshell-process-list
(cons (list object eshell-current-handles
eshell-current-subjob-p nil nil)
eshell-process-list)))
(defun eshell-remove-process-entry (entry)
"Record the process ENTRY as fully completed."
(if (and (processp (car entry))
(nth 2 entry)
eshell-done-messages-in-minibuffer)
(message (format "[%s]+ Done %s" (process-name (car entry))
(process-command (car entry)))))
(setq eshell-process-list
(delq entry eshell-process-list)))
(defun eshell-gather-process-output (command args)
"Gather the output from COMMAND + ARGS."
(unless (and (file-executable-p command)
(file-regular-p command))
(error "%s: not an executable file" command))
(let* ((delete-exited-processes
(if eshell-current-subjob-p
eshell-delete-exited-processes
delete-exited-processes))
(process-environment (eshell-environment-variables))
(proc (apply 'start-process
(file-name-nondirectory command) nil
;; `start-process' can't deal with relative
;; filenames
(append (list (expand-file-name command)) args)))
decoding encoding changed)
(eshell-record-process-object proc)
(set-process-buffer proc (current-buffer))
(if (eshell-interactive-output-p)
(set-process-filter proc 'eshell-output-filter)
(set-process-filter proc 'eshell-insertion-filter))
(set-process-sentinel proc 'eshell-sentinel)
(run-hook-with-args 'eshell-exec-hook proc)
(when (fboundp 'process-coding-system)
(let ((coding-systems (process-coding-system proc)))
(setq decoding (car coding-systems)
encoding (cdr coding-systems)))
;; If start-process decided to use some coding system for
;; decoding data sent from the process and the coding system
;; doesn't specify EOL conversion, we had better convert CRLF
;; to LF.
(if (vectorp (coding-system-eol-type decoding))
(setq decoding (coding-system-change-eol-conversion decoding 'dos)
changed t))
;; Even if start-process left the coding system for encoding
;; data sent from the process undecided, we had better use the
;; same one as what we use for decoding. But, we should
;; suppress EOL conversion.
(if (and decoding (not encoding))
(setq encoding (coding-system-change-eol-conversion decoding 'unix)
changed t))
(if changed
(set-process-coding-system proc decoding encoding)))
proc))
(defun eshell-insertion-filter (proc string)
"Insert a string into the eshell buffer, or a process/file/buffer.
PROC is the process for which we're inserting output. STRING is the
output."
(when (buffer-live-p (process-buffer proc))
(set-buffer (process-buffer proc))
(let ((entry (assq proc eshell-process-list)))
(when entry
(setcar (nthcdr 3 entry)
(concat (nth 3 entry) string))
(unless (nth 4 entry) ; already being handled?
(while (nth 3 entry)
(let ((data (nth 3 entry)))
(setcar (nthcdr 3 entry) nil)
(setcar (nthcdr 4 entry) t)
(eshell-output-object data nil (cadr entry))
(setcar (nthcdr 4 entry) nil))))))))
(defun eshell-sentinel (proc string)
"Generic sentinel for command processes. Reports only signals.
PROC is the process that's exiting. STRING is the exit message."
(when (buffer-live-p (process-buffer proc))
(set-buffer (process-buffer proc))
(unwind-protect
(let* ((entry (assq proc eshell-process-list)))
; (if (not entry)
; (error "Sentinel called for unowned process `%s'"
; (process-name proc))
(when entry
(unwind-protect
(progn
(unless (string= string "run")
(unless (string-match "^\\(finished\\|exited\\)" string)
(eshell-insertion-filter proc string))
(eshell-close-handles (process-exit-status proc) 'nil
(cadr entry))))
(eshell-remove-process-entry entry))))
(run-hook-with-args 'eshell-kill-hook proc string))))
(defun eshell-process-interact (func &optional all query)
"Interact with a process, using PROMPT if more than one, via FUNC.
If ALL is non-nil, background processes will be interacted with as well.
If QUERY is non-nil, query the user with QUERY before calling FUNC."
(let (defunct result)
(eshell-for entry eshell-process-list
(if (and (memq (process-status (car entry))
'(run stop open closed))
(or all
(not (nth 2 entry)))
(or (not query)
(y-or-n-p (format query (process-name (car entry))))))
(setq result (funcall func (car entry))))
(unless (memq (process-status (car entry))
'(run stop open closed))
(setq defunct (cons entry defunct))))
;; clean up the process list; this can get dirty if an error
;; occurred that brought the user into the debugger, and then they
;; quit, so that the sentinel was never called.
(eshell-for d defunct
(eshell-remove-process-entry d))
result))
(defcustom eshell-kill-process-wait-time 5
"*Seconds to wait between sending termination signals to a subprocess."
:type 'integer
:group 'eshell-proc)
(defcustom eshell-kill-process-signals '(SIGINT SIGQUIT SIGKILL)
"*Signals used to kill processes when an Eshell buffer exits.
Eshell calls each of these signals in order when an Eshell buffer is
killed; if the process is still alive afterwards, Eshell waits a
number of seconds defined by `eshell-kill-process-wait-time', and
tries the next signal in the list."
:type '(repeat symbol)
:group 'eshell-proc)
(defcustom eshell-kill-processes-on-exit nil
"*If non-nil, kill active processes when exiting an Eshell buffer.
Emacs will only kill processes owned by that Eshell buffer.
If nil, ownership of background and foreground processes reverts to
Emacs itself, and will die only if the user exits Emacs, calls
`kill-process', or terminates the processes externally.
If `ask', Emacs prompts the user before killing any processes.
If `every', it prompts once for every process.
If t, it kills all buffer-owned processes without asking.
Processes are first sent SIGHUP, then SIGINT, then SIGQUIT, then
SIGKILL. The variable `eshell-kill-process-wait-time' specifies how
long to delay between signals."
:type '(choice (const :tag "Kill all, don't ask" t)
(const :tag "Ask before killing" ask)
(const :tag "Ask for each process" every)
(const :tag "Don't kill subprocesses" nil))
:group 'eshell-proc)
(defun eshell-round-robin-kill (&optional query)
"Kill current process by trying various signals in sequence.
See the variable `eshell-kill-processes-on-exit'."
(let ((sigs eshell-kill-process-signals))
(while sigs
(eshell-process-interact
(function
(lambda (proc)
(signal-process (process-id proc) (car sigs)))) t query)
(setq query nil)
(if (not eshell-process-list)
(setq sigs nil)
(sleep-for eshell-kill-process-wait-time)
(setq sigs (cdr sigs))))))
(defun eshell-query-kill-processes ()
"Kill processes belonging to the current Eshell buffer, possibly w/ query."
(when (and eshell-kill-processes-on-exit
eshell-process-list)
(save-window-excursion
(list-processes)
(if (or (not (eq eshell-kill-processes-on-exit 'ask))
(y-or-n-p (format "Kill processes owned by `%s'? "
(buffer-name))))
(eshell-round-robin-kill
(if (eq eshell-kill-processes-on-exit 'every)
"Kill Eshell child process `%s'? ")))
(let ((buf (get-buffer "*Process List*")))
(if (and buf (buffer-live-p buf))
(kill-buffer buf)))
(message nil))))
(custom-add-option 'eshell-exit-hook 'eshell-query-kill-processes)
(defun eshell-interrupt-process ()
"Interrupt a process."
(interactive)
(unless (eshell-process-interact 'interrupt-process)
(run-hook-with-args 'eshell-kill-hook nil "interrupt")))
(defun eshell-kill-process ()
"Kill a process."
(interactive)
(unless (eshell-process-interact 'kill-process)
(run-hook-with-args 'eshell-kill-hook nil "killed")))
(defun eshell-quit-process ()
"Send quit signal to process."
(interactive)
(unless (eshell-process-interact 'quit-process)
(run-hook-with-args 'eshell-kill-hook nil "quit")))
(defun eshell-stop-process ()
"Send STOP signal to process."
(interactive)
(unless (eshell-process-interact 'stop-process)
(run-hook-with-args 'eshell-kill-hook nil "stopped")))
(defun eshell-continue-process ()
"Send CONTINUE signal to process."
(interactive)
(unless (eshell-process-interact 'continue-process)
;; jww (1999-09-17): this signal is not dealt with yet. For
;; example, `eshell-reset' will be called, and so will
;; `eshell-resume-eval'.
(run-hook-with-args 'eshell-kill-hook nil "continue")))
(defun eshell-send-eof-to-process ()
"Send EOF to process."
(interactive)
(eshell-send-input nil nil t)
(eshell-process-interact 'process-send-eof))
;;; Code:
;;; esh-proc.el ends here

242
lisp/eshell/esh-test.el Normal file
View File

@ -0,0 +1,242 @@
;;; esh-test --- Eshell test suite
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'esh-test)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-test nil
"This module is meant to ensure that Eshell is working correctly."
:tag "Eshell test suite"
:group 'eshell)
;;; Commentary:
;; The purpose of this module is to verify that Eshell works as
;; expected. To run it on your system, use the command
;; \\[eshell-test].
;;; Code:
(require 'esh-mode)
;;; User Variables:
(defface eshell-test-ok-face
'((((class color) (background light)) (:foreground "Green" :bold t))
(((class color) (background dark)) (:foreground "Green" :bold t)))
"*The face used to highlight OK result strings."
:group 'eshell-test)
(defface eshell-test-failed-face
'((((class color) (background light)) (:foreground "OrangeRed" :bold t))
(((class color) (background dark)) (:foreground "OrangeRed" :bold t))
(t (:bold t)))
"*The face used to highlight FAILED result strings."
:group 'eshell-test)
(defcustom eshell-show-usage-metrics nil
"*If non-nil, display different usage metrics for each Eshell command."
:set (lambda (symbol value)
(if value
(add-hook 'eshell-mode-hook 'eshell-show-usage-metrics)
(remove-hook 'eshell-mode-hook 'eshell-show-usage-metrics))
(set symbol value))
:type '(choice (const :tag "No metrics" nil)
(const :tag "Cons cells consumed" t)
(const :tag "Time elapsed" 0))
:group 'eshell-test)
;;; Code:
(eval-when-compile
(defvar test-buffer))
(defun eshell-insert-command (text &optional func)
"Insert a command at the end of the buffer."
(goto-char eshell-last-output-end)
(insert-and-inherit text)
(funcall (or func 'eshell-send-input)))
(defun eshell-match-result (regexp)
"Insert a command at the end of the buffer."
(goto-char eshell-last-input-end)
(looking-at regexp))
(defun eshell-command-result-p (text regexp &optional func)
"Insert a command at the end of the buffer."
(eshell-insert-command text func)
(eshell-match-result regexp))
(defvar eshell-test-failures nil)
(defun eshell-run-test (module funcsym label command)
"Test whether FORM evaluates to a non-nil value."
(when (let ((sym (intern-soft (concat "eshell-" (symbol-name module)))))
(or (memq sym (eshell-subgroups 'eshell))
(eshell-using-module sym)))
(with-current-buffer test-buffer
(insert-before-markers
(format "%-70s " (substring label 0 (min 70 (length label)))))
(insert-before-markers " ....")
(eshell-redisplay))
(let ((truth (eval command)))
(with-current-buffer test-buffer
(delete-backward-char 6)
(insert-before-markers
"[" (let (str)
(if truth
(progn
(setq str " OK ")
(put-text-property 0 6 'face
'eshell-test-ok-face str))
(setq str "FAILED")
(setq eshell-test-failures (1+ eshell-test-failures))
(put-text-property 0 6 'face
'eshell-test-failed-face str))
str) "]")
(add-text-properties (line-beginning-position) (point)
(list 'test-func funcsym))
(eshell-redisplay)))))
(defun eshell-test-goto-func ()
"Jump to the function that defines a particular test."
(interactive)
(let ((fsym (get-text-property (point) 'test-func)))
(when fsym
(let* ((def (symbol-function fsym))
(library (locate-library (symbol-file fsym)))
(name (substring (symbol-name fsym)
(length "eshell-test--")))
(inhibit-redisplay t))
(find-file library)
(goto-char (point-min))
(re-search-forward (concat "^(eshell-deftest\\s-+\\w+\\s-+"
name))
(beginning-of-line)))))
(defun eshell-run-one-test (&optional arg)
"Jump to the function that defines a particular test."
(interactive "P")
(let ((fsym (get-text-property (point) 'test-func)))
(when fsym
(beginning-of-line)
(delete-region (point) (line-end-position))
(let ((test-buffer (current-buffer)))
(set-buffer (let ((inhibit-redisplay t))
(save-window-excursion (eshell t))))
(funcall fsym)
(unless arg
(kill-buffer (current-buffer)))))))
;;;###autoload
(defun eshell-test (&optional arg)
"Test Eshell to verify that it works as expected."
(interactive "P")
(let* ((begin (eshell-time-to-seconds (current-time)))
(test-buffer (get-buffer-create "*eshell test*")))
(set-buffer (let ((inhibit-redisplay t))
(save-window-excursion (eshell t))))
(with-current-buffer test-buffer
(erase-buffer)
(setq major-mode 'eshell-test-mode)
(setq mode-name "EShell Test")
(set (make-local-variable 'eshell-test-failures) 0)
(local-set-key [(control ?c) (control ?c)] 'eshell-test-goto-func)
(local-set-key [(control ?c) (control ?r)] 'eshell-run-one-test)
(local-set-key [(control ?m)] 'eshell-test-goto-func)
(local-set-key [return] 'eshell-test-goto-func)
(insert "Testing Eshell under "
(format "GNU Emacs %s (%s%s)"
emacs-version
system-configuration
(cond ((featurep 'motif) ", Motif")
((featurep 'x-toolkit) ", X toolkit")
(t ""))) "\n")
(switch-to-buffer test-buffer)
(delete-other-windows))
(eshell-for funcname
(sort (all-completions "eshell-test--" obarray 'functionp)
'string-lessp)
(with-current-buffer test-buffer
(insert "\n"))
(funcall (intern-soft funcname)))
(with-current-buffer test-buffer
(insert (format "\n\n--- %s --- (completed in %d seconds)\n"
(current-time-string)
(- (eshell-time-to-seconds (current-time))
begin)))
(message "Eshell test suite completed: %s failure%s"
(if (> eshell-test-failures 0)
(number-to-string eshell-test-failures)
"No")
(if (= eshell-test-failures 1) "" "s"))))
(goto-char eshell-last-output-end)
(unless arg
(kill-buffer (current-buffer))))
(defvar eshell-metric-before-command 0)
(defvar eshell-metric-after-command 0)
(defun eshell-show-usage-metrics ()
"If run at Eshell mode startup, metrics are shown after each command."
(set (make-local-variable 'eshell-metric-before-command)
(if (eq eshell-show-usage-metrics t)
0
(current-time)))
(set (make-local-variable 'eshell-metric-after-command)
(if (eq eshell-show-usage-metrics t)
0
(current-time)))
(make-local-hook 'eshell-pre-command-hook)
(add-hook 'eshell-pre-command-hook
(function
(lambda ()
(setq eshell-metric-before-command
(if (eq eshell-show-usage-metrics t)
(car (memory-use-counts))
(current-time))))) nil t)
(make-local-hook 'eshell-post-command-hook)
(add-hook 'eshell-post-command-hook
(function
(lambda ()
(setq eshell-metric-after-command
(if (eq eshell-show-usage-metrics t)
(car (memory-use-counts))
(current-time)))
(eshell-interactive-print
(concat
(int-to-string
(if (eq eshell-show-usage-metrics t)
(- eshell-metric-after-command
eshell-metric-before-command 7)
(- (eshell-time-to-seconds
eshell-metric-after-command)
(eshell-time-to-seconds
eshell-metric-before-command))))
"\n"))))
nil t))
;;; esh-test.el ends here

179
lisp/eshell/esh-toggle.el Normal file
View File

@ -0,0 +1,179 @@
;;; esh-toggle --- toggle to and from the *eshell* buffer
;; Copyright (C) 1997, 1998 Mikael Sjödin (mic@docs.uu.se)
;; Author: Mikael Sjödin <mic@docs.uu.se>
;; John Wiegley <johnw@gnu.org>
;; Created: 19 Nov 1998
;; Version: 2.0
;; Keywords: processes
;; X-URL: http://www.emacs.org/~johnw/eshell.html
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or (at
;; your option) any later version.
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Provides the command eshell-toggle which toggles between the
;; *eshell* buffer and whatever buffer you are editing.
;;
;; This is done in an "intelligent" way. Features are:
;;
;; - Starts a eshell if non is existing.
;;
;; - Minimum distortion of your window configuration.
;;
;; - When done in the eshell-buffer you are returned to the same
;; window configuration you had before you toggled to the eshell.
;;
;; - If you desire, you automagically get a "cd" command in the
;; eshell to the directory where your current buffers file exists;
;; just call eshell-toggle-cd instead of eshell-toggle.
;;
;; - You can convinently choose if you want to have the eshell in
;; another window or in the whole frame. Just invoke eshell-toggle
;; again to get the eshell in the whole frame.
;;
;; This file has been tested under Emacs 20.2.
;;
;; To use, call the functions `eshell-toggle' or `eshell-toggle-cd'.
;; It's most helpful to bind these to a key.
;;; Thanks to:
;; Christian Stern <Christian.Stern@physik.uni-regensburg.de> for
;; helpful sugestions.
;;; User Variables:
(defvar eshell-toggle-goto-eob t
"*If non-nil `eshell-toggle' moves point to end of Eshell buffer.
When `eshell-toggle-cd' is called the point is always moved to the
end of the eshell-buffer")
(defvar eshell-toggle-automatic-cd t
"*If non-nil `eshell-toggle-cd' will send a \"cd\" to Eshell.
If nil `eshell-toggle-cd' will only insert the \"cd\" command in the
eshell-buffer. Leaving it to the user to press RET to send the
command to the eshell.")
;;; User Functions:
;;;###autoload
(defun eshell-toggle-cd ()
"Calls `eshell-toggle' with a prefix argument.
See the command `eshell-toggle'"
(interactive)
(eshell-toggle t))
;;;###autoload
(defun eshell-toggle (make-cd)
"Toggles between the *eshell* buffer and the current buffer.
With a prefix ARG also insert a \"cd DIR\" command into the eshell,
where DIR is the directory of the current buffer.
Call twice in a row to get a full screen window for the *eshell*
buffer.
When called in the *eshell* buffer returns you to the buffer you were
editing before caling the first time.
Options: `eshell-toggle-goto-eob'"
(interactive "P")
;; Try to descide on one of three possibilities:
;; 1. If not in eshell-buffer, switch to it.
;; 2. If in eshell-buffer and called twice in a row, delete other
;; windows
;; 3. If in eshell-buffer and not called twice in a row, return to
;; state before going to the eshell-buffer
(if (eq major-mode 'eshell-mode)
(if (and (or (eq last-command 'eshell-toggle)
(eq last-command 'eshell-toggle-cd))
(not (eq (count-windows) 1)))
(delete-other-windows)
(eshell-toggle-buffer-return-from-eshell))
(eshell-toggle-buffer-goto-eshell make-cd)))
;;; Internal Functions:
(defvar eshell-toggle-pre-eshell-win-conf nil
"Contains window config before the *eshell* buffer was selected")
(defun eshell-toggle-buffer-return-from-eshell ()
"Restores window config used before switching the *eshell* buffer.
If no configuration has been stored, just bury the *eshell* buffer."
(if (window-configuration-p eshell-toggle-pre-eshell-win-conf)
(progn
(set-window-configuration eshell-toggle-pre-eshell-win-conf)
(setq eshell-toggle-pre-eshell-win-conf nil)
(bury-buffer (get-buffer "*eshell*")))
(bury-buffer)))
(defun eshell-toggle-buffer-goto-eshell (make-cd)
"Switches other window to the *eshell* buffer.
If no *eshell* buffer exists start a new eshell and switch to it in
other window. If argument MAKE-CD is non-nil, insert a \"cd DIR\"
command into the eshell, where DIR is the directory of the current
buffer.
Stores the window cofiguration before creating and/or switching window."
(setq eshell-toggle-pre-eshell-win-conf (current-window-configuration))
(let ((eshell-buffer (get-buffer "*eshell*"))
(cd-command
;; Find out which directory we are in (the method differs for
;; different buffers)
(or (and make-cd
(buffer-file-name)
(file-name-directory (buffer-file-name))
(concat "cd " (file-name-directory (buffer-file-name))))
(and make-cd
list-buffers-directory
(concat "cd " list-buffers-directory)))))
;; Switch to an existin eshell if one exists, otherwise switch to
;; another window and start a new eshell
(if eshell-buffer
(switch-to-buffer-other-window eshell-buffer)
(eshell-toggle-buffer-switch-to-other-window)
;; Sometimes an error is generated when I call `eshell' (it has
;; to do with my eshell-mode-hook which inserts text into the
;; newly created eshell-buffer and thats not allways a good
;; idea).
(condition-case the-error
(eshell)
(error (switch-to-buffer "*eshell*"))))
(if (or cd-command eshell-toggle-goto-eob)
(goto-char (point-max)))
(if cd-command
(progn
(insert cd-command)
(if eshell-toggle-automatic-cd
(eshell-send-input))))))
(defun eshell-toggle-buffer-switch-to-other-window ()
"Switches to other window.
If the current window is the only window in the current frame, create
a new window and switch to it. (This is less intrusive to the current
window configuration then `switch-buffer-other-window')"
(let ((this-window (selected-window)))
(other-window 1)
;; If we did not switch window then we only have one window and
;; need to create a new one.
(if (eq this-window (selected-window))
(progn
(split-window-vertically)
(other-window 1)))))
(provide 'esh-toggle)
;;; esh-toggle.el ends here

635
lisp/eshell/esh-var.el Normal file
View File

@ -0,0 +1,635 @@
;;; esh-var --- handling of variables
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'esh-var)
(eval-when-compile (require 'esh-maint))
(defgroup eshell-var nil
"Variable interpolation is introduced whenever the '$' character
appears unquoted in any argument (except when that argument is
surrounded by single quotes) . It may be used to interpolate a
variable value, a subcommand, or even the result of a Lisp form."
:tag "Variable handling"
:group 'eshell)
;;; Commentary:
;; These are the possible variable interpolation syntaxes. Also keep
;; in mind that if an argument looks like a number, it will be
;; converted to a number. This is not significant when invoking
;; external commands, but it's important when calling Lisp functions.
;;
;; $VARIABLE
;;
;; Interval the value of an environment variable, or a Lisp variable
;;
;; $ALSO-VAR
;;
;; "-" is a legal part of a variable name.
;;
;; $<MYVAR>-TOO
;;
;; Only "MYVAR" is part of the variable name in this case.
;;
;; $#VARIABLE
;;
;; Returns the length of the value of VARIABLE. This could also be
;; done using the `length' Lisp function.
;;
;; $(lisp)
;;
;; Returns result of lisp evaluation. Note: Used alone like this, it
;; is identical to just saying (lisp); but with the variable expansion
;; form, the result may be interpolated a larger string, such as
;; '$(lisp)/other'.
;;
;; ${command}
;;
;; Returns the value of an eshell subcommand. See the note above
;; regarding Lisp evaluations.
;;
;; $ANYVAR[10]
;;
;; Return the 10th element of ANYVAR. If ANYVAR's value is a string,
;; it will be split in order to make it a list. The splitting will
;; occur at whitespace.
;;
;; $ANYVAR[: 10]
;;
;; As above, except that splitting occurs at the colon now.
;;
;; $ANYVAR[: 10 20]
;;
;; As above, but instead of returning just a string, it now returns a
;; list of two strings. If the result is being interpolated into a
;; larger string, this list will be flattened into one big string,
;; with each element separated by a space.
;;
;; $ANYVAR["\\\\" 10]
;;
;; Separate on backslash characters. Actually, the first argument --
;; if it doesn't have the form of a number, or a plain variable name
;; -- can be any regular expression. So to split on numbers, use
;; '$ANYVAR["[0-9]+" 10 20]'.
;;
;; $ANYVAR[hello]
;;
;; Calls `assoc' on ANYVAR with 'hello', expecting it to be an alist.
;;
;; $#ANYVAR[hello]
;;
;; Returns the length of the cdr of the element of ANYVAR who car is
;; equal to "hello".
;;
;; There are also a few special variables defined by Eshell. '$$' is
;; the value of the last command (t or nil, in the case of an external
;; command). This makes it possible to chain results:
;;
;; /tmp $ echo /var/spool/mail/johnw
;; /var/spool/mail/johnw
;; /tmp $ dirname $$
;; /var/spool/mail/
;; /tmp $ cd $$
;; /var/spool/mail $
;;
;; '$_' refers to the last argument of the last command. And $?
;; contains the exit code of the last command (0 or 1 for Lisp
;; functions, based on successful completion).
(require 'env)
(require 'ring)
;;; User Variables:
(defcustom eshell-var-load-hook '(eshell-var-initialize)
"*A list of functions to call when loading `eshell-var'."
:type 'hook
:group 'eshell-var)
(defcustom eshell-prefer-lisp-variables nil
"*If non-nil, prefer Lisp variables to environment variables."
:type 'boolean
:group 'eshell-var)
(defcustom eshell-complete-export-definition t
"*If non-nil, completing names for `export' shows current definition."
:type 'boolean
:group 'eshell-var)
(defcustom eshell-variable-name-regexp "[A-Za-z0-9_-]+"
"*A regexp identifying what constitutes a variable name reference.
Note that this only applies for '$NAME'. If the syntax '$<NAME>' is
used, then NAME can contain any character, including angle brackets,
if they are quoted with a backslash."
:type 'regexp
:group 'eshell-var)
(defcustom eshell-variable-aliases-list
'(;; for eshell.el
("COLUMNS" (lambda (indices) (window-width)) t)
("LINES" (lambda (indices) (window-height)) t)
;; for eshell-cmd.el
("_" (lambda (indices)
(if (not indices)
(car (last eshell-last-arguments))
(eshell-apply-indices eshell-last-arguments
indices))))
("?" eshell-last-command-status)
("$" eshell-last-command-result)
("0" eshell-command-name)
("1" (lambda (indices) (nth 0 eshell-command-arguments)))
("2" (lambda (indices) (nth 1 eshell-command-arguments)))
("3" (lambda (indices) (nth 2 eshell-command-arguments)))
("4" (lambda (indices) (nth 3 eshell-command-arguments)))
("5" (lambda (indices) (nth 4 eshell-command-arguments)))
("6" (lambda (indices) (nth 5 eshell-command-arguments)))
("7" (lambda (indices) (nth 6 eshell-command-arguments)))
("8" (lambda (indices) (nth 7 eshell-command-arguments)))
("9" (lambda (indices) (nth 8 eshell-command-arguments)))
("*" (lambda (indices)
(if (not indices)
eshell-command-arguments
(eshell-apply-indices eshell-command-arguments
indices)))))
"*This list provides aliasing for variable references.
It is very similar in concept to what `eshell-user-aliases-list' does
for commands. Each member of this defines defines the name of a
command, and the Lisp value to return for that variable if it is
accessed via the syntax '$NAME'.
If the value is a function, that function will be called with two
arguments: the list of the indices that was used in the reference, and
whether the user is requesting the length of the ultimate element.
For example, a reference of '$NAME[10][20]' would result in the
function for alias `NAME' being called (assuming it were aliased to a
function), and the arguments passed to this function would be the list
'(10 20)', and nil."
:type '(repeat (list string sexp
(choice (const :tag "Copy to environment" t)
(const :tag "Use only in Eshell" nil))))
:group 'eshell-var)
(put 'eshell-variable-aliases-list 'risky-local-variable t)
;;; Functions:
(defun eshell-var-initialize ()
"Initialize the variable handle code."
;; Break the association with our parent's environment. Otherwise,
;; changing a variable will affect all of Emacs.
(set (make-local-variable 'process-environment) (eshell-copy-environment))
(define-key eshell-command-map [(meta ?v)] 'eshell-insert-envvar)
(set (make-local-variable 'eshell-special-chars-inside-quoting)
(append eshell-special-chars-inside-quoting '(?$)))
(set (make-local-variable 'eshell-special-chars-outside-quoting)
(append eshell-special-chars-outside-quoting '(?$)))
(make-local-hook 'eshell-parse-argument-hook)
(add-hook 'eshell-parse-argument-hook 'eshell-interpolate-variable t t)
(make-local-hook 'eshell-prepare-command-hook)
(add-hook 'eshell-prepare-command-hook
'eshell-handle-local-variables nil t)
(when (eshell-using-module 'eshell-cmpl)
(make-local-hook 'pcomplete-try-first-hook)
(add-hook 'pcomplete-try-first-hook
'eshell-complete-variable-reference nil t)
(add-hook 'pcomplete-try-first-hook
'eshell-complete-variable-assignment nil t)))
(defun eshell-handle-local-variables ()
"Allow for the syntax 'VAR=val <command> <args>'."
;; strip off any null commands, which can only happen if a variable
;; evaluates to nil, such as "$var x", where `var' is nil. The
;; command name in that case becomes `x', for compatibility with
;; most regular shells (the difference is that they do an
;; interpolation pass before the argument parsing pass, but Eshell
;; does both at the same time).
(while (and (not eshell-last-command-name)
eshell-last-arguments)
(setq eshell-last-command-name (car eshell-last-arguments)
eshell-last-arguments (cdr eshell-last-arguments)))
(let ((setvar "\\`\\([A-Za-z_][A-Za-z0-9_]*\\)=\\(.*\\)\\'")
(command (eshell-stringify eshell-last-command-name))
(args eshell-last-arguments))
;; local variable settings (such as 'CFLAGS=-O2 make') are handled
;; by making the whole command into a subcommand, and calling
;; setenv immediately before the command is invoked. This means
;; that 'BLAH=x cd blah' won't work exactly as expected, but that
;; is by no means a typical use of local environment variables.
(if (and command (string-match setvar command))
(throw
'eshell-replace-command
(list
'eshell-as-subcommand
(append
(list 'progn)
(let ((l (list t)))
(while (string-match setvar command)
(nconc
l (list
(list 'setenv (match-string 1 command)
(match-string 2 command)
(= (length (match-string 2 command)) 0))))
(setq command (eshell-stringify (car args))
args (cdr args)))
(cdr l))
(list (list 'eshell-named-command
command (list 'quote args)))))))))
(defun eshell-interpolate-variable ()
"Parse a variable interpolation.
This function is explicit for adding to `eshell-parse-argument-hook'."
(when (and (eq (char-after) ?$)
(not (= (1+ (point)) (point-max))))
(forward-char)
(list 'eshell-escape-arg
(eshell-parse-variable))))
(defun eshell/define (var-alias definition)
"Define an VAR-ALIAS using DEFINITION."
(if (not definition)
(setq eshell-variable-aliases-list
(delq (assoc var-alias eshell-variable-aliases-list)
eshell-variable-aliases-list))
(let ((def (assoc var-alias eshell-variable-aliases-list))
(alias-def
(list var-alias
(list 'quote (if (= (length definition) 1)
(car definition)
definition)))))
(if def
(setq eshell-variable-aliases-list
(delq (assoc var-alias eshell-variable-aliases-list)
eshell-variable-aliases-list)))
(setq eshell-variable-aliases-list
(cons alias-def
eshell-variable-aliases-list))))
nil)
(defun eshell/export (&rest sets)
"This alias allows the 'export' command to act as bash users expect."
(while sets
(if (string-match "^\\([^=]+\\)=\\(.*\\)" (car sets))
(setenv (match-string 1 (car sets))
(match-string 2 (car sets))))
(setq sets (cdr sets))))
(defun pcomplete/eshell-mode/export ()
"Completion function for Eshell's `export'."
(while (pcomplete-here
(if eshell-complete-export-definition
process-environment
(eshell-envvar-names)))))
(defun eshell/setq (&rest args)
"Allow command-ish use of `setq'."
(let (last-value)
(while args
(let ((sym (intern (car args)))
(val (cadr args)))
(setq last-value (set sym val)
args (cddr args))))
last-value))
(defun pcomplete/eshell-mode/setq ()
"Completion function for Eshell's `setq'."
(while (and (pcomplete-here (all-completions pcomplete-stub
obarray 'boundp))
(pcomplete-here))))
(defun eshell/env (&rest args)
"Implemention of `env' in Lisp."
(eshell-init-print-buffer)
(eshell-eval-using-options
"env" args
'((?h "help" nil nil "show this usage screen")
:external "env"
:usage "<no arguments>")
(eshell-for setting (sort (eshell-environment-variables)
'string-lessp)
(eshell-buffered-print setting "\n"))
(eshell-flush)))
(defun eshell-insert-envvar (envvar-name)
"Insert ENVVAR-NAME into the current buffer at point."
(interactive
(list (read-envvar-name "Name of environment variable: " t)))
(insert-and-inherit "$" envvar-name))
(defun eshell-envvar-names (&optional environment)
"Return a list of currently visible environment variable names."
(mapcar (function
(lambda (x)
(substring x 0 (string-match "=" x))))
(or environment process-environment)))
(defun eshell-environment-variables ()
"Return a `process-environment', fully updated.
This involves setting any variable aliases which affect the
environment, as specified in `eshell-variable-aliases-list'."
(let ((process-environment (eshell-copy-environment)))
(eshell-for var-alias eshell-variable-aliases-list
(if (nth 2 var-alias)
(setenv (car var-alias)
(eshell-stringify
(or (eshell-get-variable (car var-alias)) "")))))
process-environment))
(defun eshell-parse-variable ()
"Parse the next variable reference at point.
The variable name could refer to either an environment variable, or a
Lisp variable. The priority order depends on the setting of
`eshell-prefer-lisp-variables'.
Its purpose is to call `eshell-parse-variable-ref', and then to
process any indices that come after the variable reference."
(let* ((get-len (when (eq (char-after) ?#)
(forward-char) t))
value indices)
(setq value (eshell-parse-variable-ref)
indices (and (not (eobp))
(eq (char-after) ?\[)
(eshell-parse-indices))
value (list 'let
(list (list 'indices
(list 'quote indices)))
value))
(if get-len
(list 'length value)
value)))
(defun eshell-parse-variable-ref ()
"Eval a variable reference.
Returns a Lisp form which, if evaluated, will return the value of the
variable.
Possible options are:
NAME an environment or Lisp variable value
<LONG-NAME> disambiguates the length of the name
{COMMAND} result of command is variable's value
(LISP-FORM) result of Lisp form is variable's value"
(let (end)
(cond
((eq (char-after) ?{)
(let ((end (eshell-find-delimiter ?\{ ?\})))
(if (not end)
(throw 'eshell-incomplete ?\{)
(prog1
(list 'eshell-convert
(list 'eshell-command-to-value
(list 'eshell-as-subcommand
(eshell-parse-command
(cons (1+ (point)) end)))))
(goto-char (1+ end))))))
((memq (char-after) '(?\' ?\"))
(let ((name (if (eq (char-after) ?\')
(eshell-parse-literal-quote)
(eshell-parse-double-quote))))
(if name
(list 'eshell-get-variable (eval name) 'indices))))
((eq (char-after) ?<)
(let ((end (eshell-find-delimiter ?\< ?\>)))
(if (not end)
(throw 'eshell-incomplete ?\<)
(let* ((temp (make-temp-name temporary-file-directory))
(cmd (concat (buffer-substring (1+ (point)) end)
" > " temp)))
(prog1
(list
'let (list (list 'eshell-current-handles
(list 'eshell-create-handles temp
(list 'quote 'overwrite))))
(list
'progn
(list 'eshell-as-subcommand
(eshell-parse-command cmd))
(list 'ignore
(list 'nconc 'eshell-this-command-hook
(list 'list
(list 'function
(list 'lambda nil
(list 'delete-file temp))))))
(list 'quote temp)))
(goto-char (1+ end)))))))
((eq (char-after) ?\()
(condition-case err
(list 'eshell-command-to-value
(list 'eshell-lisp-command
(list 'quote (read (current-buffer)))))
(end-of-file
(throw 'eshell-incomplete ?\())))
((assoc (char-to-string (char-after))
eshell-variable-aliases-list)
(forward-char)
(list 'eshell-get-variable
(char-to-string (char-before)) 'indices))
((looking-at eshell-variable-name-regexp)
(prog1
(list 'eshell-get-variable (match-string 0) 'indices)
(goto-char (match-end 0))))
(t
(error "Invalid variable reference")))))
(eshell-deftest var interp-cmd
"Interpolate command result"
(eshell-command-result-p "+ ${+ 1 2} 3" "6\n"))
(eshell-deftest var interp-lisp
"Interpolate Lisp form evalution"
(eshell-command-result-p "+ $(+ 1 2) 3" "6\n"))
(eshell-deftest var interp-concat
"Interpolate and concat command"
(eshell-command-result-p "+ ${+ 1 2}3 3" "36\n"))
(eshell-deftest var interp-concat-lisp
"Interpolate and concat Lisp form"
(eshell-command-result-p "+ $(+ 1 2)3 3" "36\n"))
(eshell-deftest var interp-concat2
"Interpolate and concat two commands"
(eshell-command-result-p "+ ${+ 1 2}${+ 1 2} 3" "36\n"))
(eshell-deftest var interp-concat-lisp2
"Interpolate and concat two Lisp forms"
(eshell-command-result-p "+ $(+ 1 2)$(+ 1 2) 3" "36\n"))
(defun eshell-parse-indices ()
"Parse and return a list of list of indices."
(let (indices)
(while (eq (char-after) ?\[)
(let ((end (eshell-find-delimiter ?\[ ?\])))
(if (not end)
(throw 'eshell-incomplete ?\[)
(forward-char)
(let (eshell-glob-function)
(setq indices (cons (eshell-parse-arguments (point) end)
indices)))
(goto-char (1+ end)))))
(nreverse indices)))
(defun eshell-get-variable (name &optional indices)
"Get the value for the variable NAME."
(let* ((alias (assoc name eshell-variable-aliases-list))
(var (if alias
(cadr alias)
name)))
(if (and alias (functionp var))
(funcall var indices)
(eshell-apply-indices
(cond
((stringp var)
(let ((sym (intern-soft var)))
(if (and sym (boundp sym)
(or eshell-prefer-lisp-variables
(not (getenv var))))
(symbol-value sym)
(getenv var))))
((symbolp var)
(symbol-value var))
(t
(error "Unknown variable `%s'" (eshell-stringify var))))
indices))))
(defun eshell-apply-indices (value indices)
"Apply to VALUE all of the given INDICES, returning the sub-result.
The format of INDICES is:
((INT-OR-NAME-OR-OTHER INT-OR-NAME INT-OR-NAME ...)
...)
Each member of INDICES represents a level of nesting. If the first
member of a sublist is not an integer or name, and the value it's
reference is a string, that will be used as the regexp with which is
to divide the string into sub-parts. The default is whitespace.
Otherwise, each INT-OR-NAME refers to an element of the list value.
Integers imply a direct index, and names, an associate lookup using
`assoc'.
For example, to retrieve the second element of a user's record in
'/etc/passwd', the variable reference would look like:
${egrep johnw /etc/passwd}[: 2]"
(while indices
(let ((refs (car indices)))
(when (stringp value)
(let (separator)
(if (not (or (not (stringp (caar indices)))
(string-match
(concat "^" eshell-variable-name-regexp "$")
(caar indices))))
(setq separator (caar indices)
refs (cdr refs)))
(setq value
(mapcar 'eshell-convert
(split-string value separator)))))
(cond
((< (length refs) 0)
(error "Illegal array variable index: %s"
(eshell-stringify refs)))
((= (length refs) 1)
(setq value (eshell-index-value value (car refs))))
(t
(let ((new-value (list t)))
(while refs
(nconc new-value
(list (eshell-index-value value
(car refs))))
(setq refs (cdr refs)))
(setq value (cdr new-value))))))
(setq indices (cdr indices)))
value)
(defun eshell-index-value (value index)
"Reference VALUE using the given INDEX."
(if (stringp index)
(cdr (assoc index value))
(cond
((ring-p value)
(if (> index (ring-length value))
(error "Index exceeds length of ring")
(ring-ref value index)))
((listp value)
(if (> index (length value))
(error "Index exceeds length of list")
(nth index value)))
((vectorp value)
(if (> index (length value))
(error "Index exceeds length of vector")
(aref value index)))
(t
(error "Invalid data type for indexing")))))
;;;_* Variable name completion
(defun eshell-complete-variable-reference ()
"If there is a variable reference, complete it."
(let ((arg (pcomplete-actual-arg)) index)
(when (setq index
(string-match
(concat "\\$\\(" eshell-variable-name-regexp
"\\)?\\'") arg))
(setq pcomplete-stub (substring arg (1+ index)))
(throw 'pcomplete-completions (eshell-variables-list)))))
(defun eshell-variables-list ()
"Generate list of applicable variables."
(let ((argname pcomplete-stub)
completions)
(eshell-for alias eshell-variable-aliases-list
(if (string-match (concat "^" argname) (car alias))
(setq completions (cons (car alias) completions))))
(sort
(append
(mapcar
(function
(lambda (varname)
(let ((value (eshell-get-variable varname)))
(if (and value
(stringp value)
(file-directory-p value))
(concat varname (char-to-string directory-sep-char))
varname))))
(eshell-envvar-names (eshell-environment-variables)))
(all-completions argname obarray 'boundp)
completions)
'string-lessp)))
(defun eshell-complete-variable-assignment ()
"If there is a variable assignment, allow completion of entries."
(let ((arg (pcomplete-actual-arg)) pos)
(when (string-match (concat "\\`" eshell-variable-name-regexp "=") arg)
(setq pos (match-end 0))
(if (string-match "\\(:\\)[^:]*\\'" arg)
(setq pos (match-end 1)))
(setq pcomplete-stub (substring arg pos))
(throw 'pcomplete-completions (pcomplete-entries)))))
;;; Code:
;;; esh-var.el ends here

495
lisp/eshell/eshell.el Normal file
View File

@ -0,0 +1,495 @@
;;; eshell --- the Emacs command shell
;; Copyright (C) 1999, 2000 Free Sofware Foundation
;; Author: John Wiegley <johnw@gnu.org>
;; Keywords: processes
;; X-URL: http://www.emacs.org/~johnw/eshell.html
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
(provide 'eshell)
(eval-when-compile (require 'esh-maint))
(defgroup eshell nil
"Eshell is a command shell implemented entirely in Emacs Lisp. It
invokes no external processes beyond those requested by the user. It
is intended to be a functional replacement for command shells such as
bash, zsh, rc, 4dos; since Emacs itself is capable of handling most of
the tasks accomplished by such tools."
:tag "The Emacs shell"
:link '(info-link "(eshell.info)The Emacs shell")
:group 'applications)
;;; Commentary:
;;;_* What does Eshell offer you?
;;
;; Despite the sheer fact that running an Emacs shell can be fun, here
;; are a few of the unique features offered by Eshell:
;;
;; @ Integration with the Emacs Lisp programming environment
;;
;; @ A high degree of configurability
;;
;; @ The ability to have the same shell on every system Emacs has been
;; ported to. Since Eshell imposes no external requirements, and
;; relies upon only the Lisp functions exposed by Emacs, it is quite
;; operating system independent. Several of the common UNIX
;; commands, such as ls, mv, rm, ln, etc., have been implemented in
;; Lisp in order to provide a more consistent work environment.
;;
;; For those who might be using an older version of Eshell, version
;; 2.1 represents an entirely new, module-based architecture. It
;; supports most of the features offered by modern shells. Here is a
;; brief list of some of its more visible features:
;;
;; @ Command argument completion (tcsh, zsh)
;; @ Input history management (bash)
;; @ Intelligent output scrolling
;; @ Psuedo-devices (such as "/dev/clip" for copying to the clipboard)
;; @ Extended globbing (zsh)
;; @ Argument and globbing predication (zsh)
;; @ I/O redirection to buffers, files, symbols, processes, etc.
;; @ Many niceties otherwise seen only in 4DOS
;; @ Alias functions, both Lisp and Eshell-syntax
;; @ Piping, sequenced commands, background jobs, etc...
;;
;;;_* Eshell is free software
;;
;; Eshell is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Eshell; see the file COPYING. If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.
;;
;;;_* How to begin
;;
;; To start using Eshell, add the following to your .emacs file:
;;
;; (load "eshell-auto")
;;
;; This will define all of the necessary autoloads.
;;
;; Now type `M-x eshell'. See the INSTALL file for full installation
;; instructions.
;;
;;;_* Philosophy
;;
;; A shell is a layer which metaphorically surrounds the kernel, or
;; heart of an operating system. This kernel can be seen as an engine
;; of pure functionality, waiting to serve, while the user programs
;; take advantage of that functionality to accomplish their purpose.
;;
;; The shell's role is to make that functionality accessible to the
;; user in an unformed state. Very roughly, it associates kernel
;; functionality with textual commands, allowing the user to interact
;; with the operating system via linguistic constructs. Process
;; invocation is perhaps the most significant form this takes, using
;; the kernel's `fork' and `exec' functions.
;;
;; Other programs also interact with the functionality of the kernel,
;; but these user applications typically offer a specific range of
;; functionality, and thus are not classed as "shells" proper.
;; (What they lose in quiddity, they gain in rigidity).
;;
;; Emacs is also a user application, but it does make the
;; functionality of the kernel accessible through an interpreted
;; language -- namely, Lisp. For that reason, there is little
;; preventing Emacs from serving the same role as a modern shell. It
;; too can manipulate the kernel in an unpredetermined way to cause
;; system changes. All it's missing is the shell-ish linguistic
;; model.
;;
;; Enter Eshell. Eshell translates "shell-like" syntax into Lisp
;; in order to exercise the kernel in the same manner as typical
;; system shells. There is a fundamental difference here, however,
;; although it may seem subtle at first...
;;
;; Shells like csh and Bourne shell were written several decades ago,
;; in different times, under more restrictive circumstances. This
;; confined perspective shows itself in the paradigm used by nearly
;; all command-line shells since. They are linear in conception, byte
;; stream-based, sequential, and confined to movement within a single
;; host machine.
;;
;; Emacs, on the other hand, is more than just a limited translator
;; that can invoke subprocesses and redirect file handles. It also
;; manages character buffers, windowing frames, network connections,
;; registers, bookmarks, processes, etc. In other words, it's a very
;; multi-dimensional environment, within which eshell emulates a highly
;; linear methodology.
;;
;; Taking a moment, let's look at how this could affect the future of
;; a shell allowed to develop in such a wider field of play:
;;
;; @ There is no reason why directory movement should be linear, and
;; confined to a single file-system. Emacs, through w3 and ange-ftp,
;; has access to the entire Web. Why not allow a user to cd to
;; multiple directories simultaneously, for example? It might make
;; some tasks easier, such as diff'ing files separated by very long
;; pathnames.
;;
;; @ Data sources are available from anywhere Emacs can derive
;; information from: not just from files or the output of other
;; processes.
;;
;; @ Multiple shell invocations all share the same environment -- even
;; the same process list! It would be possible to have "process
;; views", so that one buffer is watching standard output, another
;; standard error, and another the result of standard output grep'd
;; through a regular expression...
;;
;; @ It is not necessary to "leave" the shell, losing all input and
;; output history, environment variables, directory stack, etc.
;; Emacs could save the contents of your eshell environment, and
;; restore all of it (or at least as much as possible) each time you
;; restart. This could occur automatically, without requiring
;; complex initialization scripts.
;;
;; @ Typos occur all of the time; many of them are repeats of common
;; errors, such as 'dri' for `dir'. Since executing non-existent
;; programs is rarely the intention of the user, eshell could prompt
;; for the replacement string, and then record that in a database of
;; known misspellings. (Note: The typo at the beginning of this
;; paragraph wasn't discovered until two months after I wrote the
;; text; it was not intentional).
;;
;; @ Emacs' register and bookmarking facilities can be used for
;; remembering where you've been, and what you've seen -- to varying
;; levels of persistence. They could perhaps even be tied to
;; specific "moments" during eshell execution, which would include
;; the environment at that time, as well as other variables.
;; Although this would require functionality orthogonal to Emacs'
;; own bookmarking facilities, the interface used could be made to
;; operate very similarly.
;;
;; This presents a brief idea of what the fuller dimensionality of an
;; Emacs shell could offer. It's not just the language of a shell
;; that determines how it's used, but also the Weltanschauung
;; underlying its design -- and which is felt behind even the smallest
;; feature. I would hope the freedom provided by using Emacs as a
;; parent environment will invite rich ideas from others. It
;; certainly feels as though all I've done so far is to tie down the
;; horse, so to speak, so that he will run at a man's pace.
;;
;;;_* Influences
;;
;; The author of Eshell has been a long-time user of the following
;; shells, all of which contributed to Eshell's design:
;;
;; @ rc
;; @ bash
;; @ zsh
;; @ sh
;; @ 4nt
;; @ csh
;;;_* User Options
;;
;; The following user options modify the behavior of Eshell overall.
(load "esh-util" nil t)
(defsubst eshell-add-to-window-buffer-names ()
"Add `eshell-buffer-name' to `same-window-buffer-names'."
(add-to-list 'same-window-buffer-names eshell-buffer-name))
(defsubst eshell-remove-from-window-buffer-names ()
"Remove `eshell-buffer-name' from `same-window-buffer-names'."
(setq same-window-buffer-names
(delete eshell-buffer-name same-window-buffer-names)))
(defcustom eshell-load-hook nil
"*A hook run once Eshell has been loaded."
:type 'hook
:group 'eshell)
(defcustom eshell-unload-hook
'(eshell-remove-from-window-buffer-names
eshell-unload-all-modules)
"*A hook run when Eshell is unloaded from memory."
:type 'hook
:group 'eshell)
(defcustom eshell-buffer-name "*eshell*"
"*The basename used for Eshell buffers."
:set (lambda (symbol value)
;; remove the old value of `eshell-buffer-name', if present
(if (boundp 'eshell-buffer-name)
(eshell-remove-from-window-buffer-names))
(set symbol value)
;; add the new value
(eshell-add-to-window-buffer-names)
value)
:type 'string
:group 'eshell)
(eshell-deftest mode same-window-buffer-names
"`eshell-buffer-name' is a member of `same-window-buffer-names'"
(member eshell-buffer-name same-window-buffer-names))
(defcustom eshell-directory-name "~/.eshell/"
"*The directory where Eshell control files should be kept."
:type 'directory
:group 'eshell)
(eshell-deftest mode eshell-directory-exists
"`eshell-directory-name' exists and is writable"
(file-writable-p eshell-directory-name))
(eshell-deftest mode eshell-directory-modes
"`eshell-directory-name' has correct access protections"
(or (eshell-under-windows-p)
(= (file-modes eshell-directory-name)
eshell-private-directory-modes)))
(defcustom eshell-prefer-to-shell nil
"*If non-nil, \\[shell-command] will use Eshell instead of shell-mode."
:set (lambda (symbol value)
;; modifying the global keymap directly is odious, but how
;; else to achieve the takeover?
(if value
(progn
(define-key global-map [(meta ?!)] 'eshell-command)
;;; (define-key global-map [(meta ?|)] 'eshell-command-on-region)
)
(define-key global-map [(meta ?!)] 'shell-command)
;;; (define-key global-map [(meta ?|)] 'shell-command-on-region)
)
(set symbol value))
:type 'boolean
:require 'eshell
:group 'eshell)
;;;_* Running Eshell
;;
;; There are only three commands used to invoke Eshell. The first two
;; are intended for interactive use, while the third is meant for
;; programmers. They are:
;;;###autoload
(defun eshell (&optional arg)
"Create an interactive Eshell buffer.
The buffer used for Eshell sessions is determined by the value of
`eshell-buffer-name'. If there is already an Eshell session active in
that buffer, Emacs will simply switch to it. Otherwise, a new session
will begin. A new session is always created if the the prefix
argument ARG is specified. Returns the buffer selected (or created)."
(interactive "P")
(assert eshell-buffer-name)
(let ((buf (if arg
(generate-new-buffer eshell-buffer-name)
(get-buffer-create eshell-buffer-name))))
;; Simply calling `pop-to-buffer' will not mimic the way that
;; shell-mode buffers appear, since they always reuse the same
;; window that that command was invoked from. To achieve this,
;; it's necessary to add `eshell-buffer-name' to the variable
;; `same-window-buffer-names', which is done when Eshell is loaded
(assert (and buf (buffer-live-p buf)))
(pop-to-buffer buf)
(unless (fboundp 'eshell-mode)
(error "`eshell-auto' must be loaded before Eshell can be used"))
(unless (eq major-mode 'eshell-mode)
(eshell-mode))
(assert (eq major-mode 'eshell-mode))
buf))
(defun eshell-return-exits-minibuffer ()
(define-key eshell-mode-map [(control ?g)] 'abort-recursive-edit)
(define-key eshell-mode-map [return] 'exit-minibuffer)
(define-key eshell-mode-map [(control ?m)] 'exit-minibuffer)
(define-key eshell-mode-map [(control ?j)] 'exit-minibuffer)
(define-key eshell-mode-map [(meta return)] 'exit-minibuffer)
(define-key eshell-mode-map [(meta control ?m)] 'exit-minibuffer))
;;;###autoload
(defun eshell-command (&optional command arg)
"Execute the Eshell command string COMMAND.
With prefix ARG, insert output into the current buffer at point."
(interactive)
(require 'esh-cmd)
(setq arg current-prefix-arg)
(unwind-protect
(let ((eshell-non-interactive-p t))
(add-hook 'minibuffer-setup-hook 'eshell-mode)
(add-hook 'eshell-mode-hook 'eshell-return-exits-minibuffer)
(setq command (read-from-minibuffer "Emacs shell command: ")))
(remove-hook 'eshell-mode-hook 'eshell-return-exits-minibuffer)
(remove-hook 'minibuffer-setup-hook 'eshell-mode))
(unless command
(error "No command specified!"))
;; redirection into the current buffer is achieved by adding an
;; output redirection to the end of the command, of the form
;; 'COMMAND >>> #<buffer BUFFER>'. This will not interfere with
;; other redirections, since multiple redirections merely cause the
;; output to be copied to multiple target locations
(if arg
(setq command
(concat command
(format " >>> #<buffer %s>"
(buffer-name (current-buffer))))))
(save-excursion
(require 'esh-mode)
(let ((buf (set-buffer (generate-new-buffer " *eshell cmd*")))
(eshell-non-interactive-p t))
(eshell-mode)
(let* ((proc (eshell-eval-command
(list 'eshell-commands
(eshell-parse-command command))))
intr
(bufname (if (and proc (listp proc))
"*EShell Async Command Output*"
(setq intr t)
"*EShell Command Output*")))
(if (buffer-live-p (get-buffer bufname))
(kill-buffer bufname))
(rename-buffer bufname)
;; things get a little coarse here, since the desire is to
;; make the output as attractive as possible, with no
;; extraneous newlines
(when intr
(if (eshell-interactive-process)
(eshell-wait-for-process (eshell-interactive-process)))
(assert (not (eshell-interactive-process)))
(goto-char (point-max))
(while (and (bolp) (not (bobp)))
(delete-backward-char 1)))
(assert (and buf (buffer-live-p buf)))
(unless arg
(let ((len (if (not intr) 2
(count-lines (point-min) (point-max)))))
(cond
((= len 0)
(message "(There was no command output)")
(kill-buffer buf))
((= len 1)
(message (buffer-string))
(kill-buffer buf))
(t
(save-selected-window
(select-window (display-buffer buf))
(goto-char (point-min))
;; cause the output buffer to take up as little screen
;; real-estate as possible, if temp buffer resizing is
;; enabled
(and intr temp-buffer-resize-mode
(resize-temp-buffer-window)))))))))))
;;;###autoload
(defun eshell-command-result (command &optional status-var)
"Execute the given Eshell COMMAND, and return the result.
The result might be any Lisp object.
If STATUS-VAR is a symbol, it will be set to the exit status of the
command. This is the only way to determine whether the value returned
corresponding to a successful execution."
;; a null command produces a null, successful result
(if (not command)
(ignore
(if (and status-var (symbolp status-var))
(set status-var 0)))
(with-temp-buffer
(require 'esh-mode)
(let ((eshell-non-interactive-p t))
(eshell-mode)
(let ((result (eshell-do-eval
(list 'eshell-commands
(list 'eshell-command-to-value
(eshell-parse-command command))) t)))
(assert (eq (car result) 'quote))
(if (and status-var (symbolp status-var))
(set status-var eshell-last-command-status))
(cadr result))))))
(eshell-deftest mode simple-command-result
"`eshell-command-result' works with a simple command."
(= (eshell-command-result "+ 1 2") 3))
;;;_* Reporting bugs
;;
;; Since Eshell has not yet been in use by a wide audience, and since
;; the number of possible configurations is quite large, it is certain
;; that many bugs slipped past the rigors of testing it was put
;; through. If you do encounter a bug, on any system, please report
;; it -- in addition to any particular oddities in your configuration
;; -- so that the problem may be corrected for the benefit of others.
(defconst eshell-report-bug-address "johnw@gnu.org"
"E-mail address to send Eshell bug reports to.")
;;;###autoload
(defun eshell-report-bug (topic)
"Report a bug in Eshell.
Prompts for the TOPIC. Leaves you in a mail buffer.
Please include any configuration details that might be involved."
(interactive "sBug Subject: ")
(compose-mail eshell-report-bug-address topic)
(goto-char (point-min))
(re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
(forward-line 1)
(let ((signature (buffer-substring (point) (point-max))))
;; Discourage users from writing non-English text.
(set-buffer-multibyte nil)
(delete-region (point) (point-max))
(insert signature)
(backward-char (length signature)))
(insert "emacs-version: " (emacs-version))
(insert "\n\nThere appears to be a bug in Eshell.\n\n"
"Please describe exactly what actions "
"triggered the bug and the precise\n"
"symptoms of the bug:\n\n")
;; This is so the user has to type something in order to send
;; the report easily.
(use-local-map (nconc (make-sparse-keymap) (current-local-map))))
;;; Code:
(defun eshell-unload-all-modules ()
"Unload all modules that were loaded by Eshell, if possible.
If the user has require'd in any of the modules, or customized a
variable with a :require tag (such as `eshell-prefer-to-shell'), it
will be impossible to unload Eshell completely without restarting
Emacs."
;; if the user set `eshell-prefer-to-shell' to t, but never loaded
;; Eshell, then `eshell-subgroups' will be unbound
(when (fboundp 'eshell-subgroups)
(eshell-for module (eshell-subgroups 'eshell)
;; this really only unloads as many modules as possible,
;; since other `require' references (such as by customizing
;; `eshell-prefer-to-shell' to a non-nil value) might make it
;; impossible to unload Eshell completely
(if (featurep module)
(ignore-errors
(message "Unloading %s..." (symbol-name module))
(unload-feature module)
(message "Unloading %s...done" (symbol-name module)))))
(message "Unloading eshell...done")))
(run-hooks 'eshell-load-hook)
;;; eshell.el ends here

1189
lisp/pcomplete.el Normal file
View File

File diff suppressed because it is too large Load Diff