Merge from emacs-24; up to 2012-12-02T06:22:32Z!cyd@gnu.org
[bpt/emacs.git] / lisp / emacs-lisp / cl.el
index 52567f3..3782175 100644 (file)
 ;;           (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 '(
                ))
   (defvaralias var (intern (format "cl-%s" var))))
 
-;; Before overwriting subr.el's `dotimes' and `dolist', let's remember
-;; them under a different name, so we can use them in our implementation
-;; of `dotimes' and `dolist'.
-(unless (fboundp 'cl--dotimes)
-  (defalias 'cl--dotimes (symbol-function 'dotimes) "The non-CL `dotimes'."))
-(unless (fboundp 'cl--dolist)
-  (defalias 'cl--dolist (symbol-function 'dolist) "The non-CL `dolist'."))
-
 (dolist (fun '(
                (get* . cl-get)
                (random* . cl-random)
                callf2
                callf
                letf*
-               ;; letf
+               letf
                rotatef
                shiftf
                remf
                psetf
                (define-setf-method . define-setf-expander)
-               declare
                the
                locally
                multiple-value-setq
                psetq
                do-all-symbols
                do-symbols
-               dotimes
-               dolist
                do*
                do
                loop
                (intern (format "cl-%s" fun)))))
     (defalias fun new)))
 
+(defun cl--wrap-in-nil-block (fun &rest args)
+  `(cl-block nil ,(apply fun args)))
+(advice-add 'dolist :around #'cl--wrap-in-nil-block)
+(advice-add 'dotimes :around #'cl--wrap-in-nil-block)
+
+(defun cl--pass-args-to-cl-declare (&rest specs)
+   (macroexpand `(cl-declare ,@specs)))
+(advice-add 'declare :after #'cl--pass-args-to-cl-declare)
+
 ;;; Features provided a bit differently in Elisp.
 
 ;; First, the old lexical-let is now better served by `lexical-binding', tho
@@ -500,28 +504,6 @@ rather than relying on `lexical-binding'."
 ;; 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.
@@ -547,13 +529,15 @@ deprecated usage of `symbol-function' in place forms)."  ; bug#12760
 
 (defmacro define-setf-expander (name arglist &rest body)
   "Define a `setf' method.
-This method shows how to handle `setf's to places of the form (NAME ARGS...).
-The argument forms ARGS are bound according to ARGLIST, as if NAME were
-going to be expanded as a macro, then the BODY forms are executed and must
-return a list of five elements: a temporary-variables list, a value-forms
-list, a store-variables list (of length one), a store-form, and an access-
-form.  See `gv-define-expander', `gv-define-setter', and `gv-define-expander'
-for a better and simpler ways to define setf-methods."
+This method shows how to handle `setf's to places of the form
+\(NAME ARGS...).  The argument forms ARGS are bound according to
+ARGLIST, as if NAME were going to be expanded as a macro, then
+the BODY forms are executed and must return a list of five elements:
+a temporary-variables list, a value-forms list, a store-variables list
+\(of length one), a store-form, and an access- form.
+
+See `gv-define-expander', and `gv-define-setter' for better and
+simpler ways to define setf-methods."
   (declare (debug
             (&define name cl-lambda-list cl-declarations-or-string def-body)))
   `(progn
@@ -566,23 +550,31 @@ for a better and simpler ways to define setf-methods."
 
 (defmacro defsetf (name arg1 &rest args)
   "Define a `setf' method.
-This macro is an easy-to-use substitute for `define-setf-expander' that works
-well for simple place forms.  In the simple `defsetf' form, `setf's of
-the form (setf (NAME ARGS...) VAL) are transformed to function or macro
-calls of the form (FUNC ARGS... VAL).  Example:
+This macro is an easy-to-use substitute for `define-setf-expander'
+that works well for simple place forms.
+
+In the simple `defsetf' form, `setf's of the form (setf (NAME
+ARGS...) VAL) are transformed to function or macro calls of the
+form (FUNC ARGS... VAL).  For example:
 
   (defsetf aref aset)
 
+You can replace this form with `gv-define-simple-setter'.
+
 Alternate form: (defsetf NAME ARGLIST (STORE) BODY...).
-Here, the above `setf' call is expanded by binding the argument forms ARGS
-according to ARGLIST, binding the value form VAL to STORE, then executing
-BODY, which must return a Lisp form that does the necessary `setf' operation.
-Actually, ARGLIST and STORE may be bound to temporary variables which are
-introduced automatically to preserve proper execution order of the arguments.
-Example:
+
+Here, the above `setf' call is expanded by binding the argument
+forms ARGS according to ARGLIST, binding the value form VAL to
+STORE, then executing BODY, which must return a Lisp form that
+does the necessary `setf' operation.  Actually, ARGLIST and STORE
+may be bound to temporary variables which are introduced
+automatically to preserve proper execution order of the arguments.
+For example:
 
   (defsetf nth (n x) (v) `(setcar (nthcdr ,n ,x) ,v))
 
+You can replace this form with `gv-define-setter'.
+
 \(fn NAME [FUNC | ARGLIST (STORE) BODY...])"
   (declare (debug
             (&define name
@@ -639,8 +631,12 @@ Example:
 
 (defmacro define-modify-macro (name arglist func &optional doc)
   "Define a `setf'-like modify macro.
-If NAME is called, it combines its PLACE argument with the other arguments
-from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)"
+If NAME is called, it combines its PLACE argument with the other
+arguments from ARGLIST using FUNC.  For example:
+
+  (define-modify-macro incf (&optional (n 1)) +)
+
+You can replace this macro with `gv-letplace'."
   (declare (debug
             (&define name cl-lambda-list ;; should exclude &key
                      symbolp &optional stringp)))
@@ -723,4 +719,7 @@ from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)"
          (list accessor temp))))
 
 (provide 'cl)
+
+(run-hooks 'cl-load-hook)
+
 ;;; cl.el ends here