Update org-drill.el to version 1.4

This commit is contained in:
Carsten Dominik 2010-09-17 23:10:36 +02:00
parent 59531de090
commit 3ad98da667
1 changed files with 589 additions and 220 deletions

View File

@ -1,7 +1,7 @@
;;; org-drill.el - Self-testing with org-learn
;;;
;;; Author: Paul Sexton <eeeickythump@gmail.com>
;;; Version: 1.0
;;; Version: 1.4
;;; Repository at http://bitbucket.org/eeeickythump/org-drill/
;;;
;;;
@ -96,6 +96,12 @@ Possible values:
(defface org-drill-visible-cloze-face
'((t (:foreground "darkseagreen")))
"The face used to hide the contents of cloze phrases."
:group 'org-drill)
(defface org-drill-visible-cloze-hint-face
'((t (:foreground "dark slate blue")))
"The face used to hide the contents of cloze phrases."
:group 'org-drill)
@ -115,6 +121,35 @@ buffers?"
:group 'org-drill)
(defcustom org-drill-new-count-color
"royal blue"
"Foreground colour used to display the count of remaining new items
during a drill session."
:group 'org-drill
:type 'color)
(defcustom org-drill-mature-count-color
"green"
"Foreground colour used to display the count of remaining mature items
during a drill session. Mature items are due for review, but are not new."
:group 'org-drill
:type 'color)
(defcustom org-drill-failed-count-color
"red"
"Foreground colour used to display the count of remaining failed items
during a drill session."
:group 'org-drill
:type 'color)
(defcustom org-drill-done-count-color
"sienna"
"Foreground colour used to display the count of reviewed items
during a drill session."
:group 'org-drill
:type 'color)
(setplist 'org-drill-cloze-overlay-defaults
'(display "[...]"
face org-drill-hidden-cloze-face
@ -124,7 +159,15 @@ buffers?"
(defvar org-drill-cloze-regexp
;; ver 1 "[^][]\\(\\[[^][][^]]*\\]\\)"
;; ver 2 "\\(\\[.*?\\]\\|^[^[[:cntrl:]]*?\\]\\|\\[.*?$\\)"
"\\(\\[.*?\\]\\|\\[.*?[[:cntrl:]]+.*?\\]\\)")
;; ver 3! "\\(\\[.*?\\]\\|\\[.*?[[:cntrl:]]+.*?\\]\\)"
"\\(\\[[[:cntrl:][:graph:][:space:]]*?\\)\\(\\||.+?\\)\\(\\]\\)")
(defvar org-drill-cloze-keywords
`((,org-drill-cloze-regexp
(1 'org-drill-visible-cloze-face nil)
(2 'org-drill-visible-cloze-hint-face t)
(3 'org-drill-visible-cloze-face nil)
)))
(defcustom org-drill-card-type-alist
@ -132,6 +175,7 @@ buffers?"
("simple" . org-drill-present-simple-card)
("twosided" . org-drill-present-two-sided-card)
("multisided" . org-drill-present-multi-sided-card)
("multicloze" . org-drill-present-multicloze)
("spanish_verb" . org-drill-present-spanish-verb))
"Alist associating card types with presentation functions. Each entry in the
alist takes the form (CARDTYPE . FUNCTION), where CARDTYPE is a string
@ -158,11 +202,41 @@ random noise is adapted from Mnemosyne."
:group 'org-drill
:type 'boolean)
(defcustom org-drill-cram-hours
12
"When in cram mode, items are considered due for review if
they were reviewed at least this many hours ago."
:group 'org-drill
:type 'integer)
(defvar *org-drill-done-entry-count* 0)
(defvar *org-drill-pending-entry-count* 0)
(defvar *org-drill-session-qualities* nil)
(defvar *org-drill-start-time* 0)
(defvar *org-drill-new-entries* nil)
(defvar *org-drill-mature-entries* nil)
(defvar *org-drill-failed-entries* nil)
(defvar *org-drill-again-entries* nil)
(defvar *org-drill-done-entries* nil)
(defvar *org-drill-cram-mode* nil
"Are we in 'cram mode', where all items are considered due
for review unless they were already reviewed in the recent past?")
;;;; Utilities ================================================================
(defun free-marker (m)
(set-marker m nil))
(defmacro pop-random (place)
(let ((elt (gensym)))
`(if (null ,place)
nil
(let ((,elt (nth (random (length ,place)) ,place)))
(setq ,place (remove ,elt ,place))
,elt))))
(defun shuffle-list (list)
@ -181,10 +255,52 @@ random noise is adapted from Mnemosyne."
list)
(defun time-to-inactive-org-timestamp (time)
(format-time-string
(concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]")
time))
(defmacro with-hidden-cloze-text (&rest body)
`(progn
(org-drill-hide-clozed-text)
(unwind-protect
(progn
,@body)
(org-drill-unhide-clozed-text))))
(defun org-drill-days-since-last-review ()
"Nil means a last review date has not yet been stored for
the item.
Zero means it was reviewed today.
A positive number means it was reviewed that many days ago.
A negative number means the date of last review is in the future --
this should never happen."
(let ((datestr (org-entry-get (point) "DRILL_LAST_REVIEWED")))
(when datestr
(- (time-to-days (current-time))
(time-to-days (apply 'encode-time
(org-parse-time-string datestr)))))))
(defun org-drill-hours-since-last-review ()
"Like `org-drill-days-since-last-review', but return value is
in hours rather than days."
(let ((datestr (org-entry-get (point) "DRILL_LAST_REVIEWED")))
(when datestr
(floor
(/ (- (time-to-seconds (current-time))
(time-to-seconds (apply 'encode-time
(org-parse-time-string datestr))))
(* 60 60))))))
(defun org-drill-entry-p ()
"Is the current entry a 'drill item'?"
(or (assoc "LEARN_DATA" (org-entry-properties nil))
(or (org-entry-get (point) "LEARN_DATA")
;;(assoc "LEARN_DATA" (org-entry-properties nil))
(member org-drill-question-tag (org-get-local-tags))))
@ -196,6 +312,19 @@ or a subheading within a drill item?"
(member org-drill-question-tag (org-get-tags-at))))
(defun org-drill-goto-drill-entry-heading ()
"Move the point to the heading which hold the :drill: tag for this
drill entry."
(unless (org-at-heading-p)
(org-back-to-heading))
(unless (org-part-of-drill-entry-p)
(error "Point is not inside a drill entry"))
(while (not (org-drill-entry-p))
(unless (org-up-heading-safe)
(error "Cannot find a parent heading that is marked as a drill entry"))))
(defun org-drill-entry-leech-p ()
"Is the current entry a 'leech item'?"
(and (org-drill-entry-p)
@ -203,25 +332,32 @@ or a subheading within a drill item?"
(defun org-drill-entry-due-p ()
(let ((item-time (org-get-scheduled-time (point))))
(and (org-drill-entry-p)
(or (not (eql 'skip org-drill-leech-method))
(not (org-drill-entry-leech-p)))
(or (null item-time)
(not (minusp ; scheduled for today/in future
(- (time-to-days (current-time))
(time-to-days item-time))))))))
(cond
(*org-drill-cram-mode*
(let ((hours (org-drill-hours-since-last-review)))
(and (org-drill-entry-p)
(or (null hours)
(>= hours org-drill-cram-hours)))))
(t
(let ((item-time (org-get-scheduled-time (point))))
(and (org-drill-entry-p)
(or (not (eql 'skip org-drill-leech-method))
(not (org-drill-entry-leech-p)))
(or (null item-time)
(not (minusp ; scheduled for today/in future
(- (time-to-days (current-time))
(time-to-days item-time))))))))))
(defun org-drill-entry-new-p ()
(let ((item-time (org-get-scheduled-time (point))))
(and (org-drill-entry-p)
(and (org-drill-entry-p)
(let ((item-time (org-get-scheduled-time (point))))
(null item-time))))
(defun org-drill-entry-last-quality ()
(let ((quality (cdr (assoc "DRILL_LAST_QUALITY" (org-entry-properties nil)))))
(let ((quality (org-entry-get (point) "DRILL_LAST_QUALITY")))
(if quality
(string-to-number quality)
nil)))
@ -351,6 +487,8 @@ Returns a list: (INTERVAL N EF OFMATRIX), where:
(cond
((= 0 (nth 0 learn-data))
(org-schedule t))
((minusp (first learn-data))
(org-schedule nil (current-time)))
(t
(org-schedule nil (time-add (current-time)
(days-to-time (nth 0 learn-data))))))))
@ -359,8 +497,8 @@ Returns a list: (INTERVAL N EF OFMATRIX), where:
(defun org-drill-reschedule ()
"Returns quality rating (0-5), or nil if the user quit."
(let ((ch nil))
(while (not (memq ch '(?q ?0 ?1 ?2 ?3 ?4 ?5)))
(setq ch (read-char
(while (not (memq ch '(?q ?e ?0 ?1 ?2 ?3 ?4 ?5)))
(setq ch (read-char-exclusive
(if (eq ch ??)
"0-2 Means you have forgotten the item.
3-5 Means you have remembered the item.
@ -372,12 +510,14 @@ Returns a list: (INTERVAL N EF OFMATRIX), where:
4 - After a little bit of thought you remembered.
5 - You remembered the item really easily.
How well did you do? (0-5, ?=help, q=quit)"
"How well did you do? (0-5, ?=help, q=quit)"))))
How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"
"How well did you do? (0-5, ?=help, e=edit, q=quit)")))
(if (eql ch ?t)
(org-set-tags-command)))
(cond
((and (>= ch ?0) (<= ch ?5))
(let ((quality (- ch ?0))
(failures (cdr (assoc "DRILL_FAILURE_COUNT" (org-entry-properties nil)))))
(failures (org-entry-get (point) "DRILL_FAILURE_COUNT")))
(save-excursion
(org-drill-smart-reschedule quality))
(push quality *org-drill-session-qualities*)
@ -388,9 +528,20 @@ How well did you do? (0-5, ?=help, q=quit)"
(org-set-property "DRILL_FAILURE_COUNT"
(format "%d" (1+ failures)))
(if (> (1+ failures) org-drill-leech-failure-threshold)
(org-toggle-tag "leech" 'on)))))
(org-toggle-tag "leech" 'on))))
(t
(let ((scheduled-time (org-get-scheduled-time (point))))
(when scheduled-time
(message "Next review in %d days"
(- (time-to-days scheduled-time)
(time-to-days (current-time))))
(sit-for 0.5)))))
(org-set-property "DRILL_LAST_QUALITY" (format "%d" quality))
(org-set-property "DRILL_LAST_REVIEWED"
(time-to-inactive-org-timestamp (current-time)))
quality))
((= ch ?e)
'edit)
(t
nil))))
@ -416,42 +567,92 @@ the current topic."
(defun org-drill-presentation-prompt (&rest fmt-and-args)
(let ((ch nil)
(prompt
(if fmt-and-args
(apply 'format
(first fmt-and-args)
(rest fmt-and-args))
"Press any key to see the answer, 'e' to edit, 'q' to quit.")))
(let* ((item-start-time (current-time))
(ch nil)
(last-second 0)
(prompt
(if fmt-and-args
(apply 'format
(first fmt-and-args)
(rest fmt-and-args))
(concat "Press key for answer, "
"e=edit, t=tags, s=skip, q=quit."))))
(setq prompt
(format "(%d) %s" *org-drill-pending-entry-count* prompt))
(format "%s %s %s %s %s"
(propertize
(number-to-string (length *org-drill-done-entries*))
'face `(:foreground ,org-drill-done-count-color)
'help-echo "The number of items you have reviewed this session.")
(propertize
(number-to-string (+ (length *org-drill-again-entries*)
(length *org-drill-failed-entries*)))
'face `(:foreground ,org-drill-failed-count-color)
'help-echo (concat "The number of items that you failed, "
"and need to review again."))
(propertize
(number-to-string (length *org-drill-mature-entries*))
'face `(:foreground ,org-drill-mature-count-color)
'help-echo "The number of old items due for review.")
(propertize
(number-to-string (length *org-drill-new-entries*))
'face `(:foreground ,org-drill-new-count-color)
'help-echo (concat "The number of new items that you "
"have never reviewed."))
prompt))
(if (and (eql 'warn org-drill-leech-method)
(org-drill-entry-leech-p))
(setq prompt (concat "!!! LEECH ITEM !!!
(setq prompt (concat
(propertize "!!! LEECH ITEM !!!
You seem to be having a lot of trouble memorising this item.
Consider reformulating the item to make it easier to remember.\n" prompt)))
(setq ch (read-char prompt))
Consider reformulating the item to make it easier to remember.\n"
'face '(:foreground "red"))
prompt)))
(while (memq ch '(nil ?t))
(while (not (input-pending-p))
(message (concat (format-time-string
"%M:%S " (time-subtract
(current-time) item-start-time))
prompt))
(sit-for 1))
(setq ch (read-char-exclusive))
(if (eql ch ?t)
(org-set-tags-command)))
(case ch
(?q nil)
(?e 'edit)
(?s 'skip)
(otherwise t))))
(defun org-pos-in-regexp (pos regexp &optional nlines)
(save-excursion
(goto-char pos)
(org-in-regexp regexp nlines)))
(defun org-drill-hide-clozed-text ()
(let ((ovl nil))
(save-excursion
(while (re-search-forward org-drill-cloze-regexp nil t)
(setf ovl (make-overlay (match-beginning 0) (match-end 0)))
(overlay-put ovl 'category
'org-drill-cloze-overlay-defaults)
(when (find ?| (match-string 0))
(overlay-put ovl
'display
(format "[...%s]"
(substring-no-properties
(match-string 0)
(1+ (position ?| (match-string 0)))
(1- (length (match-string 0)))))))))))
(save-excursion
(while (re-search-forward org-drill-cloze-regexp nil t)
;; Don't hide org links, partly because they might contain inline
;; images which we want to keep visible
(unless (org-pos-in-regexp (match-beginning 0)
org-bracket-link-regexp 1)
(org-drill-hide-matched-cloze-text)))))
(defun org-drill-hide-matched-cloze-text ()
"Hide the current match with a 'cloze' visual overlay."
(let ((ovl (make-overlay (match-beginning 0) (match-end 0))))
(overlay-put ovl 'category
'org-drill-cloze-overlay-defaults)
(when (find ?| (match-string 0))
(overlay-put ovl
'display
(format "[...%s]"
(substring-no-properties
(match-string 0)
(1+ (position ?| (match-string 0)))
(1- (length (match-string 0)))))))))
(defun org-drill-unhide-clozed-text ()
@ -472,80 +673,110 @@ Consider reformulating the item to make it easier to remember.\n" prompt)))
;; recall, nil if they chose to quit.
(defun org-drill-present-simple-card ()
(org-drill-hide-all-subheadings-except nil)
(prog1 (org-drill-presentation-prompt)
(org-show-subtree)))
(with-hidden-cloze-text
(org-drill-hide-all-subheadings-except nil)
(org-display-inline-images t)
(org-cycle-hide-drawers 'all)
(prog1 (org-drill-presentation-prompt)
(org-show-subtree))))
(defun org-drill-present-two-sided-card ()
(let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
(when drill-sections
(save-excursion
(goto-char (nth (random (min 2 (length drill-sections))) drill-sections))
(org-show-subtree)))
(prog1
(org-drill-presentation-prompt)
(org-show-subtree))))
(with-hidden-cloze-text
(let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
(when drill-sections
(save-excursion
(goto-char (nth (random (min 2 (length drill-sections)))
drill-sections))
(org-show-subtree)))
(org-display-inline-images t)
(org-cycle-hide-drawers 'all)
(prog1
(org-drill-presentation-prompt)
(org-show-subtree)))))
(defun org-drill-present-multi-sided-card ()
(let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
(when drill-sections
(with-hidden-cloze-text
(let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
(when drill-sections
(save-excursion
(goto-char (nth (random (length drill-sections)) drill-sections))
(org-show-subtree)))
(org-display-inline-images t)
(org-cycle-hide-drawers 'all)
(prog1
(org-drill-presentation-prompt)
(org-show-subtree)))))
(defun org-drill-present-multicloze ()
(let ((item-end nil)
(match-count 0)
(body-start (or (cdr (org-get-property-block))
(point))))
(org-drill-hide-all-subheadings-except nil)
(save-excursion
(outline-next-heading)
(setq item-end (point)))
(save-excursion
(goto-char body-start)
(while (re-search-forward org-drill-cloze-regexp item-end t)
(incf match-count)))
(when (plusp match-count)
(save-excursion
(goto-char (nth (random (length drill-sections)) drill-sections))
(org-show-subtree)))
(prog1
(org-drill-presentation-prompt)
(org-show-subtree))))
(goto-char body-start)
(re-search-forward org-drill-cloze-regexp
item-end t (1+ (random match-count)))
(org-drill-hide-matched-cloze-text)))
(org-display-inline-images t)
(org-cycle-hide-drawers 'all)
(prog1 (org-drill-presentation-prompt)
(org-show-subtree)
(org-drill-unhide-clozed-text))))
(defun org-drill-present-spanish-verb ()
(case (random 6)
(0
(org-drill-hide-all-subheadings-except '("Infinitive"))
(let ((prompt nil)
(reveal-headings nil))
(with-hidden-cloze-text
(case (random 6)
(0
(org-drill-hide-all-subheadings-except '("Infinitive"))
(setq prompt
(concat "Translate this Spanish verb, and conjugate it "
"for the *present* tense.")
reveal-headings '("English" "Present Tense" "Notes")))
(1
(org-drill-hide-all-subheadings-except '("English"))
(setq prompt (concat "For the *present* tense, conjugate the "
"Spanish translation of this English verb.")
reveal-headings '("Infinitive" "Present Tense" "Notes")))
(2
(org-drill-hide-all-subheadings-except '("Infinitive"))
(setq prompt (concat "Translate this Spanish verb, and "
"conjugate it for the *past* tense.")
reveal-headings '("English" "Past Tense" "Notes")))
(3
(org-drill-hide-all-subheadings-except '("English"))
(setq prompt (concat "For the *past* tense, conjugate the "
"Spanish translation of this English verb.")
reveal-headings '("Infinitive" "Past Tense" "Notes")))
(4
(org-drill-hide-all-subheadings-except '("Infinitive"))
(setq prompt (concat "Translate this Spanish verb, and "
"conjugate it for the *future perfect* tense.")
reveal-headings '("English" "Future Perfect Tense" "Notes")))
(5
(org-drill-hide-all-subheadings-except '("English"))
(setq prompt (concat "For the *future perfect* tense, conjugate the "
"Spanish translation of this English verb.")
reveal-headings '("Infinitive" "Future Perfect Tense" "Notes"))))
(org-cycle-hide-drawers 'all)
(prog1
(org-drill-presentation-prompt
"Translate this Spanish verb, and conjugate it for the *present* tense.")
(org-drill-hide-all-subheadings-except '("English" "Present Tense"
"Notes"))))
(1
(org-drill-hide-all-subheadings-except '("English"))
(prog1
(org-drill-presentation-prompt
"For the *present* tense, conjugate the Spanish translation of this English verb.")
(org-drill-hide-all-subheadings-except '("Infinitive" "Present Tense"
"Notes"))))
(2
(org-drill-hide-all-subheadings-except '("Infinitive"))
(prog1
(org-drill-presentation-prompt
"Translate this Spanish verb, and conjugate it for the *past* tense.")
(org-drill-hide-all-subheadings-except '("English" "Past Tense"
"Notes"))))
(3
(org-drill-hide-all-subheadings-except '("English"))
(prog1
(org-drill-presentation-prompt
"For the *past* tense, conjugate the Spanish translation of this English verb.")
(org-drill-hide-all-subheadings-except '("Infinitive" "Past Tense"
"Notes"))))
(4
(org-drill-hide-all-subheadings-except '("Infinitive"))
(prog1
(org-drill-presentation-prompt
"Translate this Spanish verb, and conjugate it for the *future perfect* tense.")
(org-drill-hide-all-subheadings-except '("English" "Future Perfect Tense"
"Notes"))))
(5
(org-drill-hide-all-subheadings-except '("English"))
(prog1
(org-drill-presentation-prompt
"For the *future perfect* tense, conjugate the Spanish translation of this English verb.")
(org-drill-hide-all-subheadings-except '("Infinitive" "Future Perfect Tense"
"Notes"))))))
(org-drill-presentation-prompt prompt)
(org-drill-hide-all-subheadings-except reveal-headings)))))
@ -559,9 +790,12 @@ EDIT if the user chose to exit the drill and edit the current item.
See `org-drill' for more details."
(interactive)
(unless (org-at-heading-p)
(org-back-to-heading))
(let ((card-type (cdr (assoc "DRILL_CARD_TYPE" (org-entry-properties nil))))
(org-drill-goto-drill-entry-heading)
;;(unless (org-part-of-drill-entry-p)
;; (error "Point is not inside a drill entry"))
;;(unless (org-at-heading-p)
;; (org-back-to-heading))
(let ((card-type (org-entry-get (point) "DRILL_CARD_TYPE"))
(cont nil))
(save-restriction
(org-narrow-to-subtree)
@ -571,15 +805,7 @@ See `org-drill' for more details."
(let ((presentation-fn (cdr (assoc card-type org-drill-card-type-alist))))
(cond
(presentation-fn
(org-drill-hide-clozed-text)
;;(highlight-regexp org-drill-cloze-regexp
;; 'org-drill-hidden-cloze-face)
(unwind-protect
(progn
(setq cont (funcall presentation-fn)))
(org-drill-unhide-clozed-text))
;;(unhighlight-regexp org-drill-cloze-regexp)
)
(setq cont (funcall presentation-fn)))
(t
(error "Unknown card type: '%s'" card-type))))
@ -589,83 +815,188 @@ See `org-drill' for more details."
nil)
((eql cont 'edit)
'edit)
((eql cont 'skip)
'skip)
(t
(save-excursion
(org-drill-reschedule)))))))
(defun org-drill-entries (entries)
;; (defun org-drill-entries (entries)
;; "Returns nil, t, or a list of markers representing entries that were
;; 'failed' and need to be presented again before the session ends."
;; (let ((again-entries nil))
;; (setq *org-drill-done-entry-count* 0
;; *org-drill-pending-entry-count* (length entries))
;; (if (and org-drill-maximum-items-per-session
;; (> (length entries)
;; org-drill-maximum-items-per-session))
;; (setq entries (subseq entries 0
;; org-drill-maximum-items-per-session)))
;; (block org-drill-entries
;; (dolist (m entries)
;; (save-restriction
;; (switch-to-buffer (marker-buffer m))
;; (goto-char (marker-position m))
;; (setq result (org-drill-entry))
;; (cond
;; ((null result)
;; (message "Quit")
;; (return-from org-drill-entries nil))
;; ((eql result 'edit)
;; (setq end-pos (point-marker))
;; (return-from org-drill-entries nil))
;; (t
;; (cond
;; ((< result 3)
;; (push m again-entries))
;; (t
;; (decf *org-drill-pending-entry-count*)
;; (incf *org-drill-done-entry-count*)))
;; (when (and org-drill-maximum-duration
;; (> (- (float-time (current-time)) *org-drill-start-time*)
;; (* org-drill-maximum-duration 60)))
;; (message "This drill session has reached its maximum duration.")
;; (return-from org-drill-entries nil))))))
;; (or again-entries
;; t))))
(defun org-drill-entries-pending-p ()
(or *org-drill-again-entries*
(and (not (org-drill-maximum-item-count-reached-p))
(not (org-drill-maximum-duration-reached-p))
(or *org-drill-new-entries*
*org-drill-failed-entries*
*org-drill-mature-entries*
*org-drill-again-entries*))))
(defun org-drill-pending-entry-count ()
(+ (length *org-drill-new-entries*)
(length *org-drill-failed-entries*)
(length *org-drill-mature-entries*)
(length *org-drill-again-entries*)))
(defun org-drill-maximum-duration-reached-p ()
"Returns true if the current drill session has continued past its
maximum duration."
(and org-drill-maximum-duration
*org-drill-start-time*
(> (- (float-time (current-time)) *org-drill-start-time*)
(* org-drill-maximum-duration 60))))
(defun org-drill-maximum-item-count-reached-p ()
"Returns true if the current drill session has reached the
maximum number of items."
(and org-drill-maximum-items-per-session
(>= (length *org-drill-done-entries*)
org-drill-maximum-items-per-session)))
(defun org-drill-pop-next-pending-entry ()
(cond
;; First priority is items we failed in a prior session.
((and *org-drill-failed-entries*
(not (org-drill-maximum-item-count-reached-p))
(not (org-drill-maximum-duration-reached-p)))
(pop-random *org-drill-failed-entries*))
;; Next priority is newly added items, and items which
;; are not new and were not failed when they were last
;; reviewed.
((and (or *org-drill-new-entries*
*org-drill-mature-entries*)
(not (org-drill-maximum-item-count-reached-p))
(not (org-drill-maximum-duration-reached-p)))
(if (< (random (+ (length *org-drill-new-entries*)
(length *org-drill-mature-entries*)))
(length *org-drill-new-entries*))
(pop-random *org-drill-new-entries*)
;; else
(pop-random *org-drill-mature-entries*)))
;; After all the above are done, last priority is items
;; that were failed earlier THIS SESSION.
(*org-drill-again-entries*
(pop-random *org-drill-again-entries*))
(t
nil)))
(defun org-drill-entries ()
"Returns nil, t, or a list of markers representing entries that were
'failed' and need to be presented again before the session ends."
(let ((again-entries nil)
(*org-drill-done-entry-count* 0)
(*org-drill-pending-entry-count* (length entries)))
(if (and org-drill-maximum-items-per-session
(> (length entries)
org-drill-maximum-items-per-session))
(setq entries (subseq entries 0
org-drill-maximum-items-per-session)))
(block org-drill-entries
(dolist (m entries)
(save-restriction
(switch-to-buffer (marker-buffer m))
(goto-char (marker-position m))
(setq result (org-drill-entry))
(block org-drill-entries
(while (org-drill-entries-pending-p)
(setq m (org-drill-pop-next-pending-entry))
(unless m
(error "Unexpectedly ran out of pending drill items"))
(save-excursion
(set-buffer (marker-buffer m))
(goto-char m)
(setq result (org-drill-entry))
(cond
((null result)
(message "Quit")
(return-from org-drill-entries nil))
((eql result 'edit)
(setq end-pos (point-marker))
(return-from org-drill-entries nil))
((eql result 'skip)
nil) ; skip this item
(t
(cond
((null result)
(message "Quit")
(return-from org-drill-entries nil))
((eql result 'edit)
(setq end-pos (point-marker))
(return-from org-drill-entries nil))
((<= result org-drill-failure-quality)
(push m *org-drill-again-entries*))
(t
(cond
((< result 3)
(push m again-entries))
(t
(decf *org-drill-pending-entry-count*)
(incf *org-drill-done-entry-count*)))
(when (and org-drill-maximum-duration
(> (- (float-time (current-time)) *org-drill-start-time*)
(* org-drill-maximum-duration 60)))
(message "This drill session has reached its maximum duration.")
(return-from org-drill-entries nil))))))
(or again-entries
t))))
(push m *org-drill-done-entries*)))))))))
(defun org-drill-final-report ()
(read-char
(format
"%d items reviewed, %d items awaiting review
(read-char-exclusive
(format
"%d items reviewed
%d items awaiting review (%s, %s, %s)
Session duration %s
Recall of reviewed items:
Excellent (5): %3d%%
Good (4): %3d%%
Hard (3): %3d%%
Near miss (2): %3d%%
Failure (1): %3d%%
Total failure (0): %3d%%
Excellent (5): %3d%% | Near miss (2): %3d%%
Good (4): %3d%% | Failure (1): %3d%%
Hard (3): %3d%% | Total failure (0): %3d%%
Session finished. Press a key to continue..."
*org-drill-done-entry-count*
*org-drill-pending-entry-count*
(format-seconds "%h:%.2m:%.2s"
(- (float-time (current-time)) *org-drill-start-time*))
(round (* 100 (count 5 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 4 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 3 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 2 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 1 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 0 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
)))
(length *org-drill-done-entries*)
(org-drill-pending-entry-count)
(propertize
(format "%d failed"
(+ (length *org-drill-failed-entries*)
(length *org-drill-again-entries*)))
'face `(:foreground ,org-drill-failed-count-color))
(propertize
(format "%d old"
(length *org-drill-mature-entries*))
'face `(:foreground ,org-drill-mature-count-color))
(propertize
(format "%d new"
(length *org-drill-new-entries*))
'face `(:foreground ,org-drill-new-count-color))
(format-seconds "%h:%.2m:%.2s"
(- (float-time (current-time)) *org-drill-start-time*))
(round (* 100 (count 5 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 2 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 4 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 1 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 3 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
(round (* 100 (count 0 *org-drill-session-qualities*))
(max 1 (length *org-drill-session-qualities*)))
)))
@ -712,46 +1043,74 @@ agenda-with-archives
(interactive)
(let ((entries nil)
(failed-entries nil)
(new-entries nil)
(old-entries nil)
(result nil)
(results nil)
(end-pos nil))
(end-pos nil)
(cnt 0))
(block org-drill
(setq *org-drill-done-entries* nil
*org-drill-new-entries* nil
*org-drill-mature-entries* nil
*org-drill-failed-entries* nil
*org-drill-again-entries* nil)
(setq *org-drill-session-qualities* nil)
(setq *org-drill-start-time* (float-time (current-time)))
(save-excursion
(org-map-entries
(lambda () (when (org-drill-entry-due-p)
(cond
((org-drill-entry-new-p)
(push (point-marker) new-entries))
((<= (org-drill-entry-last-quality)
org-drill-failure-quality)
(push (point-marker) failed-entries))
(t
(push (point-marker) old-entries)))))
"" scope)
;; Failed first, then random mix of old + new
(setq entries (append (shuffle-list failed-entries)
(shuffle-list (append old-entries
new-entries))))
(cond
((null entries)
(message "I did not find any pending drill items."))
(t
(let ((again t))
(while again
(when (listp again)
(setq entries (shuffle-list again)))
(setq again (org-drill-entries entries))
(cond
((null again)
(return-from org-drill nil))
((eql t again)
(setq again nil))))
(message "Drill session finished!")
)))))
(unwind-protect
(save-excursion
(let ((org-trust-scanner-tags t))
(org-map-entries
(lambda ()
(when (zerop (% (incf cnt) 50))
(message "Processing drill items: %4d%s"
(+ (length *org-drill-new-entries*)
(length *org-drill-mature-entries*)
(length *org-drill-failed-entries*))
(make-string (ceiling cnt 50) ?.)))
(when (org-drill-entry-due-p)
(cond
((org-drill-entry-new-p)
(push (point-marker) *org-drill-new-entries*))
((and (org-drill-entry-last-quality)
(<= (org-drill-entry-last-quality)
org-drill-failure-quality))
(push (point-marker) *org-drill-failed-entries*))
(t
(push (point-marker) *org-drill-mature-entries*)))))
(concat "+" org-drill-question-tag) scope))
;; Failed first, then random mix of old + new
(setq entries (append (shuffle-list *org-drill-failed-entries*)
(shuffle-list (append *org-drill-mature-entries*
*org-drill-new-entries*))))
(cond
((and (null *org-drill-new-entries*)
(null *org-drill-failed-entries*)
(null *org-drill-mature-entries*))
(message "I did not find any pending drill items."))
(t
(org-drill-entries)
(message "Drill session finished!"))))
;; (cond
;; ((null entries)
;; (message "I did not find any pending drill items."))
;; (t
;; (let ((again t))
;; (while again
;; (when (listp again)
;; (setq entries (shuffle-list again)))
;; (setq again (org-drill-entries entries))
;; (cond
;; ((null again)
;; (return-from org-drill nil))
;; ((eql t again)
;; (setq again nil))))
;; (message "Drill session finished!")
;; ))))
(progn
(dolist (m (append *org-drill-new-entries*
*org-drill-failed-entries*
*org-drill-again-entries*
*org-drill-mature-entries*))
(free-marker m)))))
(cond
(end-pos
(switch-to-buffer (marker-buffer end-pos))
@ -761,15 +1120,25 @@ agenda-with-archives
(org-drill-final-report)))))
(defun org-drill-cram (&optional scope)
"Run an interactive drill session in 'cram mode'. In cram mode,
all drill items are considered to be due for review, unless they
have been reviewed within the last `org-drill-cram-hours'
hours."
(interactive)
(let ((*org-drill-cram-mode* t))
(org-drill scope)))
(add-hook 'org-mode-hook
(lambda ()
(if org-drill-use-visible-cloze-face-p
(font-lock-add-keywords
'org-mode
`((,org-drill-cloze-regexp
(0 'org-drill-visible-cloze-face nil)))
t))))
org-drill-cloze-keywords
t))))
(provide 'org-drill)