branch: elpa/with-simulated-input
commit 80d57be4582e23f2808a8048a656143ab033d9e6
Author: Ryan C. Thompson <[email protected]>
Commit: Ryan C. Thompson <[email protected]>
Make all the tests pass
In theory, this brings the new implementation of with-simulated-input
to feature parity with the old one. This is only a prototype and needs
a lot of cleanup to be release-ready.
---
tests/test-with-simulated-input.el | 18 ++++++++++++-
with-simulated-input.el | 52 +++++++++++++++++++++++++++++++++++---
2 files changed, 65 insertions(+), 5 deletions(-)
diff --git a/tests/test-with-simulated-input.el
b/tests/test-with-simulated-input.el
index da4955d12b..a349e47045 100644
--- a/tests/test-with-simulated-input.el
+++ b/tests/test-with-simulated-input.el
@@ -73,6 +73,7 @@
(read-string "Enter a string: "))
:to-equal "hello")))
+ ;; This syntax is not known to be used in any real code
(it "is an arbitrary expression evaluating to any of the above"
(expect
(with-simulated-input (list "hello" "RET")
@@ -80,7 +81,7 @@
:to-equal "hello")
(expect
(let ((my-input "hello"))
- (with-simulated-input (list '(insert my-input) "RET")
+ (with-simulated-input (list (list 'insert my-input) "RET")
(read-string "Enter a string: ")))
:to-equal "hello")
(expect
@@ -89,13 +90,28 @@
:to-equal "hello")
(let ((my-key-sequence "hello")
(my-lisp-form '(insert " world")))
+ (expect
+ (with-simulated-input '((execute-kbd-macro my-key-sequence)
+ (eval my-lisp-form)
+ "RET")
+ (read-string "Enter a string: "))
+ :to-equal "hello world")
(expect
(with-simulated-input (list
my-key-sequence
my-lisp-form
"RET")
(read-string "Enter a string: "))
+ :to-equal "hello world")
+ (expect
+ (with-simulated-input (list
+ `(execute-kbd-macro ,my-key-sequence)
+ `(eval ,my-lisp-form)
+ "RET")
+ (read-string "Enter a string: "))
:to-equal "hello world")))
+
+ ;; This syntax is not known to be used in any real code
(it "is evaluated at run time in a lexical environment"
(let ((my-input "hello"))
(expect
diff --git a/with-simulated-input.el b/with-simulated-input.el
index 1595ec42c9..794f7d6a9a 100644
--- a/with-simulated-input.el
+++ b/with-simulated-input.el
@@ -177,22 +177,66 @@ The return value is the last form in BODY, as if it was
wrapped
in `progn'."
(declare (indent 1) (debug ([&or ("quote" (&rest &or stringp def-form))
(&rest &or stringp def-form)
+ ;; TODO Is this redundant with symbolp?
+ "nil"
stringp symbolp]
def-body)))
- (if (and (symbolp keys) keys)
- `(progn
- (cl-check-type ,keys string)
+ (cond
+ ((null keys)
+ ;; (message "Keys is nil")
+ `(with-simulated-input-1
+ (lambda ()
+ ,@body)
+ nil))
+ ((and keys (symbolp keys))
+ ;; (message "keys is symbol: %S" keys)
+ `(progn
+ (cond
+ ((null ,keys)
+ (with-simulated-input-1
+ (lambda ()
+ ,@body)
+ nil))
+ ((stringp ,keys)
(with-simulated-input-1
(lambda ()
,@body)
,keys))
+ ((listp ,keys)
+ (apply
+ #'with-simulated-input-1
+ (lambda ()
+ ,@body)
+ (cl-loop for key in ,keys collect (if (stringp key) key `(lambda ()
,key)))))
+ (t
+ (error "INVALID VAR VALUE: %S" ,keys)))))
+ ((and (listp keys)
+ (not (eq (car keys) 'quote))
+ (or (functionp (car keys))
+ (macrop (car keys))
+ (subrp (indirect-function (car keys)))))
+ ;; (message "Keys is lisp form: %S" keys)
+ `(let ((evaluated-keys (,@keys)))
+ ;; (message "Evaluated keys: %S" evaluated-keys)
+ (pcase evaluated-keys
+ (`(quote ,x) (setq evaluated-keys x))
+ ((guard (not (listp evaluated-keys))) (cl-callf list evaluated-keys)))
+ ;; (message "Evaluated keys transformed: %S"
+ ;; (cl-loop for key in evaluated-keys collect (if (stringp
key) key `(lambda () ,key))))
+ (apply
+ #'with-simulated-input-1
+ (lambda ()
+ ,@body)
+ (cl-loop for key in evaluated-keys collect (if (stringp key) key
`(lambda () ,key))))))
+ (t
+ ;; (message "Keys is something else: %S" keys)
(pcase keys
(`(quote ,x) (setq keys x))
((guard (not (listp keys))) (cl-callf list keys)))
`(with-simulated-input-1
(lambda ()
,@body)
- ,@(cl-loop for key in keys collect (if (stringp key) key `(lambda ()
,key))))))
+ ,@(cl-loop for key in keys collect (if (stringp key) key `(lambda ()
,key)))))))
(defvar wsi-simulated-idle-time nil
"The current simulated idle time.
