diff lisp/emacs-lisp/cl.el @ 88155:d7ddb3e565de

sync with trunk

--- a/lisp/emacs-lisp/cl.el	Sun Jan 15 23:02:10 2006 +0000
+++ b/lisp/emacs-lisp/cl.el	Mon Jan 16 00:03:54 2006 +0000
@@ -1,6 +1,6 @@
 ;;; cl.el --- Common Lisp extensions for Emacs -*-byte-compile-dynamic: t;-*-
 
-;; Copyright (C) 1993 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
 
 ;; Author: Dave Gillespie <[e-mail]>
 ;; Version: 2.02
@@ -20,8 +20,8 @@
 
 ;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -108,16 +108,9 @@
 This variable is not used at present, but it is defined in hopes that
 a future Emacs interpreter will be able to use it.")
 
-
-;;; Predicates.
-
-(defun eql (a b)    ; See compiler macro in cl-macs.el
-  "T if the two args are the same Lisp object.
-Floating-point numbers of equal value are `eql', but they may not be `eq'."
-  (if (numberp a)
-      (equal a b)
-    (eq a b)))
-
+(add-hook 'cl-unload-hook 'cl-cannot-unload)
+(defun cl-cannot-unload ()
+  (error "Cannot unload the feature `cl'"))
 
 ;;; Generalized variables.  These macros are defined here so that they
 ;;; can safely be used in .emacs files.
@@ -159,7 +152,8 @@
   "(pushnew X PLACE): insert X at the head of the list if not already there.
 Like (push X PLACE), except that the list is unmodified if X is `eql' to
 an element already on the list.
-Keywords supported:  :test :test-not :key"
+\nKeywords supported:  :test :test-not :key
+\n(fn X PLACE [KEYWORD VALUE]...)"
   (if (symbolp place) (list 'setq place (list* 'adjoin x place keys))
     (list* 'callf2 'adjoin x place keys)))
 
@@ -253,7 +247,8 @@
 in place of FORM.  When a non-macro-call results, it is returned.
 
 The second optional arg ENVIRONMENT specifies an environment of macro
-definitions to shadow the loaded ones for use in file byte-compilation."
+definitions to shadow the loaded ones for use in file byte-compilation.
+\n(fn FORM &optional ENVIRONMENT)"
   (let ((cl-macro-environment cl-env))
     (while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env))
 		  (and (symbolp cl-macro)
@@ -297,27 +292,27 @@
 
 ;;; Numbers.
 
-(defun floatp-safe (x)
-  "T if OBJECT is a floating point number.
+(defun floatp-safe (object)
+  "Return t if OBJECT is a floating point number.
 On Emacs versions that lack floating-point support, this function
 always returns nil."
-  (and (numberp x) (not (integerp x))))
+  (and (numberp object) (not (integerp object))))
 
-(defun plusp (x)
-  "T if NUMBER is positive."
-  (> x 0))
+(defun plusp (number)
+  "Return t if NUMBER is positive."
+  (> number 0))
 
-(defun minusp (x)
-  "T if NUMBER is negative."
-  (< x 0))
+(defun minusp (number)
+  "Return t if NUMBER is negative."
+  (< number 0))
 
-(defun oddp (x)
-  "T if INTEGER is odd."
-  (eq (logand x 1) 1))
+(defun oddp (integer)
+  "Return t if INTEGER is odd."
+  (eq (logand integer 1) 1))
 
-(defun evenp (x)
-  "T if INTEGER is even."
-  (eq (logand x 1) 0))
+(defun evenp (integer)
+  "Return t if INTEGER is even."
+  (eq (logand integer 1) 0))
 
 (defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time)))
 
@@ -341,7 +336,8 @@
 If there are several SEQs, FUNCTION is called with that many arguments,
 and mapping stops as soon as the shortest list runs out.  With just one
 SEQ, this is like `mapcar'.  With several, it is like the Common Lisp
