From affbf6477576c38d98111b55fbb1eb5b13d1a735 Mon Sep 17 00:00:00 2001 From: Gerd Moellmann Date: Fri, 23 Jun 2000 05:24:10 +0000 Subject: [PATCH] *** empty log message *** --- lisp/ChangeLog | 5 + lisp/eshell/em-alias.el | 270 +++++++++ lisp/eshell/em-banner.el | 90 +++ lisp/eshell/em-basic.el | 183 ++++++ lisp/eshell/em-cmpl.el | 443 ++++++++++++++ lisp/eshell/em-dirs.el | 563 ++++++++++++++++++ lisp/eshell/em-glob.el | 357 +++++++++++ lisp/eshell/em-hist.el | 966 ++++++++++++++++++++++++++++++ lisp/eshell/em-ls.el | 863 +++++++++++++++++++++++++++ lisp/eshell/em-pred.el | 602 +++++++++++++++++++ lisp/eshell/em-prompt.el | 174 ++++++ lisp/eshell/em-rebind.el | 248 ++++++++ lisp/eshell/em-script.el | 130 ++++ lisp/eshell/em-smart.el | 305 ++++++++++ lisp/eshell/em-term.el | 266 +++++++++ lisp/eshell/em-unix.el | 927 +++++++++++++++++++++++++++++ lisp/eshell/em-xtra.el | 119 ++++ lisp/eshell/esh-arg.el | 383 ++++++++++++ lisp/eshell/esh-ext.el | 311 ++++++++++ lisp/eshell/esh-groups.el | 135 +++++ lisp/eshell/esh-io.el | 509 ++++++++++++++++ lisp/eshell/esh-maint.el | 142 +++++ lisp/eshell/esh-module.el | 139 +++++ lisp/eshell/esh-opt.el | 226 +++++++ lisp/eshell/esh-proc.el | 447 ++++++++++++++ lisp/eshell/esh-test.el | 242 ++++++++ lisp/eshell/esh-toggle.el | 179 ++++++ lisp/eshell/esh-var.el | 635 ++++++++++++++++++++ lisp/eshell/eshell.el | 495 +++++++++++++++ lisp/pcomplete.el | 1189 +++++++++++++++++++++++++++++++++++++ 30 files changed, 11543 insertions(+) create mode 100644 lisp/eshell/em-alias.el create mode 100644 lisp/eshell/em-banner.el create mode 100644 lisp/eshell/em-basic.el create mode 100644 lisp/eshell/em-cmpl.el create mode 100644 lisp/eshell/em-dirs.el create mode 100644 lisp/eshell/em-glob.el create mode 100644 lisp/eshell/em-hist.el create mode 100644 lisp/eshell/em-ls.el create mode 100644 lisp/eshell/em-pred.el create mode 100644 lisp/eshell/em-prompt.el create mode 100644 lisp/eshell/em-rebind.el create mode 100644 lisp/eshell/em-script.el create mode 100644 lisp/eshell/em-smart.el create mode 100644 lisp/eshell/em-term.el create mode 100644 lisp/eshell/em-unix.el create mode 100644 lisp/eshell/em-xtra.el create mode 100644 lisp/eshell/esh-arg.el create mode 100644 lisp/eshell/esh-ext.el create mode 100644 lisp/eshell/esh-groups.el create mode 100644 lisp/eshell/esh-io.el create mode 100644 lisp/eshell/esh-maint.el create mode 100644 lisp/eshell/esh-module.el create mode 100644 lisp/eshell/esh-opt.el create mode 100644 lisp/eshell/esh-proc.el create mode 100644 lisp/eshell/esh-test.el create mode 100644 lisp/eshell/esh-toggle.el create mode 100644 lisp/eshell/esh-var.el create mode 100644 lisp/eshell/eshell.el create mode 100644 lisp/pcomplete.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 22877bb8335..9816542a339 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,10 @@ 2000-06-23 Gerd Moellmann + * 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. diff --git a/lisp/eshell/em-alias.el b/lisp/eshell/em-alias.el new file mode 100644 index 00000000000..84ab339584f --- /dev/null +++ b/lisp/eshell/em-alias.el @@ -0,0 +1,270 @@ +;;; 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 diff --git a/lisp/eshell/em-banner.el b/lisp/eshell/em-banner.el new file mode 100644 index 00000000000..f56bef25503 --- /dev/null +++ b/lisp/eshell/em-banner.el @@ -0,0 +1,90 @@ +;;; 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 diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el new file mode 100644 index 00000000000..0a7e9a97573 --- /dev/null +++ b/lisp/eshell/em-basic.el @@ -0,0 +1,183 @@ +;;; 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 diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el new file mode 100644 index 00000000000..64f1debca11 --- /dev/null +++ b/lisp/eshell/em-cmpl.el @@ -0,0 +1,443 @@ +;;; 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 +;; 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 +;; is pressed. may be used to cycle in the opposite +;; direction. +;; +;; Glob patterns can also be cycled. For example, entering 'echo +;; x*' 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 will insert all +;; of the matching glob patterns at point. +;; +;; If a Lisp form is being entered, will complete the Lisp +;; symbol name, in exactly the same way that does in Emacs +;; Lisp mode. +;; +;; The list of possible completions can be viewed at any point by +;; pressing . +;; +;; Finally, context-related help can be accessed by pressing . +;; 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 diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el new file mode 100644 index 00000000000..642163cb1bd --- /dev/null +++ b/lisp/eshell/em-dirs.el @@ -0,0 +1,563 @@ +;;; 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 + (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 diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el new file mode 100644 index 00000000000..7bd69d1d932 --- /dev/null +++ b/lisp/eshell/em-glob.el @@ -0,0 +1,357 @@ +;;; 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 | xargs ' 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 diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el new file mode 100644 index 00000000000..5b661bbd748 --- /dev/null +++ b/lisp/eshell/em-hist.el @@ -0,0 +1,966 @@ +;;; 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 ; complete against all possible words in this +;; ; position, by looking at the history list +;; !ls ; 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 and will always go to the next history +element, regardless of any text on the command line. In that case, + and 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 diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el new file mode 100644 index 00000000000..1cea10314ba --- /dev/null +++ b/lisp/eshell/em-ls.el @@ -0,0 +1,863 @@ +;;; 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 diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el new file mode 100644 index 00000000000..f2a5a30733a --- /dev/null +++ b/lisp/eshell/em-pred.el @@ -0,0 +1,602 @@ +;;; 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 diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el new file mode 100644 index 00000000000..5cc37dbc287 --- /dev/null +++ b/lisp/eshell/em-prompt.el @@ -0,0 +1,174 @@ +;;; 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 diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el new file mode 100644 index 00000000000..112cff536e7 --- /dev/null +++ b/lisp/eshell/em-rebind.el @@ -0,0 +1,248 @@ +;;; 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 diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el new file mode 100644 index 00000000000..fd290b2d229 --- /dev/null +++ b/lisp/eshell/em-script.el @@ -0,0 +1,130 @@ +;;; 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 diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el new file mode 100644 index 00000000000..ac2545b728b --- /dev/null +++ b/lisp/eshell/em-smart.el @@ -0,0 +1,305 @@ +;;; 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 diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el new file mode 100644 index 00000000000..2871070c043 --- /dev/null +++ b/lisp/eshell/em-term.el @@ -0,0 +1,266 @@ +;;; 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 to be handled by Emacs key in visual buffers. +See the variable `eshell-visual-commands'. If this variable is set to +nil, 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 diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el new file mode 100644 index 00000000000..365f7931789 --- /dev/null +++ b/lisp/eshell/em-unix.el @@ -0,0 +1,927 @@ +;;; 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 diff --git a/lisp/eshell/em-xtra.el b/lisp/eshell/em-xtra.el new file mode 100644 index 00000000000..9baa46a3e97 --- /dev/null +++ b/lisp/eshell/em-xtra.el @@ -0,0 +1,119 @@ +;;; 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 diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el new file mode 100644 index 00000000000..49fe815abc8 --- /dev/null +++ b/lisp/eshell/esh-arg.el @@ -0,0 +1,383 @@ +;;; 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 #, or # 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 "#")) + +(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 \\ 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 '#'." + (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 diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el new file mode 100644 index 00000000000..51139fb37bd --- /dev/null +++ b/lisp/eshell/esh-ext.el @@ -0,0 +1,311 @@ +;;; 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 #! 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 #!." + (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 diff --git a/lisp/eshell/esh-groups.el b/lisp/eshell/esh-groups.el new file mode 100644 index 00000000000..64348b00b7c --- /dev/null +++ b/lisp/eshell/esh-groups.el @@ -0,0 +1,135 @@ +;;; 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) + diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el new file mode 100644 index 00000000000..04840509fa1 --- /dev/null +++ b/lisp/eshell/esh-io.el @@ -0,0 +1,509 @@ +;;; 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 | +;; +;; 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 >>> #; +;; +;;;_* 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 > # ; 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 diff --git a/lisp/eshell/esh-maint.el b/lisp/eshell/esh-maint.el new file mode 100644 index 00000000000..7c6f33f3e62 --- /dev/null +++ b/lisp/eshell/esh-maint.el @@ -0,0 +1,142 @@ +;;; 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 diff --git a/lisp/eshell/esh-module.el b/lisp/eshell/esh-module.el new file mode 100644 index 00000000000..7de8aecbd73 --- /dev/null +++ b/lisp/eshell/esh-module.el @@ -0,0 +1,139 @@ +;;; 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 diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el new file mode 100644 index 00000000000..9665bc8cc72 --- /dev/null +++ b/lisp/eshell/esh-opt.el @@ -0,0 +1,226 @@ +;;; 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 diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el new file mode 100644 index 00000000000..767d96b10f4 --- /dev/null +++ b/lisp/eshell/esh-proc.el @@ -0,0 +1,447 @@ +;;; 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 "#")) + +(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 diff --git a/lisp/eshell/esh-test.el b/lisp/eshell/esh-test.el new file mode 100644 index 00000000000..64a3a00aae7 --- /dev/null +++ b/lisp/eshell/esh-test.el @@ -0,0 +1,242 @@ +;;; 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 diff --git a/lisp/eshell/esh-toggle.el b/lisp/eshell/esh-toggle.el new file mode 100644 index 00000000000..5027b6dc153 --- /dev/null +++ b/lisp/eshell/esh-toggle.el @@ -0,0 +1,179 @@ +;;; esh-toggle --- toggle to and from the *eshell* buffer + +;; Copyright (C) 1997, 1998 Mikael Sjödin (mic@docs.uu.se) + +;; Author: Mikael Sjödin +;; John Wiegley +;; 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 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 diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el new file mode 100644 index 00000000000..5c74a19c428 --- /dev/null +++ b/lisp/eshell/esh-var.el @@ -0,0 +1,635 @@ +;;; 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. +;; +;; $-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 '$' 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 '." + ;; 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 "") + (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 + 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 diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el new file mode 100644 index 00000000000..9399bc5e407 --- /dev/null +++ b/lisp/eshell/eshell.el @@ -0,0 +1,495 @@ +;;; eshell --- the Emacs command shell + +;; Copyright (C) 1999, 2000 Free Sofware Foundation + +;; Author: John Wiegley +;; 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 >>> #'. 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-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 diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el new file mode 100644 index 00000000000..2b66b1d45b9 --- /dev/null +++ b/lisp/pcomplete.el @@ -0,0 +1,1189 @@ +;;; pcomplete --- programmable completion + +;; Copyright (C) 1999, 2000 Free Sofware Foundation + +;; Author: John Wiegley +;; Keywords: processes +;; X-URL: http://www.emacs.org/~johnw/emacs.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. + +;;; Commentary: + +;; This module provides a programmable completion facility using +;; "completion functions". Each completion function is responsible +;; for producing a list of possible completions relevant to the current +;; argument position. +;; +;; To use pcomplete with shell-mode, for example, you will need the +;; following in your .emacs file: +;; +;; (load "pcmpl-auto") +;; (add-hook 'shell-mode-hook 'pcomplete-shell-setup) +;; +;; Most of the code below simply provides support mechanisms for +;; writing completion functions. Completion functions themselves are +;; very easy to write. They have few requirements beyond those of +;; regular Lisp functions. +;; +;; Consider the following example, which will complete against +;; filenames for the first two arguments, and directories for all +;; remaining arguments: +;; +;; (defun pcomplete/my-command () +;; (pcomplete-here (pcomplete-entries)) +;; (pcomplete-here (pcomplete-entries)) +;; (while (pcomplete-here (pcomplete-dirs)))) +;; +;; Here are the requirements for completion functions: +;; +;; @ They must be called "pcomplete/MAJOR-MODE/NAME", or +;; "pcomplete/NAME". This is how they are looked up, using the NAME +;; specified in the command argument (the argument in first +;; position). +;; +;; @ They must be callable with no arguments. +;; +;; @ Their return value is ignored. If they actually return normally, +;; it means no completions were available. +;; +;; @ In order to provide completions, they must throw the tag +;; `pcomplete-completions'. The value must be the list of possible +;; completions for the final argument. +;; +;; @ To simplify completion function logic, the tag `pcompleted' may +;; be thrown with a value of nil in order to abort the function. It +;; means that there were no completions available. +;; +;; When a completion function is called, the variable `pcomplete-args' +;; is in scope, and contains all of the arguments specified on the +;; command line. The variable `pcomplete-last' is the index of the +;; last argument in that list. +;; +;; The variable `pcomplete-index' is used by the completion code to +;; know which argument the completion function is currently examining. +;; It always begins at 1, meaning the first argument after the command +;; name. +;; +;; To facilitate writing completion logic, a special macro, +;; `pcomplete-here', has been provided which does several things: +;; +;; 1. It will throw `pcompleted' (with a value of nil) whenever +;; `pcomplete-index' exceeds `pcomplete-last'. +;; +;; 2. It will increment `pcomplete-index' if the final argument has +;; not been reached yet. +;; +;; 3. It will evaluate the form passed to it, and throw the result +;; using the `pcomplete-completions' tag, if it is called when +;; `pcomplete-index' is pointing to the final argument. +;; +;; Sometimes a completion function will want to vary the possible +;; completions for an argument based on the previous one. To +;; facilitate tests like this, the function `pcomplete-test' and +;; `pcomplete-match' are provided. Called with one argument, they +;; test the value of the previous command argument. Otherwise, a +;; relative index may be given as an optional second argument, where 0 +;; refers to the current argument, 1 the previous, 2 the one before +;; that, etc. The symbols `first' and `last' specify absolute +;; offsets. +;; +;; Here is an example which will only complete against directories for +;; the second argument if the first argument is also a directory: +;; +;; (defun pcomplete/example () +;; (pcomplete-here (pcomplete-entries)) +;; (if (pcomplete-test 'file-directory-p) +;; (pcomplete-here (pcomplete-dirs)) +;; (pcomplete-here (pcomplete-entries)))) +;; +;; For generating completion lists based on directory contents, see +;; the functions `pcomplete-entries', `pcomplete-dirs', +;; `pcomplete-executables' and `pcomplete-all-entries'. +;; +;; Consult the documentation for `pcomplete-here' for information +;; about its other arguments. + +;;; Code: + +(provide 'pcomplete) + +(defgroup pcomplete nil + "Programmable completion." + :group 'processes) + +;;; User Variables: + +(defcustom pcomplete-file-ignore nil + "*A regexp of filenames to be disregarded during file completion." + :type 'regexp + :group 'pcomplete) + +(defcustom pcomplete-dir-ignore nil + "*A regexp of names to be disregarded during directory completion." + :type 'regexp + :group 'pcomplete) + +(defcustom pcomplete-ignore-case (memq system-type '(ms-dos windows-nt)) + "*If non-nil, ignore case when doing filename completion." + :type 'boolean + :group 'pcomplete) + +(defcustom pcomplete-autolist nil + "*If non-nil, automatically list possibilities on partial completion. +This mirrors the optional behavior of tcsh." + :type 'boolean + :group 'pcomplete) + +(defcustom pcomplete-suffix-list (list directory-sep-char ?:) + "*A list of characters which constitute a proper suffix." + :type '(repeat character) + :group 'pcomplete) + +(defcustom pcomplete-recexact nil + "*If non-nil, use shortest completion if characters cannot be added. +This mirrors the optional behavior of tcsh. + +A non-nil value is useful if `pcomplete-autolist' is non-nil too." + :type 'boolean + :group 'pcomplete) + +(defcustom pcomplete-arg-quote-list nil + "*List of characters to quote when completing an argument." + :type '(choice (repeat character) + (const :tag "Don't quote" nil)) + :group 'pcomplete) + +(defcustom pcomplete-quote-arg-hook nil + "*A hook which is run to quote a character within a filename. +Each function is passed both the filename to be quoted, and the index +to be considered. If the function wishes to provide an alternate +quoted form, it need only return the replacement string. If no +function provides a replacement, quoting shall proceed as normal, +using a backslash to quote any character which is a member of +`pcomplete-arg-quote-list'." + :type 'hook + :group 'pcomplete) + +(defcustom pcomplete-man-function 'man + "*A function to that will be called to display a manual page. +It will be passed the name of the command to document." + :type 'function + :group 'pcomplete) + +(defcustom pcomplete-compare-entry-function 'string-lessp + "*This function is used to order file entries for completion. +The behavior of most all shells is to sort alphabetically." + :type '(radio (function-item string-lessp) + (function-item file-newer-than-file-p) + (function :tag "Other")) + :group 'pcomplete) + +(defcustom pcomplete-help nil + "*A string or function (or nil) used for context-sensitive help. +If a string, it should name an Info node that will be jumped to. +If non-nil, it must a sexp that will be evaluated, and whose +result will be shown in the minibuffer. +If nil, the function `pcomplete-man-function' will be called with the +current command argument." + :type '(choice string sexp (const :tag "Use man page" nil)) + :group 'pcomplete) + +(defcustom pcomplete-expand-before-complete nil + "*If non-nil, expand the current argument before completing it. +This means that typing something such as '$HOME/bi' followed by +\\[pcomplete-argument] will cause the variable reference to be +resolved first, and the resultant value that will be completed against +to be inserted in the buffer. Note that exactly what gets expanded +and how is entirely up to the behavior of the +`pcomplete-parse-arguments-function'." + :type 'boolean + :group 'pcomplete) + +(defcustom pcomplete-parse-arguments-function + 'pcomplete-parse-buffer-arguments + "*A function to call to parse the current line's arguments. +It should be called with no parameters, and with point at the position +of the argument that is to be completed. + +It must either return nil, or a cons cell of the form: + + ((ARG...) (BEG-POS...)) + +The two lists must be identical in length. The first gives the final +value of each command line argument (which need not match the textual +representation of that argument), and BEG-POS gives the beginning +position of each argument, as it is seen by the user. The establishes +a relationship between the fully resolved value of the argument, and +the textual representation of the argument." + :type 'function + :group 'pcomplete) + +(defcustom pcomplete-cycle-completions t + "*If non-nil, hitting the TAB key cycles through the completion list. +Typical Emacs behavior is to complete as much as possible, then pause +waiting for further input. Then if TAB is hit again, show a list of +possible completions. When `pcomplete-cycle-completions' is non-nil, +it acts more like zsh or 4nt, showing the first maximal match first, +followed by any further matches on each subsequent pressing of the TAB +key. \\[pcomplete-list] is the key to press if the user wants to see +the list of possible completions." + :type 'boolean + :group 'pcomplete) + +(defcustom pcomplete-cycle-cutoff-length 5 + "*If the number of completions is greater than this, don't cycle. +This variable is a compromise between the traditional Emacs style of +completion, and the \"cycling\" style. Basically, if there are more +than this number of completions possible, don't automatically pick the +first one and then expect the user to press TAB to cycle through them. +Typically, when there are a large number of completion possibilities, +the user wants to see them in a list buffer so that they can know what +options are available. But if the list is small, it means the user +has already entered enough input to disambiguate most of the +possibilities, and therefore they are probably most interested in +cycling through the candidates. Set this value to nil if you want +cycling to always be enabled." + :type '(choice integer (const :tag "Always cycle" nil)) + :group 'pcomplete) + +(defcustom pcomplete-restore-window-delay 1 + "*The number of seconds to wait before restoring completion windows. +Once the completion window has been displayed, if the user then goes +on to type something else, that completion window will be removed from +the display (actually, the original window configuration before it was +displayed will be restored), after this many seconds of idle time. If +set to nil, completion windows will be left on second until the user +removes them manually. If set to 0, they will disappear immediately +after the user enters a key other than TAB." + :type '(choice integer (const :tag "Never restore" nil)) + :group 'pcomplete) + +(defcustom pcomplete-try-first-hook nil + "*A list of functions which are called before completing an argument. +This can be used, for example, for completing things which might apply +to all arguments, such as variable names after a $." + :type 'hook + :group 'pcomplete) + +(defcustom pcomplete-command-completion-function + (function + (lambda () + (pcomplete-here (pcomplete-executables)))) + "*Function called for completing the initial command argument." + :type 'function + :group 'pcomplete) + +(defcustom pcomplete-command-name-function 'pcomplete-command-name + "*Function called for determining the current command name." + :type 'function + :group 'pcomplete) + +(defcustom pcomplete-default-completion-function + (function + (lambda () + (while (pcomplete-here (pcomplete-entries))))) + "*Function called when no completion rule can be found. +This function is used to generate completions for every argument." + :type 'function + :group 'pcomplete) + +;;; Internal Variables: + +;; for cycling completion support +(defvar pcomplete-current-completions nil) +(defvar pcomplete-last-completion-length) +(defvar pcomplete-last-completion-stub) +(defvar pcomplete-last-completion-raw) +(defvar pcomplete-last-window-config nil) +(defvar pcomplete-window-restore-timer nil) + +(make-variable-buffer-local 'pcomplete-current-completions) +(make-variable-buffer-local 'pcomplete-last-completion-length) +(make-variable-buffer-local 'pcomplete-last-completion-stub) +(make-variable-buffer-local 'pcomplete-last-completion-raw) +(make-variable-buffer-local 'pcomplete-last-window-config) +(make-variable-buffer-local 'pcomplete-window-restore-timer) + +;; used for altering pcomplete's behavior. These global variables +;; should always be nil. +(defvar pcomplete-show-help nil) +(defvar pcomplete-show-list nil) +(defvar pcomplete-expand-only-p nil) + +;;; User Functions: + +;;;###autoload +(defun pcomplete () + "Support extensible programmable completion. +To use this function, just bind the TAB key to it, or add it to your +completion functions list (it should occur fairly early in the list)." + (interactive) + (if (and (interactive-p) + pcomplete-cycle-completions + pcomplete-current-completions + (memq last-command '(pcomplete + pcomplete-expand-and-complete + pcomplete-reverse))) + (progn + (delete-backward-char pcomplete-last-completion-length) + (if (eq this-command 'pcomplete-reverse) + (progn + (setq pcomplete-current-completions + (cons (car (last pcomplete-current-completions)) + pcomplete-current-completions)) + (setcdr (last pcomplete-current-completions 2) nil)) + (nconc pcomplete-current-completions + (list (car pcomplete-current-completions))) + (setq pcomplete-current-completions + (cdr pcomplete-current-completions))) + (pcomplete-insert-entry pcomplete-last-completion-stub + (car pcomplete-current-completions) + nil pcomplete-last-completion-raw)) + (setq pcomplete-current-completions nil + pcomplete-last-completion-raw nil) + (catch 'pcompleted + (let* ((pcomplete-stub) + pcomplete-seen pcomplete-norm-func + pcomplete-args pcomplete-last pcomplete-index + (pcomplete-autolist pcomplete-autolist) + (pcomplete-suffix-list pcomplete-suffix-list) + (completions (pcomplete-completions)) + (result (pcomplete-do-complete pcomplete-stub completions))) + (and result + (not (eq (car result) 'listed)) + (cdr result) + (pcomplete-insert-entry pcomplete-stub (cdr result) + (memq (car result) + '(sole shortest)) + pcomplete-last-completion-raw)))))) + +;;;###autoload +(defun pcomplete-reverse () + "If cycling completion is in use, cycle backwards." + (interactive) + (call-interactively 'pcomplete)) + +;;;###autoload +(defun pcomplete-expand-and-complete () + "Expand the textual value of the current argument. +This will modify the current buffer." + (interactive) + (let ((pcomplete-expand-before-complete t)) + (pcomplete))) + +;;;###autoload +(defun pcomplete-continue () + "Complete without reference to any cycling completions." + (interactive) + (setq pcomplete-current-completions nil + pcomplete-last-completion-raw nil) + (call-interactively 'pcomplete)) + +;;;###autoload +(defun pcomplete-expand () + "Expand the textual value of the current argument. +This will modify the current buffer." + (interactive) + (let ((pcomplete-expand-before-complete t) + (pcomplete-expand-only-p t)) + (pcomplete) + (when (and pcomplete-current-completions + (> (length pcomplete-current-completions) 0)) + (delete-backward-char pcomplete-last-completion-length) + (while pcomplete-current-completions + (unless (pcomplete-insert-entry + "" (car pcomplete-current-completions) t + pcomplete-last-completion-raw) + (insert-and-inherit " ")) + (setq pcomplete-current-completions + (cdr pcomplete-current-completions)))))) + +;;;###autoload +(defun pcomplete-help () + "Display any help information relative to the current argument." + (interactive) + (let ((pcomplete-show-help t)) + (pcomplete))) + +;;;###autoload +(defun pcomplete-list () + "Show the list of possible completions for the current argument." + (interactive) + (when (and pcomplete-cycle-completions + pcomplete-current-completions + (eq last-command 'pcomplete-argument)) + (delete-backward-char pcomplete-last-completion-length) + (setq pcomplete-current-completions nil + pcomplete-last-completion-raw nil)) + (let ((pcomplete-show-list t)) + (pcomplete))) + +;;; Internal Functions: + +;; argument handling + +;; for the sake of the bye-compiler, when compiling other files that +;; contain completion functions +(defvar pcomplete-args nil) +(defvar pcomplete-begins nil) +(defvar pcomplete-last nil) +(defvar pcomplete-index nil) +(defvar pcomplete-stub nil) +(defvar pcomplete-seen nil) +(defvar pcomplete-norm-func nil) + +(defun pcomplete-arg (&optional index offset) + "Return the textual content of the INDEXth argument. +INDEX is based from the current processing position. If INDEX is +positive, values returned are closer to the command argument; if +negative, they are closer to the last argument. If the INDEX is +outside of the argument list, nil is returned. The default value for +INDEX is 0, meaning the current argument being examined. + +The special indices `first' and `last' may be used to access those +parts of the list. + +The OFFSET argument is added to/taken away from the index that will be +used. This is really only useful with `first' and `last', for +accessing absolute argument positions." + (setq index + (if (eq index 'first) + 0 + (if (eq index 'last) + pcomplete-last + (- pcomplete-index (or index 0))))) + (if offset + (setq index (+ index offset))) + (nth index pcomplete-args)) + +(defun pcomplete-begin (&optional index offset) + "Return the beginning position of the INDEXth argument. +See the documentation for `pcomplete-arg'." + (setq index + (if (eq index 'first) + 0 + (if (eq index 'last) + pcomplete-last + (- pcomplete-index (or index 0))))) + (if offset + (setq index (+ index offset))) + (nth index pcomplete-begins)) + +(defsubst pcomplete-actual-arg (&optional index offset) + "Return the actual text representation of the last argument. +This different from `pcomplete-arg', which returns the textual value +that the last argument evaluated to. This function returns what the +user actually typed in." + (buffer-substring (pcomplete-begin index offset) (point))) + +(defsubst pcomplete-next-arg () + "Move the various pointers to the next argument." + (setq pcomplete-index (1+ pcomplete-index) + pcomplete-stub (pcomplete-arg)) + (if (> pcomplete-index pcomplete-last) + (progn + (message "No completions") + (throw 'pcompleted nil)))) + +(defun pcomplete-command-name () + "Return the command name of the first argument." + (file-name-nondirectory (pcomplete-arg 'first))) + +(defun pcomplete-match (regexp &optional index offset start) + "Like `string-match', but on the current completion argument." + (let ((arg (pcomplete-arg (or index 1) offset))) + (if arg + (string-match regexp arg start) + (throw 'pcompleted nil)))) + +(defun pcomplete-match-string (which &optional index offset) + "Like `string-match', but on the current completion argument." + (let ((arg (pcomplete-arg (or index 1) offset))) + (if arg + (match-string which arg) + (throw 'pcompleted nil)))) + +(defalias 'pcomplete-match-beginning 'match-beginning) +(defalias 'pcomplete-match-end 'match-end) + +(defsubst pcomplete--test (pred arg) + "Perform a programmable completion predicate match." + (and pred + (cond ((eq pred t) t) + ((functionp pred) + (funcall pred arg)) + ((stringp pred) + (string-match (concat "^" pred "$") arg))) + pred)) + +(defun pcomplete-test (predicates &optional index offset) + "Predicates to test the current programmable argument with." + (let ((arg (pcomplete-arg (or index 1) offset))) + (unless (null predicates) + (if (not (listp predicates)) + (pcomplete--test predicates arg) + (let ((pred predicates) + found) + (while (and pred (not found)) + (setq found (pcomplete--test (car pred) arg) + pred (cdr pred))) + found))))) + +(defun pcomplete-parse-buffer-arguments () + "Parse whitespace separated arguments in the current region." + (let ((begin (point-min)) + (end (point-max)) + begins args) + (save-excursion + (goto-char begin) + (while (< (point) end) + (skip-chars-forward " \t\n") + (setq begins (cons (point) begins)) + (skip-chars-forward "^ \t\n") + (setq args (cons (buffer-substring-no-properties + (car begins) (point)) + args))) + (cons (reverse args) (reverse begins))))) + +;;;###autoload +(defun pcomplete-comint-setup (completef-sym) + "Setup a comint buffer to use pcomplete. +COMPLETEF-SYM should be the symbol where the +dynamic-complete-functions are kept. For comint mode itself, this is +`comint-dynamic-complete-functions'." + (set (make-local-variable 'pcomplete-parse-arguments-function) + 'pcomplete-parse-comint-arguments) + (make-local-variable completef-sym) + (let ((elem (memq 'comint-dynamic-complete-filename + (symbol-value completef-sym)))) + (if elem + (setcar elem 'pcomplete) + (nconc (symbol-value completef-sym) + (list 'pcomplete))))) + +;;;###autoload +(defun pcomplete-shell-setup () + "Setup shell-mode to use pcomplete." + (pcomplete-comint-setup 'shell-dynamic-complete-functions)) + +(defun pcomplete-parse-comint-arguments () + "Parse whitespace separated arguments in the current region." + (let ((begin (save-excursion (comint-bol nil) (point))) + (end (point)) + begins args) + (save-excursion + (goto-char begin) + (while (< (point) end) + (skip-chars-forward " \t\n") + (setq begins (cons (point) begins)) + (let ((skip t)) + (while skip + (skip-chars-forward "^ \t\n") + (if (eq (char-before) ?\\) + (skip-chars-forward " \t\n") + (setq skip nil)))) + (setq args (cons (buffer-substring-no-properties + (car begins) (point)) + args))) + (cons (reverse args) (reverse begins))))) + +(defun pcomplete-parse-arguments (&optional expand-p) + "Parse the command line arguments. Most completions need this info." + (let ((results (funcall pcomplete-parse-arguments-function))) + (when results + (setq pcomplete-args (or (car results) (list "")) + pcomplete-begins (or (cdr results) (list (point))) + pcomplete-last (1- (length pcomplete-args)) + pcomplete-index 0 + pcomplete-stub (pcomplete-arg 'last)) + (let ((begin (pcomplete-begin 'last))) + (if (and pcomplete-cycle-completions + (listp pcomplete-stub) + (not pcomplete-expand-only-p)) + (let* ((completions pcomplete-stub) + (common-stub (car completions)) + (c completions) + (len (length common-stub))) + (while (and c (> len 0)) + (while (and (> len 0) + (not (string= + (substring common-stub 0 len) + (substring (car c) 0 + (min (length (car c)) + len))))) + (setq len (1- len))) + (setq c (cdr c))) + (setq pcomplete-stub (substring common-stub 0 len) + pcomplete-autolist t) + (when (and begin (not pcomplete-show-list)) + (delete-region begin (point)) + (pcomplete-insert-entry "" pcomplete-stub)) + (throw 'pcomplete-completions completions)) + (when expand-p + (if (stringp pcomplete-stub) + (when begin + (delete-region begin (point)) + (insert-and-inherit pcomplete-stub)) + (if (and (listp pcomplete-stub) + pcomplete-expand-only-p) + ;; this is for the benefit of `pcomplete-expand' + (setq pcomplete-last-completion-length (- (point) begin) + pcomplete-current-completions pcomplete-stub) + (error "Cannot expand argument")))) + (if pcomplete-expand-only-p + (throw 'pcompleted t) + pcomplete-args)))))) + +(defun pcomplete-quote-argument (filename) + "Return FILENAME with magic characters quoted. +Magic characters are those in `pcomplete-arg-quote-list'." + (if (null pcomplete-arg-quote-list) + filename + (let ((len (length filename)) + (index 0) + (result "") + replacement char) + (while (< index len) + (setq replacement (run-hook-with-args-until-success + 'pcomplete-quote-arg-hook filename index)) + (cond + (replacement + (setq result (concat result replacement))) + ((and (setq char (aref filename index)) + (memq char pcomplete-arg-quote-list)) + (setq result (concat result "\\" (char-to-string char)))) + (t + (setq result (concat result (char-to-string char))))) + (setq index (1+ index))) + result))) + +;; file-system completion lists + +(defsubst pcomplete-dirs-or-entries (&optional regexp predicate) + "Return either directories, or qualified entries." + (append (let ((pcomplete-stub pcomplete-stub)) + (pcomplete-entries regexp predicate)) + (pcomplete-entries nil 'file-directory-p))) + +(defun pcomplete-entries (&optional regexp predicate) + "Complete against a list of directory candidates. +This function always uses the last argument as the basis for +completion. +If REGEXP is non-nil, it is a regular expression used to refine the +match (files not matching the REGEXP will be excluded). +If PREDICATE is non-nil, it will also be used to refine the match +\(files for which the PREDICATE returns nil will be excluded). +If PATH is non-nil, it will be used for completion instead of +consulting the last argument." + (let* ((name pcomplete-stub) + (default-directory (expand-file-name + (or (file-name-directory name) + default-directory))) + above-cutoff) + (setq name (file-name-nondirectory name) + pcomplete-stub name) + (let ((completions + (file-name-all-completions name default-directory))) + (if regexp + (setq completions + (pcomplete-pare-list + completions nil + (function + (lambda (file) + (not (string-match regexp file))))))) + (if predicate + (setq completions + (pcomplete-pare-list + completions nil + (function + (lambda (file) + (not (funcall predicate file))))))) + (if (or pcomplete-file-ignore pcomplete-dir-ignore) + (setq completions + (pcomplete-pare-list + completions nil + (function + (lambda (file) + (if (eq (aref file (1- (length file))) + directory-sep-char) + (and pcomplete-dir-ignore + (string-match pcomplete-dir-ignore file)) + (and pcomplete-file-ignore + (string-match pcomplete-file-ignore file)))))))) + (setq above-cutoff (> (length completions) + pcomplete-cycle-cutoff-length)) + (sort completions + (function + (lambda (l r) + ;; for the purposes of comparison, remove the + ;; trailing slash from directory names. + ;; Otherwise, "foo.old/" will come before "foo/", + ;; since . is earlier in the ASCII alphabet than + ;; / + (let ((left (if (eq (aref l (1- (length l))) + directory-sep-char) + (substring l 0 (1- (length l))) + l)) + (right (if (eq (aref r (1- (length r))) + directory-sep-char) + (substring r 0 (1- (length r))) + r))) + (if above-cutoff + (string-lessp left right) + (funcall pcomplete-compare-entry-function + left right))))))))) + +(defsubst pcomplete-all-entries (&optional regexp predicate) + "Like `pcomplete-entries', but doesn't ignore any entries." + (let (pcomplete-file-ignore + pcomplete-dir-ignore) + (pcomplete-entries regexp predicate))) + +(defsubst pcomplete-dirs (&optional regexp) + "Complete amongst a list of directories." + (pcomplete-entries regexp 'file-directory-p)) + +(defsubst pcomplete-executables (&optional regexp) + "Complete amongst a list of directories and executables." + (pcomplete-entries regexp 'file-executable-p)) + +;; generation of completion lists + +(defun pcomplete-find-completion-function (command) + "Find the completion function to call for the given COMMAND." + (let ((sym (intern-soft + (concat "pcomplete/" (symbol-name major-mode) "/" command)))) + (unless sym + (setq sym (intern-soft (concat "pcomplete/" command)))) + (and sym (fboundp sym) sym))) + +(defun pcomplete-completions () + "Return a list of completions for the current argument position." + (catch 'pcomplete-completions + (when (pcomplete-parse-arguments pcomplete-expand-before-complete) + (if (= pcomplete-index pcomplete-last) + (funcall pcomplete-command-completion-function) + (let ((sym (or (pcomplete-find-completion-function + (funcall pcomplete-command-name-function)) + pcomplete-default-completion-function))) + (ignore + (pcomplete-next-arg) + (funcall sym))))))) + +(defun pcomplete-opt (options &optional prefix no-ganging args-follow) + "Complete a set of OPTIONS, each beginning with PREFIX (?- by default). +PREFIX may be t, in which case no PREFIX character is necessary. +If REQUIRED is non-nil, the options must be present. +If NO-GANGING is non-nil, each option is separate. -xy is not allowed. +If ARGS-FOLLOW is non-nil, then options which arguments which take may +have the argument appear after a ganged set of options. This is how +tar behaves, for example." + (if (and (= pcomplete-index pcomplete-last) + (string= (pcomplete-arg) "-")) + (let ((len (length options)) + (index 0) + char choices) + (while (< index len) + (setq char (aref options index)) + (if (eq char ?\() + (let ((result (read-from-string options index))) + (setq index (cdr result))) + (unless (memq char '(?/ ?* ?? ?.)) + (setq choices (cons (char-to-string char) choices))) + (setq index (1+ index)))) + (throw 'pcomplete-completions + (mapcar + (function + (lambda (opt) + (concat "-" opt))) + (pcomplete-uniqify-list choices)))) + (let ((arg (pcomplete-arg))) + (when (and (> (length arg) 1) + (stringp arg) + (eq (aref arg 0) (or prefix ?-))) + (pcomplete-next-arg) + (let ((char (aref arg 1)) + (len (length options)) + (index 0) + opt-char arg-char result) + (while (< (1+ index) len) + (setq opt-char (aref options index) + arg-char (aref options (1+ index))) + (if (eq arg-char ?\() + (setq result + (read-from-string options (1+ index)) + index (cdr result) + result (car result)) + (setq result nil)) + (when (and (eq char opt-char) + (memq arg-char '(?\( ?/ ?* ?? ?.))) + (if (< pcomplete-index pcomplete-last) + (pcomplete-next-arg) + (throw 'pcomplete-completions + (cond ((eq arg-char ?/) (pcomplete-dirs)) + ((eq arg-char ?*) (pcomplete-executables)) + ((eq arg-char ??) nil) + ((eq arg-char ?.) (pcomplete-entries)) + ((eq arg-char ?\() (eval result)))))) + (setq index (1+ index)))))))) + +(defun pcomplete--here (&optional form stub paring form-only) + "Complete aganst the current argument, if at the end. +See the documentation for `pcomplete-here'." + (if (< pcomplete-index pcomplete-last) + (progn + (if (eq paring 0) + (setq pcomplete-seen nil) + (unless (eq paring t) + (let ((arg (pcomplete-arg))) + (unless (not (stringp arg)) + (setq pcomplete-seen + (cons (if paring + (funcall paring arg) + (file-truename arg)) + pcomplete-seen)))))) + (pcomplete-next-arg) + t) + (when pcomplete-show-help + (pcomplete--help) + (throw 'pcompleted t)) + (if stub + (setq pcomplete-stub stub)) + (if (or (eq paring t) (eq paring 0)) + (setq pcomplete-seen nil) + (setq pcomplete-norm-func (or paring 'file-truename))) + (unless form-only + (run-hooks 'pcomplete-try-first-hook)) + (throw 'pcomplete-completions (eval form)))) + +(defmacro pcomplete-here (&optional form stub paring form-only) + "Complete aganst the current argument, if at the end. +If completion is to be done here, evaluate FORM to generate the list +of strings which will be used for completion purposes. If STUB is a +string, use it as the completion stub instead of the default (which is +the entire text of the current argument). + +For an example of when you might want to use STUB: if the current +argument text is 'long-path-name/', you don't want the completions +list display to be cluttered by 'long-path-name/' appearing at the +beginning of every alternative. Not only does this make things less +intelligle, but it is also inefficient. Yet, if the completion list +does not begin with this string for every entry, the current argument +won't complete correctly. + +The solution is to specify a relative stub. It allows you to +substitute a different argument from the current argument, almost +always for the sake of efficiency. + +If PARING is nil, this argument will be pared against previous +arguments using the function `file-truename' to normalize them. +PARING may be a function, in which case that function is for +normalization. If PARING is the value t, the argument dealt with by +this call will not participate in argument paring. If it the integer +0, all previous arguments that have been seen will be cleared. + +If FORM-ONLY is non-nil, only the result of FORM will be used to +generate the completions list. This means that the hook +`pcomplete-try-first-hook' will not be run." + `(pcomplete--here (quote ,form) ,stub ,paring ,form-only)) + +(defmacro pcomplete-here* (&optional form stub form-only) + "An alternate form which does not participate in argument paring." + `(pcomplete-here ,form ,stub t ,form-only)) + +;; display support + +(defun pcomplete-restore-windows () + "If the only window change was due to Completions, restore things." + (if pcomplete-last-window-config + (let* ((cbuf (get-buffer "*Completions*")) + (cwin (and cbuf (get-buffer-window cbuf)))) + (when (and cwin (window-live-p cwin)) + (bury-buffer cbuf) + (set-window-configuration pcomplete-last-window-config)))) + (setq pcomplete-last-window-config nil + pcomplete-window-restore-timer nil)) + +;; Abstractions so that the code below will work for both Emacs 20 and +;; XEmacs 21 + +(unless (fboundp 'event-matches-key-specifier-p) + (defalias 'event-matches-key-specifier-p 'eq)) + +(unless (fboundp 'read-event) + (defsubst read-event (&optional prompt) + (aref (read-key-sequence prompt) 0))) + +(unless (fboundp 'event-basic-type) + (defalias 'event-basic-type 'event-key)) + +(defun pcomplete-show-completions (completions) + "List in help buffer sorted COMPLETIONS. +Typing SPC flushes the help buffer." + (let* ((curbuf (current-buffer))) + (when pcomplete-window-restore-timer + (cancel-timer pcomplete-window-restore-timer) + (setq pcomplete-window-restore-timer nil)) + (unless pcomplete-last-window-config + (setq pcomplete-last-window-config (current-window-configuration))) + (with-output-to-temp-buffer "*Completions*" + (display-completion-list completions)) + (message "Hit space to flush") + (let (event) + (prog1 + (catch 'done + (while (with-current-buffer (get-buffer "*Completions*") + (setq event (read-event))) + (cond + ((event-matches-key-specifier-p event ? ) + (set-window-configuration pcomplete-last-window-config) + (setq pcomplete-last-window-config nil) + (throw 'done nil)) + ((event-matches-key-specifier-p event 'tab) + (save-selected-window + (select-window (get-buffer-window "*Completions*")) + (if (pos-visible-in-window-p (point-max)) + (goto-char (point-min)) + (scroll-up))) + (message "")) + (t + (setq unread-command-events (list event)) + (throw 'done nil))))) + (if (and pcomplete-last-window-config + pcomplete-restore-window-delay) + (setq pcomplete-window-restore-timer + (run-with-timer pcomplete-restore-window-delay nil + 'pcomplete-restore-windows))))))) + +;; insert completion at point + +(defun pcomplete-insert-entry (stub entry &optional addsuffix raw-p) + "Insert a completion entry at point. +Returns non-nil if a space was appended at the end." + (let ((here (point))) + (if (not pcomplete-ignore-case) + (insert-and-inherit (if raw-p + (substring entry (length stub)) + (pcomplete-quote-argument + (substring entry (length stub))))) + ;; the stub is not quoted at this time, so to determine the + ;; length of what should be in the buffer, we must quote it + (delete-backward-char (length (pcomplete-quote-argument stub))) + ;; if there is already a backslash present to handle the first + ;; character, don't bother quoting it + (when (eq (char-before) ?\\) + (insert-and-inherit (substring entry 0 1)) + (setq entry (substring entry 1))) + (insert-and-inherit (if raw-p + entry + (pcomplete-quote-argument entry)))) + (let (space-added) + (when (and (not (memq (char-before) pcomplete-suffix-list)) + addsuffix) + (insert-and-inherit " ") + (setq space-added t)) + (setq pcomplete-last-completion-length (- (point) here) + pcomplete-last-completion-stub stub) + space-added))) + +;; selection of completions + +(defun pcomplete-do-complete (stub completions) + "Dynamically complete at point using STUB and COMPLETIONS. +This is basically just a wrapper for `pcomplete-stub' which does some +extra checking, and munging of the COMPLETIONS list." + (unless (stringp stub) + (message "Cannot complete argument") + (throw 'pcompleted nil)) + (if (null completions) + (ignore + (if (and stub (> (length stub) 0)) + (message "No completions of %s" stub) + (message "No completions"))) + ;; pare it down, if applicable + (if pcomplete-seen + (let* ((arg (pcomplete-arg)) + (prefix + (file-name-as-directory + (funcall pcomplete-norm-func + (substring arg 0 (- (length arg) + (length pcomplete-stub))))))) + (setq pcomplete-seen + (mapcar 'directory-file-name pcomplete-seen)) + (let ((p pcomplete-seen)) + (while p + (add-to-list 'pcomplete-seen + (funcall pcomplete-norm-func (car p))) + (setq p (cdr p)))) + (setq completions + (mapcar + (function + (lambda (elem) + (file-relative-name elem prefix))) + (pcomplete-pare-list + (mapcar + (function + (lambda (elem) + (expand-file-name elem prefix))) + completions) + pcomplete-seen + (function + (lambda (elem) + (member (directory-file-name + (funcall pcomplete-norm-func elem)) + pcomplete-seen)))))))) + ;; OK, we've got a list of completions. + (if pcomplete-show-list + (pcomplete-show-completions completions) + (pcomplete-stub stub completions)))) + +(defun pcomplete-stub (stub candidates &optional cycle-p) + "Dynamically complete STUB from CANDIDATES list. +This function inserts completion characters at point by completing +STUB from the strings in CANDIDATES. A completions listing may be +shown in a help buffer if completion is ambiguous. + +Returns nil if no completion was inserted. +Returns `sole' if completed with the only completion match. +Returns `shortest' if completed with the shortest of the matches. +Returns `partial' if completed as far as possible with the matches. +Returns `listed' if a completion listing was shown. + +See also `pcomplete-filename'." + (let* ((completion-ignore-case pcomplete-ignore-case) + (candidates (mapcar 'list candidates)) + (completions (all-completions stub candidates))) + (let (result entry) + (cond + ((null completions) + (if (and stub (> (length stub) 0)) + (message "No completions of %s" stub) + (message "No completions"))) + ((= 1 (length completions)) + (setq entry (car completions)) + (if (string-equal entry stub) + (message "Sole completion")) + (setq result 'sole)) + ((and pcomplete-cycle-completions + (or cycle-p + (not pcomplete-cycle-cutoff-length) + (<= (length completions) + pcomplete-cycle-cutoff-length))) + (setq entry (car completions) + pcomplete-current-completions completions)) + (t ; There's no unique completion; use longest substring + (setq entry (try-completion stub candidates)) + (cond ((and pcomplete-recexact + (string-equal stub entry) + (member entry completions)) + ;; It's not unique, but user wants shortest match. + (message "Completed shortest") + (setq result 'shortest)) + ((or pcomplete-autolist + (string-equal stub entry)) + ;; It's not unique, list possible completions. + (pcomplete-show-completions completions) + (setq result 'listed)) + (t + (message "Partially completed") + (setq result 'partial))))) + (cons result entry)))) + +;; context sensitive help + +(defun pcomplete--help () + "Produce context-sensitive help for the current argument. +If specific documentation can't be given, be generic. +INFODOC specifies the Info node to goto. DOCUMENTATION is a sexp +which will produce documentation for the argument (it is responsible +for displaying in its own buffer)." + (if (and pcomplete-help + (or (and (stringp pcomplete-help) + (fboundp 'Info-goto-node)) + (listp pcomplete-help))) + (if (listp pcomplete-help) + (message (eval pcomplete-help)) + (save-window-excursion (info)) + (switch-to-buffer-other-window "*info*") + (funcall (symbol-function 'Info-goto-node) pcomplete-help)) + (if pcomplete-man-function + (let ((cmd (funcall pcomplete-command-name-function))) + (if (and cmd (> (length cmd) 0)) + (funcall pcomplete-man-function cmd))) + (message "No context-sensitive help available")))) + +;; general utilities + +(defsubst pcomplete-time-less-p (t1 t2) + "Say whether time T1 is less than time T2." + (or (< (car t1) (car t2)) + (and (= (car t1) (car t2)) + (< (nth 1 t1) (nth 1 t2))))) + +(defun pcomplete-pare-list (l r &optional pred) + "Destructively remove from list L all elements matching any in list R. +Test is done using `equal'. +If PRED is non-nil, it is a function used for further removal. +Returns the resultant list." + (while (and l (or (and r (member (car l) r)) + (and pred + (funcall pred (car l))))) + (setq l (cdr l))) + (let ((m l)) + (while m + (while (and (cdr m) + (or (and r (member (cadr m) r)) + (and pred + (funcall pred (cadr m))))) + (setcdr m (cddr m))) + (setq m (cdr m)))) + l) + +(defun pcomplete-uniqify-list (l) + "Sort and remove multiples in L." + (setq l (sort l 'string-lessp)) + (let ((m l)) + (while m + (while (and (cdr m) + (string= (car m) + (cadr m))) + (setcdr m (cddr m))) + (setq m (cdr m)))) + l) + +(defun pcomplete-process-result (cmd &rest args) + "Call CMD using `call-process' and return the simplest result." + (with-temp-buffer + (apply 'call-process cmd nil t nil args) + (skip-chars-backward "\n") + (buffer-substring (point-min) (point)))) + +;; create a set of aliases which allow completion functions to be not +;; quite so verbose + +;; jww (1999-10-20): are these a good idea? +; (defalias 'pc-here 'pcomplete-here) +; (defalias 'pc-test 'pcomplete-test) +; (defalias 'pc-opt 'pcomplete-opt) +; (defalias 'pc-match 'pcomplete-match) +; (defalias 'pc-match-string 'pcomplete-match-string) +; (defalias 'pc-match-beginning 'pcomplete-match-beginning) +; (defalias 'pc-match-end 'pcomplete-match-end) + +;;; pcomplete.el ends here -- 2.39.2