view lisp/eshell/em-alias.el @ 83310:e58cb448e07c

Merged from miles@gnu.org--gnu-2005 (patch 80-82, 350-422) Patches applied: * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-350 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-351 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-352 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-353 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-354 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-355 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-356 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-357 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-358 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-359 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-360 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-361 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-362 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-363 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-364 Remove "-face" suffix from widget faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-365 Remove "-face" suffix from custom faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-366 Remove "-face" suffix from change-log faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-367 Remove "-face" suffix from compilation faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-368 Remove "-face" suffix from diff-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-369 lisp/longlines.el (longlines-visible-face): Face removed * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-370 Remove "-face" suffix from woman faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-371 Remove "-face" suffix from whitespace-highlight face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-372 Remove "-face" suffix from ruler-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-373 Remove "-face" suffix from show-paren faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-374 Remove "-face" suffix from log-view faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-375 Remove "-face" suffix from smerge faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-376 Remove "-face" suffix from show-tabs faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-377 Remove "-face" suffix from highlight-changes faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-378 Remove "-face" suffix from and downcase info faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-379 Remove "-face" suffix from pcvs faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-380 Update uses of renamed pcvs faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-381 Tweak ChangeLog * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-382 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-383 Remove "-face" suffix from strokes-char face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-384 Remove "-face" suffix from compare-windows face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-385 Remove "-face" suffix from calendar faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-386 Remove "-face" suffix from diary-button face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-387 Remove "-face" suffix from testcover faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-388 Remove "-face" suffix from viper faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-389 Remove "-face" suffix from org faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-390 Remove "-face" suffix from sgml-namespace face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-391 Remove "-face" suffix from table-cell face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-392 Remove "-face" suffix from tex-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-393 Remove "-face" suffix from texinfo-heading face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-394 Remove "-face" suffix from flyspell faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-395 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-396 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-397 Remove "-face" suffix from gomoku faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-398 Remove "-face" suffix from mpuz faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-399 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-400 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-401 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-402 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-403 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-404 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-405 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-406 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-407 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-408 Remove "-face" suffix from Buffer-menu-buffer face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-409 Remove "-face" suffix from antlr-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-410 Remove "-face" suffix from ebrowse faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-411 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-412 Remove "-face" suffix from flymake faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-413 Remove "-face" suffix from idlwave faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-414 Remove "-face" suffix from sh-script faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-415 Remove "-face" suffix from vhdl-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-416 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-417 Remove "-face" suffix from which-func face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-418 Remove "-face" suffix from cperl-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-419 Remove "-face" suffix from ld-script faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-420 Fix cperl-mode font-lock problem * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-421 Tweak which-func face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-422 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-80 Merge from emacs--cvs-trunk--0 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-81 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-82 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-350
author Karoly Lorentey <lorentey@elte.hu>
date Wed, 15 Jun 2005 12:57:51 +0000
parents f243dc772a99
children 18a818a2ee7c 4c90ffeb71c5
line wrap: on
line source

;;; em-alias.el --- creation and management of command aliases

;; Copyright (C) 1999, 2000, 2004 Free Software Foundation

;; Author: John Wiegley <johnw@gnu.org>

;; 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))
(require 'eshell)

(defgroup eshell-alias nil
  "Command aliases allow for easy definition of alternate commands."
  :tag "Command aliases"
  ;; :link '(info-link "(eshell)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)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)
  (add-hook 'eshell-alternate-command-hook 'eshell-fix-bad-commands t t)
  (eshell-read-aliases-list)
  (add-hook 'eshell-named-command-hook 'eshell-maybe-replace-by-alias t t)
  (make-local-variable 'eshell-complex-commands)
  (add-to-list 'eshell-complex-commands 'eshell-command-aliased-p))

(defun eshell-command-aliased-p (name)
  (assoc name eshell-command-aliases-list))

(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 ARGS."
  (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))))))))))

;;; arch-tag: 8b018fc1-4e07-4ccc-aa73-c0a1ba361f82
;;; em-alias.el ends here