blob: e330cbfaef83dc558d28984dfcafa4b9b31891a9 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
|
;;; test-org-drill-presentation-prompt.el --- Tests for the card-prompt return values -*- lexical-binding: t; -*-
;;; Commentary:
;; Tests for `org-drill-presentation-prompt-in-mini-buffer'. The
;; function shows the card body, runs a busy-wait loop until the user
;; presses a key, and returns:
;;
;; nil — quit key pressed
;; 'edit — edit key pressed
;; 'skip — skip key pressed
;; t — any other key (user wants to see the answer)
;;
;; Tests mock both `input-pending-p' (to bypass the busy-wait) and
;; `read-key-sequence' (to inject the desired key).
;;; Code:
(require 'ert)
(require 'cl-lib)
(require 'org)
(require 'org-drill)
;;;; Helpers
(defmacro with-fresh-drill-entry (&rest body)
(declare (indent 0))
`(with-temp-buffer
(let ((org-startup-folded nil))
(insert "* Question :drill:\nbody\n")
(org-mode)
(goto-char (point-min))
,@body)))
(defmacro with-key-input (key &rest body)
"Run BODY with the prompt's busy-wait skipped and `read-key-sequence' returning KEY."
(declare (indent 1))
`(cl-letf (((symbol-function 'input-pending-p) (lambda () t))
((symbol-function 'read-key-sequence) (lambda (_) ,key))
((symbol-function 'sit-for) #'ignore))
,@body))
;;;; Return values
(ert-deftest test-org-drill-presentation-prompt-quit-returns-nil ()
(with-fresh-drill-entry
(with-key-input (string org-drill--quit-key)
(let ((session (org-drill-session)))
(should (null (org-drill-presentation-prompt-in-mini-buffer session)))))))
(ert-deftest test-org-drill-presentation-prompt-edit-returns-edit ()
(with-fresh-drill-entry
(with-key-input (string org-drill--edit-key)
(let ((session (org-drill-session)))
(should (eq 'edit (org-drill-presentation-prompt-in-mini-buffer session)))))))
(ert-deftest test-org-drill-presentation-prompt-skip-returns-skip ()
(with-fresh-drill-entry
(with-key-input (string org-drill--skip-key)
(let ((session (org-drill-session)))
(should (eq 'skip (org-drill-presentation-prompt-in-mini-buffer session)))))))
(ert-deftest test-org-drill-presentation-prompt-answer-returns-t ()
"Pressing any non-control key (here SPC) returns t — `show me the answer'."
(with-fresh-drill-entry
(with-key-input " "
(let ((session (org-drill-session)))
(should (eq t (org-drill-presentation-prompt-in-mini-buffer session)))))))
(ert-deftest test-org-drill-presentation-prompt-honors-explicit-prompt-arg ()
"An explicit PROMPT arg is honored — the user's prompt text appears in
the formatted full-prompt that gets displayed.
Lets the busy-wait loop run one iteration so message actually fires."
(with-fresh-drill-entry
(let ((messages-seen nil)
(loop-iterations 0))
(cl-letf (((symbol-function 'input-pending-p)
(lambda ()
(cl-incf loop-iterations)
;; Return nil first time (run loop body), then t (exit).
(> loop-iterations 1)))
((symbol-function 'read-key-sequence) (lambda (_) " "))
((symbol-function 'sit-for) #'ignore)
((symbol-function 'message)
(lambda (fmt &rest args)
(push (apply #'format fmt args) messages-seen))))
(let ((session (org-drill-session)))
(org-drill-presentation-prompt-in-mini-buffer session "MY-CUSTOM-PROMPT")
(should (cl-some (lambda (m) (string-match-p "MY-CUSTOM-PROMPT" m))
messages-seen)))))))
;;;; org-drill-presentation-prompt (top-level dispatcher)
(ert-deftest test-org-drill-presentation-prompt-dispatches-to-mini-buffer-by-default ()
"When `org-drill-presentation-prompt-with-typing' is nil, the dispatcher
sends the call to the mini-buffer variant."
(with-fresh-drill-entry
(let ((mini-called nil)
(buffer-called nil)
(org-drill-presentation-prompt-with-typing nil))
(cl-letf (((symbol-function 'org-drill-presentation-prompt-in-mini-buffer)
(lambda (&rest _) (setq mini-called t) t))
((symbol-function 'org-drill-presentation-prompt-in-buffer)
(lambda (&rest _) (setq buffer-called t) t)))
(org-drill-presentation-prompt (org-drill-session))
(should mini-called)
(should-not buffer-called)))))
(ert-deftest test-org-drill-presentation-prompt-dispatches-to-buffer-when-typing ()
"When `org-drill-presentation-prompt-with-typing' is non-nil, dispatcher
goes to the in-buffer variant."
(with-fresh-drill-entry
(let ((mini-called nil)
(buffer-called nil)
(org-drill-presentation-prompt-with-typing t))
(cl-letf (((symbol-function 'org-drill-presentation-prompt-in-mini-buffer)
(lambda (&rest _) (setq mini-called t) t))
((symbol-function 'org-drill-presentation-prompt-in-buffer)
(lambda (&rest _) (setq buffer-called t) t)))
(org-drill-presentation-prompt (org-drill-session))
(should-not mini-called)
(should buffer-called)))))
;;;; org-drill-presentation-prompt-in-buffer
(defmacro with-mocked-in-buffer-deps (&rest body)
(declare (indent 0))
`(cl-letf (((symbol-function 'run-with-idle-timer)
(lambda (&rest _) 'fake-timer))
((symbol-function 'cancel-timer) #'ignore)
((symbol-function 'recursive-edit) #'ignore)
((symbol-function 'select-window) #'ignore)
((symbol-function 'display-buffer)
(lambda (buf &rest _)
(or (get-buffer-window buf)
(selected-window))))
((symbol-function 'org-drill--make-minibuffer-prompt)
(lambda (_s p) p)))
,@body))
(ert-deftest test-presentation-prompt-in-buffer-uses-default-prompt-when-nil ()
"When PROMPT is nil, `prompt-in-buffer' assembles a default prompt that
mentions the response keys."
(let ((seen-prompt nil))
(with-mocked-in-buffer-deps
(cl-letf (((symbol-function 'org-drill--maybe-prepend-leech-warning)
(lambda (p) (setq seen-prompt p) p)))
(with-fresh-drill-entry
(org-drill-presentation-prompt-in-buffer (org-drill-session)))))
(should (string-match-p "Type answer" seen-prompt))))
(ert-deftest test-presentation-prompt-in-buffer-with-explicit-prompt ()
"When PROMPT is supplied, that string is the one fed to the leech-warning prepass."
(let ((seen-prompt nil))
(with-mocked-in-buffer-deps
(cl-letf (((symbol-function 'org-drill--maybe-prepend-leech-warning)
(lambda (p) (setq seen-prompt p) p)))
(with-fresh-drill-entry
(org-drill-presentation-prompt-in-buffer (org-drill-session) "EXPLICIT-P"))))
(should (equal "EXPLICIT-P" seen-prompt))))
(ert-deftest test-presentation-prompt-in-buffer-clears-drill-answer ()
"Calling the prompt resets the session's drill-answer slot."
(let ((session (org-drill-session)))
(oset session drill-answer "stale")
(with-mocked-in-buffer-deps
(cl-letf (((symbol-function 'org-drill--maybe-prepend-leech-warning)
(lambda (p) p)))
(with-fresh-drill-entry
(org-drill-presentation-prompt-in-buffer session "p"))))
(should (null (oref session drill-answer)))))
(ert-deftest test-presentation-prompt-in-buffer-returns-exit-kind ()
"The function returns the session's exit-kind set by recursive-edit."
(let ((session (org-drill-session)))
(with-mocked-in-buffer-deps
(cl-letf (((symbol-function 'recursive-edit)
(lambda () (oset session exit-kind 'mock-result)))
((symbol-function 'org-drill--maybe-prepend-leech-warning)
(lambda (p) p)))
(with-fresh-drill-entry
(let ((result (org-drill-presentation-prompt-in-buffer session "p")))
(should (eq 'mock-result result))))))))
;;;; org-drill-present-simple-card-with-typed-answer
(ert-deftest test-present-simple-card-with-typed-answer-runs-prompt ()
"The typed-answer presenter calls `prompt-for-string' and returns its value."
(let ((called-with nil))
(cl-letf (((symbol-function 'org-drill-hide-all-subheadings-except) #'ignore)
((symbol-function 'org-drill--show-latex-fragments) #'ignore)
((symbol-function 'org-display-inline-images) #'ignore)
((symbol-function 'org-drill-hide-drawers) #'ignore)
((symbol-function 'org-drill-hide-subheadings-if) #'ignore)
((symbol-function 'org-drill-presentation-prompt-for-string)
(lambda (s _p) (setq called-with s) 'prompt-result)))
(with-fresh-drill-entry
(let* ((session (org-drill-session))
(result (org-drill-present-simple-card-with-typed-answer session)))
(should (eq 'prompt-result result))
(should (eq session called-with)))))))
(provide 'test-org-drill-presentation-prompt)
;;; test-org-drill-presentation-prompt.el ends here
|
