Codebase list org-drill / fd3efa2
Port to cl-lib Phillip Lord 4 years ago
4 changed file(s) with 140 addition(s) and 141 deletion(s). Raw diff Collapse all Expand all
+2
-0
.gitignore less more
22 /*.elc
33 /makefile-local
44 /robot/Makefile
5 /robot/main-test-copy.org
6 /robot/failure.txt
+1
-0
Makefile less more
3535 $(MAKE) test-cp DOCKER_TAG=25.3
3636
3737 robot-test:
38 $(CASK) clean-elc
3839 $(EMACS_ENV) ./robot/robot-test.sh
3940
4041 .PHONY: test
+118
-123
org-drill.el less more
5555 (require 'org)
5656 (require 'org-id)
5757 (require 'savehist)
58
59 (eval-when-compile
60 (require 'cl))
61
62
6358 (require 'seq)
6459
6560 (defgroup org-drill nil
260255
261256 (defun org-drill--compute-cloze-keywords ()
262257 (list (list (org-drill--compute-cloze-regexp)
263 (copy-list '(1 'org-drill-visible-cloze-face nil))
264 (copy-list '(2 'org-drill-visible-cloze-hint-face t))
265 (copy-list '(3 'org-drill-visible-cloze-face nil))
258 (cl-copy-list '(1 'org-drill-visible-cloze-face nil))
259 (cl-copy-list '(2 'org-drill-visible-cloze-hint-face t))
260 (cl-copy-list '(3 'org-drill-visible-cloze-face nil))
266261 )))
267262
268263 (defvar-local org-drill-cloze-regexp
682677 (let ((idx (gensym)))
683678 `(if (null ,place)
684679 nil
685 (let ((,idx (random* (length ,place))))
680 (let ((,idx (cl-random (length ,place))))
686681 (prog1 (nth ,idx ,place)
687 (setq ,place (append (subseq ,place 0 ,idx)
688 (subseq ,place (1+ ,idx)))))))))
682 (setq ,place (append (cl-subseq ,place 0 ,idx)
683 (cl-subseq ,place (1+ ,idx)))))))))
689684
690685
691686 (defmacro push-end (val place)
702697 temp
703698 (len (length list)))
704699 (while (< i len)
705 (setq j (+ i (random* (- len i))))
700 (setq j (+ i (cl-random (- len i))))
706701 (setq temp (nth i list))
707702 (setf (nth i list) (nth j list))
708703 (setf (nth j list) temp)
750745 skip)))
751746
752747 (defun org-drill-current-scope (scope)
753 (case scope
748 (cl-case scope
754749 (file nil)
755750 (file-no-restriction 'file)
756751 (directory
869864 ;; (or (not (eql 'skip org-drill-leech-method))
870865 ;; (not (org-drill-entry-leech-p)))
871866 ;; (or (null item-time) ; not scheduled
872 ;; (not (minusp ; scheduled for today/in past
867 ;; (not (cl-minusp ; scheduled for today/in past
873868 ;; (- (time-to-days (current-time))
874869 ;; (time-to-days item-time))))))))))
875870
924919 (defun org-drill-entry-due-p ()
925920 (let ((due (org-drill-entry-days-overdue)))
926921 (and (not (null due))
927 (not (minusp due)))))
922 (not (cl-minusp due)))))
928923
929924
930925 (defun org-drill-entry-new-p ()
983978 "Returns a random number between 0.5 and 1.5."
984979 (let ((a 0.047)
985980 (b 0.092)
986 (p (- (random* 1.0) 0.5)))
981 (p (- (cl-random 1.0) 0.5)))
987982 (cl-flet ((sign (n)
988983 (cond ((zerop n) 0)
989 ((plusp n) 1)
984 ((cl-plusp n) 1)
990985 (t -1))))
991986 (/ (+ 100 (* (* (/ -1 b) (log (- 1 (* (/ b a ) (abs p)))))
992987 (sign p)))
995990 (defun pseudonormal (mean variation)
996991 "Random numbers in a pseudo-normal distribution with mean MEAN, range
997992 MEAN-VARIATION to MEAN+VARIATION"
998 (+ (random* variation)
999 (random* variation)
993 (+ (cl-random variation)
994 (cl-random variation)
1000995 (- variation)
1001996 mean))
1002997
10401035 (learn-str
10411036 (let ((learn-data (or (and learn-str
10421037 (read learn-str))
1043 (copy-list initial-repetition-state))))
1038 (cp-copy-list initial-repetition-state))))
10441039 (list (nth 0 learn-data) ; last interval
10451040 (nth 1 learn-data) ; repetitions
10461041 (org-drill-entry-failure-count)
10981093 (/ (+ quality (* meanq total-repeats 1.0))
10991094 (1+ total-repeats))
11001095 quality))
1101 (assert (> n 0))
1102 (assert (and (>= quality 0) (<= quality 5)))
1096 (cl-assert (> n 0))
1097 (cl-assert (and (>= quality 0) (<= quality 5)))
11031098 (if (<= quality org-drill-failure-quality)
11041099 ;; When an item is failed, its interval is reset to 0,
11051100 ;; but its EF is unchanged
11131108 ((= n 2)
11141109 (cond
11151110 (org-drill-add-random-noise-to-intervals-p
1116 (case quality
1111 (cl-case quality
11171112 (5 6)
11181113 (4 4)
11191114 (3 3)
11781173 of-matrix &optional delta-days)
11791174 (if (zerop n) (setq n 1))
11801175 (if (null ef) (setq ef 2.5))
1181 (assert (> n 0))
1182 (assert (and (>= quality 0) (<= quality 5)))
1176 (cl-assert (> n 0))
1177 (cl-assert (and (>= quality 0) (<= quality 5)))
11831178 (unless of-matrix
11841179 (setq of-matrix org-drill-sm5-optimal-factor-matrix))
1185 (setq of-matrix (cl-copy-tree of-matrix))
1180 (setq of-matrix (copy-tree of-matrix))
11861181
11871182 (setq meanq (if meanq
11881183 (/ (+ quality (* meanq total-repeats 1.0))
11951190 quality org-drill-learn-fraction))
11961191 (interval nil))
11971192 (when (and org-drill-adjust-intervals-for-early-and-late-repetitions-p
1198 delta-days (minusp delta-days))
1193 delta-days (cl-minusp delta-days))
11991194 (setq new-of (org-drill-early-interval-factor
12001195 (get-optimal-factor-sm5 n ef of-matrix)
12011196 (inter-repetition-interval-sm5
12871282 - AVERAGE-QUALITY
12881283 - TOTAL-REPEATS.
12891284 See the documentation for `org-drill-get-item-data' for a description of these."
1290 (assert (>= repeats 0))
1291 (assert (and (>= quality 0) (<= quality 5)))
1292 (assert (or (null meanq) (and (>= meanq 0) (<= meanq 5))))
1285 (cl-assert (>= repeats 0))
1286 (cl-assert (and (>= quality 0) (<= quality 5)))
1287 (cl-assert (or (null meanq) (and (>= meanq 0) (<= meanq 5))))
12931288 (let ((next-interval nil))
12941289 (setf meanq (if meanq
12951290 (/ (+ quality (* meanq totaln 1.0)) (1+ totaln))
12961291 quality))
12971292 (cond
12981293 ((<= quality org-drill-failure-quality)
1299 (incf failures)
1294 (cl-incf failures)
13001295 (setf repeats 0
13011296 next-interval -1))
13021297 ((or (zerop repeats)
13031298 (zerop last-interval))
13041299 (setf next-interval (org-drill-simple8-first-interval failures))
1305 (incf repeats)
1306 (incf totaln))
1300 (cl-incf repeats)
1301 (cl-incf totaln))
13071302 (t
13081303 (let* ((use-n
13091304 (if (and
13101305 org-drill-adjust-intervals-for-early-and-late-repetitions-p
1311 (numberp delta-days) (plusp delta-days)
1312 (plusp last-interval))
1306 (numberp delta-days) (cl-plusp delta-days)
1307 (cl-plusp last-interval))
13131308 (+ repeats (min 1 (/ delta-days last-interval 1.0)))
13141309 repeats))
13151310 (factor (org-drill-simple8-interval-factor
13161311 (org-drill-simple8-quality->ease meanq) use-n))
13171312 (next-int (* last-interval factor)))
13181313 (when (and org-drill-adjust-intervals-for-early-and-late-repetitions-p
1319 (numberp delta-days) (minusp delta-days))
1314 (numberp delta-days) (cl-minusp delta-days))
13201315 ;; The item was reviewed earlier than scheduled.
13211316 (setf factor (org-drill-early-interval-factor
13221317 factor next-int (abs delta-days))
13231318 next-int (* last-interval factor)))
13241319 (setf next-interval next-int)
1325 (incf repeats)
1326 (incf totaln))))
1320 (cl-incf repeats)
1321 (cl-incf totaln))))
13271322 (list
13281323 (if (and org-drill-add-random-noise-to-intervals-p
1329 (plusp next-interval))
1324 (cl-plusp next-interval))
13301325 (* next-interval (org-drill-random-dispersal-factor))
13311326 next-interval)
13321327 repeats
13551350 (weight (org-entry-get (point) "DRILL_CARD_WEIGHT")))
13561351 (if (stringp weight)
13571352 (setq weight (read weight)))
1358 (destructuring-bind (last-interval repetitions failures
1353 (cl-destructuring-bind (last-interval repetitions failures
13591354 total-repeats meanq ease)
13601355 (org-drill-get-item-data)
1361 (destructuring-bind (next-interval repetitions ease
1356 (cl-destructuring-bind (next-interval repetitions ease
13621357 failures meanq total-repeats
13631358 &optional new-ofmatrix)
1364 (case org-drill-spaced-repetition-algorithm
1359 (cl-case org-drill-spaced-repetition-algorithm
13651360 (sm5 (determine-next-interval-sm5 last-interval repetitions
13661361 ease quality failures
13671362 meanq total-repeats ofmatrix))
13761371 (setq next-interval days-ahead))
13771372
13781373 (if (and (null days-ahead)
1379 (numberp weight) (plusp weight)
1380 (not (minusp next-interval)))
1374 (numberp weight) (cl-plusp weight)
1375 (not (cl-minusp next-interval)))
13811376 (setq next-interval
13821377 (max 1.0 (+ last-interval
13831378 (/ (- next-interval last-interval) weight)))))
13911386 (cond
13921387 ((= 0 days-ahead)
13931388 (org-schedule '(4)))
1394 ((minusp days-ahead)
1389 ((cl-minusp days-ahead)
13951390 (org-schedule nil (current-time)))
13961391 (t
13971392 (org-schedule nil (time-add (current-time)
14041399 that the current item would be scheduled, based on a recall quality
14051400 of QUALITY."
14061401 (let ((weight (org-entry-get (point) "DRILL_CARD_WEIGHT")))
1407 (destructuring-bind (last-interval repetitions failures
1402 (cl-destructuring-bind (last-interval repetitions failures
14081403 total-repeats meanq ease)
14091404 (org-drill-get-item-data)
14101405 (if (stringp weight)
14111406 (setq weight (read weight)))
1412 (destructuring-bind (next-interval repetitions ease
1407 (cl-destructuring-bind (next-interval repetitions ease
14131408 failures meanq total-repeats
14141409 &optional ofmatrix)
1415 (case org-drill-spaced-repetition-algorithm
1410 (cl-case org-drill-spaced-repetition-algorithm
14161411 (sm5 (determine-next-interval-sm5 last-interval repetitions
14171412 ease quality failures
14181413 meanq total-repeats
14241419 quality failures meanq
14251420 total-repeats)))
14261421 (cond
1427 ((not (plusp next-interval))
1422 ((not (cl-plusp next-interval))
14281423 0)
1429 ((and (numberp weight) (plusp weight))
1424 ((and (numberp weight) (cl-plusp weight))
14301425 (+ last-interval
14311426 (max 1.0 (/ (- next-interval last-interval) weight))))
14321427 (t
14941489 ((stringp input)
14951490 (setq ch (elt input 0)))
14961491 ((and (vectorp input) (symbolp (elt input 0)))
1497 (case (elt input 0)
1492 (cl-case (elt input 0)
14981493 (up (ignore-errors (forward-line -1)))
14991494 (down (ignore-errors (forward-line 1)))
15001495 (left (ignore-errors (backward-char)))
15031498 (next (ignore-errors (scroll-up))))) ; pgdn
15041499 ((and (vectorp input) (listp (elt input 0))
15051500 (eventp (elt input 0)))
1506 (case (car (elt input 0))
1501 (cl-case (car (elt input 0))
15071502 (wheel-up (ignore-errors (mwheel-scroll (elt input 0))))
15081503 (wheel-down (ignore-errors (mwheel-scroll (elt input 0)))))))
15091504 (if (eql ch org-drill--tags-key)
15951590
15961591
15971592 (defun org-drill--make-minibuffer-prompt (prompt)
1598 (let ((status (first (org-drill-entry-status)))
1593 (let ((status (cl-first (org-drill-entry-status)))
15991594 (mature-entry-count (+ (length *org-drill-young-mature-entries*)
16001595 (length *org-drill-old-mature-entries*)
16011596 (length *org-drill-overdue-entries*))))
16061601 ((eql status :failed) ?F)
16071602 (*org-drill-cram-mode* ?C)
16081603 (t
1609 (case status
1604 (cl-case status
16101605 (:new ?N) (:young ?Y) (:old ?o) (:overdue ?!)
16111606 (t ??)))))
16121607 'face `(:foreground
1613 ,(case status
1608 ,(cl-case status
16141609 (:new org-drill-new-count-color)
16151610 ((:young :old) org-drill-mature-count-color)
16161611 ((:overdue :failed) org-drill-failed-count-color)
17441739 (format-time-string "%M:%S " elapsed))
17451740 full-prompt)))
17461741 ;; if we have done it this many times, we probably want to stop
1747 (when (< 10 (incf org-drill-presentation-timer-calls))
1742 (when (< 10 (cl-incf org-drill-presentation-timer-calls))
17481743 (org-drill-presentation-timer-cancel)))
17491744
17501745 (define-derived-mode org-drill-response-mode nil "Org-Drill")
20272022 (p-max (save-excursion
20282023 (outline-next-heading)
20292024 (point))))
2030 (assert (>= (- p-max p-min) (length replacements)))
2025 (cl-assert (>= (- p-max p-min) (length replacements)))
20312026 (dotimes (i (length replacements))
20322027 (setq ovl (make-overlay (+ p-min (* 2 i))
20332028 (if (= i (1- (length replacements)))
21572152 (let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
21582153 (when drill-sections
21592154 (save-excursion
2160 (goto-char (nth (random* (min 2 (length drill-sections)))
2155 (goto-char (nth (cl-random (min 2 (length drill-sections)))
21612156 drill-sections))
21622157 (org-show-subtree)))
21632158 (org-drill--show-latex-fragments)
21762171 (let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
21772172 (when drill-sections
21782173 (save-excursion
2179 (goto-char (nth (random* (length drill-sections)) drill-sections))
2174 (goto-char (nth (cl-random (length drill-sections)) drill-sections))
21802175 (org-show-subtree)))
21812176 (org-drill--show-latex-fragments)
21822177 (ignore-errors
22222217 org-bracket-link-regexp 1))))
22232218 (unless (or in-regexp?
22242219 (org-inside-LaTeX-fragment-p))
2225 (incf match-count)))))
2226 (if (minusp number-to-hide)
2220 (cl-incf match-count)))))
2221 (if (cl-minusp number-to-hide)
22272222 (setq number-to-hide (+ match-count number-to-hide)))
2228 (when (plusp match-count)
2223 (when (cl-plusp match-count)
22292224 (let* ((positions (shuffle-list (loop for i from 1
22302225 to match-count
22312226 collect i)))
22402235 (if force-show-last
22412236 (setq positions (remove match-count positions)))
22422237 (setq match-nums
2243 (subseq positions
2238 (cl-subseq positions
22442239 0 (min number-to-hide (length positions))))
22452240 ;; (dolist (pos-to-hide match-nums)
22462241 (save-excursion
22512246 (or (org-pos-in-regexp (match-beginning 0)
22522247 org-bracket-link-regexp 1)
22532248 (org-inside-LaTeX-fragment-p)))
2254 (incf cnt)
2249 (cl-incf cnt)
22552250 (if (memq cnt match-nums)
22562251 (org-drill-hide-matched-cloze-text)))))))
22572252 ;; (loop
22922287 org-bracket-link-regexp 1))))
22932288 (unless (or in-regexp?
22942289 (org-inside-LaTeX-fragment-p))
2295 (incf match-count)))))
2296 (if (minusp to-hide)
2290 (cl-incf match-count)))))
2291 (if (cl-minusp to-hide)
22972292 (setq to-hide (+ 1 to-hide match-count)))
22982293 (cond
2299 ((or (not (plusp match-count))
2294 ((or (not (cl-plusp match-count))
23002295 (> to-hide match-count))
23012296 nil)
23022297 (t
23112306 (or (org-pos-in-regexp (match-beginning 0)
23122307 org-bracket-link-regexp 1)
23132308 (org-inside-LaTeX-fragment-p)))
2314 (incf cnt)
2309 (cl-incf cnt)
23152310 (if (= cnt to-hide)
23162311 (org-drill-hide-matched-cloze-text)))))))
23172312 (org-drill--show-latex-fragments)
23632358 ;; Behave as hide1cloze
23642359 (org-drill-present-multicloze-hide1))
23652360 ((not (and (integerp org-drill-cloze-text-weight)
2366 (plusp org-drill-cloze-text-weight)))
2361 (cl-plusp org-drill-cloze-text-weight)))
23672362 (error "Illegal value for org-drill-cloze-text-weight: %S"
23682363 org-drill-cloze-text-weight))
23692364 ((zerop (mod (1+ (org-drill-entry-total-repeats 0))
23882383 ;; Behave as show1cloze
23892384 (org-drill-present-multicloze-show1))
23902385 ((not (and (integerp org-drill-cloze-text-weight)
2391 (plusp org-drill-cloze-text-weight)))
2386 (cl-plusp org-drill-cloze-text-weight)))
23922387 (error "Illegal value for org-drill-cloze-text-weight: %S"
23932388 org-drill-cloze-text-weight))
23942389 ((zerop (mod (1+ (org-drill-entry-total-repeats 0))
24142409 ;; Behave as show1cloze
24152410 (org-drill-present-multicloze-show1))
24162411 ((not (and (integerp org-drill-cloze-text-weight)
2417 (plusp org-drill-cloze-text-weight)))
2412 (cl-plusp org-drill-cloze-text-weight)))
24182413 (error "Illegal value for org-drill-cloze-text-weight: %S"
24192414 org-drill-cloze-text-weight))
24202415 ((zerop (mod (1+ (org-drill-entry-total-repeats 0))
25132508 (let ((presentation-fn
25142509 (cdr (assoc card-type org-drill-card-type-alist))))
25152510 (if (listp presentation-fn)
2516 (psetq answer-fn (or (second presentation-fn)
2511 (cl-psetq answer-fn (or (cl-second presentation-fn)
25172512 'org-drill-present-default-answer)
2518 present-empty-cards (third presentation-fn)
2519 presentation-fn (first presentation-fn)))
2513 present-empty-cards (cl-third presentation-fn)
2514 presentation-fn (cl-first presentation-fn)))
25202515 (let* ((tags (org-get-tags))
25212516 (rtn
25222517 (cond
25972592
25982593
25992594 (defun org-drill-pop-next-pending-entry ()
2600 (block org-drill-pop-next-pending-entry
2595 (cl-block org-drill-pop-next-pending-entry
26012596 (let ((m nil))
26022597 (while (or (null m)
26032598 (not (org-drill-entry-p m)))
26292624 (not (org-drill-maximum-item-count-reached-p))
26302625 (not (org-drill-maximum-duration-reached-p)))
26312626 (cond
2632 ((< (random* (+ (length *org-drill-new-entries*)
2627 ((< (cl-random (+ (length *org-drill-new-entries*)
26332628 (length *org-drill-old-mature-entries*)))
26342629 (length *org-drill-new-entries*))
26352630 (pop-random *org-drill-new-entries*))
26492644 'failed' and need to be presented again before the session ends.
26502645
26512646 RESUMING-P is true if we are resuming a suspended drill session."
2652 (block org-drill-entries
2647 (cl-block org-drill-entries
26532648 (while (org-drill-entries-pending-p)
26542649 (let ((m (cond
26552650 ((or (not resuming-p)
27042699
27052700 (defun org-drill-final-report ()
27062701 (let ((pass-percent
2707 (round (* 100 (count-if (lambda (qual)
2702 (round (* 100 (cl-count-if (lambda (qual)
27082703 (> qual org-drill-failure-quality))
27092704 *org-drill-session-qualities*))
27102705 (max 1 (length *org-drill-session-qualities*))))
27252720 (length *org-drill-done-entries*)
27262721 (format-seconds "%h:%.2m:%.2s"
27272722 (- (float-time (current-time)) *org-drill-start-time*))
2728 (round (* 100 (count 5 *org-drill-session-qualities*))
2723 (round (* 100 (cl-count 5 *org-drill-session-qualities*))
27292724 (max 1 (length *org-drill-session-qualities*)))
2730 (round (* 100 (count 2 *org-drill-session-qualities*))
2725 (round (* 100 (cl-count 2 *org-drill-session-qualities*))
27312726 (max 1 (length *org-drill-session-qualities*)))
2732 (round (* 100 (count 4 *org-drill-session-qualities*))
2727 (round (* 100 (cl-count 4 *org-drill-session-qualities*))
27332728 (max 1 (length *org-drill-session-qualities*)))
2734 (round (* 100 (count 1 *org-drill-session-qualities*))
2729 (round (* 100 (cl-count 1 *org-drill-session-qualities*))
27352730 (max 1 (length *org-drill-session-qualities*)))
2736 (round (* 100 (count 3 *org-drill-session-qualities*))
2731 (round (* 100 (cl-count 3 *org-drill-session-qualities*))
27372732 (max 1 (length *org-drill-session-qualities*)))
2738 (round (* 100 (count 0 *org-drill-session-qualities*))
2733 (round (* 100 (cl-count 0 *org-drill-session-qualities*))
27392734 (max 1 (length *org-drill-session-qualities*)))
27402735 pass-percent
27412736 org-drill-failure-quality
28202815 (defun org-drill-order-overdue-entries (overdue-data)
28212816 (let* ((lapsed-days (if org-drill--lapse-very-overdue-entries-p
28222817 90 most-positive-fixnum))
2823 (not-lapsed (remove-if (lambda (a) (> (or (second a) 0) lapsed-days))
2818 (not-lapsed (cl-remove-if (lambda (a) (> (or (cl-second a) 0) lapsed-days))
28242819 overdue-data))
2825 (lapsed (remove-if-not (lambda (a) (> (or (second a) 0)
2820 (lapsed (cl-remove-if-not (lambda (a) (> (or (cl-second a) 0)
28262821 lapsed-days)) overdue-data)))
28272822 (setq *org-drill-overdue-entries*
28282823 (mapcar 'first
28292824 (append
28302825 (sort (shuffle-list not-lapsed)
2831 (lambda (a b) (> (second a) (second b))))
2826 (lambda (a b) (> (cl-second a) (cl-second b))))
28322827 (sort lapsed
2833 (lambda (a b) (> (third a) (third b)))))))))
2828 (lambda (a b) (> (cl-third a) (cl-third b)))))))))
28342829
28352830
28362831 (defun org-drill--entry-lapsed-p ()
28832878 (let* ((card-type (org-entry-get (point) "DRILL_CARD_TYPE" nil))
28842879 (dat (cdr (assoc card-type org-drill-card-type-alist))))
28852880 (or (null card-type)
2886 (not (third dat)))))
2881 (not (cl-third dat)))))
28872882 ;; body is empty, and this is not a card type where empty bodies are
28882883 ;; meaningful, so skip it.
28892884 nil)
28912886 :unscheduled)
28922887 ;; ((eql -1 due)
28932888 ;; :tomorrow)
2894 ((minusp due) ; scheduled in the future
2889 ((cl-minusp due) ; scheduled in the future
28952890 :future)
28962891 ;; The rest of the stati all denote 'due' items ==========================
28972892 ((<= (org-drill-entry-last-quality 9999)
29352930 (length *org-drill-young-mature-entries*)
29362931 (length *org-drill-old-mature-entries*)
29372932 (length *org-drill-failed-entries*))
2938 (incf cnt))
2933 (cl-incf cnt))
29392934 (when (org-drill-entry-p)
29402935 (org-drill-id-get-create-with-warning)
2941 (destructuring-bind (status due age)
2936 (cl-destructuring-bind (status due age)
29422937 (org-drill-entry-status)
2943 (case status
2938 (cl-case status
29442939 (:unscheduled
2945 (incf *org-drill-dormant-entry-count*))
2940 (cl-incf *org-drill-dormant-entry-count*))
29462941 ;; (:tomorrow
2947 ;; (incf *org-drill-dormant-entry-count*)
2948 ;; (incf *org-drill-due-tomorrow-count*))
2942 ;; (cl-incf *org-drill-dormant-entry-count*)
2943 ;; (cl-incf *org-drill-due-tomorrow-count*))
29492944 (:future
2950 (incf *org-drill-dormant-entry-count*)
2945 (cl-incf *org-drill-dormant-entry-count*)
29512946 (if (eq -1 due)
2952 (incf *org-drill-due-tomorrow-count*)))
2947 (cl-incf *org-drill-due-tomorrow-count*)))
29532948 (:new
29542949 (push (point-marker) *org-drill-new-entries*))
29552950 (:failed
30123007 ;; Check org version. Org 7.9.3f introduced a backwards-incompatible change
30133008 ;; to the arguments accepted by `org-schedule'. At the time of writing there
30143009 ;; are still lots of people using versions of org older than this.
3015 (let ((majorv (first (mapcar 'string-to-number (split-string (org-release) "[.]")))))
3010 (let ((majorv (cl-first (mapcar 'string-to-number (split-string (org-release) "[.]")))))
30163011 (if (and (< majorv 8)
30173012 (not (string-match-p "universal prefix argument" (documentation 'org-schedule))))
30183013 (read-char-exclusive
30223017 (let ((end-pos nil)
30233018 (overdue-data nil)
30243019 (cnt 0))
3025 (block org-drill
3020 (cl-block org-drill
30263021 (unless resume-p
30273022 (org-drill-free-markers t)
30283023 (setq *org-drill-current-item* nil
30393034 *org-drill-again-entries* nil)
30403035 (setq *org-drill-session-qualities* nil)
30413036 (setq *org-drill-start-time* (float-time (current-time))))
3042 (setq *random-state* (make-random-state t)) ; reseed RNG
3037 (setq *random-state* (cl-make-random-state t)) ; reseed RNG
30433038 (unwind-protect
30443039 (save-excursion
30453040 (unless resume-p
31353130 (interactive)
31363131 (setq *org-drill-cram-mode* nil)
31373132 (cond
3138 ((plusp (org-drill-pending-entry-count))
3133 ((cl-plusp (org-drill-pending-entry-count))
31393134 (org-drill-free-markers *org-drill-done-entries*)
31403135 (if (markerp *org-drill-current-item*)
31413136 (free-marker *org-drill-current-item*))
31553150 (cond
31563151 ((org-drill-entries-pending-p)
31573152 (org-drill nil nil t))
3158 ((and (plusp (org-drill-pending-entry-count))
3153 ((and (cl-plusp (org-drill-pending-entry-count))
31593154 ;; Current drill session is finished, but there are still
31603155 ;; more items which need to be reviewed.
31613156 (y-or-n-p (format
32093204 (setq-local org-drill-cloze-keywords (org-drill--compute-cloze-keywords))
32103205 (when org-drill-use-visible-cloze-face-p
32113206 (add-to-list 'org-font-lock-extra-keywords
3212 (first org-drill-cloze-keywords))))
3207 (cl-first org-drill-cloze-keywords))))
32133208
32143209
32153210 ;; Can't add to org-mode-hook, because local variables won't have been loaded
32423237 (defun org-drill-copy-entry-to-other-buffer (dest &optional path)
32433238 "Copy the subtree at point to the buffer DEST. The copy will receive
32443239 the tag 'imported'."
3245 (block org-drill-copy-entry-to-other-buffer
3240 (cl-block org-drill-copy-entry-to-other-buffer
32463241 (save-excursion
32473242 (let ((src (current-buffer))
32483243 (m nil))
33353330 ;; scheduling data, then go to the matching location in dest
33363331 ;; and write the data.
33373332 (let ((marker (gethash id *org-drill-dest-id-table*)))
3338 (destructuring-bind (last-interval repetitions failures
3333 (cl-destructuring-bind (last-interval repetitions failures
33393334 total-repeats meanq ease)
33403335 (org-drill-get-item-data)
33413336 (setq last-reviewed (org-entry-get (point) "DRILL_LAST_REVIEWED")
34343429 translation (car (read-from-string translation)))
34353430 (setq highlight-face
34363431 (list :foreground
3437 (or (second (assoc-string tense org-drill-verb-tense-alist t))
3432 (or (cl-second (assoc-string tense org-drill-verb-tense-alist t))
34383433 "hotpink")
34393434 :background
34403435 (or
3441 (second (assoc-string mood org-drill-verb-tense-alist t))
3436 (cl-second (assoc-string mood org-drill-verb-tense-alist t))
34423437 "black")))
34433438 (setq infinitive (propertize infinitive 'face highlight-face))
34443439 (setq translation (propertize translation 'face highlight-face))
34583453 (format "%s tense" tense))
34593454 (mood
34603455 (format "%s mood" mood)))))
3461 (destructuring-bind (infinitive inf-hint translation tense mood)
3456 (cl-destructuring-bind (infinitive inf-hint translation tense mood)
34623457 (org-drill-get-verb-conjugation-info)
34633458 (org-drill-present-card-using-text
34643459 (cond
3465 ((zerop (random* 2))
3460 ((zerop (cl-random 2))
34663461 (format "\nTranslate the verb\n\n%s\n\nand conjugate for the %s.\n\n"
34673462 infinitive (tense-and-mood-to-string tense mood)))
34683463
34783473 "Show the answer for a drill item whose card type is 'conjugate'.
34793474 RESCHEDULE-FN must be a function that calls `org-drill-reschedule' and
34803475 returns its return value."
3481 (destructuring-bind (infinitive inf-hint translation tense mood)
3476 (cl-destructuring-bind (infinitive inf-hint translation tense mood)
34823477 (org-drill-get-verb-conjugation-info)
34833478 (with-replaced-entry-heading
34843479 (format "%s of %s ==> %s\n\n"
35333528 translation (car (read-from-string translation)))
35343529 (setq highlight-face
35353530 (list :foreground
3536 (or (second (assoc-string noun-gender
3531 (or (cl-second (assoc-string noun-gender
35373532 org-drill-noun-gender-alist t))
35383533 "red")))
35393534 (setq noun (propertize noun 'face highlight-face))
35433538
35443539 (defun org-drill-present-noun-declension ()
35453540 "Present a drill entry whose card type is 'decline_noun'."
3546 (destructuring-bind (noun noun-root noun-gender noun-hint translation)
3541 (cl-destructuring-bind (noun noun-root noun-gender noun-hint translation)
35473542 (org-drill-get-noun-info)
35483543 (let* ((props (org-entry-properties (point)))
35493544 (definite
35623557 (t nil))))
35633558 (org-drill-present-card-using-text
35643559 (cond
3565 ((zerop (random* 2))
3560 ((zerop (cl-random 2))
35663561 (format "\nTranslate the noun\n\n%s (%s)\n\nand list its declensions%s.\n\n"
35673562 noun noun-gender
35683563 (if (or plural definite)
35823577 "Show the answer for a drill item whose card type is 'decline_noun'.
35833578 RESCHEDULE-FN must be a function that calls `org-drill-reschedule' and
35843579 returns its return value."
3585 (destructuring-bind (noun noun-root noun-gender noun-hint translation)
3580 (cl-destructuring-bind (noun noun-root noun-gender noun-hint translation)
35863581 (org-drill-get-noun-info)
35873582 (with-replaced-entry-heading
35883583 (format "Declensions of %s (%s) ==> %s\n\n"
36183613 (psetf num-min num-max
36193614 num-max num-min))
36203615 (setq drilled-number
3621 (+ num-min (random* (abs (1+ (- num-max num-min))))))
3616 (+ num-min (cl-random (abs (1+ (- num-max num-min))))))
36223617 (setq drilled-number-direction
3623 (if (zerop (random* 2)) 'from-english 'to-english))
3618 (if (zerop (cl-random 2)) 'from-english 'to-english))
36243619 (cond
36253620 ((eql 'to-english drilled-number-direction)
36263621 (org-drill-present-card-using-text
36733668 (with-hidden-comments
36743669 (with-hidden-cloze-hints
36753670 (with-hidden-cloze-text
3676 (case (random* 6)
3671 (cl-case (cl-random 6)
36773672 (0
36783673 (org-drill-hide-all-subheadings-except '("Infinitive"))
36793674 (setq prompt
37803775 ;; org-drill-again uses org-drill-pending-entry-count to decide
37813776 ;; whether it needs to scan or not.
37823777 (let ((pending (org-drill-pending-entry-count)))
3783 (unless (plusp pending)
3778 (unless (cl-plusp pending)
37843779 (let ((warned-about-id-creation nil)
37853780 (cnt 0)
37863781 (overdue-data nil)
38953890 (+ (length org-drill-leitner-unboxed-entries)
38963891 (length org-drill-leitner-boxed-entries))
38973892 ;; This variable is dynamically scoped in!
3898 (incf cnt))
3893 (cl-incf cnt))
38993894 (when (org-drill-entry-p)
39003895 (org-drill-id-get-create-with-warning)
39013896 (let ((leitner-box (org-entry-get (point) "DRILL_LEITNER_BOX" nil)))
39573952 ((stringp input)
39583953 (setq ch (elt input 0)))
39593954 ((and (vectorp input) (symbolp (elt input 0)))
3960 (case (elt input 0)
3955 (cl-case (elt input 0)
39613956 (up (ignore-errors (forward-line -1)))
39623957 (down (ignore-errors (forward-line 1)))
39633958 (left (ignore-errors (backward-char)))
39663961 (next (ignore-errors (scroll-up))))) ; pgdn
39673962 ((and (vectorp input) (listp (elt input 0))
39683963 (eventp (elt input 0)))
3969 (case (car (elt input 0))
3964 (cl-case (car (elt input 0))
39703965 (wheel-up (ignore-errors (mwheel-scroll (elt input 0))))
39713966 (wheel-down (ignore-errors (mwheel-scroll (elt input 0)))))))
39723967 (if (eql ch org-drill--tags-key)
40104005 (org-toggle-tag "leitner" 'off)
40114006 (when org-drill-leitner-promote-to-drill-p
40124007 (org-toggle-tag "drill" 'on))
4013 (incf org-drill-leitner-completed))
4008 (cl-incf org-drill-leitner-completed))
40144009 (org-set-property
40154010 "DRILL_LEITNER_BOX"
40164011 (format
+19
-18
robot/org-drill-launch.el less more
11 (setq make-backup-files nil)
22 (setq auto-save-default nil)
33
4 (setq top-dir default-directory)
5
46 ;; Clean up
5 (delete-file "./robot/failure.txt")
7 (delete-file (concat top-dir "robot/failure.txt"))
68
79 (set-frame-name "emacs-bot")
810
9 (condition-case e
10 (load-file "org-drill.el")
11 (error
12 (with-temp-buffer
13 (insert (format "%s" (error-message-string e)))
14 (write-region (point-min) (point-max) "./robot/failure.txt"))
15 (let ((kill-emacs-hook nil))
16 (kill-emacs))))
11 (setq debug-on-error t)
12 (setq debug-on-quit t)
13
14 (add-hook 'debugger-mode-hook
15 'org-drill-launcher-dump-in-a-bit)
16 (defun org-drill-launcher-dump-in-a-bit ()
17 (run-with-timer 1 nil #'org-drill-launcher-dump))
18
19 (defun org-drill-launcher-dump ()
20 (save-excursion
21 (set-buffer "*Backtrace*")
22 (write-region (point-min) (point-max) (concat top-dir "robot/failure.txt")))
23 (kill-emacs))
24
25 (load-file "org-drill.el")
1726
1827 (copy-file "robot/main-test.org" "robot/main-test-copy.org" t)
1928 (find-file "robot/main-test-copy.org")
2029
21 (condition-case e
22 (org-drill)
23 (error
24 (with-temp-buffer
25 (insert (format "%s" (error-message-string e)))
26 ;; write to ./ now because we have changed directory
27 (write-region (point-min) (point-max) "./failure.txt"))
28 (let ((kill-emacs-hook nil))
29 (kill-emacs))))
30 (org-drill)