diff options
| author | Sébastien Delafond <sdelafond@gmail.com> | 2014-07-13 13:35:01 +0200 |
|---|---|---|
| committer | Sébastien Delafond <sdelafond@gmail.com> | 2014-07-13 13:35:01 +0200 |
| commit | 7697fa4daf3ec84f85711a84035d8f0224afd4e3 (patch) | |
| tree | 24d0f1d2a9751ca8c063409fd2ab71478b296efb /contrib/lisp/org-drill.el | |
Imported Upstream version 7.9.2
Diffstat (limited to 'contrib/lisp/org-drill.el')
| -rw-r--r-- | contrib/lisp/org-drill.el | 3001 |
1 files changed, 3001 insertions, 0 deletions
diff --git a/contrib/lisp/org-drill.el b/contrib/lisp/org-drill.el new file mode 100644 index 0000000..2ffc201 --- /dev/null +++ b/contrib/lisp/org-drill.el @@ -0,0 +1,3001 @@ +;;; -*- coding: utf-8-unix -*- +;;; org-drill.el - Self-testing using spaced repetition +;;; +;;; Author: Paul Sexton <eeeickythump@gmail.com> +;;; Version: 2.3.6 +;;; Repository at http://bitbucket.org/eeeickythump/org-drill/ +;;; +;;; +;;; Synopsis +;;; ======== +;;; +;;; Uses the SuperMemo spaced repetition algorithms to conduct interactive +;;; "drill sessions", where the material to be remembered is presented to the +;;; student in random order. The student rates his or her recall of each item, +;;; and this information is used to schedule the item for later revision. +;;; +;;; Each drill session can be restricted to topics in the current buffer +;;; (default), one or several files, all agenda files, or a subtree. A single +;;; topic can also be drilled. +;;; +;;; Different "card types" can be defined, which present their information to +;;; the student in different ways. +;;; +;;; See the file README.org for more detailed documentation. + + +(eval-when-compile (require 'cl)) +(eval-when-compile (require 'hi-lock)) +(require 'org) +(require 'org-id) +(require 'org-learn) + + +(defgroup org-drill nil + "Options concerning interactive drill sessions in Org mode (org-drill)." + :tag "Org-Drill" + :group 'org-link) + + + +(defcustom org-drill-question-tag + "drill" + "Tag which topics must possess in order to be identified as review topics +by `org-drill'." + :group 'org-drill + :type 'string) + + +(defcustom org-drill-maximum-items-per-session + 30 + "Each drill session will present at most this many topics for review. +Nil means unlimited." + :group 'org-drill + :type '(choice integer (const nil))) + + + +(defcustom org-drill-maximum-duration + 20 + "Maximum duration of a drill session, in minutes. +Nil means unlimited." + :group 'org-drill + :type '(choice integer (const nil))) + + +(defcustom org-drill-failure-quality + 2 + "If the quality of recall for an item is this number or lower, +it is regarded as an unambiguous failure, and the repetition +interval for the card is reset to 0 days. If the quality is higher +than this number, it is regarded as successfully recalled, but the +time interval to the next repetition will be lowered if the quality +was near to a fail. + +By default this is 2, for SuperMemo-like behaviour. For +Mnemosyne-like behaviour, set it to 1. Other values are not +really sensible." + :group 'org-drill + :type '(choice (const 2) (const 1))) + + +(defcustom org-drill-forgetting-index + 10 + "What percentage of items do you consider it is 'acceptable' to +forget each drill session? The default is 10%. A warning message +is displayed at the end of the session if the percentage forgotten +climbs above this number." + :group 'org-drill + :type 'integer) + + +(defcustom org-drill-leech-failure-threshold + 15 + "If an item is forgotten more than this many times, it is tagged +as a 'leech' item." + :group 'org-drill + :type '(choice integer (const nil))) + + +(defcustom org-drill-leech-method + 'skip + "How should 'leech items' be handled during drill sessions? +Possible values: +- nil :: Leech items are treated the same as normal items. +- skip :: Leech items are not included in drill sessions. +- warn :: Leech items are still included in drill sessions, + but a warning message is printed when each leech item is + presented." + :group 'org-drill + :type '(choice (const 'warn) (const 'skip) (const nil))) + + +(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) + + +(defface org-drill-hidden-cloze-face + '((t (:foreground "deep sky blue" :background "blue"))) + "The face used to hide the contents of cloze phrases." + :group 'org-drill) + + +(defcustom org-drill-use-visible-cloze-face-p + nil + "Use a special face to highlight cloze-deleted text in org mode +buffers?" + :group 'org-drill + :type 'boolean) + + +(defcustom org-drill-hide-item-headings-p + nil + "Conceal the contents of the main heading of each item during drill +sessions? You may want to enable this behaviour if item headings or tags +contain information that could 'give away' the answer." + :group 'org-drill + :type 'boolean) + + +(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 + window t)) + +(setplist 'org-drill-hidden-text-overlay + '(invisible t)) + +(setplist 'org-drill-replaced-text-overlay + '(display "Replaced text" + face default + window t)) + + +(defvar org-drill-cloze-regexp + ;; ver 1 "[^][]\\(\\[[^][][^]]*\\]\\)" + ;; ver 2 "\\(\\[.*?\\]\\|^[^[[: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 + '((nil . org-drill-present-simple-card) + ("simple" . org-drill-present-simple-card) + ("twosided" . org-drill-present-two-sided-card) + ("multisided" . org-drill-present-multi-sided-card) + ("hide1cloze" . org-drill-present-multicloze-hide1) + ("hide2cloze" . org-drill-present-multicloze-hide2) + ("show1cloze" . org-drill-present-multicloze-show1) + ("show2cloze" . org-drill-present-multicloze-show2) + ("multicloze" . org-drill-present-multicloze-hide1) + ("hidefirst" . org-drill-present-multicloze-hide-first) + ("hidelast" . org-drill-present-multicloze-hide-last) + ("hide1_firstmore" . org-drill-present-multicloze-hide1-firstmore) + ("show1_lastmore" . org-drill-present-multicloze-show1-lastmore) + ("show1_firstless" . org-drill-present-multicloze-show1-firstless) + ("conjugate" org-drill-present-verb-conjugation + org-drill-show-answer-verb-conjugation) + ("spanish_verb" . org-drill-present-spanish-verb) + ("translate_number" org-drill-present-translate-number + org-drill-show-answer-translate-number)) + "Alist associating card types with presentation functions. Each entry in the +alist takes one of two forms: +1. (CARDTYPE . QUESTION-FN), where CARDTYPE is a string or nil (for default), + and QUESTION-FN is a function which takes no arguments and returns a boolean + value. +2. (CARDTYPE QUESTION-FN ANSWER-FN), where ANSWER-FN is a function that takes + one argument -- the argument is a function that itself takes no arguments. + ANSWER-FN is called with the point on the active item's + heading, just prior to displaying the item's 'answer'. It can therefore be + used to modify the appearance of the answer. ANSWER-FN must call its argument + before returning. (Its argument is a function that prompts the user and + performs rescheduling)." + :group 'org-drill + :type '(alist :key-type (choice string (const nil)) :value-type function)) + + +(defcustom org-drill-scope + 'file + "The scope in which to search for drill items when conducting a +drill session. This can be any of: + +file The current buffer, respecting the restriction if any. + This is the default. +tree The subtree started with the entry at point +file-no-restriction The current buffer, without restriction +file-with-archives The current buffer, and any archives associated with it. +agenda All agenda files +agenda-with-archives All agenda files with any archive files associated + with them. +directory All files with the extension '.org' in the same + directory as the current file (includes the current + file if it is an .org file.) + (FILE1 FILE2 ...) If this is a list, all files in the list will be scanned. +" + ;; Note -- meanings differ slightly from the argument to org-map-entries: + ;; 'file' means current file/buffer, respecting any restriction + ;; 'file-no-restriction' means current file/buffer, ignoring restrictions + ;; 'directory' means all *.org files in current directory + :group 'org-drill + :type '(choice (const 'file) (const 'tree) (const 'file-no-restriction) + (const 'file-with-archives) (const 'agenda) + (const 'agenda-with-archives) (const 'directory) + list)) + + +(defcustom org-drill-save-buffers-after-drill-sessions-p + t + "If non-nil, prompt to save all modified buffers after a drill session +finishes." + :group 'org-drill + :type 'boolean) + + +(defcustom org-drill-spaced-repetition-algorithm + 'sm5 + "Which SuperMemo spaced repetition algorithm to use for scheduling items. +Available choices are: +- SM2 :: the SM2 algorithm, used in SuperMemo 2.0 +- SM5 :: the SM5 algorithm, used in SuperMemo 5.0 +- Simple8 :: a modified version of the SM8 algorithm. SM8 is used in + SuperMemo 98. The version implemented here is simplified in that while it + 'learns' the difficulty of each item using quality grades and number of + failures, it does not modify the matrix of values that + governs how fast the inter-repetition intervals increase. A method for + adjusting intervals when items are reviewed early or late has been taken + from SM11, a later version of the algorithm, and included in Simple8." + :group 'org-drill + :type '(choice (const 'sm2) (const 'sm5) (const 'simple8))) + + +(defcustom org-drill-optimal-factor-matrix + nil + "DO NOT CHANGE THE VALUE OF THIS VARIABLE. + +Persistent matrix of optimal factors, used by the SuperMemo SM5 algorithm. +The matrix is saved (using the 'customize' facility) at the end of each +drill session. + +Over time, values in the matrix will adapt to the individual user's +pace of learning." + :group 'org-drill + :type 'sexp) + + +(defcustom org-drill-sm5-initial-interval + 4.0 + "In the SM5 algorithm, the initial interval after the first +successful presentation of an item is always 4 days. If you wish to change +this, you can do so here." + :group 'org-drill + :type 'float) + + +(defcustom org-drill-add-random-noise-to-intervals-p + nil + "If true, the number of days until an item's next repetition +will vary slightly from the interval calculated by the SM2 +algorithm. The variation is very small when the interval is +small, but scales up with the interval." + :group 'org-drill + :type 'boolean) + + +(defcustom org-drill-adjust-intervals-for-early-and-late-repetitions-p + nil + "If true, when the student successfully reviews an item 1 or more days +before or after the scheduled review date, this will affect that date of +the item's next scheduled review, according to the algorithm presented at + [[http://www.supermemo.com/english/algsm11.htm#Advanced%20repetitions]]. + +Items that were reviewed early will have their next review date brought +forward. Those that were reviewed late will have their next review +date postponed further. + +Note that this option currently has no effect if the SM2 algorithm +is used." + :group 'org-drill + :type 'boolean) + + +(defcustom org-drill-cloze-text-weight + 4 + "For card types 'hide1_firstmore', 'show1_lastmore' and 'show1_firstless', +this number determines how often the 'less favoured' situation +should arise. It will occur 1 in every N trials, where N is the +value of the variable. + +For example, with the hide1_firstmore card type, the first piece +of clozed text should be hidden more often than the other +pieces. If this variable is set to 4 (default), the first item +will only be shown 25% of the time (1 in 4 trials). Similarly for +show1_lastmore, the last item will be shown 75% of the time, and +for show1_firstless, the first item would only be shown 25% of the +time. + +If the value of this variable is NIL, then weighting is disabled, and +all weighted card types are treated as their unweighted equivalents." + :group 'org-drill + :type '(choice integer (const nil))) + + +(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) + + +;;; NEW items have never been presented in a drill session before. +;;; MATURE items HAVE been presented at least once before. +;;; - YOUNG mature items were scheduled no more than +;;; ORG-DRILL-DAYS-BEFORE-OLD days after their last +;;; repetition. These items will have been learned 'recently' and will have a +;;; low repetition count. +;;; - OLD mature items have intervals greater than +;;; ORG-DRILL-DAYS-BEFORE-OLD. +;;; - OVERDUE items are past their scheduled review date by more than +;;; LAST-INTERVAL * (ORG-DRILL-OVERDUE-INTERVAL-FACTOR - 1) days, +;;; regardless of young/old status. + + +(defcustom org-drill-days-before-old + 10 + "When an item's inter-repetition interval rises above this value in days, +it is no longer considered a 'young' (recently learned) item." + :group 'org-drill + :type 'integer) + + +(defcustom org-drill-overdue-interval-factor + 1.2 + "An item is considered overdue if its scheduled review date is +more than (ORG-DRILL-OVERDUE-INTERVAL-FACTOR - 1) * LAST-INTERVAL +days in the past. For example, a value of 1.2 means an additional +20% of the last scheduled interval is allowed to elapse before +the item is overdue. A value of 1.0 means no extra time is +allowed at all - items are immediately considered overdue if +there is even one day's delay in reviewing them. This variable +should never be less than 1.0." + :group 'org-drill + :type 'float) + + +(defcustom org-drill-learn-fraction + 0.5 + "Fraction between 0 and 1 that governs how quickly the spaces +between successive repetitions increase, for all items. The +default value is 0.5. Higher values make spaces increase more +quickly with each successful repetition. You should only change +this in small increments (for example 0.05-0.1) as it has an +exponential effect on inter-repetition spacing." + :group 'org-drill + :type 'float) + + +(defvar *org-drill-session-qualities* nil) +(defvar *org-drill-start-time* 0) +(defvar *org-drill-new-entries* nil) +(defvar *org-drill-dormant-entry-count* 0) +(defvar *org-drill-due-entry-count* 0) +(defvar *org-drill-overdue-entry-count* 0) +(defvar *org-drill-due-tomorrow-count* 0) +(defvar *org-drill-overdue-entries* nil + "List of markers for items that are considered 'overdue', based on +the value of ORG-DRILL-OVERDUE-INTERVAL-FACTOR.") +(defvar *org-drill-young-mature-entries* nil + "List of markers for mature entries whose last inter-repetition +interval was <= ORG-DRILL-DAYS-BEFORE-OLD days.") +(defvar *org-drill-old-mature-entries* nil + "List of markers for mature entries whose last inter-repetition +interval was greater than ORG-DRILL-DAYS-BEFORE-OLD days.") +(defvar *org-drill-failed-entries* nil) +(defvar *org-drill-again-entries* nil) +(defvar *org-drill-done-entries* nil) +(defvar *org-drill-current-item* nil + "Set to the marker for the item currently being tested.") +(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?") +(defvar org-drill-scheduling-properties + '("LEARN_DATA" "DRILL_LAST_INTERVAL" "DRILL_REPEATS_SINCE_FAIL" + "DRILL_TOTAL_REPEATS" "DRILL_FAILURE_COUNT" "DRILL_AVERAGE_QUALITY" + "DRILL_EASE" "DRILL_LAST_QUALITY" "DRILL_LAST_REVIEWED")) + + +;;; Make the above settings safe as file-local variables. + + +(put 'org-drill-question-tag 'safe-local-variable 'stringp) +(put 'org-drill-maximum-items-per-session 'safe-local-variable + '(lambda (val) (or (integerp val) (null val)))) +(put 'org-drill-maximum-duration 'safe-local-variable + '(lambda (val) (or (integerp val) (null val)))) +(put 'org-drill-failure-quality 'safe-local-variable 'integerp) +(put 'org-drill-forgetting-index 'safe-local-variable 'integerp) +(put 'org-drill-leech-failure-threshold 'safe-local-variable 'integerp) +(put 'org-drill-leech-method 'safe-local-variable + '(lambda (val) (memq val '(nil skip warn)))) +(put 'org-drill-use-visible-cloze-face-p 'safe-local-variable 'booleanp) +(put 'org-drill-hide-item-headings-p 'safe-local-variable 'booleanp) +(put 'org-drill-spaced-repetition-algorithm 'safe-local-variable + '(lambda (val) (memq val '(simple8 sm5 sm2)))) +(put 'org-drill-sm5-initial-interval 'safe-local-variable 'floatp) +(put 'org-drill-add-random-noise-to-intervals-p 'safe-local-variable 'booleanp) +(put 'org-drill-adjust-intervals-for-early-and-late-repetitions-p + 'safe-local-variable 'booleanp) +(put 'org-drill-cram-hours 'safe-local-variable 'integerp) +(put 'org-drill-learn-fraction 'safe-local-variable 'floatp) +(put 'org-drill-days-before-old 'safe-local-variable 'integerp) +(put 'org-drill-overdue-interval-factor 'safe-local-variable 'floatp) +(put 'org-drill-scope 'safe-local-variable + '(lambda (val) (or (symbolp val) (listp val)))) +(put 'org-drill-save-buffers-after-drill-sessions-p 'safe-local-variable 'booleanp) +(put 'org-drill-cloze-text-weight 'safe-local-variable + '(lambda (val) (or (null val) (integerp val)))) + + +;;;; Utilities ================================================================ + + +(defun free-marker (m) + (set-marker m nil)) + + +(defmacro pop-random (place) + (let ((idx (gensym))) + `(if (null ,place) + nil + (let ((,idx (random* (length ,place)))) + (prog1 (nth ,idx ,place) + (setq ,place (append (subseq ,place 0 ,idx) + (subseq ,place (1+ ,idx))))))))) + + +(defmacro push-end (val place) + "Add VAL to the end of the sequence stored in PLACE. Return the new +value." + `(setq ,place (append ,place (list ,val)))) + + +(defun shuffle-list (list) + "Randomly permute the elements of LIST (all permutations equally likely)." + ;; Adapted from 'shuffle-vector' in cookie1.el + (let ((i 0) + j + temp + (len (length list))) + (while (< i len) + (setq j (+ i (random* (- len i)))) + (setq temp (nth i list)) + (setf (nth i list) (nth j list)) + (setf (nth j list) temp) + (setq i (1+ i)))) + list) + + +(defun round-float (floatnum fix) + "Round the floating point number FLOATNUM to FIX decimal places. +Example: (round-float 3.56755765 3) -> 3.568" + (let ((n (expt 10 fix))) + (/ (float (round (* floatnum n))) n))) + + +(defun command-keybinding-to-string (cmd) + "Return a human-readable description of the key/keys to which the command +CMD is bound, or nil if it is not bound to a key." + (let ((key (where-is-internal cmd overriding-local-map t))) + (if key (key-description key)))) + + +(defun time-to-inactive-org-timestamp (time) + (format-time-string + (concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]") + time)) + + +(defun org-map-drill-entries (func &optional scope &rest skip) + "Like `org-map-entries', but only drill entries are processed." + (let ((org-drill-scope (or scope org-drill-scope))) + (apply 'org-map-entries func + (concat "+" org-drill-question-tag) + (case org-drill-scope + (file nil) + (file-no-restriction 'file) + (directory + (directory-files (file-name-directory (buffer-file-name)) + t "\\.org$")) + (t org-drill-scope)) + skip))) + + +(defmacro with-hidden-cloze-text (&rest body) + `(progn + (org-drill-hide-clozed-text) + (unwind-protect + (progn + ,@body) + (org-drill-unhide-clozed-text)))) + + +(defmacro with-hidden-cloze-hints (&rest body) + `(progn + (org-drill-hide-cloze-hints) + (unwind-protect + (progn + ,@body) + (org-drill-unhide-text)))) + + +(defmacro with-hidden-comments (&rest body) + `(progn + (if org-drill-hide-item-headings-p + (org-drill-hide-heading-at-point)) + (org-drill-hide-comments) + (unwind-protect + (progn + ,@body) + (org-drill-unhide-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 (&optional marker) + "Is MARKER, or the point, in a 'drill item'? This will return nil if +the point is inside a subheading of a drill item -- to handle that +situation use `org-part-of-drill-entry-p'." + (save-excursion + (when marker + (org-drill-goto-entry marker)) + (member org-drill-question-tag (org-get-local-tags)))) + + +(defun org-drill-goto-entry (marker) + (switch-to-buffer (marker-buffer marker)) + (goto-char marker)) + + +(defun org-part-of-drill-entry-p () + "Is the current entry either the main heading of a 'drill item', +or a subheading within a drill item?" + (or (org-drill-entry-p) + ;; Does this heading INHERIT the drill tag + (member org-drill-question-tag (org-get-tags-at)))) + + +(defun org-drill-goto-drill-entry-heading () + "Move the point to the heading which holds 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) + (member "leech" (org-get-local-tags)))) + + +;; (defun org-drill-entry-due-p () +;; (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 scheduled +;; (not (minusp ; scheduled for today/in past +;; (- (time-to-days (current-time)) +;; (time-to-days item-time)))))))))) + + +(defun org-drill-entry-days-overdue () + "Returns: +- NIL if the item is not to be regarded as scheduled for review at all. + This is the case if it is not a drill item, or if it is a leech item + that we wish to skip, or if we are in cram mode and have already reviewed + the item within the last few hours. +- 0 if the item is new, or if it scheduled for review today. +- A negative integer - item is scheduled that many days in the future. +- A positive integer - item is scheduled that many days in the past." + (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)) + 0))) + (t + (let ((item-time (org-get-scheduled-time (point)))) + (cond + ((or (not (org-drill-entry-p)) + (and (eql 'skip org-drill-leech-method) + (org-drill-entry-leech-p))) + nil) + ((null item-time) ; not scheduled -> due now + 0) + (t + (- (time-to-days (current-time)) + (time-to-days item-time)))))))) + + +(defun org-drill-entry-overdue-p (&optional days-overdue last-interval) + "Returns true if entry that is scheduled DAYS-OVERDUE dasy in the past, +and whose last inter-repetition interval was LAST-INTERVAL, should be +considered 'overdue'. If the arguments are not given they are extracted +from the entry at point." + (unless days-overdue + (setq days-overdue (org-drill-entry-days-overdue))) + (unless last-interval + (setq last-interval (org-drill-entry-last-interval 1))) + (and (numberp days-overdue) + (> days-overdue 1) ; enforce a sane minimum 'overdue' gap + ;;(> due org-drill-days-before-overdue) + (> (/ (+ days-overdue last-interval 1.0) last-interval) + org-drill-overdue-interval-factor))) + + + +(defun org-drill-entry-due-p () + (let ((due (org-drill-entry-days-overdue))) + (and (not (null due)) + (not (minusp due))))) + + +(defun org-drill-entry-new-p () + (and (org-drill-entry-p) + (let ((item-time (org-get-scheduled-time (point)))) + (null item-time)))) + + +(defun org-drill-entry-last-quality (&optional default) + (let ((quality (org-entry-get (point) "DRILL_LAST_QUALITY"))) + (if quality + (string-to-number quality) + default))) + + +(defun org-drill-entry-failure-count () + (let ((quality (org-entry-get (point) "DRILL_FAILURE_COUNT"))) + (if quality + (string-to-number quality) + 0))) + + +(defun org-drill-entry-average-quality (&optional default) + (let ((val (org-entry-get (point) "DRILL_AVERAGE_QUALITY"))) + (if val + (string-to-number val) + (or default nil)))) + +(defun org-drill-entry-last-interval (&optional default) + (let ((val (org-entry-get (point) "DRILL_LAST_INTERVAL"))) + (if val + (string-to-number val) + (or default 0)))) + +(defun org-drill-entry-repeats-since-fail (&optional default) + (let ((val (org-entry-get (point) "DRILL_REPEATS_SINCE_FAIL"))) + (if val + (string-to-number val) + (or default 0)))) + +(defun org-drill-entry-total-repeats (&optional default) + (let ((val (org-entry-get (point) "DRILL_TOTAL_REPEATS"))) + (if val + (string-to-number val) + (or default 0)))) + +(defun org-drill-entry-ease (&optional default) + (let ((val (org-entry-get (point) "DRILL_EASE"))) + (if val + (string-to-number val) + default))) + + +;;; From http://www.supermemo.com/english/ol/sm5.htm +(defun org-drill-random-dispersal-factor () + "Returns a random number between 0.5 and 1.5." + (let ((a 0.047) + (b 0.092) + (p (- (random* 1.0) 0.5))) + (flet ((sign (n) + (cond ((zerop n) 0) + ((plusp n) 1) + (t -1)))) + (/ (+ 100 (* (* (/ -1 b) (log (- 1 (* (/ b a ) (abs p))))) + (sign p))) + 100.0)))) + +(defun pseudonormal (mean variation) + "Random numbers in a pseudo-normal distribution with mean MEAN, range + MEAN-VARIATION to MEAN+VARIATION" + (+ (random* variation) + (random* variation) + (- variation) + mean)) + + +(defun org-drill-early-interval-factor (optimal-factor + optimal-interval + days-ahead) + "Arguments: +- OPTIMAL-FACTOR: interval-factor if the item had been tested +exactly when it was supposed to be. +- OPTIMAL-INTERVAL: interval for next repetition (days) if the item had been +tested exactly when it was supposed to be. +- DAYS-AHEAD: how many days ahead of time the item was reviewed. + +Returns an adjusted optimal factor which should be used to +calculate the next interval, instead of the optimal factor found +in the matrix." + (let ((delta-ofmax (* (1- optimal-factor) + (/ (+ optimal-interval + (* 0.6 optimal-interval) -1) (1- optimal-interval))))) + (- optimal-factor + (* delta-ofmax (/ days-ahead (+ days-ahead (* 0.6 optimal-interval))))))) + + +(defun org-drill-get-item-data () + "Returns a list of 6 items, containing all the stored recall + data for the item at point: +- LAST-INTERVAL is the interval in days that was used to schedule the item's + current review date. +- REPEATS is the number of items the item has been successfully recalled without + without any failures. It is reset to 0 upon failure to recall the item. +- FAILURES is the total number of times the user has failed to recall the item. +- TOTAL-REPEATS includes both successful and unsuccessful repetitions. +- AVERAGE-QUALITY is the mean quality of recall of the item over + all its repetitions, successful and unsuccessful. +- EASE is a number reflecting how easy the item is to learn. Higher is easier. +" + (let ((learn-str (org-entry-get (point) "LEARN_DATA")) + (repeats (org-drill-entry-total-repeats :missing))) + (cond + (learn-str + (let ((learn-data (or (and learn-str + (read learn-str)) + (copy-list initial-repetition-state)))) + (list (nth 0 learn-data) ; last interval + (nth 1 learn-data) ; repetitions + (org-drill-entry-failure-count) + (nth 1 learn-data) + (org-drill-entry-last-quality) + (nth 2 learn-data) ; EF + ))) + ((not (eql :missing repeats)) + (list (org-drill-entry-last-interval) + (org-drill-entry-repeats-since-fail) + (org-drill-entry-failure-count) + (org-drill-entry-total-repeats) + (org-drill-entry-average-quality) + (org-drill-entry-ease))) + (t ; virgin item + (list 0 0 0 0 nil nil))))) + + +(defun org-drill-store-item-data (last-interval repeats failures + total-repeats meanq + ease) + "Stores the given data in the item at point." + (org-entry-delete (point) "LEARN_DATA") + (org-set-property "DRILL_LAST_INTERVAL" + (number-to-string (round-float last-interval 4))) + (org-set-property "DRILL_REPEATS_SINCE_FAIL" (number-to-string repeats)) + (org-set-property "DRILL_TOTAL_REPEATS" (number-to-string total-repeats)) + (org-set-property "DRILL_FAILURE_COUNT" (number-to-string failures)) + (org-set-property "DRILL_AVERAGE_QUALITY" + (number-to-string (round-float meanq 3))) + (org-set-property "DRILL_EASE" + (number-to-string (round-float ease 3)))) + + + +;;; SM2 Algorithm ============================================================= + + +(defun determine-next-interval-sm2 (last-interval n ef quality + failures meanq total-repeats) + "Arguments: +- LAST-INTERVAL -- the number of days since the item was last reviewed. +- REPEATS -- the number of times the item has been successfully reviewed +- EF -- the 'easiness factor' +- QUALITY -- 0 to 5 + +Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), where: +- INTERVAL is the number of days until the item should next be reviewed +- REPEATS is incremented by 1. +- EF is modified based on the recall quality for the item. +- OF-MATRIX is not modified." + (assert (> n 0)) + (assert (and (>= quality 0) (<= quality 5))) + (if (<= quality org-drill-failure-quality) + ;; When an item is failed, its interval is reset to 0, + ;; but its EF is unchanged + (list -1 1 ef (1+ failures) meanq (1+ total-repeats) + org-drill-optimal-factor-matrix) + ;; else: + (let* ((next-ef (modify-e-factor ef quality)) + (interval + (cond + ((<= n 1) 1) + ((= n 2) + (cond + (org-drill-add-random-noise-to-intervals-p + (case quality + (5 6) + (4 4) + (3 3) + (2 1) + (t -1))) + (t 6))) + (t (* last-interval next-ef))))) + (list (if org-drill-add-random-noise-to-intervals-p + (+ last-interval (* (- interval last-interval) + (org-drill-random-dispersal-factor))) + interval) + (1+ n) + next-ef + failures meanq (1+ total-repeats) + org-drill-optimal-factor-matrix)))) + + +;;; SM5 Algorithm ============================================================= + + + +(defun initial-optimal-factor-sm5 (n ef) + (if (= 1 n) + org-drill-sm5-initial-interval + ef)) + +(defun get-optimal-factor-sm5 (n ef of-matrix) + (let ((factors (assoc n of-matrix))) + (or (and factors + (let ((ef-of (assoc ef (cdr factors)))) + (and ef-of (cdr ef-of)))) + (initial-optimal-factor-sm5 n ef)))) + + +(defun inter-repetition-interval-sm5 (last-interval n ef &optional of-matrix) + (let ((of (get-optimal-factor-sm5 n ef (or of-matrix + org-drill-optimal-factor-matrix)))) + (if (= 1 n) + of + (* of last-interval)))) + + +(defun determine-next-interval-sm5 (last-interval n ef quality + failures meanq total-repeats + of-matrix &optional delta-days) + (if (zerop n) (setq n 1)) + (if (null ef) (setq ef 2.5)) + (assert (> n 0)) + (assert (and (>= quality 0) (<= quality 5))) + (unless of-matrix + (setq of-matrix org-drill-optimal-factor-matrix)) + (setq of-matrix (cl-copy-tree of-matrix)) + + (setq meanq (if meanq + (/ (+ quality (* meanq total-repeats 1.0)) + (1+ total-repeats)) + quality)) + + (let ((next-ef (modify-e-factor ef quality)) + (old-ef ef) + (new-of (modify-of (get-optimal-factor-sm5 n ef of-matrix) + quality org-drill-learn-fraction)) + (interval nil)) + (when (and org-drill-adjust-intervals-for-early-and-late-repetitions-p + delta-days (minusp delta-days)) + (setq new-of (org-drill-early-interval-factor + (get-optimal-factor-sm5 n ef of-matrix) + (inter-repetition-interval-sm5 + last-interval n ef of-matrix) + delta-days))) + + (setq of-matrix + (set-optimal-factor n next-ef of-matrix + (round-float new-of 3))) ; round OF to 3 d.p. + + (setq ef next-ef) + + (cond + ;; "Failed" -- reset repetitions to 0, + ((<= quality org-drill-failure-quality) + (list -1 1 old-ef (1+ failures) meanq (1+ total-repeats) + of-matrix)) ; Not clear if OF matrix is supposed to be + ; preserved + ;; For a zero-based quality of 4 or 5, don't repeat + ;; ((and (>= quality 4) + ;; (not org-learn-always-reschedule)) + ;; (list 0 (1+ n) ef failures meanq + ;; (1+ total-repeats) of-matrix)) ; 0 interval = unschedule + (t + (setq interval (inter-repetition-interval-sm5 + last-interval n ef of-matrix)) + (if org-drill-add-random-noise-to-intervals-p + (setq interval (* interval (org-drill-random-dispersal-factor)))) + (list interval + (1+ n) + ef + failures + meanq + (1+ total-repeats) + of-matrix))))) + + +;;; Simple8 Algorithm ========================================================= + + +(defun org-drill-simple8-first-interval (failures) + "Arguments: +- FAILURES: integer >= 0. The total number of times the item has + been forgotten, ever. + +Returns the optimal FIRST interval for an item which has previously been +forgotten on FAILURES occasions." + (* 2.4849 (exp (* -0.057 failures)))) + + +(defun org-drill-simple8-interval-factor (ease repetition) + "Arguments: +- EASE: floating point number >= 1.2. Corresponds to `AF' in SM8 algorithm. +- REPETITION: the number of times the item has been tested. +1 is the first repetition (ie the second trial). +Returns: +The factor by which the last interval should be +multiplied to give the next interval. Corresponds to `RF' or `OF'." + (+ 1.2 (* (- ease 1.2) (expt org-drill-learn-fraction (log repetition 2))))) + + +(defun org-drill-simple8-quality->ease (quality) + "Returns the ease (`AF' in the SM8 algorithm) which corresponds +to a mean item quality of QUALITY." + (+ (* 0.0542 (expt quality 4)) + (* -0.4848 (expt quality 3)) + (* 1.4916 (expt quality 2)) + (* -1.2403 quality) + 1.4515)) + + +(defun determine-next-interval-simple8 (last-interval repeats quality + failures meanq totaln + &optional delta-days) + "Arguments: +- LAST-INTERVAL -- the number of days since the item was last reviewed. +- REPEATS -- the number of times the item has been successfully reviewed +- EASE -- the 'easiness factor' +- QUALITY -- 0 to 5 +- DELTA-DAYS -- how many days overdue was the item when it was reviewed. + 0 = reviewed on the scheduled day. +N = N days overdue. + -N = reviewed N days early. + +Returns the new item data, as a list of 6 values: +- NEXT-INTERVAL +- REPEATS +- EASE +- FAILURES +- AVERAGE-QUALITY +- TOTAL-REPEATS. +See the documentation for `org-drill-get-item-data' for a description of these." + (assert (>= repeats 0)) + (assert (and (>= quality 0) (<= quality 5))) + (assert (or (null meanq) (and (>= meanq 0) (<= meanq 5)))) + (let ((next-interval nil)) + (setf meanq (if meanq + (/ (+ quality (* meanq totaln 1.0)) (1+ totaln)) + quality)) + (cond + ((<= quality org-drill-failure-quality) + (incf failures) + (setf repeats 0 + next-interval -1)) + ((or (zerop repeats) + (zerop last-interval)) + (setf next-interval (org-drill-simple8-first-interval failures)) + (incf repeats) + (incf totaln)) + (t + (let* ((use-n + (if (and + org-drill-adjust-intervals-for-early-and-late-repetitions-p + (numberp delta-days) (plusp delta-days) + (plusp last-interval)) + (+ repeats (min 1 (/ delta-days last-interval 1.0))) + repeats)) + (factor (org-drill-simple8-interval-factor + (org-drill-simple8-quality->ease meanq) use-n)) + (next-int (* last-interval factor))) + (when (and org-drill-adjust-intervals-for-early-and-late-repetitions-p + (numberp delta-days) (minusp delta-days)) + ;; The item was reviewed earlier than scheduled. + (setf factor (org-drill-early-interval-factor + factor next-int (abs delta-days)) + next-int (* last-interval factor))) + (setf next-interval next-int) + (incf repeats) + (incf totaln)))) + (list + (if (and org-drill-add-random-noise-to-intervals-p + (plusp next-interval)) + (* next-interval (org-drill-random-dispersal-factor)) + next-interval) + repeats + (org-drill-simple8-quality->ease meanq) + failures + meanq + totaln + ))) + + + + +;;; Essentially copied from `org-learn.el', but modified to +;;; optionally call the SM2 or simple8 functions. +(defun org-drill-smart-reschedule (quality &optional days-ahead) + "If DAYS-AHEAD is supplied it must be a positive integer. The +item will be scheduled exactly this many days into the future." + (let ((delta-days (- (time-to-days (current-time)) + (time-to-days (or (org-get-scheduled-time (point)) + (current-time))))) + (ofmatrix org-drill-optimal-factor-matrix) + ;; Entries can have weights, 1 by default. Intervals are divided by the + ;; item's weight, so an item with a weight of 2 will have all intervals + ;; halved, meaning you will end up reviewing it twice as often. + ;; Useful for entries which randomly present any of several facts. + (weight (org-entry-get (point) "DRILL_CARD_WEIGHT"))) + (if (stringp weight) + (setq weight (read weight))) + (destructuring-bind (last-interval repetitions failures + total-repeats meanq ease) + (org-drill-get-item-data) + (destructuring-bind (next-interval repetitions ease + failures meanq total-repeats + &optional new-ofmatrix) + (case org-drill-spaced-repetition-algorithm + (sm5 (determine-next-interval-sm5 last-interval repetitions + ease quality failures + meanq total-repeats ofmatrix)) + (sm2 (determine-next-interval-sm2 last-interval repetitions + ease quality failures + meanq total-repeats)) + (simple8 (determine-next-interval-simple8 last-interval repetitions + quality failures meanq + total-repeats + delta-days))) + (if (numberp days-ahead) + (setq next-interval days-ahead)) + + (if (and (null days-ahead) + (numberp weight) (plusp weight) + (not (minusp next-interval))) + (setq next-interval + (max 1.0 (+ last-interval + (/ (- next-interval last-interval) weight))))) + + (org-drill-store-item-data next-interval repetitions failures + total-repeats meanq ease) + + (if (eql 'sm5 org-drill-spaced-repetition-algorithm) + (setq org-drill-optimal-factor-matrix new-ofmatrix)) + + (cond + ((= 0 days-ahead) + (org-schedule t)) + ((minusp days-ahead) + (org-schedule nil (current-time))) + (t + (org-schedule nil (time-add (current-time) + (days-to-time + (round next-interval)))))))))) + + +(defun org-drill-hypothetical-next-review-date (quality) + "Returns an integer representing the number of days into the future +that the current item would be scheduled, based on a recall quality +of QUALITY." + (let ((weight (org-entry-get (point) "DRILL_CARD_WEIGHT"))) + (destructuring-bind (last-interval repetitions failures + total-repeats meanq ease) + (org-drill-get-item-data) + (if (stringp weight) + (setq weight (read weight))) + (destructuring-bind (next-interval repetitions ease + failures meanq total-repeats + &optional ofmatrix) + (case org-drill-spaced-repetition-algorithm + (sm5 (determine-next-interval-sm5 last-interval repetitions + ease quality failures + meanq total-repeats + org-drill-optimal-factor-matrix)) + (sm2 (determine-next-interval-sm2 last-interval repetitions + ease quality failures + meanq total-repeats)) + (simple8 (determine-next-interval-simple8 last-interval repetitions + quality failures meanq + total-repeats))) + (cond + ((not (plusp next-interval)) + 0) + ((and (numberp weight) (plusp weight)) + (+ last-interval + (max 1.0 (/ (- next-interval last-interval) weight)))) + (t + next-interval)))))) + + +(defun org-drill-hypothetical-next-review-dates () + (let ((intervals nil)) + (dotimes (q 6) + (push (max (or (car intervals) 0) + (org-drill-hypothetical-next-review-date q)) + intervals)) + (reverse intervals))) + + +(defun org-drill-reschedule () + "Returns quality rating (0-5), or nil if the user quit." + (let ((ch nil) + (input nil) + (next-review-dates (org-drill-hypothetical-next-review-dates))) + (save-excursion + (while (not (memq ch '(?q ?e ?0 ?1 ?2 ?3 ?4 ?5))) + (setq input (read-key-sequence + (if (eq ch ??) + (format "0-2 Means you have forgotten the item. +3-5 Means you have remembered the item. + +0 - Completely forgot. +1 - Even after seeing the answer, it still took a bit to sink in. +2 - After seeing the answer, you remembered it. +3 - It took you awhile, but you finally remembered. (+%s days) +4 - After a little bit of thought you remembered. (+%s days) +5 - You remembered the item really easily. (+%s days) + +How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)" + (round (nth 3 next-review-dates)) + (round (nth 4 next-review-dates)) + (round (nth 5 next-review-dates))) + "How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"))) + (cond + ((stringp input) + (setq ch (elt input 0))) + ((and (vectorp input) (symbolp (elt input 0))) + (case (elt input 0) + (up (ignore-errors (forward-line -1))) + (down (ignore-errors (forward-line 1))) + (left (ignore-errors (backward-char))) + (right (ignore-errors (forward-char))) + (prior (ignore-errors (scroll-down))) ; pgup + (next (ignore-errors (scroll-up))))) ; pgdn + ((and (vectorp input) (listp (elt input 0)) + (eventp (elt input 0))) + (case (car (elt input 0)) + (wheel-up (ignore-errors (mwheel-scroll (elt input 0)))) + (wheel-down (ignore-errors (mwheel-scroll (elt input 0))))))) + (if (eql ch ?t) + (org-set-tags-command)))) + (cond + ((and (>= ch ?0) (<= ch ?5)) + (let ((quality (- ch ?0)) + (failures (org-drill-entry-failure-count))) + (save-excursion + (org-drill-smart-reschedule quality + (nth quality next-review-dates))) + (push quality *org-drill-session-qualities*) + (cond + ((<= quality org-drill-failure-quality) + (when org-drill-leech-failure-threshold + ;;(setq failures (if failures (string-to-number failures) 0)) + ;; (org-set-property "DRILL_FAILURE_COUNT" + ;; (format "%d" (1+ failures))) + (if (> (1+ failures) org-drill-leech-failure-threshold) + (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)))) + + +;; (defun org-drill-hide-all-subheadings-except (heading-list) +;; "Returns a list containing the position of each immediate subheading of +;; the current topic." +;; (let ((drill-entry-level (org-current-level)) +;; (drill-sections nil) +;; (drill-heading nil)) +;; (org-show-subtree) +;; (save-excursion +;; (org-map-entries +;; (lambda () +;; (when (and (not (outline-invisible-p)) +;; (> (org-current-level) drill-entry-level)) +;; (setq drill-heading (org-get-heading t)) +;; (unless (and (= (org-current-level) (1+ drill-entry-level)) +;; (member drill-heading heading-list)) +;; (hide-subtree)) +;; (push (point) drill-sections))) +;; "" 'tree)) +;; (reverse drill-sections))) + + + +(defun org-drill-hide-subheadings-if (test) + "TEST is a function taking no arguments. TEST will be called for each +of the immediate subheadings of the current drill item, with the point +on the relevant subheading. TEST should return nil if the subheading is +to be revealed, non-nil if it is to be hidden. +Returns a list containing the position of each immediate subheading of +the current topic." + (let ((drill-entry-level (org-current-level)) + (drill-sections nil)) + (org-show-subtree) + (save-excursion + (org-map-entries + (lambda () + (when (and (not (outline-invisible-p)) + (> (org-current-level) drill-entry-level)) + (when (or (/= (org-current-level) (1+ drill-entry-level)) + (funcall test)) + (hide-subtree)) + (push (point) drill-sections))) + "" 'tree)) + (reverse drill-sections))) + + +(defun org-drill-hide-all-subheadings-except (heading-list) + (org-drill-hide-subheadings-if + (lambda () (let ((drill-heading (org-get-heading t))) + (not (member drill-heading heading-list)))))) + + +(defun org-drill-presentation-prompt (&rest fmt-and-args) + (let* ((item-start-time (current-time)) + (input nil) + (ch nil) + (last-second 0) + (mature-entry-count (+ (length *org-drill-young-mature-entries*) + (length *org-drill-old-mature-entries*) + (length *org-drill-overdue-entries*))) + (status (first (org-drill-entry-status))) + (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 "%s %s %s %s %s %s" + (propertize + (char-to-string + (case status + (:new ?N) (:young ?Y) (:old ?o) (:overdue ?!) + (:failed ?F) (t ??))) + 'face `(:foreground + ,(case status + (:new org-drill-new-count-color) + ((:young :old) org-drill-mature-count-color) + ((:overdue :failed) org-drill-failed-count-color) + (t org-drill-done-count-color)))) + (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 mature-entry-count) + '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 + (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" + 'face '(:foreground "red")) + prompt))) + (while (memq ch '(nil ?t)) + (setq ch nil) + (while (not (input-pending-p)) + (let ((elapsed (time-subtract (current-time) item-start-time))) + (message (concat (if (>= (time-to-seconds elapsed) (* 60 60)) + "++:++ " + (format-time-string "%M:%S " elapsed)) + prompt)) + (sit-for 1))) + (setq input (read-key-sequence nil)) + (if (stringp input) (setq ch (elt input 0))) + (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-region (beg end &optional text) + "Hide the buffer region between BEG and END with an 'invisible text' +visual overlay, or with the string TEXT if it is supplied." + (let ((ovl (make-overlay beg end))) + (overlay-put ovl 'category + 'org-drill-hidden-text-overlay) + (when (stringp text) + (overlay-put ovl 'invisible nil) + (overlay-put ovl 'face 'default) + (overlay-put ovl 'display text)))) + + +(defun org-drill-hide-heading-at-point (&optional text) + (unless (org-at-heading-p) + (error "Point is not on a heading")) + (save-excursion + (let ((beg (point))) + (end-of-line) + (org-drill-hide-region beg (point) text)))) + + +(defun org-drill-hide-comments () + (save-excursion + (while (re-search-forward "^#.*$" nil t) + (org-drill-hide-region (match-beginning 0) (match-end 0))))) + + +(defun org-drill-unhide-text () + ;; This will also unhide the item's heading. + (save-excursion + (dolist (ovl (overlays-in (point-min) (point-max))) + (when (eql 'org-drill-hidden-text-overlay (overlay-get ovl 'category)) + (delete-overlay ovl))))) + + +(defun org-drill-hide-clozed-text () + (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 (save-match-data + (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)) + (let ((hint (substring-no-properties + (match-string 0) + (1+ (position ?| (match-string 0))) + (1- (length (match-string 0)))))) + (overlay-put + ovl 'display + ;; If hint is like `X...' then display [X...] + ;; otherwise display [...X] + (format (if (string-match-p "\\.\\.\\." hint) "[%s]" "[%s...]") + hint)))))) + + +(defun org-drill-hide-cloze-hints () + (save-excursion + (while (re-search-forward org-drill-cloze-regexp nil t) + (unless (or (save-match-data + (org-pos-in-regexp (match-beginning 0) + org-bracket-link-regexp 1)) + (null (match-beginning 2))) ; hint subexpression matched + (org-drill-hide-region (match-beginning 2) (match-end 2)))))) + + +(defmacro with-replaced-entry-text (text &rest body) + "During the execution of BODY, the entire text of the current entry is +concealed by an overlay that displays the string TEXT." + `(progn + (org-drill-replace-entry-text ,text) + (unwind-protect + (progn + ,@body) + (org-drill-unreplace-entry-text)))) + + +(defmacro with-replaced-entry-text-multi (replacements &rest body) + "During the execution of BODY, the entire text of the current entry is +concealed by an overlay that displays the overlays in REPLACEMENTS." + `(progn + (org-drill-replace-entry-text ,replacements t) + (unwind-protect + (progn + ,@body) + (org-drill-unreplace-entry-text)))) + + +(defun org-drill-replace-entry-text (text &optional multi-p) + "Make an overlay that conceals the entire text of the item, not +including properties or the contents of subheadings. The overlay shows +the string TEXT. +If MULTI-P is non-nil, TEXT must be a list of values which are legal +for the `display' text property. The text of the item will be temporarily +replaced by all of these items, in the order in which they appear in +the list. +Note: does not actually alter the item." + (cond + ((and multi-p + (listp text)) + (org-drill-replace-entry-text-multi text)) + (t + (let ((ovl (make-overlay (point-min) + (save-excursion + (outline-next-heading) + (point))))) + (overlay-put ovl 'category + 'org-drill-replaced-text-overlay) + (overlay-put ovl 'display text))))) + + +(defun org-drill-unreplace-entry-text () + (save-excursion + (dolist (ovl (overlays-in (point-min) (point-max))) + (when (eql 'org-drill-replaced-text-overlay (overlay-get ovl 'category)) + (delete-overlay ovl))))) + + +(defun org-drill-replace-entry-text-multi (replacements) + "Make overlays that conceal the entire text of the item, not +including properties or the contents of subheadings. The overlay shows +the string TEXT. +Note: does not actually alter the item." + (let ((ovl nil) + (p-min (point-min)) + (p-max (save-excursion + (outline-next-heading) + (point)))) + (assert (>= (- p-max p-min) (length replacements))) + (dotimes (i (length replacements)) + (setq ovl (make-overlay (+ p-min (* 2 i)) + (if (= i (1- (length replacements))) + p-max + (+ p-min (* 2 i) 1)))) + (overlay-put ovl 'category + 'org-drill-replaced-text-overlay) + (overlay-put ovl 'display (nth i replacements))))) + + +(defmacro with-replaced-entry-heading (heading &rest body) + `(progn + (org-drill-replace-entry-heading ,heading) + (unwind-protect + (progn + ,@body) + (org-drill-unhide-text)))) + + +(defun org-drill-replace-entry-heading (heading) + "Make an overlay that conceals the heading of the item. The overlay shows +the string TEXT. +Note: does not actually alter the item." + (org-drill-hide-heading-at-point heading)) + + +(defun org-drill-unhide-clozed-text () + (save-excursion + (dolist (ovl (overlays-in (point-min) (point-max))) + (when (eql 'org-drill-cloze-overlay-defaults (overlay-get ovl 'category)) + (delete-overlay ovl))))) + + +(defun org-drill-get-entry-text (&optional keep-properties-p) + (let ((text (org-agenda-get-some-entry-text (point-marker) 100))) + (if keep-properties-p + text + (substring-no-properties text)))) + + +(defun org-drill-entry-empty-p () + (zerop (length (org-drill-get-entry-text)))) + + + +;;; Presentation functions ==================================================== + +;; Each of these is called with point on topic heading. Each needs to show the +;; topic in the form of a 'question' or with some information 'hidden', as +;; appropriate for the card type. The user should then be prompted to press a +;; key. The function should then reveal either the 'answer' or the entire +;; topic, and should return t if the user chose to see the answer and rate their +;; recall, nil if they chose to quit. + +(defun org-drill-present-simple-card () + (with-hidden-comments + (with-hidden-cloze-hints + (with-hidden-cloze-text + (org-drill-hide-all-subheadings-except nil) + (ignore-errors + (org-display-inline-images t)) + (org-cycle-hide-drawers 'all) + (prog1 (org-drill-presentation-prompt) + (org-drill-hide-subheadings-if 'org-drill-entry-p)))))) + + +(defun org-drill-present-default-answer (reschedule-fn) + (org-drill-hide-subheadings-if 'org-drill-entry-p) + (org-drill-unhide-clozed-text) + (ignore-errors + (org-display-inline-images t)) + (with-hidden-cloze-hints + (funcall reschedule-fn))) + + +(defun org-drill-present-two-sided-card () + (with-hidden-comments + (with-hidden-cloze-hints + (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))) + (ignore-errors + (org-display-inline-images t)) + (org-cycle-hide-drawers 'all) + (prog1 (org-drill-presentation-prompt) + (org-drill-hide-subheadings-if 'org-drill-entry-p))))))) + + + +(defun org-drill-present-multi-sided-card () + (with-hidden-comments + (with-hidden-cloze-hints + (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))) + (ignore-errors + (org-display-inline-images t)) + (org-cycle-hide-drawers 'all) + (prog1 (org-drill-presentation-prompt) + (org-drill-hide-subheadings-if 'org-drill-entry-p))))))) + + +(defun org-drill-present-multicloze-hide-n (number-to-hide + &optional + force-show-first + force-show-last + force-hide-first) + "Hides NUMBER-TO-HIDE pieces of text that are marked for cloze deletion, +chosen at random. +If NUMBER-TO-HIDE is negative, show only (ABS NUMBER-TO-HIDE) pieces, +hiding all the rest. +If FORCE-HIDE-FIRST is non-nil, force the first piece of text to be one of +the hidden items. +If FORCE-SHOW-FIRST is non-nil, never hide the first piece of text. +If FORCE-SHOW-LAST is non-nil, never hide the last piece of text. +If the number of text pieces in the item is less than +NUMBER-TO-HIDE, then all text pieces will be hidden (except the first or last +items if FORCE-SHOW-FIRST or FORCE-SHOW-LAST is non-nil)." + (with-hidden-comments + (with-hidden-cloze-hints + (let ((item-end nil) + (match-count 0) + (body-start (or (cdr (org-get-property-block)) + (point)))) + (if (and force-hide-first force-show-first) + (error "FORCE-HIDE-FIRST and FORCE-SHOW-FIRST are mutually exclusive")) + (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) + (let ((in-regexp? (save-match-data + (org-pos-in-regexp (match-beginning 0) + org-bracket-link-regexp 1)))) + (unless in-regexp? + (incf match-count))))) + (if (minusp number-to-hide) + (setq number-to-hide (+ match-count number-to-hide))) + (when (plusp match-count) + (let* ((positions (shuffle-list (loop for i from 1 + to match-count + collect i))) + (match-nums nil) + (cnt nil)) + (if force-hide-first + ;; Force '1' to be in the list, and to be the first item + ;; in the list. + (setq positions (cons 1 (remove 1 positions)))) + (if force-show-first + (setq positions (remove 1 positions))) + (if force-show-last + (setq positions (remove match-count positions))) + (setq match-nums + (subseq positions + 0 (min number-to-hide (length positions)))) + ;; (dolist (pos-to-hide match-nums) + (save-excursion + (goto-char body-start) + (setq cnt 0) + (while (re-search-forward org-drill-cloze-regexp item-end t) + (unless (save-match-data + (org-pos-in-regexp (match-beginning 0) + org-bracket-link-regexp 1)) + (incf cnt) + (if (memq cnt match-nums) + (org-drill-hide-matched-cloze-text))))))) + ;; (loop + ;; do (re-search-forward org-drill-cloze-regexp + ;; item-end t pos-to-hide) + ;; while (org-pos-in-regexp (match-beginning 0) + ;; org-bracket-link-regexp 1)) + ;; (org-drill-hide-matched-cloze-text))))) + (ignore-errors + (org-display-inline-images t)) + (org-cycle-hide-drawers 'all) + (prog1 (org-drill-presentation-prompt) + (org-drill-hide-subheadings-if 'org-drill-entry-p) + (org-drill-unhide-clozed-text)))))) + + +(defun org-drill-present-multicloze-hide-nth (to-hide) + "Hide the TO-HIDE'th piece of clozed text. 1 is the first piece. If +TO-HIDE is negative, count backwards, so -1 means the last item, -2 +the second to last, etc." + (with-hidden-comments + (with-hidden-cloze-hints + (let ((item-end nil) + (match-count 0) + (body-start (or (cdr (org-get-property-block)) + (point))) + (cnt 0)) + (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) + (let ((in-regexp? (save-match-data + (org-pos-in-regexp (match-beginning 0) + org-bracket-link-regexp 1)))) + (unless in-regexp? + (incf match-count))))) + (if (minusp to-hide) + (setq to-hide (+ 1 to-hide match-count))) + (cond + ((or (not (plusp match-count)) + (> to-hide match-count)) + nil) + (t + (save-excursion + (goto-char body-start) + (setq cnt 0) + (while (re-search-forward org-drill-cloze-regexp item-end t) + (unless (save-match-data + (org-pos-in-regexp (match-beginning 0) + org-bracket-link-regexp 1)) + (incf cnt) + (if (= cnt to-hide) + (org-drill-hide-matched-cloze-text))))))) + (ignore-errors + (org-display-inline-images t)) + (org-cycle-hide-drawers 'all) + (prog1 (org-drill-presentation-prompt) + (org-drill-hide-subheadings-if 'org-drill-entry-p) + (org-drill-unhide-clozed-text)))))) + + +(defun org-drill-present-multicloze-hide1 () + "Hides one of the pieces of text that are marked for cloze deletion, +chosen at random." + (org-drill-present-multicloze-hide-n 1)) + + +(defun org-drill-present-multicloze-hide2 () + "Hides two of the pieces of text that are marked for cloze deletion, +chosen at random." + (org-drill-present-multicloze-hide-n 2)) + + +(defun org-drill-present-multicloze-hide-first () + "Hides the first piece of text that is marked for cloze deletion." + (org-drill-present-multicloze-hide-nth 1)) + + +(defun org-drill-present-multicloze-hide-last () + "Hides the last piece of text that is marked for cloze deletion." + (org-drill-present-multicloze-hide-nth -1)) + + +(defun org-drill-present-multicloze-hide1-firstmore () + "Commonly, hides the FIRST piece of text that is marked for +cloze deletion. Uncommonly, hide one of the other pieces of text, +chosen at random. + +The definitions of 'commonly' and 'uncommonly' are determined by +the value of `org-drill-cloze-text-weight'." + ;; The 'firstmore' and 'lastmore' functions used to randomly choose whether + ;; to hide the 'favoured' piece of text. However even when the chance of + ;; hiding it was set quite high (80%), the outcome was too unpredictable over + ;; the small number of repetitions where most learning takes place for each + ;; item. In other words, the actual frequency during the first 10 repetitions + ;; was often very different from 80%. Hence we use modulo instead. + (cond + ((null org-drill-cloze-text-weight) + ;; Behave as hide1cloze + (org-drill-present-multicloze-hide1)) + ((not (and (integerp org-drill-cloze-text-weight) + (plusp org-drill-cloze-text-weight))) + (error "Illegal value for org-drill-cloze-text-weight: %S" + org-drill-cloze-text-weight)) + ((zerop (mod (1+ (org-drill-entry-total-repeats 0)) + org-drill-cloze-text-weight)) + ;; Uncommonly, hide any item except the first + (org-drill-present-multicloze-hide-n 1 t)) + (t + ;; Commonly, hide first item + (org-drill-present-multicloze-hide-first)))) + + +(defun org-drill-present-multicloze-show1-lastmore () + "Commonly, hides all pieces except the last. Uncommonly, shows +any random piece. The effect is similar to 'show1cloze' except +that the last item is much less likely to be the item that is +visible. + +The definitions of 'commonly' and 'uncommonly' are determined by +the value of `org-drill-cloze-text-weight'." + (cond + ((null org-drill-cloze-text-weight) + ;; Behave as show1cloze + (org-drill-present-multicloze-show1)) + ((not (and (integerp org-drill-cloze-text-weight) + (plusp org-drill-cloze-text-weight))) + (error "Illegal value for org-drill-cloze-text-weight: %S" + org-drill-cloze-text-weight)) + ((zerop (mod (1+ (org-drill-entry-total-repeats 0)) + org-drill-cloze-text-weight)) + ;; Uncommonly, show any item except the last + (org-drill-present-multicloze-hide-n -1 nil nil t)) + (t + ;; Commonly, show the LAST item + (org-drill-present-multicloze-hide-n -1 nil t)))) + + +(defun org-drill-present-multicloze-show1-firstless () + "Commonly, hides all pieces except one, where the shown piece +is guaranteed NOT to be the first piece. Uncommonly, shows any +random piece. The effect is similar to 'show1cloze' except that +the first item is much less likely to be the item that is +visible. + +The definitions of 'commonly' and 'uncommonly' are determined by +the value of `org-drill-cloze-text-weight'." + (cond + ((null org-drill-cloze-text-weight) + ;; Behave as show1cloze + (org-drill-present-multicloze-show1)) + ((not (and (integerp org-drill-cloze-text-weight) + (plusp org-drill-cloze-text-weight))) + (error "Illegal value for org-drill-cloze-text-weight: %S" + org-drill-cloze-text-weight)) + ((zerop (mod (1+ (org-drill-entry-total-repeats 0)) + org-drill-cloze-text-weight)) + ;; Uncommonly, show the first item + (org-drill-present-multicloze-hide-n -1 t)) + (t + ;; Commonly, show any item, except the first + (org-drill-present-multicloze-hide-n -1 nil nil t)))) + + +(defun org-drill-present-multicloze-show1 () + "Similar to `org-drill-present-multicloze-hide1', but hides all +the pieces of text that are marked for cloze deletion, except for one +piece which is chosen at random." + (org-drill-present-multicloze-hide-n -1)) + + +(defun org-drill-present-multicloze-show2 () + "Similar to `org-drill-present-multicloze-show1', but reveals two +pieces rather than one." + (org-drill-present-multicloze-hide-n -2)) + + +;; (defun org-drill-present-multicloze-show1 () +;; "Similar to `org-drill-present-multicloze-hide1', but hides all +;; the pieces of text that are marked for cloze deletion, except for one +;; piece which is chosen at random." +;; (with-hidden-comments +;; (with-hidden-cloze-hints +;; (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) +;; (let ((match-to-hide (random* match-count))) +;; (save-excursion +;; (goto-char body-start) +;; (dotimes (n match-count) +;; (re-search-forward org-drill-cloze-regexp +;; item-end t) +;; (unless (= n match-to-hide) +;; (org-drill-hide-matched-cloze-text)))))) +;; (org-display-inline-images t) +;; (org-cycle-hide-drawers 'all) +;; (prog1 (org-drill-presentation-prompt) +;; (org-drill-hide-subheadings-if 'org-drill-entry-p) +;; (org-drill-unhide-clozed-text)))))) + + +(defun org-drill-present-card-using-text (question &optional answer) + "Present the string QUESTION as the only visible content of the card." + (with-hidden-comments + (with-replaced-entry-text + question + (org-drill-hide-all-subheadings-except nil) + (org-cycle-hide-drawers 'all) + (ignore-errors + (org-display-inline-images t)) + (prog1 (org-drill-presentation-prompt) + (org-drill-hide-subheadings-if 'org-drill-entry-p))))) + + +(defun org-drill-present-card-using-multiple-overlays (replacements &optional answer) + "TEXTS is a list of valid values for the 'display' text property. +Present these overlays, in sequence, as the only +visible content of the card." + (with-hidden-comments + (with-replaced-entry-text-multi + replacements + (org-drill-hide-all-subheadings-except nil) + (org-cycle-hide-drawers 'all) + (ignore-errors + (org-display-inline-images t)) + (prog1 (org-drill-presentation-prompt) + (org-drill-hide-subheadings-if 'org-drill-entry-p))))) + + +(defun org-drill-entry () + "Present the current topic for interactive review, as in `org-drill'. +Review will occur regardless of whether the topic is due for review or whether +it meets the definition of a 'review topic' used by `org-drill'. + +Returns a quality rating from 0 to 5, or nil if the user quit, or the symbol +EDIT if the user chose to exit the drill and edit the current item. Choosing +the latter option leaves the drill session suspended; it can be resumed +later using `org-drill-resume'. + +See `org-drill' for more details." + (interactive) + (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")) + (answer-fn 'org-drill-present-default-answer) + (cont nil) + ;; fontification functions in `outline-view-change-hook' can cause big + ;; slowdowns, so we temporarily bind this variable to nil here. + (outline-view-change-hook nil)) + (org-save-outline-visibility t + (save-restriction + (org-narrow-to-subtree) + (org-show-subtree) + (org-cycle-hide-drawers 'all) + + (let ((presentation-fn (cdr (assoc card-type org-drill-card-type-alist)))) + (if (listp presentation-fn) + (psetq answer-fn (or (second presentation-fn) + 'org-drill-present-default-answer) + presentation-fn (first presentation-fn))) + (cond + ((null presentation-fn) + (message "%s:%d: Unrecognised card type '%s', skipping..." + (buffer-name) (point) card-type) + (sit-for 0.5) + 'skip) + (t + (setq cont (funcall presentation-fn)) + (cond + ((not cont) + (message "Quit") + nil) + ((eql cont 'edit) + 'edit) + ((eql cont 'skip) + 'skip) + (t + (save-excursion + (funcall answer-fn + (lambda () (org-drill-reschedule))))))))))))) + + +(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-young-mature-entries* + *org-drill-old-mature-entries* + *org-drill-overdue-entries* + *org-drill-again-entries*)))) + + +(defun org-drill-pending-entry-count () + (+ (length *org-drill-new-entries*) + (length *org-drill-failed-entries*) + (length *org-drill-young-mature-entries*) + (length *org-drill-old-mature-entries*) + (length *org-drill-overdue-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 () + (block org-drill-pop-next-pending-entry + (let ((m nil)) + (while (or (null m) + (not (org-drill-entry-p m))) + (setq + m + (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 overdue items. + ((and *org-drill-overdue-entries* + (not (org-drill-maximum-item-count-reached-p)) + (not (org-drill-maximum-duration-reached-p))) + ;; We use `pop', not `pop-random', because we have already + ;; sorted overdue items into a random order which takes + ;; number of days overdue into account. + (pop *org-drill-overdue-entries*)) + ;; Next priority is 'young' items. + ((and *org-drill-young-mature-entries* + (not (org-drill-maximum-item-count-reached-p)) + (not (org-drill-maximum-duration-reached-p))) + (pop-random *org-drill-young-mature-entries*)) + ;; Next priority is newly added items, and older entries. + ;; We pool these into a single group. + ((and (or *org-drill-new-entries* + *org-drill-old-mature-entries*) + (not (org-drill-maximum-item-count-reached-p)) + (not (org-drill-maximum-duration-reached-p))) + (cond + ((< (random* (+ (length *org-drill-new-entries*) + (length *org-drill-old-mature-entries*))) + (length *org-drill-new-entries*)) + (pop-random *org-drill-new-entries*)) + (t + (pop-random *org-drill-old-mature-entries*)))) + ;; After all the above are done, last priority is items + ;; that were failed earlier THIS SESSION. + (*org-drill-again-entries* + (pop *org-drill-again-entries*)) + (t ; nothing left -- return nil + (return-from org-drill-pop-next-pending-entry nil))))) + m))) + + +(defun org-drill-entries (&optional resuming-p) + "Returns nil, t, or a list of markers representing entries that were +'failed' and need to be presented again before the session ends. + +RESUMING-P is true if we are resuming a suspended drill session." + (block org-drill-entries + (while (org-drill-entries-pending-p) + (let ((m (cond + ((or (not resuming-p) + (null *org-drill-current-item*) + (not (org-drill-entry-p *org-drill-current-item*))) + (org-drill-pop-next-pending-entry)) + (t ; resuming a suspended session. + (setq resuming-p nil) + *org-drill-current-item*)))) + (setq *org-drill-current-item* m) + (unless m + (error "Unexpectedly ran out of pending drill items")) + (save-excursion + (org-drill-goto-entry m) + (cond + ((not (org-drill-entry-due-p)) + ;; The entry is not due anymore. This could arise if the user + ;; suspends a drill session, then drills an individual entry, + ;; then resumes the session. + (message "Entry no longer due, skipping...") + (sit-for 0.3) + nil) + (t + (setq result (org-drill-entry)) + (cond + ((null result) + (message "Quit") + (setq end-pos :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 + ((<= result org-drill-failure-quality) + (if *org-drill-again-entries* + (setq *org-drill-again-entries* + (shuffle-list *org-drill-again-entries*))) + (push-end m *org-drill-again-entries*)) + (t + (push m *org-drill-done-entries*)))))))))))) + + + +(defun org-drill-final-report () + (let ((pass-percent + (round (* 100 (count-if (lambda (qual) + (> qual org-drill-failure-quality)) + *org-drill-session-qualities*)) + (max 1 (length *org-drill-session-qualities*)))) + (prompt nil)) + (setq prompt + (format + "%d items reviewed. Session duration %s. +Recall of reviewed items: + Excellent (5): %3d%% | Near miss (2): %3d%% + Good (4): %3d%% | Failure (1): %3d%% + Hard (3): %3d%% | Abject failure (0): %3d%% + +You successfully recalled %d%% of reviewed items (quality > %s) +%d/%d items still await review (%s, %s, %s, %s, %s). +Tomorrow, %d more items will become due for review. +Session finished. Press a key to continue..." + (length *org-drill-done-entries*) + (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*))) + pass-percent + org-drill-failure-quality + (org-drill-pending-entry-count) + (+ (org-drill-pending-entry-count) + *org-drill-dormant-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 overdue" + (length *org-drill-overdue-entries*)) + 'face `(:foreground ,org-drill-failed-count-color)) + (propertize + (format "%d new" + (length *org-drill-new-entries*)) + 'face `(:foreground ,org-drill-new-count-color)) + (propertize + (format "%d young" + (length *org-drill-young-mature-entries*)) + 'face `(:foreground ,org-drill-mature-count-color)) + (propertize + (format "%d old" + (length *org-drill-old-mature-entries*)) + 'face `(:foreground ,org-drill-mature-count-color)) + *org-drill-due-tomorrow-count* + )) + + (while (not (input-pending-p)) + (message "%s" prompt) + (sit-for 0.5)) + (read-char-exclusive) + + (if (and *org-drill-session-qualities* + (< pass-percent (- 100 org-drill-forgetting-index))) + (read-char-exclusive + (format + "%s +You failed %d%% of the items you reviewed during this session. +%d (%d%%) of all items scanned were overdue. + +Are you keeping up with your items, and reviewing them +when they are scheduled? If so, you may want to consider +lowering the value of `org-drill-learn-fraction' slightly in +order to make items appear more frequently over time." + (propertize "WARNING!" 'face 'org-warning) + (- 100 pass-percent) + *org-drill-overdue-entry-count* + (round (* 100 *org-drill-overdue-entry-count*) + (+ *org-drill-dormant-entry-count* + *org-drill-due-entry-count*))) + )))) + + + +(defun org-drill-free-markers (markers) + "MARKERS is a list of markers, all of which will be freed (set to +point nowhere). Alternatively, MARKERS can be 't', in which case +all the markers used by Org-Drill will be freed." + (dolist (m (if (eql t markers) + (append *org-drill-done-entries* + *org-drill-new-entries* + *org-drill-failed-entries* + *org-drill-again-entries* + *org-drill-overdue-entries* + *org-drill-young-mature-entries* + *org-drill-old-mature-entries*) + markers)) + (free-marker m))) + + +(defun org-drill-order-overdue-entries (overdue-data) + (setq *org-drill-overdue-entries* + (mapcar 'car + (sort (shuffle-list overdue-data) + (lambda (a b) (> (cdr a) (cdr b))))))) + + +(defun org-drill-entry-status () + "Returns a list (STATUS DUE) where DUE is the number of days overdue, +zero being due today, -1 being scheduled 1 day in the future. STATUS is +one of the following values: +- nil, if the item is not a drill entry, or has an empty body +- :unscheduled +- :future +- :new +- :failed +- :overdue +- :young +- :old +" + (save-excursion + (unless (org-at-heading-p) + (org-back-to-heading)) + (let ((due (org-drill-entry-days-overdue)) + (last-int (org-drill-entry-last-interval 1))) + (list + (cond + ((not (org-drill-entry-p)) + nil) + ((org-drill-entry-empty-p) + nil) ; skip -- item body is empty + ((null due) ; unscheduled - usually a skipped leech + :unscheduled) + ;; ((eql -1 due) + ;; :tomorrow) + ((minusp due) ; scheduled in the future + :future) + ;; The rest of the stati all denote 'due' items ========================== + ((<= (org-drill-entry-last-quality 9999) + org-drill-failure-quality) + ;; Mature entries that were failed last time are + ;; FAILED, regardless of how young, old or overdue + ;; they are. + :failed) + ((org-drill-entry-new-p) + :new) + ((org-drill-entry-overdue-p due last-int) + ;; Overdue status overrides young versus old + ;; distinction. + ;; Store marker + due, for sorting of overdue entries + :overdue) + ((<= (org-drill-entry-last-interval 9999) + org-drill-days-before-old) + :young) + (t + :old)) + due)))) + + +(defun org-drill-progress-message (collected scanned) + (when (zerop (% scanned 50)) + (let* ((meter-width 40) + (sym1 (if (oddp (floor scanned (* 50 meter-width))) ?| ?.)) + (sym2 (if (eql sym1 ?.) ?| ?.))) + (message "Collecting due drill items:%4d %s%s" + collected + (make-string (% (ceiling scanned 50) meter-width) + sym2) + (make-string (- meter-width (% (ceiling scanned 50) meter-width)) + sym1))))) + + +(defun org-drill (&optional scope resume-p) + "Begin an interactive 'drill session'. The user is asked to +review a series of topics (headers). Each topic is initially +presented as a 'question', often with part of the topic content +hidden. The user attempts to recall the hidden information or +answer the question, then presses a key to reveal the answer. The +user then rates his or her recall or performance on that +topic. This rating information is used to reschedule the topic +for future review. + +Org-drill proceeds by: + +- Finding all topics (headings) in SCOPE which have either been + used and rescheduled before, or which have a tag that matches + `org-drill-question-tag'. + +- All matching topics which are either unscheduled, or are + scheduled for the current date or a date in the past, are + considered to be candidates for the drill session. + +- If `org-drill-maximum-items-per-session' is set, a random + subset of these topics is presented. Otherwise, all of the + eligible topics will be presented. + +SCOPE determines the scope in which to search for +questions. It accepts the same values as `org-drill-scope', +which see. + +If RESUME-P is non-nil, resume a suspended drill session rather +than starting a new one." + + (interactive) + (let ((end-pos nil) + (overdue-data nil) + (cnt 0)) + (block org-drill + (unless resume-p + (org-drill-free-markers t) + (setq *org-drill-current-item* nil + *org-drill-done-entries* nil + *org-drill-dormant-entry-count* 0 + *org-drill-due-entry-count* 0 + *org-drill-due-tomorrow-count* 0 + *org-drill-overdue-entry-count* 0 + *org-drill-new-entries* nil + *org-drill-overdue-entries* nil + *org-drill-young-mature-entries* nil + *org-drill-old-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)))) + (setq *random-state* (make-random-state t)) ; reseed RNG + (unwind-protect + (save-excursion + (unless resume-p + (let ((org-trust-scanner-tags t) + (warned-about-id-creation nil)) + (org-map-drill-entries + (lambda () + (org-drill-progress-message + (+ (length *org-drill-new-entries*) + (length *org-drill-overdue-entries*) + (length *org-drill-young-mature-entries*) + (length *org-drill-old-mature-entries*) + (length *org-drill-failed-entries*)) + (incf cnt)) + (cond + ((not (org-drill-entry-p)) + nil) ; skip + (t + (when (and (not warned-about-id-creation) + (null (org-id-get))) + (message (concat "Creating unique IDs for items " + "(slow, but only happens once)")) + (sit-for 0.5) + (setq warned-about-id-creation t)) + (org-id-get-create) ; ensure drill entry has unique ID + (destructuring-bind (status due) (org-drill-entry-status) + (case status + (:unscheduled + (incf *org-drill-dormant-entry-count*)) + ;; (:tomorrow + ;; (incf *org-drill-dormant-entry-count*) + ;; (incf *org-drill-due-tomorrow-count*)) + (:future + (incf *org-drill-dormant-entry-count*) + (if (eq -1 due) + (incf *org-drill-due-tomorrow-count*))) + (:new + (push (point-marker) *org-drill-new-entries*)) + (:failed + (push (point-marker) *org-drill-failed-entries*)) + (:young + (push (point-marker) *org-drill-young-mature-entries*)) + (:overdue + (push (cons (point-marker) due) overdue-data)) + (:old + (push (point-marker) *org-drill-old-mature-entries*))))))) + scope) + ;; (let ((due (org-drill-entry-days-overdue)) + ;; (last-int (org-drill-entry-last-interval 1))) + ;; (cond + ;; ((org-drill-entry-empty-p) + ;; nil) ; skip -- item body is empty + ;; ((or (null due) ; unscheduled - usually a skipped leech + ;; (minusp due)) ; scheduled in the future + ;; (incf *org-drill-dormant-entry-count*) + ;; (if (eq -1 due) + ;; (incf *org-drill-due-tomorrow-count*))) + ;; ((org-drill-entry-new-p) + ;; (push (point-marker) *org-drill-new-entries*)) + ;; ((<= (org-drill-entry-last-quality 9999) + ;; org-drill-failure-quality) + ;; ;; Mature entries that were failed last time are + ;; ;; FAILED, regardless of how young, old or overdue + ;; ;; they are. + ;; (push (point-marker) *org-drill-failed-entries*)) + ;; ((org-drill-entry-overdue-p due last-int) + ;; ;; Overdue status overrides young versus old + ;; ;; distinction. + ;; ;; Store marker + due, for sorting of overdue entries + ;; (push (cons (point-marker) due) overdue-data)) + ;; ((<= (org-drill-entry-last-interval 9999) + ;; org-drill-days-before-old) + ;; ;; Item is 'young'. + ;; (push (point-marker) + ;; *org-drill-young-mature-entries*)) + ;; (t + ;; (push (point-marker) + ;; *org-drill-old-mature-entries*)))) + ;; Order 'overdue' items so that the most overdue will tend to + ;; come up for review first, while keeping exact order random + (org-drill-order-overdue-entries overdue-data) + (setq *org-drill-overdue-entry-count* + (length *org-drill-overdue-entries*)))) + (setq *org-drill-due-entry-count* (org-drill-pending-entry-count)) + (cond + ((and (null *org-drill-new-entries*) + (null *org-drill-failed-entries*) + (null *org-drill-overdue-entries*) + (null *org-drill-young-mature-entries*) + (null *org-drill-old-mature-entries*)) + (message "I did not find any pending drill items.")) + (t + (org-drill-entries resume-p) + (message "Drill session finished!")))) + (progn + (unless end-pos + (org-drill-free-markers *org-drill-done-entries*))))) + (cond + (end-pos + (when (markerp end-pos) + (org-drill-goto-entry end-pos) + (org-reveal) + (org-show-entry)) + (let ((keystr (command-keybinding-to-string 'org-drill-resume))) + (message + "You can continue the drill session with the command `org-drill-resume'.%s" + (if keystr (format "\nYou can run this command by pressing %s." keystr) + "")))) + (t + (org-drill-final-report) + (if (eql 'sm5 org-drill-spaced-repetition-algorithm) + (org-drill-save-optimal-factor-matrix)) + (if org-drill-save-buffers-after-drill-sessions-p + (save-some-buffers)) + (message "Drill session finished!") + )))) + + +(defun org-drill-save-optimal-factor-matrix () + (message "Saving optimal factor matrix...") + (customize-save-variable 'org-drill-optimal-factor-matrix + org-drill-optimal-factor-matrix)) + + +(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))) + + +(defun org-drill-tree () + "Run an interactive drill session using drill items within the +subtree at point." + (interactive) + (org-drill 'tree)) + + +(defun org-drill-directory () + "Run an interactive drill session using drill items from all org +files in the same directory as the current file." + (interactive) + (org-drill 'directory)) + + +(defun org-drill-again (&optional scope) + "Run a new drill session, but try to use leftover due items that +were not reviewed during the last session, rather than scanning for +unreviewed items. If there are no leftover items in memory, a full +scan will be performed." + (interactive) + (cond + ((plusp (org-drill-pending-entry-count)) + (org-drill-free-markers *org-drill-done-entries*) + (if (markerp *org-drill-current-item*) + (free-marker *org-drill-current-item*)) + (setq *org-drill-start-time* (float-time (current-time)) + *org-drill-done-entries* nil + *org-drill-current-item* nil) + (org-drill scope t)) + (t + (org-drill scope)))) + + + +(defun org-drill-resume () + "Resume a suspended drill session. Sessions are suspended by +exiting them with the `edit' or `quit' options." + (interactive) + (cond + ((org-drill-entries-pending-p) + (org-drill nil t)) + ((and (plusp (org-drill-pending-entry-count)) + ;; Current drill session is finished, but there are still + ;; more items which need to be reviewed. + (y-or-n-p (format + "You have finished the drill session. However, %d items still +need reviewing. Start a new drill session? " + (org-drill-pending-entry-count)))) + (org-drill-again)) + (t + (message "You have finished the drill session.")))) + + +(defun org-drill-strip-entry-data () + (dolist (prop org-drill-scheduling-properties) + (org-delete-property prop)) + (org-schedule t)) + + +(defun org-drill-strip-all-data (&optional scope) + "Delete scheduling data from every drill entry in scope. This +function may be useful if you want to give your collection of +entries to someone else. Scope defaults to the current buffer, +and is specified by the argument SCOPE, which accepts the same +values as `org-drill-scope'." + (interactive) + (when (yes-or-no-p + "Delete scheduling data from ALL items in scope: are you sure?") + (cond + ((null scope) + ;; Scope is the current buffer. This means we can use + ;; `org-delete-property-globally', which is faster. + (dolist (prop org-drill-scheduling-properties) + (org-delete-property-globally prop)) + (org-map-drill-entries (lambda () (org-schedule t)) scope)) + (t + (org-map-drill-entries 'org-drill-strip-entry-data scope))) + (message "Done."))) + + + +(defun org-drill-add-cloze-fontification () + (when org-drill-use-visible-cloze-face-p + (font-lock-add-keywords 'org-mode + org-drill-cloze-keywords + nil))) + +(add-hook 'org-mode-hook 'org-drill-add-cloze-fontification) + +(org-drill-add-cloze-fontification) + + +;;; Synching card collections ================================================= + + +(defvar *org-drill-dest-id-table* (make-hash-table :test 'equal)) + + +(defun org-drill-copy-entry-to-other-buffer (dest &optional path) + "Copy the subtree at point to the buffer DEST. The copy will receive +the tag 'imported'." + (block org-drill-copy-entry-to-other-buffer + (save-excursion + (let ((src (current-buffer)) + (m nil)) + (flet ((paste-tree-here (&optional level) + (org-paste-subtree level) + (org-drill-strip-entry-data) + (org-toggle-tag "imported" 'on) + (org-map-drill-entries + (lambda () + (let ((id (org-id-get))) + (org-drill-strip-entry-data) + (unless (gethash id *org-drill-dest-id-table*) + (puthash id (point-marker) + *org-drill-dest-id-table*)))) + 'tree))) + (unless path + (setq path (org-get-outline-path))) + (org-copy-subtree) + (switch-to-buffer dest) + (setq m + (condition-case nil + (org-find-olp path t) + (error ; path does not exist in DEST + (return-from org-drill-copy-entry-to-other-buffer + (cond + ((cdr path) + (org-drill-copy-entry-to-other-buffer + dest (butlast path))) + (t + ;; We've looked all the way up the path + ;; Default to appending to the end of DEST + (goto-char (point-max)) + (newline) + (paste-tree-here))))))) + (goto-char m) + (outline-next-heading) + (newline) + (forward-line -1) + (paste-tree-here (1+ (or (org-current-level) 0))) + ))))) + + + +(defun org-drill-merge-buffers (src &optional dest ignore-new-items-p) + "SRC and DEST are two org mode buffers containing drill items. +For each drill item in DEST that shares an ID with an item in SRC, +overwrite scheduling data in DEST with data taken from the item in SRC. +This is intended for use when two people are sharing a set of drill items, +one person has made some updates to the item set, and the other person +wants to migrate to the updated set without losing their scheduling data. + +By default, any drill items in SRC which do not exist in DEST are +copied into DEST. We attempt to place the copied item in the +equivalent location in DEST to its location in SRC, by matching +the heading hierarchy. However if IGNORE-NEW-ITEMS-P is non-nil, +we simply ignore any items that do not exist in DEST, and do not +copy them across." + (interactive "bImport scheduling info from which buffer?") + (unless dest + (setq dest (current-buffer))) + (setq src (get-buffer src) + dest (get-buffer dest)) + (when (yes-or-no-p + (format + (concat "About to overwrite all scheduling data for drill items in `%s' " + "with information taken from matching items in `%s'. Proceed? ") + (buffer-name dest) (buffer-name src))) + ;; Compile list of all IDs in the destination buffer. + (clrhash *org-drill-dest-id-table*) + (with-current-buffer dest + (org-map-drill-entries + (lambda () + (let ((this-id (org-id-get))) + (when this-id + (puthash this-id (point-marker) *org-drill-dest-id-table*)))) + 'file)) + ;; Look through all entries in source buffer. + (with-current-buffer src + (org-map-drill-entries + (lambda () + (let ((id (org-id-get)) + (last-quality nil) (last-reviewed nil) + (scheduled-time nil)) + (cond + ((or (null id) + (not (org-drill-entry-p))) + nil) + ((gethash id *org-drill-dest-id-table*) + ;; This entry matches an entry in dest. Retrieve all its + ;; scheduling data, then go to the matching location in dest + ;; and write the data. + (let ((marker (gethash id *org-drill-dest-id-table*))) + (destructuring-bind (last-interval repetitions failures + total-repeats meanq ease) + (org-drill-get-item-data) + (setq last-reviewed (org-entry-get (point) "DRILL_LAST_REVIEWED") + last-quality (org-entry-get (point) "DRILL_LAST_QUALITY") + scheduled-time (org-get-scheduled-time (point))) + (save-excursion + ;; go to matching entry in destination buffer + (switch-to-buffer (marker-buffer marker)) + (goto-char marker) + (org-drill-strip-entry-data) + (unless (zerop total-repeats) + (org-drill-store-item-data last-interval repetitions failures + total-repeats meanq ease) + (if last-quality + (org-set-property "LAST_QUALITY" last-quality) + (org-delete-property "LAST_QUALITY")) + (if last-reviewed + (org-set-property "LAST_REVIEWED" last-reviewed) + (org-delete-property "LAST_REVIEWED")) + (if scheduled-time + (org-schedule nil scheduled-time))))) + (remhash id *org-drill-dest-id-table*) + (free-marker marker))) + (t + ;; item in SRC has ID, but no matching ID in DEST. + ;; It must be a new item that does not exist in DEST. + ;; Copy the entire item to the *end* of DEST. + (unless ignore-new-items-p + (org-drill-copy-entry-to-other-buffer dest)))))) + 'file)) + ;; Finally: there may be some items in DEST which are not in SRC, and + ;; which have been scheduled by another user of DEST. Clear out the + ;; scheduling info from all the unmatched items in DEST. + (with-current-buffer dest + (maphash (lambda (id m) + (goto-char m) + (org-drill-strip-entry-data) + (free-marker m)) + *org-drill-dest-id-table*)))) + + + +;;; Card types for learning languages ========================================= + +;;; Get spell-number.el from: +;;; http://www.emacswiki.org/emacs/spell-number.el +(autoload 'spelln-integer-in-words "spell-number") + + +;;; `conjugate' card type ===================================================== +;;; See spanish.org for usage + +(defvar org-drill-verb-tense-alist + '(("present" "tomato") + ("simple present" "tomato") + ("present indicative" "tomato") + ;; past tenses + ("past" "purple") + ("simple past" "purple") + ("preterite" "purple") + ("imperfect" "darkturquoise") + ("present perfect" "royalblue") + ;; future tenses + ("future" "green") + ;; moods (backgrounds). + ("indicative" nil) ; default + ("subjunctive" "medium blue") + ("conditional" "grey30") + ("negative imperative" "red4") + ("positive imperative" "darkgreen") + ) + "Alist where each entry has the form (TENSE COLOUR), where +TENSE is a string naming a tense in which verbs can be +conjugated, and COLOUR is a string specifying a foreground colour +which will be used by `org-drill-present-verb-conjugation' and +`org-drill-show-answer-verb-conjugation' to fontify the verb and +the name of the tense.") + + +(defun org-drill-get-verb-conjugation-info () + "Auxiliary function used by `org-drill-present-verb-conjugation' and +`org-drill-show-answer-verb-conjugation'." + (let ((infinitive (org-entry-get (point) "VERB_INFINITIVE" t)) + (inf-hint (org-entry-get (point) "VERB_INFINITIVE_HINT" t)) + (translation (org-entry-get (point) "VERB_TRANSLATION" t)) + (tense (org-entry-get (point) "VERB_TENSE" nil)) + (mood (org-entry-get (point) "VERB_MOOD" nil)) + (highlight-face nil)) + (unless (and infinitive translation (or tense mood)) + (error "Missing information for verb conjugation card (%s, %s, %s, %s) at %s" + infinitive translation tense mood (point))) + (setq tense (if tense (downcase (car (read-from-string tense)))) + mood (if mood (downcase (car (read-from-string mood)))) + infinitive (car (read-from-string infinitive)) + inf-hint (if inf-hint (car (read-from-string inf-hint))) + translation (car (read-from-string translation))) + (setq highlight-face + (list :foreground + (or (second (assoc-string tense org-drill-verb-tense-alist t)) + "hotpink") + :background + (second (assoc-string mood org-drill-verb-tense-alist t)))) + (setq infinitive (propertize infinitive 'face highlight-face)) + (setq translation (propertize translation 'face highlight-face)) + (if tense (setq tense (propertize tense 'face highlight-face))) + (if mood (setq mood (propertize mood 'face highlight-face))) + (list infinitive inf-hint translation tense mood))) + + +(defun org-drill-present-verb-conjugation () + "Present a drill entry whose card type is 'conjugate'." + (flet ((tense-and-mood-to-string + (tense mood) + (cond + ((and tense mood) + (format "%s tense, %s mood" tense mood)) + (tense + (format "%s tense" tense)) + (mood + (format "%s mood" mood))))) + (destructuring-bind (infinitive inf-hint translation tense mood) + (org-drill-get-verb-conjugation-info) + (org-drill-present-card-using-text + (cond + ((zerop (random* 2)) + (format "\nTranslate the verb\n\n%s\n\nand conjugate for the %s.\n\n" + infinitive (tense-and-mood-to-string tense mood))) + + (t + (format "\nGive the verb that means\n\n%s %s\n +and conjugate for the %s.\n\n" + translation + (if inf-hint (format " [HINT: %s]" inf-hint) "") + (tense-and-mood-to-string tense mood)))))))) + + +(defun org-drill-show-answer-verb-conjugation (reschedule-fn) + "Show the answer for a drill item whose card type is 'conjugate'. +RESCHEDULE-FN must be a function that calls `org-drill-reschedule' and +returns its return value." + (destructuring-bind (infinitive inf-hint translation tense mood) + (org-drill-get-verb-conjugation-info) + (with-replaced-entry-heading + (format "%s of %s ==> %s\n\n" + (capitalize + (cond + ((and tense mood) + (format "%s tense, %s mood" tense mood)) + (tense + (format "%s tense" tense)) + (mood + (format "%s mood" mood)))) + infinitive translation) + (funcall reschedule-fn)))) + + +;;; `translate_number' card type ============================================== +;;; See spanish.org for usage + +(defvar *drilled-number* 0) +(defvar *drilled-number-direction* 'to-english) + +(defun org-drill-present-translate-number () + (let ((num-min (read (org-entry-get (point) "DRILL_NUMBER_MIN"))) + (num-max (read (org-entry-get (point) "DRILL_NUMBER_MAX"))) + (language (read (org-entry-get (point) "DRILL_LANGUAGE" t))) + (highlight-face 'font-lock-warning-face)) + (cond + ((not (fboundp 'spelln-integer-in-words)) + (message "`spell-number.el' not loaded, skipping 'translate_number' card...") + (sit-for 0.5) + 'skip) + ((not (and (numberp num-min) (numberp num-max) language)) + (error "Missing language or minimum or maximum numbers for number card")) + (t + (if (> num-min num-max) + (psetf num-min num-max + num-max num-min)) + (setq *drilled-number* + (+ num-min (random* (abs (1+ (- num-max num-min)))))) + (setq *drilled-number-direction* + (if (zerop (random* 2)) 'from-english 'to-english)) + (org-drill-present-card-using-text + (if (eql 'to-english *drilled-number-direction*) + (format "\nTranslate into English:\n\n%s\n" + (let ((spelln-language language)) + (propertize + (spelln-integer-in-words *drilled-number*) + 'face highlight-face))) + (format "\nTranslate into %s:\n\n%s\n" + (capitalize (format "%s" language)) + (let ((spelln-language 'english-gb)) + (propertize + (spelln-integer-in-words *drilled-number*) + 'face highlight-face))))))))) + + +(defun org-drill-show-answer-translate-number (reschedule-fn) + (let* ((language (read (org-entry-get (point) "DRILL_LANGUAGE" t))) + (highlight-face 'font-lock-warning-face) + (non-english + (let ((spelln-language language)) + (propertize (spelln-integer-in-words *drilled-number*) + 'face highlight-face))) + (english + (let ((spelln-language 'english-gb)) + (propertize (spelln-integer-in-words *drilled-number*) + 'face 'highlight-face)))) + (with-replaced-entry-text + (cond + ((eql 'to-english *drilled-number-direction*) + (format "\nThe English translation of %s is:\n\n%s\n" + non-english english)) + (t + (format "\nThe %s translation of %s is:\n\n%s\n" + (capitalize (format "%s" language)) + english non-english))) + (funcall reschedule-fn)))) + + +;;; `spanish_verb' card type ================================================== +;;; Not very interesting, but included to demonstrate how a presentation +;;; function can manipulate which subheading are hidden versus shown. + + +(defun org-drill-present-spanish-verb () + (let ((prompt nil) + (reveal-headings nil)) + (with-hidden-comments + (with-hidden-cloze-hints + (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) + (org-drill-hide-subheadings-if 'org-drill-entry-p))))))) + + +(provide 'org-drill) |