* lisp/emacs-lisp/macroexp.el (macroexp-parse-body): Handle cl-declare

and :documentation.  Change return value format accordingly.
* lisp/emacs-lisp/cl-generic.el (cl--generic-lambda):
* lisp/emacs-lisp/pcase.el (pcase-lambda): Adjust accordingly.
* lisp/emacs-lisp/cl-macs.el (cl--transform-lambda): Use macroexp-parse-body.

1 files changed, 16 insertions, 19 deletions

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index c5f49b0ed91..c3da091fb00 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -234,10 +234,9 @@ FORM is of the form (ARGS . BODY)."
   (let* ((args (car form)) (body (cdr form)) (orig-args args)
 	 (cl--bind-block bind-block) (cl--bind-defs nil) (cl--bind-enquote nil)
          (cl--bind-lets nil) (cl--bind-forms nil)
-	 (header nil) (simple-args nil))
-    (while (or (stringp (car body))
-	       (memq (car-safe (car body)) '(interactive declare cl-declare)))
-      (push (pop body) header))
+         (parsed-body (macroexp-parse-body body))
+	 (header (car parsed-body)) (simple-args nil))
+    (setq body (cdr parsed-body))
     (setq args (if (listp args) (cl-copy-list args) (list '&rest args)))
     (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
     (if (setq cl--bind-defs (cadr (memq '&cl-defs args)))
@@ -258,7 +257,7 @@ FORM is of the form (ARGS . BODY)."
     (or (eq cl--bind-block 'cl-none)
 	(setq body (list `(cl-block ,cl--bind-block ,@body))))
     (if (null args)
-	(cl-list* nil (nreverse simple-args) (nconc (nreverse header) body))
+	(cl-list* nil (nreverse simple-args) (nconc header body))
       (if (memq '&optional simple-args) (push '&optional args))
       (cl--do-arglist args nil (- (length simple-args)
                                   (if (memq '&optional simple-args) 1 0)))
@@ -266,20 +265,18 @@ FORM is of the form (ARGS . BODY)."
       (cl-list* nil
 	     (nconc (nreverse simple-args)
 		    (list '&rest (car (pop cl--bind-lets))))
-	     (nconc (let ((hdr (nreverse header)))
-                      ;; Macro expansion can take place in the middle of
-                      ;; apparently harmless computation, so it should not
-                      ;; touch the match-data.
-                      (save-match-data
-                        (require 'help-fns)
-                        (cons (help-add-fundoc-usage
-                               (if (stringp (car hdr)) (pop hdr))
-                               ;; Be careful with make-symbol and (back)quote,
-                               ;; see bug#12884.
-                               (let ((print-gensym nil) (print-quoted t))
-                                 (format "%S" (cons 'fn (cl--make-usage-args
-                                                         orig-args)))))
-                              hdr)))
+	     (nconc (save-match-data ;; Macro expansion can take place in the
+                      ;; middle of apparently harmless computation, so it
+                      ;; should not touch the match-data.
+                      (require 'help-fns)
+                      (cons (help-add-fundoc-usage
+                             (if (stringp (car header)) (pop header))
+                             ;; Be careful with make-symbol and (back)quote,
+                             ;; see bug#12884.
+                             (let ((print-gensym nil) (print-quoted t))
+                               (format "%S" (cons 'fn (cl--make-usage-args
+                                                       orig-args)))))
+                            header))
 		    (list `(let* ,cl--bind-lets
                              ,@(nreverse cl--bind-forms)
                              ,@body)))))))