Squashed commit of the following:

commit ee0e9ff Author: Philipp Stephani <[email protected]> Date: Sun Apr 12 10:11:57 2020 +0200 Support ‘declare’ forms in ‘aio-defun’ Fixes skeeto#12
kiennq · Dec 1, 2021 · 342ea6f · 342ea6f
1 parent da93523
commit 342ea6f
Show file tree

Hide file tree

Showing 2 changed files with 55 additions and 4 deletions.
diff --git a/aio-test.el b/aio-test.el
@@ -13,6 +13,10 @@
 (require 'aio)
 (require 'cl-lib)
 (require 'ert)
+(require 'help)
+(require 'help-fns)
+(require 'rx)
+(require 'sort)
 
 (defmacro aio-with-test (timeout &rest body)
   "Run body asynchronously but block synchronously until it completes.
@@ -135,3 +139,32 @@ aio-timeout to cause the test to fail."
       ;; Check that the threads ran in correct order
       (should (equal (number-sequence 0 63)
                      (nreverse output))))))
+
+(aio-defun aio-test-fun (foo &optional bar)
+  "Reticulate the splines.
+
+\(fn FOO &optional QUX)"
+  (declare (obsolete nil nil))
+  (interactive "sFoo: ")
+  (list foo bar))
+
+(ert-deftest aio-defun ()
+  "Test that declarations and ‘interactive’ forms in ‘aio-defun’ work."
+  (should (commandp 'aio-test-fun))
+  (should (equal (interactive-form 'aio-test-fun) '(interactive "sFoo: ")))
+  (should (equal (help-split-fundoc (documentation 'aio-test-fun)
+                                    'aio-test-fun 'doc)
+                 "Reticulate the splines."))
+  (should (equal (help-function-arglist 'aio-test-fun :preserve-names)
+                 '(foo &optional qux)))
+  (should (string-match-p
+           (rx bos "an interactive " (? "compiled ") "Lisp function")
+           (with-output-to-string
+             (help-fns-function-description-header 'aio-test-fun))))
+  (with-temp-buffer
+    (run-hook-with-args 'help-fns-describe-function-functions 'aio-test-fun)
+    (sort-lines nil (point-min) (point-max))
+    (should (equal (buffer-string)
+                   (concat "  This function is asynchronous; "
+                           "it returns an ‘aio-promise’ object.\n"
+                           "  This function is obsolete.\n")))))
diff --git a/aio.el b/aio.el
@@ -148,13 +148,31 @@ value, or any uncaught error signal."
            (aio--step iter ,promise nil))))))
 
 (defmacro aio-defun (name arglist &rest body)
-  "Like `aio-lambda' but gives the function a name like `defun'."
+  "Like `aio-lambda' but gives the function a name like `defun'.
+
+\(fn NAME ARGLIST &optional DOCSTRING DECL INTERACTIVE &rest BODY)"
   (declare (indent defun)
            (doc-string 3)
            (debug (&define name lambda-list &rest sexp)))
-  `(progn
-     (defalias ',name (aio-lambda ,arglist ,@body))
-     (function-put ',name 'aio-defun-p t)))
+  (or name (error "Cannot define `%s' as a function" name))
+  (let* ((split-body (macroexp-parse-body body))
+         (declarations (car split-body))
+         (body (cdr split-body))
+         (docstring (and (stringp (car declarations)) (pop declarations)))
+         (declares (and (eq (car-safe (car declarations)) #'declare)
+                        (cdr (pop declarations)))))
+    ;; Other declarations (e.g., ‘interactive’ forms) are left as-is.
+    `(progn
+       (defalias ',name (aio-lambda ,arglist ,docstring ,@declarations ,@body))
+       (function-put ',name 'aio-defun-p t)
+       ,@(mapcar
+          (lambda (declare)
+            (let* ((prop (car declare))
+                   (args (cdr declare))
+                   (fun (assq prop defun-declarations-alist)))
+              (or fun (error "Unknown ‘defun’ declaration property %s" prop))
+              (apply (cadr fun) name arglist args)))
+          declares))))
 
 (defun aio-wait-for (promise)
   "Synchronously wait for PROMISE, blocking the current thread."