;;; cl.el --- Common Lisp extensions for Emacs -*-byte-compile-dynamic: t;-*-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007 Free Software Foundation, Inc.
;; Author: Dave Gillespie <daveg@synaptics.com>
;; Version: 2.02
;; 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:
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.
"(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"
- (if (symbolp place) (list 'setq place (list* 'adjoin x place keys))
+\nKeywords supported: :test :test-not :key
+\n(fn X PLACE [KEYWORD VALUE]...)"
+ (if (symbolp place)
+ (if (null keys)
+ `(let ((x ,x))
+ (if (memql x ,place) ,place (setq ,place (cons x ,place))))
+ (list 'setq place (list* 'adjoin x place keys)))
(list* 'callf2 'adjoin x place keys)))
(defun cl-set-elt (seq n val)
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)
;;; 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)))
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))
;; 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))
(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))
(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)))
(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)))
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.
-(put 'cl-assertion-failed 'error-conditions '(error))
-(put 'cl-assertion-failed 'error-message "Assertion failed")
+;;; Miscellaneous.
(defvar cl-fake-autoloads nil
"Non-nil means don't make CL functions autoload.")
(run-hooks 'cl-load-hook)
-;;; arch-tag: 5f07fa74-f153-4524-9303-21f5be125851
+;; arch-tag: 5f07fa74-f153-4524-9303-21f5be125851
;;; cl.el ends here