blob: 99f794afa6ec391dc48b1da094d511da9aa421cd (
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
|
;;; test-org-drill-explain-text-and-leitner.el --- Tests for explain helpers and leitner dispatch -*- lexical-binding: t; -*-
;;; Commentary:
;; Tests for:
;;
;; - `org-drill-get-explain-text': walks up the outline collecting body
;; text from any parent heading tagged `:explain:'.
;; - `org-drill-explain-answer-presenter': appends an explanation
;; overlay below the entry.
;; - `org-drill-explain-cleaner': removes the explanation overlay.
;; - `org-drill-sm-or-leitner': chooses between SM and Leitner
;; learning based on the pending entry count.
;;; Code:
(require 'ert)
(require 'cl-lib)
(require 'org)
(require 'org-drill)
;;;; Helpers
(defmacro with-org-buffer (content &rest body)
(declare (indent 1))
`(with-temp-buffer
(let ((org-startup-folded nil))
(insert ,content)
(org-mode)
(goto-char (point-min))
,@body)))
;;;; org-drill-get-explain-text
(ert-deftest test-get-explain-text-no-explain-parent-returns-existing-text ()
"When no parent has :explain:, returns the existing-text arg unchanged."
(with-org-buffer "* Parent\n** Child :drill:\nbody\n"
(re-search-forward "^\\*\\* Child")
(org-back-to-heading t)
(should (equal '("preserved")
(org-drill-get-explain-text '("preserved"))))))
(ert-deftest test-get-explain-text-with-explain-parent-collects-body ()
"Parent tagged :explain: contributes its body text to the result."
(with-org-buffer "* Parent :explain:
explain-body
** Child :drill:
drill-body
"
(re-search-forward "^\\*\\* Child")
(org-back-to-heading t)
(let ((result (org-drill-get-explain-text)))
(should (listp result))
(should (= 1 (length result)))
(should (string-match-p "explain-body" (car result))))))
(ert-deftest test-get-explain-text-stops-at-top-level ()
"Recursion stops when outline-level reaches 1 (no further parents)."
(with-org-buffer "* Top\nbody\n"
(org-back-to-heading t)
;; outline-level is 1 → returns existing-text immediately.
(should (null (org-drill-get-explain-text)))))
;;;; org-drill-explain-answer-presenter
(ert-deftest test-explain-answer-presenter-creates-overlay-with-explanation ()
"Creates an overlay below the entry whose after-string contains the
collected explanation text."
(with-org-buffer "* Parent :explain:
the-explanation
** Child :drill:
the-question
"
(re-search-forward "^\\*\\* Child")
(org-back-to-heading t)
(setq org-drill-explain-overlay nil)
(org-drill-explain-answer-presenter)
(should org-drill-explain-overlay)
(let ((after-text (overlay-get org-drill-explain-overlay 'after-string)))
(should (string-match-p "Explanation:" after-text))
(should (string-match-p "the-explanation" after-text)))
(delete-overlay org-drill-explain-overlay)
(setq org-drill-explain-overlay nil)))
(ert-deftest test-explain-answer-presenter-replaces-existing-overlay ()
"Calling twice doesn't accumulate overlays — the prior one is cleared."
(with-org-buffer "* Parent :explain:\nA\n** Child :drill:\nQ\n"
(re-search-forward "^\\*\\* Child")
(org-back-to-heading t)
(setq org-drill-explain-overlay nil)
(org-drill-explain-answer-presenter)
(let ((first-overlay org-drill-explain-overlay))
(org-drill-explain-answer-presenter)
;; First overlay is no longer live in the buffer.
(should-not (memq first-overlay (overlays-in (point-min) (point-max)))))
(delete-overlay org-drill-explain-overlay)
(setq org-drill-explain-overlay nil)))
;;;; org-drill-explain-cleaner
(ert-deftest test-explain-cleaner-removes-the-overlay ()
(with-org-buffer "* Parent :explain:\nA\n** Child :drill:\nQ\n"
(re-search-forward "^\\*\\* Child")
(org-back-to-heading t)
(setq org-drill-explain-overlay nil)
(org-drill-explain-answer-presenter)
(should org-drill-explain-overlay)
(org-drill-explain-cleaner)
(should-not (memq org-drill-explain-overlay
(overlays-in (point-min) (point-max))))
(setq org-drill-explain-overlay nil)))
(ert-deftest test-explain-cleaner-no-overlay-no-error ()
"Cleaner is safe to call when no overlay exists."
(setq org-drill-explain-overlay nil)
;; Should not error.
(org-drill-explain-cleaner))
;;;; org-drill-sm-or-leitner
(ert-deftest test-sm-or-leitner-with-pending-entries-runs-again ()
"When the prior session has pending entries beyond leitner-completed,
sm-or-leitner runs the SM (org-drill-again) flow."
(let ((again-called nil)
(leitner-called nil)
(session (org-drill-session)))
(oset session new-entries
(list (let ((m (make-marker))) (set-marker m 1) m)
(let ((m (make-marker))) (set-marker m 1) m)))
(oset session start-time (float-time (current-time)))
(let ((org-drill-last-session session)
(org-drill-leitner-completed 0))
(cl-letf (((symbol-function 'org-drill-again)
(lambda () (setq again-called t)))
((symbol-function 'org-drill-leitner)
(lambda (&rest _) (setq leitner-called t)))
((symbol-function 'sit-for) #'ignore)
((symbol-function 'org-drill-map-entries) #'ignore))
(org-drill-sm-or-leitner)
(should again-called)
(should-not leitner-called)))))
(ert-deftest test-sm-or-leitner-no-pending-entries-runs-leitner ()
"When there's nothing pending in SM-style, fall through to Leitner."
(let ((again-called nil)
(leitner-called nil)
(session (org-drill-session)))
(let ((org-drill-last-session session)
(org-drill-leitner-completed 0))
(cl-letf (((symbol-function 'org-drill-again)
(lambda () (setq again-called t)))
((symbol-function 'org-drill-leitner)
(lambda (&rest _) (setq leitner-called t)))
((symbol-function 'sit-for) #'ignore)
((symbol-function 'org-drill-map-entries) #'ignore))
(org-drill-sm-or-leitner)
(should-not again-called)
(should leitner-called)))))
(provide 'test-org-drill-explain-text-and-leitner)
;;; test-org-drill-explain-text-and-leitner.el ends here
|
