* lisp/emacs-lisp/cl-macs.el (cl--transform-lambda): Defend against

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

diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 53c83e7..7c25972 100644 (file)
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -131,7 +131,7 @@ TYPE is the sequence type to return.
 ;;;###autoload
 (defun cl-maplist (cl-func cl-list &rest cl-rest)
   "Map FUNCTION to each sublist of LIST or LISTs.
-Like `mapcar', except applies to lists and their cdr's rather than to
+Like `cl-mapcar', except applies to lists and their cdr's rather than to
 the elements themselves.
 \n(fn FUNCTION LIST...)"
   (if cl-rest
@@ -149,8 +149,9 @@ the elements themselves.
        (setq cl-list (cdr cl-list)))
       (nreverse cl-res))))
 
+;;;###autoload
 (defun cl-mapc (cl-func cl-seq &rest cl-rest)
-  "Like `mapcar', but does not accumulate values returned by the function.
+  "Like `cl-mapcar', but does not accumulate values returned by the function.
 \n(fn FUNCTION SEQUENCE...)"
   (if cl-rest
       (progn (apply 'cl-map nil cl-func cl-seq cl-rest)
@@ -169,7 +170,7 @@ the elements themselves.
 
 ;;;###autoload
 (defun cl-mapcan (cl-func cl-seq &rest cl-rest)
-  "Like `mapcar', but nconc's together the values returned by the function.
+  "Like `cl-mapcar', but nconc's together the values returned by the function.
 \n(fn FUNCTION SEQUENCE...)"
   (apply 'nconc (apply 'cl-mapcar cl-func cl-seq cl-rest)))
 
@@ -305,7 +306,7 @@ If so, return the true (non-nil) value returned by PREDICATE.
          (setq cl-ovl (cdr cl-ovl))))
       (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil)))))
 
-;;; Support for `cl-setf'.
+;;; Support for `setf'.
 ;;;###autoload
 (defun cl--set-frame-visible-p (frame val)
   (cond ((null val) (make-frame-invisible frame))
@@ -313,25 +314,6 @@ If so, return the true (non-nil) value returned by PREDICATE.
        (t (make-frame-visible frame)))
   val)
 
-;;; Support for `cl-progv'.
-(defvar cl--progv-save)
-;;;###autoload
-(defun cl--progv-before (syms values)
-  (while syms
-    (push (if (boundp (car syms))
-                (cons (car syms) (symbol-value (car syms)))
-              (car syms)) cl--progv-save)
-    (if values
-       (set (pop syms) (pop values))
-      (makunbound (pop syms)))))
-
-(defun cl--progv-after ()
-  (while cl--progv-save
-    (if (consp (car cl--progv-save))
-       (set (car (car cl--progv-save)) (cdr (car cl--progv-save)))
-      (makunbound (car cl--progv-save)))
-    (pop cl--progv-save)))
-
 
 ;;; Numbers.
 
@@ -458,7 +440,7 @@ If STATE is t, return a new state object seeded from the time of day."
   (cond ((null state) (cl-make-random-state cl--random-state))
        ((vectorp state) (copy-tree state t))
        ((integerp state) (vector 'cl-random-state-tag -1 30 state))
-       (t (cl-make-random-state (cl-random-time)))))
+       (t (cl-make-random-state (cl--random-time)))))
 
 ;;;###autoload
 (defun cl-random-state-p (object)
@@ -523,6 +505,10 @@ This sets the values of: `cl-most-positive-float', `cl-most-negative-float',
   "Return the subsequence of SEQ from START to END.
 If END is omitted, it defaults to the length of the sequence.
 If START or END is negative, it counts from the end."
+  (declare (gv-setter
+            (lambda (new)
+              `(progn (cl-replace ,seq ,new :start1 ,start :end1 ,end)
+                      ,new))))
   (if (stringp seq) (substring seq start end)
     (let (len)
       (and end (< end 0) (setq end (+ end (setq len (length seq)))))
@@ -587,9 +573,11 @@ If START or END is negative, it counts from the end."
 (defun cl-get (sym tag &optional def)
   "Return the value of SYMBOL's PROPNAME property, or DEFAULT if none.
 \n(fn SYMBOL PROPNAME &optional DEFAULT)"
-  (declare (compiler-macro cl--compiler-macro-get))
+  (declare (compiler-macro cl--compiler-macro-get)
+           (gv-setter (lambda (store) `(put ,sym ,tag ,store))))
   (or (get sym tag)
       (and def
+           ;; Make sure `def' is really absent as opposed to set to nil.
           (let ((plist (symbol-plist sym)))
             (while (and plist (not (eq (car plist) tag)))
               (setq plist (cdr (cdr plist))))
@@ -601,12 +589,22 @@ If START or END is negative, it counts from the end."
   "Search PROPLIST for property PROPNAME; return its value or DEFAULT.
 PROPLIST is a list of the sort returned by `symbol-plist'.
 \n(fn PROPLIST PROPNAME &optional DEFAULT)"
+  (declare (gv-expander
+            (lambda (do)
+              (gv-letplace (getter setter) plist
+                (macroexp-let2 nil k tag
+                  (macroexp-let2 nil d def
+                    (funcall do `(cl-getf ,getter ,k ,d)
+                             (lambda (v)
+                               (funcall setter
+                                        `(cl--set-getf ,getter ,k ,v))))))))))
   (setplist '--cl-getf-symbol-- plist)
   (or (get '--cl-getf-symbol-- tag)
       ;; Originally we called cl-get here,
       ;; but that fails, because cl-get has a compiler macro
       ;; definition that uses getf!
       (when def
+        ;; Make sure `def' is really absent as opposed to set to nil.
        (while (and plist (not (eq (car plist) tag)))
          (setq plist (cdr (cdr plist))))
        (if plist (car (cdr plist)) def))))
@@ -677,6 +675,9 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
 
 ;;;###autoload
 (defun cl-prettyexpand (form &optional full)
+  "Expand macros in FORM and insert the pretty-printed result.
+Optional argument FULL non-nil means to expand all macros,
+including `cl-block' and `cl-eval-when'."
   (message "Expanding...")
   (let ((cl--compiling-file full)
        (byte-compile-macro-environment nil))
@@ -692,7 +693,6 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
 
 ;; Local variables:
 ;; byte-compile-dynamic: t
-;; byte-compile-warnings: (not cl-functions)
 ;; generated-autoload-file: "cl-loaddefs.el"
 ;; End: