Merge from emacs-23; up to 2010-06-16T23:27:20Z!jay.p.belanger@gmail.com.

[bpt/emacs.git] / lisp / emacs-lisp / cl.el

diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index c03c91d..526475e 100644 (file)
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -1,7 +1,6 @@
 ;;; cl.el --- Common Lisp extensions for Emacs
 
 ;;; cl.el --- Common Lisp extensions for Emacs
 

-;; Copyright (C) 1993, 2001, 2002, 2003, 2004, 2005,
-;;   2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2011  Free Software Foundation, Inc.

 
 ;; Author: Dave Gillespie <daveg@synaptics.com>
 ;; Version: 2.02
 
 ;; Author: Dave Gillespie <daveg@synaptics.com>
 ;; Version: 2.02


@@ -133,6 +132,9 @@ The return value is the decremented value of PLACE."
       (list 'setq place (if x (list '- place x) (list '1- place)))
     (list 'callf '- place (or x 1))))
 
       (list 'setq place (if x (list '- place x) (list '1- place)))
     (list 'callf '- place (or x 1))))
 

+;; Autoloaded, but we haven't loaded cl-loaddefs yet.
+(declare-function cl-do-pop "cl-macs" (place))
+

 (defmacro pop (place)
   "Remove and return the head of the list stored in PLACE.
 Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more
 (defmacro pop (place)
   "Remove and return the head of the list stored in PLACE.
 Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more


@@ -159,7 +161,14 @@ an element already on the list.
   (if (symbolp place)
       (if (null keys)
          `(let ((x ,x))
   (if (symbolp place)
       (if (null keys)
          `(let ((x ,x))

-            (if (memql x ,place) ,place (setq ,place (cons x ,place))))
+            (if (memql x ,place)
+                 ;; This symbol may later on expand to actual code which then
+                 ;; trigger warnings like "value unused" since pushnew's return
+                 ;; value is rarely used.  It should not matter that other
+                 ;; warnings may be silenced, since `place' is used earlier and
+                 ;; should have triggered them already.
+                 (with-no-warnings ,place)
+               (setq ,place (cons x ,place))))

        (list 'setq place (list* 'adjoin x place keys)))
     (list* 'callf2 'adjoin x place keys)))
 
        (list 'setq place (list* 'adjoin x place keys)))
     (list* 'callf2 'adjoin x place keys)))
 


@@ -243,7 +252,7 @@ one value."
 
 ;;; Macros.
 
 
 ;;; Macros.
 

-(defvar cl-macro-environment nil)
+(defvar cl-macro-environment)

 (defvar cl-old-macroexpand (prog1 (symbol-function 'macroexpand)
                             (defalias 'macroexpand 'cl-macroexpand)))
 
 (defvar cl-old-macroexpand (prog1 (symbol-function 'macroexpand)
                             (defalias 'macroexpand 'cl-macroexpand)))
 


@@ -269,8 +278,9 @@ definitions to shadow the loaded ones for use in file byte-compilation.
 (defvar cl-compiling-file nil)
 (defun cl-compiling-file ()
   (or cl-compiling-file
 (defvar cl-compiling-file nil)
 (defun cl-compiling-file ()
   (or cl-compiling-file

-      (and (boundp 'outbuffer) (bufferp (symbol-value 'outbuffer))
-          (equal (buffer-name (symbol-value 'outbuffer))
+      (and (boundp 'byte-compile--outbuffer)
+           (bufferp (symbol-value 'byte-compile--outbuffer))
+          (equal (buffer-name (symbol-value 'byte-compile--outbuffer))

                  " *Compiler Output*"))))
 
 (defvar cl-proclaims-deferred nil)
                  " *Compiler Output*"))))
 
 (defvar cl-proclaims-deferred nil)


@@ -338,6 +348,8 @@ always returns nil."
 
 (defalias 'copy-seq 'copy-sequence)
 
 
 (defalias 'copy-seq 'copy-sequence)
 

+(declare-function cl-mapcar-many "cl-extra" (cl-func cl-seqs))
+

 (defun mapcar* (cl-func cl-x &rest cl-rest)
   "Apply FUNCTION to each element of SEQ, and make a list of the results.
 If there are several SEQs, FUNCTION is called with that many arguments,
 (defun mapcar* (cl-func cl-x &rest cl-rest)
   "Apply FUNCTION to each element of SEQ, and make a list of the results.
 If there are several SEQs, FUNCTION is called with that many arguments,


@@ -536,6 +548,14 @@ The elements of LIST are not copied, just the list structure itself."
   list)
 
 (defalias 'cl-member 'memq)   ; for compatibility with old CL package
   list)
 
 (defalias 'cl-member 'memq)   ; for compatibility with old CL package

+
+;; Autoloaded, but we have not loaded cl-loaddefs yet.
+(declare-function floor* "cl-extra" (x &optional y))
+(declare-function ceiling* "cl-extra" (x &optional y))
+(declare-function truncate* "cl-extra" (x &optional y))
+(declare-function round* "cl-extra" (x &optional y))
+(declare-function mod* "cl-extra" (x y))
+

 (defalias 'cl-floor 'floor*)
 (defalias 'cl-ceiling 'ceiling*)
 (defalias 'cl-truncate 'truncate*)
 (defalias 'cl-floor 'floor*)
 (defalias 'cl-ceiling 'ceiling*)
 (defalias 'cl-truncate 'truncate*)


@@ -631,18 +651,17 @@ If ALIST is non-nil, the new pairs are prepended to it."
 (load "cl-loaddefs" nil 'quiet)
 
 ;; This goes here so that cl-macs can find it if it loads right now.
 (load "cl-loaddefs" nil 'quiet)
 
 ;; This goes here so that cl-macs can find it if it loads right now.

-(provide 'cl-19)     ; usage: (require 'cl-19 "cl")
+(provide 'cl)

 
 ;; Things to do after byte-compiler is loaded.
 
 ;; Things to do after byte-compiler is loaded.

-;; As a side effect, we cause cl-macs to be loaded when compiling, so
-;; that the compiler-macros defined there will be present.

 
 (defvar cl-hacked-flag nil)
 (defun cl-hack-byte-compiler ()
 
 (defvar cl-hacked-flag nil)
 (defun cl-hack-byte-compiler ()

-  (if (and (not cl-hacked-flag) (fboundp 'byte-compile-file-form))
-      (progn
-       (setq cl-hacked-flag t)         ; Do it first, to prevent recursion.
-       (cl-compile-time-init))))       ; In cl-macs.el.
+  (and (not cl-hacked-flag) (fboundp 'byte-compile-file-form)
+       (progn
+         (setq cl-hacked-flag t)  ; Do it first, to prevent recursion.
+         (load "cl-macs" nil t)
+         (run-hooks 'cl-hack-bytecomp-hook))))

 
 ;; Try it now in case the compiler has already been loaded.
 (cl-hack-byte-compiler)
 
 ;; Try it now in case the compiler has already been loaded.
 (cl-hack-byte-compiler)


@@ -663,5 +682,4 @@ If ALIST is non-nil, the new pairs are prepended to it."
 ;; byte-compile-warnings: (not cl-functions)
 ;; End:
 
 ;; byte-compile-warnings: (not cl-functions)
 ;; End:
 

-;; arch-tag: 5f07fa74-f153-4524-9303-21f5be125851

 ;;; cl.el ends here
 ;;; cl.el ends here