X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/c1473b4cfeb477ced05d457868c5e1eb97a58eb0..322b7dab59b98b5d8625d2cd29e48f1ce605f769:/lisp/emacs-lisp/cl.el diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index c03c91d76f..526475eb1b 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -1,7 +1,6 @@ ;;; 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 ;; 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)))) +;; 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 @@ -159,7 +161,14 @@ an element already on the list. (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))) @@ -243,7 +252,7 @@ one value." ;;; Macros. -(defvar cl-macro-environment nil) +(defvar cl-macro-environment) (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 - (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) @@ -338,6 +348,8 @@ always returns nil." (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, @@ -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 + +;; 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*) @@ -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. -(provide 'cl-19) ; usage: (require 'cl-19 "cl") +(provide 'cl) ;; 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 () - (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) @@ -663,5 +682,4 @@ If ALIST is non-nil, the new pairs are prepended to it." ;; byte-compile-warnings: (not cl-functions) ;; End: -;; arch-tag: 5f07fa74-f153-4524-9303-21f5be125851 ;;; cl.el ends here