autoloading eval-when forms

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

diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index 40d1235..182c01a 100644 (file)
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -1,6 +1,6 @@
 ;;; cl.el --- Compatibility aliases for the old CL library.  -*- lexical-binding: t -*-
 
-;; Copyright (C) 2012  Free Software Foundation, Inc.
+;; Copyright (C) 2012-2014 Free Software Foundation, Inc.
 
 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
 ;; Keywords: extensions
@@ -29,6 +29,7 @@
 
 (require 'cl-lib)
 (require 'macroexp)
+(require 'gv)
 
 ;; (defun cl--rename ()
 ;;   (let ((vdefs ())
@@ -83,6 +84,12 @@
 ;;           (delete-region (1- (point)) (point)))
 ;;         (save-buffer)))))
 
+(defun cl-unload-function ()
+  "Stop unloading of the Common Lisp extensions."
+  (message "Cannot unload the feature `cl'")
+  ;; Stop standard unloading!
+  t)
+
 ;;; Aliases to cl-lib's features.
 
 (dolist (var '(
@@ -214,7 +221,7 @@
                callf2
                callf
                letf*
-               ;; letf
+               letf
                rotatef
                shiftf
                remf
@@ -241,7 +248,6 @@
                ecase
                case
                load-time-value
-               eval-when
                destructuring-bind
                gentemp
                gensym
@@ -474,52 +480,10 @@ will not work - use `labels' instead" (symbol-name (car x))))
            bindings)
      ,@body))
 
-(defmacro labels (bindings &rest body)
-  "Make temporary function bindings.
-Like `cl-labels' except that the lexical scoping is handled via `lexical-let'
-rather than relying on `lexical-binding'."
-  (declare (indent 1) (debug cl-flet) (obsolete cl-labels "24.3"))
-  (let ((vars nil) (sets nil) (newenv macroexpand-all-environment))
-    (dolist (binding bindings)
-      ;; It's important that (not (eq (symbol-name var1) (symbol-name var2)))
-      ;; because these var's *names* get added to the macro-environment.
-      (let ((var (make-symbol (format "--cl-%s--" (car binding)))))
-       (push var vars)
-       (push `(cl-function (lambda . ,(cdr binding))) sets)
-       (push var sets)
-       (push (cons (car binding)
-                    `(lambda (&rest cl-labels-args)
-                       (cl-list* 'funcall ',var
-                                 cl-labels-args)))
-              newenv)))
-    (macroexpand-all `(lexical-let ,vars (setq ,@sets) ,@body) newenv)))
-
 ;; Generalized variables are provided by gv.el, but some details are
 ;; not 100% compatible: not worth the trouble to add them to cl-lib.el, but we
 ;; still need to support old users of cl.el.
 
-(defmacro cl--symbol-function (symbol)
-  "Like `symbol-function' but return `cl--unbound' if not bound."
-  ;; (declare (gv-setter (lambda (store)
-  ;;                       `(if (eq ,store 'cl--unbound)
-  ;;                            (fmakunbound ,symbol) (fset ,symbol ,store)))))
-  `(if (fboundp ,symbol) (symbol-function ,symbol) 'cl--unbound))
-(gv-define-setter cl--symbol-function (store symbol)
-  `(if (eq ,store 'cl--unbound) (fmakunbound ,symbol) (fset ,symbol ,store)))
-
-(defmacro letf (bindings &rest body)
-  "Dynamically scoped let-style bindings for places.
-For more details, see `cl-letf'.  This macro behaves like that one
-in almost every respect (apart from details that relate to some
-deprecated usage of `symbol-function' in place forms)."  ; bug#12760
-  (declare (indent 1) (debug cl-letf))
-  ;; Like cl-letf, but with special handling of symbol-function.
-  `(cl-letf ,(mapcar (lambda (x) (if (eq (car-safe (car x)) 'symbol-function)
-                                `((cl--symbol-function ,@(cdar x)) ,@(cdr x))
-                              x))
-                     bindings)
-            ,@body))
-
 (defun cl--gv-adapt (cl-gv do)
   ;; This function is used by all .elc files that use define-setf-expander and
   ;; were compiled with Emacs>=24.3.
@@ -705,6 +669,7 @@ You can replace this macro with `gv-letplace'."
   'cl--map-keymap-recursively "24.3")
 (define-obsolete-function-alias 'cl-map-intervals 'cl--map-intervals "24.3")
 (define-obsolete-function-alias 'cl-map-extents 'cl--map-overlays "24.3")
+(define-obsolete-function-alias 'cl-set-getf 'cl--set-getf "24.3")
 
 (defun cl-maclisp-member (item list)
   (declare (obsolete member "24.3"))
@@ -735,4 +700,7 @@ You can replace this macro with `gv-letplace'."
          (list accessor temp))))
 
 (provide 'cl)
+
+(run-hooks 'cl-load-hook)
+
 ;;; cl.el ends here