[nongnu] elpa/with-simulated-input b0faef361b 027/134: Properly generate lexical closures for lisp actions in KEYS

[ELPA Syncer]

branch: elpa/with-simulated-input
commit b0faef361b843c876b51ae30450dd9a7ac83b331
Author: Ryan C. Thompson <rct@thompsonclan.org>
Commit: Ryan C. Thompson <rct@thompsonclan.org>

    Properly generate lexical closures for lisp actions in KEYS
    
    Fixes #3.
---
 tests/test-with-simulated-input.el |  46 ++++++++++----
 with-simulated-input.el            | 120 ++++++++++++++++++++++---------------
 2 files changed, 105 insertions(+), 61 deletions(-)

diff --git a/tests/test-with-simulated-input.el 
b/tests/test-with-simulated-input.el
index b288f4fa45..a2d9794e7e 100644
--- a/tests/test-with-simulated-input.el
+++ b/tests/test-with-simulated-input.el
@@ -8,17 +8,20 @@
 (defvar mycollection)
 
 (describe "`with-simulated-input'"
+
   (it "should work for basic string input"
     (expect
      (with-simulated-input "hello RET"
        (read-string "Enter a string: "))
      :to-equal "hello"))
+
   (it "should throw an error if the input is incomplete"
     (expect
      (lambda ()
        (with-simulated-input "hello"
          (read-string "Enter a string: ")))
      :to-throw))
+
   (it "should allow the input to trigger errors"
     (expect
      (lambda ()
@@ -26,18 +29,21 @@
            "(error SPC \"Manually SPC throwing SPC an SPC error\") RET"
          (command-execute 'eval-expression)))
      :to-throw))
+
   (it "should ignore extra input after BODY has completed"
     (expect
      (with-simulated-input
          "hello RET M-x eval-expression (error SPC \"Manually SPC throwing SPC 
an SPC error\") RET"
        (read-string "Enter a string: "))
      :to-equal "hello"))
+
   (it "should allow multiple functions in BODY to read input"
     (expect
      (with-simulated-input "hello RET world RET"
        (list (read-string "First word: ")
              (read-string "Second word: ")))
      :to-equal '("hello" "world")))
+
   (it "should allow aborting via C-g in KEYS"
     (expect
      (condition-case nil
@@ -46,12 +52,14 @@
        (quit 'caught-quit))
      :to-be 'caught-quit))
 
-
   (describe "used with `completing-read'"
+
     :var (collection completing-read-function)
+
     (before-each
       (setq mycollection '("bluebird" "blueberry" "bluebell" "bluegrass" 
"baseball")
             completing-read-function #'completing-read-default))
+
     ;; Unambiguous completion
     (it "should work with unambiguous tab completion"
       (expect
@@ -59,11 +67,13 @@
        (with-simulated-input "bl TAB bi TAB RET"
          (completing-read "Choose: " mycollection))
        :to-equal "bluebird"))
+
     (it "should work with ambiguous tab completion"
       (expect
        (with-simulated-input "bl TAB C-j"
          (completing-read "Choose: " mycollection))
        :to-equal "blue"))
+
     (it "should fail to exit with ambiguous completion and `require-match'"
       ;; Suppress messages by replacing `message' with a stub
       (spy-on 'message)
@@ -74,23 +84,27 @@
        :to-throw)))
 
   (describe "using lisp forms in KEYS argument of `with-simulated-input'"
+
     (it "should allow evaluating arbitrary lisp forms"
       (expect
        (with-simulated-input '("hello SPC" (insert "world") "RET")
          (read-string "Enter a string: "))
        :to-equal "hello world"))
+
     (it "should allow lisp forms to throw errors"
       (expect
        (lambda ()
          (with-simulated-input '("hello SPC" (error "Throwing an error") "RET")
            (read-string "Enter a string: ")))
        :to-throw))
+
     (it "should not interpret lisp forms once BODY has finished"
       (expect
        (with-simulated-input '("hello SPC world RET RET"
                                (error "Should not reach this error"))
          (read-string "Enter a string: "))
        :to-equal "hello world"))
+
     (it "should evaluate lisp forms in the proper lexical environment"
       (let ((my-lexical-var nil))
         (with-simulated-input '("hello"
@@ -99,56 +113,62 @@
           (read-string "Enter a string: "))
         (expect my-lexical-var
                 :to-be-truthy)))
-    (it "should evaluate lisp forms in the proper lexical environment when 
manually wrapping expressions in closures"
-      (let ((my-lexical-var nil))
-        (with-simulated-input (list
-                               "hello"
-                               ;; TODO: The macro needs to generate
-                               ;; this kind of lambda wrapper natively
-                               ;; for each non-string element of KEYS
-                               (list (lambda () (setq my-lexical-var t)))
-                               "RET")
-          (read-string "Enter a string: "))
-        (expect my-lexical-var
-                :to-be-truthy)))))
+
+    (it "should allow interpolation of variables into KEYS"
+      (let ((my-key-sequence "hello")
+            (my-lisp-form '(insert " world")))
+        (expect
+         (with-simulated-input (list
+                                my-key-sequence
+                                my-lisp-form
+                                "RET")
+           (read-string "Enter a string: "))
+         :to-equal "hello world")))))
 
 (defun idle-canary ())
 (defvar timers-to-cancel nil)
 (defvar orig-timer--activate (symbol-function 'timer--activate))
 
 (describe "`wsi-simulate-idle-time'"
+
   (spy-on 'idle-canary)
   (spy-on 'timer--activate
           :and-call-fake
           (lambda (timer &rest args)
             (push timer timers-to-cancel)
             (apply orig-timer--activate timer args)))
+
   (after-each
     (mapcar #'cancel-timer timers-to-cancel)
     (setq timers-to-cancel nil)
     (spy-calls-reset 'idle-canary))
+
   (it "should run idle timers"
     (run-with-idle-timer 500 nil 'idle-canary)
     (wsi-simulate-idle-time 500)
     (expect 'idle-canary :to-have-been-called))
+
   (it "should not run idle timers with longer times even when called multiple 
times"
     (run-with-idle-timer 500 nil 'set 'idle-canary)
     (wsi-simulate-idle-time 400)
     (wsi-simulate-idle-time 400)
     (wsi-simulate-idle-time 400)
     (expect 'idle-canary :not :to-have-been-called))
+
   (it "should run idle timers added by other idle timers"
     (run-with-idle-timer
      100 nil 'run-with-idle-timer
      200 nil 'idle-canary)
     (wsi-simulate-idle-time 500)
     (expect 'idle-canary :to-have-been-called))
+
   (it "should run idle timers added by other idle timers when the new timer is 
in the past"
     (run-with-idle-timer
      100 nil 'run-with-idle-timer
      50 nil 'idle-canary)
     (wsi-simulate-idle-time 500)
     (expect 'idle-canary :to-have-been-called))
+
   (it "should run all idle timers when called with SECS = nil"
     (run-with-idle-timer 1000 nil 'idle-canary)
     (wsi-simulate-idle-time 1)
diff --git a/with-simulated-input.el b/with-simulated-input.el
index 3001825f57..87b58e8bc9 100644
--- a/with-simulated-input.el
+++ b/with-simulated-input.el
@@ -13,7 +13,7 @@
 ;; This file is NOT part of GNU Emacs.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; 
+;;
 ;;; Commentary:
 
 ;; This package provides a single macro, `with-simulated-input', which
@@ -24,22 +24,22 @@
 ;; interactive commands and functions, such as `completing-read'.
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; 
+;;
 ;; This program is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation, either version 3 of the License, or (at
 ;; your option) any later version.
-;; 
+;;
 ;; This program is distributed in the hope that it will be useful, but
 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 ;; General Public License for more details.
-;; 
+;;
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
-;; 
+;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; 
+;;
 ;;; Code:
 
 (require 'cl-lib)
@@ -101,34 +101,21 @@ to check.
        do (cl-return-from findkey bind))
    finally do (error "Could not find an unbound key with the specified 
modifiers")))
 
-(defun wsi-prepare-actions (keys exec-form-keybind)
-  (cl-loop
-   with full-key-sequence = '()
-   with action-list = '()
-   for action in keys
-   if (stringp action)
-   collect action into full-key-sequence
-   else
-   collect `(lambda () ,action) into action-list and
-   collect exec-form-keybind into full-key-sequence
-   finally return
-   (list :keys (s-join " " full-key-sequence)
-         :actions action-list)))
-
-(defvar wsi-action-list nil)
-
-(defun wsi-run-next-action ()
-  "Pop and call the next function in `wsi-action-list'.
-
-If the action list is empty, run `(keyboard-quit)' instead."
-  (interactive)
-  (condition-case err
-      (if wsi-action-list
-          (let ((next-action (pop wsi-action-list)))
-            ;; (message "Executing `%S'" next-action)
-            (funcall next-action))
-        (error "Reached end of `wsi-action-list'."))
-    (error (throw 'wsi-threw-error err))))
+(defmacro wsi-current-lexical-environment ()
+  "Return the current lexical environment.
+
+This macro expands to a lisp form that evaluates to the current
+lexical environment. It works by creating a closure and then
+extracting and returning its lexical environment.
+
+This can be used to manually construct closures in that
+environment."
+  `(let ((temp-closure (lambda () t)))
+     (cl-assert (eq (car temp-closure) 'closure) t)
+     (cadr temp-closure)))
+
+(defun wsi-make-closure (expr env)
+  `(closure ,env () ,expr))
 
 ;;;###autoload
 (defmacro with-simulated-input (keys &rest body)
@@ -153,8 +140,6 @@ example, `\"hello RET\"' could also be written as:
 
     `((insert \"hello\") \"RET\")'
 
-Currently, KEYS cannot contain more than 36 lisp forms.
-
 If BODY tries to read more input events than KEYS provides, an
 error is signalled. This is to ensure that BODY will never block
 waiting for input, since this macro is intended for
@@ -169,26 +154,65 @@ The return value is the last form in BODY, as if it was 
wrapped
 in `progn'."
   (declare (indent 1))
   `(cl-letf*
-       ((next-action-key (wsi-get-unbound-key))
+       ((lexenv (wsi-current-lexical-environment))
+        (next-action-key (wsi-get-unbound-key))
         (canary-sym ',(cl-gensym "wsi-canary-"))
         (result canary-sym)
         (thrown-error nil)
         (body-form
          '(throw 'wsi-body-finished (progn ,@body)))
+        (end-of-actions-form
+         (list 'throw
+               '(quote wsi-body-finished)
+               (list 'quote canary-sym)))
         ;; Ensure KEYS is a list, and put the body form as the first
         ;; item and `C-g' as the last item
-        (keys (append
-               (list body-form)
-               (if (listp ,keys)
-                   ,keys
-                 (list ,keys))
-               (list `(throw 'wsi-body-finished ',canary-sym))))
-        ;; Prepare the list of actions to execute, and the full key
-        ;; sequence to execute them
-        (action-plist (wsi-prepare-actions keys next-action-key))
-        (wsi-action-list (plist-get action-plist :actions))
+        (keylist ,keys)
+        (keylist (if (listp keylist)
+                     keylist
+                   (list keylist)))
+        ;; Replace non-strings with `next-action-key' and concat
+        ;; everything together
         (full-key-sequence
-         (concat (plist-get action-plist :keys)))
+         (cl-loop
+          for action in keylist
+          if (stringp action)
+          collect action into key-sequence-list
+          else
+          collect next-action-key into key-sequence-list
+          finally return
+          ;; Prepend and append `next-action-key' to run body and canary
+          (concat
+           next-action-key " "
+           (mapconcat #'identity key-sequence-list " ")
+           " " next-action-key)))
+        ;; Extract non-string forms, adding body at the front and
+        ;; canary at the back
+        (action-list
+         (nconc
+          (list body-form)
+          (cl-loop
+           for action in keylist
+           if (not (stringp action))
+           collect action)
+          (list end-of-actions-form)))
+        ;; Wrap each action in a lexical closure so it can refer to
+        ;; variables from the caller.
+        (action-closures
+         (cl-loop
+          for action in action-list
+          collect (wsi-make-closure action lexenv)))
+        ;; Define the next action command with lexical scope so it can
+        ;; access `action-closures'.
+        ((symbol-function 'wsi-run-next-action)
+         (lambda ()
+           (interactive)
+           (condition-case err
+               (if action-closures
+                   (let ((next-action (pop action-closures)))
+                     (funcall next-action))
+                 (error "`with-simulated-input' reached end of action list 
without returning."))
+             (error (throw 'wsi-threw-error err)))))
         ;; Set up the temporary keymap
         (action-map (make-sparse-keymap)))
      ;; Finish setting up the keymap for the temp command