diff options
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r-- | lisp/emacs-lisp/cconv.el | 11 | ||||
-rw-r--r-- | lisp/emacs-lisp/cl-generic.el | 4 | ||||
-rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 35 | ||||
-rw-r--r-- | lisp/emacs-lisp/generator.el | 6 | ||||
-rw-r--r-- | lisp/emacs-lisp/nadvice.el | 2 |
5 files changed, 33 insertions, 25 deletions
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 7cec91bfa82..d8f463e9d6a 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -293,15 +293,10 @@ of converted forms." (cconv-convert form env nil)) funcbody)) (if wrappers - (let ((special-forms '())) - ;; Keep special forms at the beginning of the body. - (while (or (and (cdr funcbody) (stringp (car funcbody))) ;docstring. - (memq (car-safe (car funcbody)) - '(interactive declare :documentation))) - (push (pop funcbody) special-forms)) - (let ((body (macroexp-progn funcbody))) + (pcase-let ((`(,decls . ,body) (macroexp-parse-body funcbody))) + (let ((body (macroexp-progn body))) (dolist (wrapper wrappers) (setq body (funcall wrapper body))) - `(,@(nreverse special-forms) ,@(macroexp-unprogn body)))) + `(,@decls ,@(macroexp-unprogn body)))) funcbody))) (defun cconv--lifted-arg (var env) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 9de47e4987d..d162dfbbeb5 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -286,7 +286,9 @@ DEFAULT-BODY, if present, is used as the body of a default method. (progn (defalias ',name (cl-generic-define ',name ',args ',(nreverse options)) - ,(help-add-fundoc-usage doc args)) + ,(if (consp doc) ;An expression rather than a constant. + `(help-add-fundoc-usage ,doc ',args) + (help-add-fundoc-usage doc args))) :autoload-end ,@(mapcar (lambda (method) `(cl-defmethod ,name ,@method)) (nreverse methods))) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 87f7e078516..a8f046b148c 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -301,24 +301,31 @@ FORM is of the form (ARGS . BODY)." (t ;; `simple-args' doesn't handle all the parsing that we need, ;; so we pass the rest to cl--do-arglist which will do ;; "manual" parsing. - (let ((slen (length simple-args))) - (when (memq '&optional simple-args) - (cl-decf slen)) - (setq header + (let ((slen (length simple-args)) + (usage-str ;; Macro expansion can take place in the middle of ;; apparently harmless computation, so it should not ;; touch the match-data. (save-match-data - (cons (help-add-fundoc-usage - (if (stringp (car header)) (pop header)) - ;; Be careful with make-symbol and (back)quote, - ;; see bug#12884. - (help--docstring-quote - (let ((print-gensym nil) (print-quoted t) - (print-escape-newlines t)) - (format "%S" (cons 'fn (cl--make-usage-args - orig-args)))))) - header))) + (help--docstring-quote + (let ((print-gensym nil) (print-quoted t) + (print-escape-newlines t)) + (format "%S" (cons 'fn (cl--make-usage-args + orig-args)))))))) + (when (memq '&optional simple-args) + (cl-decf slen)) + (setq header + (cons + (if (eq :documentation (car-safe (car header))) + `(:documentation (help-add-fundoc-usage + ,(cadr (pop header)) + ,usage-str)) + (help-add-fundoc-usage + (if (stringp (car header)) (pop header)) + ;; Be careful with make-symbol and (back)quote, + ;; see bug#12884. + usage-str)) + header)) ;; FIXME: we'd want to choose an arg name for the &rest param ;; and pass that as `expr' to cl--do-arglist, but that ends up ;; generating code with a redundant let-binding, so we instead diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el index ac1412704b0..86119d3e3ed 100644 --- a/lisp/emacs-lisp/generator.el +++ b/lisp/emacs-lisp/generator.el @@ -690,8 +690,10 @@ of values. Callers can retrieve each value using `iter-next'." (declare (indent defun) (debug (&define lambda-list lambda-doc &rest sexp))) (cl-assert lexical-binding) - `(lambda ,arglist - ,(cps-generate-evaluator body))) + (pcase-let* ((`(,declarations . ,exps) (macroexp-parse-body body))) + `(lambda ,arglist + ,@declarations + ,(cps-generate-evaluator exps)))) (defmacro iter-make (&rest body) "Return a new iterator." diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 8fc2986ab41..27c289e385e 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -480,6 +480,8 @@ is defined as a macro, alias, command, ..." (get symbol 'advice--pending)) (t (symbol-function symbol))) function props) + ;; FIXME: We could use a defmethod on `function-docstring' instead, + ;; except when (or (not nf) (autoloadp nf))! (put symbol 'function-documentation `(advice--make-docstring ',symbol)) (add-function :around (get symbol 'defalias-fset-function) #'advice--defalias-fset)) |