[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/oclosure a7a19617fb 2/2: oclosure.el: Add docstrings and interac
From: |
Stefan Monnier |
Subject: |
scratch/oclosure a7a19617fb 2/2: oclosure.el: Add docstrings and interactive forms |
Date: |
Sun, 9 Jan 2022 17:12:47 -0500 (EST) |
branch: scratch/oclosure
commit a7a19617fbd8947c28660f71296dd362fb1e435c
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
oclosure.el: Add docstrings and interactive forms
Use anonymous classes to add support for docstrings
and interactive forms to OClosures.
* lisp/simple.el (function-docstring, interactive-form): New methods
for `oclosure-documented` and `oclosure-command`.
* lisp/emacs-lisp/oclosure.el (oclosure-lambda): Convert docstrings and
interactive specs in the body into OClosure slots of `oclosure-documented`
and `oclosure-command`.
(oclosure-documented, oclosure-command): New types.
* test/lisp/emacs-lisp/oclosure-tests.el (oclosure-test-anonymous):
Add tests.
---
lisp/emacs-lisp/oclosure.el | 30 ++++++++++++++++++++++++++----
lisp/simple.el | 7 +++++++
test/lisp/emacs-lisp/oclosure-tests.el | 17 +++++++++++++++--
3 files changed, 48 insertions(+), 6 deletions(-)
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
index 1efaf207bb..861afbec15 100644
--- a/lisp/emacs-lisp/oclosure.el
+++ b/lisp/emacs-lisp/oclosure.el
@@ -32,14 +32,11 @@
;; - OClosure accessor functions, where the type-dispatch is used to
;; dynamically compute the docstring, and also to pretty them.
;; Here are other cases of "callable objects" where OClosures could be used:
+;; - Use the type to distinguish macros from functions.
;; - iterators (generator.el), thunks (thunk.el), streams (stream.el).
;; - PEG rules: they're currently just functions, but they should carry
;; their original (macro-expanded) definition (and should be printed
;; differently from functions)!
-;; - documented functions: this could be a subtype of normal functions, which
-;; simply has an additional `docstring' slot.
-;; - commands: this could be a subtype of documented functions, which simply
-;; has an additional `interactive-form' slot.
;; - auto-generate docstrings for cl-defstruct slot accessors instead of
;; storing them in the accessor itself?
;; - SRFI-17's `setter'.
@@ -115,6 +112,7 @@
;; - `oclosure-(cl-)defun', `oclosure-(cl-)defsubst', `oclosure-define-inline'?
;; - Use accessor in cl-defstruct.
;; - Add pcase patterns for OClosures.
+;; - anonymous OClosure types.
;; - copiers for mixins
;; - class-allocated slots?
;; - code-allocated slots?
@@ -476,6 +474,21 @@ ARGS and BODY are the same as for `lambda'."
(if (listp (car fields))
(nreverse types)
(loop (cons (pop fields) types)))))
+ (_ (when (or (and (stringp (car-safe body)) (cdr body))
+ (eq :documentation (car-safe (car-safe body))))
+ (let ((doc (pop body)))
+ (if (eq :documentation (car-safe doc))
+ (setq doc (cadr doc)))
+ (setq types (nconc types (list 'oclosure-documented)))
+ (setq fields (append fields `((docstring ,doc)))))))
+ (_ (when (assq 'interactive body)
+ (let ((spec (assq 'interactive body)))
+ (setq body (remq spec body))
+ (setq types (nconc types (list 'oclosure-command)))
+ (setq fields (append fields `((interactive-form
+ ,(if (cddr spec)
+ (vconcat (cdr spec))
+ (cadr spec)))))))))
(type-exp (if (null (cdr types))
`',(car types)
`(oclosure--anonymous-define
@@ -651,5 +664,14 @@ ARGS and BODY are the same as for `lambda'."
(oclosure--set val oclosure
(oclosure--mixin-slot-index oclosure slot))))
+;; These need to come after we define the mixin accessors.
+(oclosure-define (oclosure-documented (:mixin t)) docstring)
+(oclosure-define (oclosure-command
+ (:mixin t)
+ ;; Not indispensable, but since by convention all
+ ;; commands should be documented, we might as well.
+ (:parent oclosure-documented))
+ interactive-form)
+
(provide 'oclosure)
;;; oclosure.el ends here
diff --git a/lisp/simple.el b/lisp/simple.el
index 70ac5620b5..d44f90adcb 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2352,6 +2352,10 @@ FUNCTION is expected to be a function value rather than,
say, a mere symbol."
;; FIXME: η-reduce!
(oclosure--accessor-docstring function))
+(cl-defmethod function-docstring ((function oclosure-documented))
+ ;; FIXME: η-reduce!
+ (oclosure-documented--docstring function))
+
(cl-defgeneric interactive-form (cmd &optional original-name)
"Return the interactive form of CMD or nil if none.
If CMD is not a command, the return value is nil.
@@ -2384,6 +2388,9 @@ ORIGINAL-NAME is used internally only."
spec)))
(_ (internal--interactive-form cmd))))
+(cl-defmethod interactive-form ((cmd oclosure-command) &optional
_original-name)
+ (list 'interactive (oclosure-command--interactive-form cmd)))
+
(defun command-execute (cmd &optional record-flag keys special)
;; BEWARE: Called directly from the C code.
"Execute CMD as an editor command.
diff --git a/test/lisp/emacs-lisp/oclosure-tests.el
b/test/lisp/emacs-lisp/oclosure-tests.el
index 243921a734..95ad76ffb7 100644
--- a/test/lisp/emacs-lisp/oclosure-tests.el
+++ b/test/lisp/emacs-lisp/oclosure-tests.el
@@ -189,7 +189,12 @@
(fst 'fst) (snd 'snd)
(a 'a))
(x)
- (list x fst))))
+ (list x fst)))
+ (ocl2 (oclosure-lambda (oclosure-test (fst 'fst) (snd 'snd))
+ (x)
+ "Doc"
+ (interactive "P")
+ (list x snd))))
(should (equal (oclosure-test-mixin1--a ocl1)
'a))
@@ -198,6 +203,14 @@
(should (equal (funcall ocl1 'x) '(x fst)))
(should (cl-typep ocl1 'oclosure-test))
(should (cl-typep ocl1 'oclosure-test-mixin1))
- (should (cl-typep ocl1 '(and oclosure-test oclosure-test-mixin1)))))
+ (should (cl-typep ocl1 '(and oclosure-test oclosure-test-mixin1)))
+
+ (should (cl-typep ocl2 '(and oclosure-command oclosure-documented)))
+ (should (equal (interactive-form ocl2) '(interactive "P")))
+ (should (commandp ocl2))
+ (should (equal (let ((current-prefix-arg 'pfx))
+ (call-interactively ocl2))
+ '(pfx snd)))
+ (should (equal "Doc" (documentation ocl2)))))
;;; oclosure-tests.el ends here.