-`mapcar' function extended to arbitrary sequence types."
+`mapcar' function extended to arbitrary sequence types.
+\n(fn FUNCTION SEQ...)"
   (if cl-rest
       (if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest)))
 	  (cl-mapcar-many cl-func (cons cl-x cl-rest))
@@ -500,9 +496,10 @@
 ;;    x))
 
 (defun list* (arg &rest rest)   ; See compiler macro in cl-macs.el
-  "Return a new list with specified args as elements, cons'd to last arg.
+  "Return a new list with specified ARGs as elements, consed to last ARG.
 Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
-`(cons A (cons B (cons C D)))'."
+`(cons A (cons B (cons C D)))'.
+\n(fn ARG...)"
   (cond ((not rest) arg)
 	((not (cdr rest)) (cons arg (car rest)))
 	(t (let* ((n (length rest))
@@ -519,8 +516,8 @@
     (nreverse res)))
 
 (defun copy-list (list)
-  "Return a copy of a list, which may be a dotted list.
-The elements of the list are not copied, just the list structure itself."
+  "Return a copy of LIST, which may be a dotted list.
+The elements of LIST are not copied, just the list structure itself."
   (if (consp list)
       (let ((res nil))
 	(while (consp list) (push (pop list) res))
@@ -541,7 +538,8 @@
 (defun adjoin (cl-item cl-list &rest cl-keys)  ; See compiler macro in cl-macs
   "Return ITEM consed onto the front of LIST only if it's not already there.
 Otherwise, return LIST unmodified.
-Keywords supported:  :test :test-not :key"
+\nKeywords supported:  :test :test-not :key
+\n(fn ITEM LIST [KEYWORD VALUE]...)"
   (cond ((or (equal cl-keys '(:test eq))
 	     (and (null cl-keys) (not (numberp cl-item))))
 	 (if (memq cl-item cl-list) cl-list (cons cl-item cl-list)))
@@ -552,7 +550,8 @@
 (defun subst (cl-new cl-old cl-tree &rest cl-keys)
   "Substitute NEW for OLD everywhere in TREE (non-destructively).
 Return a copy of TREE with all elements `eql' to OLD replaced by NEW.
-Keywords supported:  :test :test-not :key"
+\nKeywords supported:  :test :test-not :key
+\n(fn NEW OLD TREE [KEYWORD VALUE]...)"
   (if (or cl-keys (and (numberp cl-old) (not (integerp cl-old))))
       (apply 'sublis (list (cons cl-old cl-new)) cl-tree cl-keys)
     (cl-do-subst cl-new cl-old cl-tree)))
@@ -566,8 +565,17 @@
 	       cl-tree (cons a d))))
 	(t cl-tree)))
 
-(defun acons (a b c) (cons (cons a b) c))
-(defun pairlis (a b &optional c) (nconc (mapcar* 'cons a b) c))
+(defun acons (key value alist)
+  "Add KEY and VALUE to ALIST.
+Return a new list with (cons KEY VALUE) as car and ALIST as cdr."
+  (cons (cons key value) alist))
+
+(defun pairlis (keys values &optional alist)
+  "Make an alist from KEYS and VALUES.
+Return a new alist composed by associating KEYS to corresponding VALUES;
+the process stops as soon as KEYS or VALUES run out.
+If ALIST is non-nil, the new pairs are prepended to it."
+  (nconc (mapcar* 'cons keys values) alist))
 
 
 ;;; Miscellaneous.
@@ -579,9 +587,10 @@
   "Non-nil means don't make CL functions autoload.")
 
 ;;; Autoload the other portions of the package.
-;; We want to replace the basic versions of dolist, dotimes below.
+;; We want to replace the basic versions of dolist, dotimes, declare below.
 (fmakunbound 'dolist)
 (fmakunbound 'dotimes)
+(fmakunbound 'declare)
 (mapcar (function
 	 (lambda (set)
 	   (let ((file (if cl-fake-autoloads "<none>" (car set))))
@@ -695,4 +704,5 @@
 
 (run-hooks 'cl-load-hook)
 
+;; arch-tag: 5f07fa74-f153-4524-9303-21f5be125851
 ;;; cl.el ends here