+ (defun cl--generic-lambda (args body)
+ "Make the lambda expression for a method with ARGS and BODY."
+ (pcase-let* ((`(,spec-args . ,plain-args)
+ (cl--generic-split-args args))
+ (fun `(cl-function (lambda ,plain-args ,@body)))
+ (macroenv (cons `(cl-generic-current-method-specializers
+ . ,(lambda () spec-args))
+ macroexpand-all-environment)))
+ (require 'cl-lib) ;Needed to expand `cl-flet' and `cl-function'.
+ ;; First macroexpand away the cl-function stuff (e.g. &key and
+ ;; destructuring args, `declare' and whatnot).
+ (pcase (macroexpand fun macroenv)
+ (`#'(lambda ,args . ,body)
+ (let* ((parsed-body (macroexp-parse-body body))
+ (cnm (make-symbol "cl--cnm"))
+ (nmp (make-symbol "cl--nmp"))
+ (nbody (macroexpand-all
+ `(cl-flet ((cl-call-next-method ,cnm)
+ (cl-next-method-p ,nmp))
+ ,@(cdr parsed-body))
+ macroenv))
+ ;; FIXME: Rather than `grep' after the fact, the
+ ;; macroexpansion should directly set some flag when cnm
+ ;; is used.
+ ;; FIXME: Also, optimize the case where call-next-method is
+ ;; only called with explicit arguments.
+ (uses-cnm (cl--generic-fgrep (list cnm nmp) nbody)))
+ (cons (not (not uses-cnm))
+ `#'(lambda (,@(if uses-cnm (list cnm)) ,@args)
+ ,@(car parsed-body)
+ ,(if (not (memq nmp uses-cnm))
+ nbody
+ `(let ((,nmp (lambda ()
+ (cl--generic-isnot-nnm-p ,cnm))))
+ ,nbody))))))
+ (f (error "Unexpected macroexpansion result: %S" f))))))
+
+(put 'cl-defmethod 'function-documentation
+ '(cl--generic-make-defmethod-docstring))
+
+(defun cl--generic-make-defmethod-docstring ()
+ ;; FIXME: Copy&paste from pcase--make-docstring.
+ (let* ((main (documentation (symbol-function 'cl-defmethod) 'raw))
+ (ud (help-split-fundoc main 'cl-defmethod)))
+ ;; So that eg emacs -Q -l cl-lib --eval "(documentation 'pcase)" works,
+ ;; where cl-lib is anything using pcase-defmacro.
+ (require 'help-fns)
+ (with-temp-buffer
+ (insert (or (cdr ud) main))
+ (insert "\n\n\tCurrently supported forms for TYPE:\n\n")
+ (dolist (method (reverse (cl--generic-method-table
+ (cl--generic 'cl-generic-generalizers))))
+ (let* ((info (cl--generic-method-info method)))
+ (when (nth 2 info)
+ (insert (nth 2 info) "\n\n"))))
+ (let ((combined-doc (buffer-string)))
+ (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))