From 4ea5658a1a14efaa7cf3fff883cd43cac2019c77 Mon Sep 17 00:00:00 2001
From: Carsten Dominik <carsten.dominik@gmail.com>
Date: Tue, 17 Aug 2010 10:40:14 +0200
Subject: [PATCH] Add org-drill.el

---
 contrib/README            |   2 +
 contrib/lisp/org-drill.el | 446 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 448 insertions(+)
 create mode 100644 contrib/lisp/org-drill.el

diff --git a/contrib/README b/contrib/README
index 4a1879092..6a158211e 100644
--- a/contrib/README
+++ b/contrib/README
@@ -18,6 +18,8 @@ org-choose.el            --- Use TODO keywords to mark decision states
 org-collector.el         --- Collect properties into tables
 org-contribdir.el        --- Dummy file to mark the org contrib Lisp directory
 org-depend.el            --- TODO dependencies for Org-mode
+org-drill.el             --- Self-testing with org-learn
+org-depend.el            --- TODO dependencies for Org-mode
 org-elisp-symbol.el      --- Org links to emacs-lisp symbols
 org-eval.el              --- The <lisp> tag, adapted from Muse
 org-eval-light.el        --- Evaluate in-buffer code on demand
diff --git a/contrib/lisp/org-drill.el b/contrib/lisp/org-drill.el
new file mode 100644
index 000000000..89c3124d0
--- /dev/null
+++ b/contrib/lisp/org-drill.el
@@ -0,0 +1,446 @@
+;;; org-drill.el - Self-testing with org-learn
+;;;
+;;; Author: Paul Sexton <eeeickythump@gmail.com>
+;;; Version: 1.0
+;;; Repository at http://bitbucket.org/eeeickythump/org-drill/
+;;;
+;;;
+;;; Synopsis
+;;; ========
+;;;
+;;; Uses the spaced repetition algorithm in `org-learn' 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 fed back to `org-learn' 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.
+;;;
+;;;
+;;; Installation
+;;; ============
+;;;
+;;; Put the following in your .emacs:
+;;;
+;;; (add-to-list 'load-path "/path/to/org-drill/")
+;;; (require 'org-drill)
+;;;
+;;;
+;;; Writing the questions
+;;; =====================
+;;;
+;;; See the file "spanish.org" for an example set of material.
+;;;
+;;; Tag all items you want to be asked about with a tag that matches
+;;; `org-drill-question-tag'. This is :drill: by default.
+;;;
+;;; You don't need to schedule the topics initially.  However org-drill *will*
+;;; recognise items that have been scheduled previously with `org-learn'.
+;;;
+;;; Within each question, the answer can be included in the following ways:
+;;; 
+;;; - Question in the main body text, answer in subtopics. This is the
+;;;   default. All subtopics will be shown collapsed, while the text under
+;;;   the main heading will stay visible.
+;;;
+;;; - Each subtopic contains a piece of information related to the topic. ONE
+;;;   of these will revealed at random, and the others hidden. To define a
+;;;   topic of this type, give the topic a property `DRILL_CARD_TYPE' with
+;;;   value `multisided'.
+;;;
+;;; - Cloze deletion -- any pieces of text in the body of the card that are
+;;;   surrounded with [SINGLE square brackets] will be hidden when the card is
+;;;   presented to the user, and revealed once they press a key. Cloze deletion
+;;;   is automatically applied to all topics.
+;;; 
+;;; - No explicit answer -- the user judges whether they recalled the
+;;;   fact adequately.
+;;;
+;;; - Other methods of your own devising, provided you write a function to
+;;;   handle selective display of the topic. See the function
+;;;   `org-drill-present-spanish-verb', which handles topics of type "spanish_verb",
+;;;   for an example.
+;;;
+;;;
+;;; Running the drill session
+;;; =========================
+;;;
+;;; Start a drill session with `M-x org-drill'. This will include all eligible
+;;; topics in the current buffer. `org-drill' can also be targeted at a particular
+;;; subtree or particular files or sets of files; see the documentation of 
+;;; the function `org-drill' for details.
+;;;
+;;; During the drill session, you will be presented with each item, then asked
+;;; to rate your recall of it by pressing a key between 0 and 5. At any time you
+;;; can press 'q' to finish the drill early (your progress will be saved), or
+;;; 'e' to finish the drill and jump to the current topic for editing.
+;;;
+;;; 
+;;; TODO
+;;; ====
+;;;
+;;; - encourage org-learn to reschedule "4" and "5" items.
+;;; - nicer "cloze face" which does not hide the space preceding the cloze,
+;;;   and behaves more nicely across line breaks
+;;; - hide drawers.
+;;; - org-drill-question-tag should use a tag match string, rather than a
+;;;   single tag
+;;; - when finished, display a message showing how many items reviewed,
+;;;   how many still pending, numbers in each recall category
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'hi-lock))
+(require 'org)
+(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)))
+
+
+
+(defface org-drill-hidden-cloze-face
+  '((t (:foreground "blue" :background "blue")))
+  "The face used to hide the contents of cloze phrases."
+  :group 'org-drill)
+
+
+(defvar org-drill-cloze-regexp
+  "[^][]\\(\\[[^][][^]]*\\]\\)")
+
+
+(defcustom org-drill-card-type-alist
+  '((nil . org-drill-present-simple-card)
+    ("simple" . org-drill-present-simple-card)
+    ("multisided" . org-drill-present-multi-sided-card)
+    ("spanish_verb" . org-drill-present-spanish-verb))
+  "Alist associating card types with presentation functions. Each entry in the
+alist takes the form (CARDTYPE . FUNCTION), where CARDTYPE is a string
+or nil, and FUNCTION is a function which takes no arguments and returns a
+boolean value."
+  :group 'org-drill
+  :type '(alist :key-type (choice string (const nil)) :value-type function))
+
+
+
+(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 org-drill-entry-due-p ()
+  (let ((item-time (org-get-scheduled-time (point))))
+    (and (or (assoc "LEARN_DATA" (org-entry-properties nil))
+             (member org-drill-question-tag (org-get-local-tags)))
+         (or (null item-time)
+             (not (minusp               ; scheduled for today/in
+                                        ; future
+                   (- (time-to-days (current-time))
+                      (time-to-days item-time))))))))
+
+
+
+(defun org-drill-reschedule ()
+  (let ((ch nil))
+    (while (not (memq ch '(?q ?0 ?1 ?2 ?3 ?4 ?5)))
+      (setq ch (read-char
+                (if (eq ch ??)
+                    "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.
+4 - After a little bit of thought you remembered.
+5 - You remembered the item really easily.
+
+How well did you do? (0-5, ?=help, q=quit)"
+                  "How well did you do? (0-5, ?=help, q=quit)"))))
+    (cond
+     ((and (>= ch ?0) (<= ch ?5))
+      (save-excursion
+        (org-smart-reschedule (- ch 48)))
+      ch)
+     (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 (= (org-current-level) (1+ drill-entry-level))
+           (setq drill-heading (org-get-heading t))
+           (unless (member drill-heading heading-list)
+             (hide-subtree))
+           (push (point) drill-sections)))
+       "" 'tree))
+    (reverse drill-sections)))
+
+
+(defun org-drill-presentation-prompt (&rest fmt-and-args)
+  (let ((ch (read-char (if fmt-and-args
+                           (apply 'format
+                                  (first fmt-and-args)
+                                  (rest fmt-and-args))
+                         "Press any key to see the answer, 'e' to edit, 'q' to quit."))))
+    (case ch
+      (?q nil)
+      (?e 'edit)
+      (otherwise t))))
+
+
+;;; 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 ()
+  (org-drill-hide-all-subheadings-except nil)
+  (prog1 (org-drill-presentation-prompt)
+    (org-show-subtree)))
+
+
+(defun org-drill-present-multi-sided-card ()
+  (let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
+    (when drill-sections
+      (save-excursion
+        (goto-char (nth (random (length drill-sections)) drill-sections))
+        (org-show-subtree)))
+    (prog1
+        (org-drill-presentation-prompt)
+      (org-show-subtree))))
+
+
+
+(defun org-drill-present-spanish-verb ()
+  (case (random 6)
+    (0
+     (org-drill-hide-all-subheadings-except '("Infinitive"))
+     (prog1
+         (org-drill-presentation-prompt
+          "Translate this Spanish verb, and conjugate it for the *present* tense.")
+       (org-drill-hide-all-subheadings-except '("English" "Present Tense"
+                                                "Notes"))))
+    (1
+     (org-drill-hide-all-subheadings-except '("English"))
+     (prog1
+         (org-drill-presentation-prompt
+          "For the *present* tense, conjugate the Spanish translation of this English verb.")
+       (org-drill-hide-all-subheadings-except '("Infinitive" "Present Tense"
+                                                "Notes"))))
+    (2
+     (org-drill-hide-all-subheadings-except '("Infinitive"))
+     (prog1
+         (org-drill-presentation-prompt
+          "Translate this Spanish verb, and conjugate it for the *past* tense.")
+       (org-drill-hide-all-subheadings-except '("English" "Past Tense"
+                                                "Notes"))))
+    (3
+     (org-drill-hide-all-subheadings-except '("English"))
+     (prog1
+         (org-drill-presentation-prompt
+          "For the *past* tense, conjugate the Spanish translation of this English verb.")
+       (org-drill-hide-all-subheadings-except '("Infinitive" "Past Tense"
+                                                "Notes"))))
+    (4
+     (org-drill-hide-all-subheadings-except '("Infinitive"))
+     (prog1
+         (org-drill-presentation-prompt
+          "Translate this Spanish verb, and conjugate it for the *future perfect* tense.")
+       (org-drill-hide-all-subheadings-except '("English" "Future Perfect Tense"
+                                                "Notes"))))
+    (5
+     (org-drill-hide-all-subheadings-except '("English"))
+     (prog1
+         (org-drill-presentation-prompt
+          "For the *future perfect* tense, conjugate the Spanish translation of this English verb.")
+       (org-drill-hide-all-subheadings-except '("Infinitive" "Future Perfect Tense"
+                                                "Notes"))))))
+    
+
+
+
+(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'.
+
+See `org-drill' for more details."
+  (interactive)
+  (unless (org-at-heading-p)
+    (org-back-to-heading))
+  (let ((card-type (cdr (assoc "DRILL_CARD_TYPE" (org-entry-properties nil))))
+        (cont nil))
+    (save-restriction
+      (org-narrow-to-subtree) 
+      (org-show-subtree)
+      (org-cycle-hide-drawers 'overview)
+      
+      (let ((presentation-fn (cdr (assoc card-type org-drill-card-type-alist))))
+        (cond
+         (presentation-fn
+          (highlight-regexp org-drill-cloze-regexp
+                            'org-drill-hidden-cloze-face)
+          (setq cont (funcall presentation-fn))
+          (unhighlight-regexp org-drill-cloze-regexp))
+         (t
+          (error "Unknown card type: '%s'" card-type))))
+      
+      (cond
+       ((not cont)
+        (message "Quit")
+        nil)
+       ((eql cont 'edit)
+        'edit)
+       (t
+        (save-excursion
+          (org-drill-reschedule)))))))
+
+
+
+(defun org-drill (&optional scope)
+  "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 using the `org-learn' library.
+
+Org-drill proceeds by:
+
+- Finding all topics (headings) in SCOPE which have either been
+  used and rescheduled by org-learn before (i.e. the LEARN_DATA
+  property is set), 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 is passed to `org-map-entries', and can be any of:
+
+nil     The current buffer, respecting the restriction if any.
+        This is the default.
+tree    The subtree started with the entry at point
+file    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
+ (file1 file2 ...)
+        If this is a list, all files in the list will be scanned."
+
+  (interactive)
+  (let ((entries nil)
+        (result nil)
+        (results nil)
+        (end-pos nil))
+    (block org-drill
+      (save-excursion
+        (org-map-entries
+         (lambda () (if (org-drill-entry-due-p)
+                   (push (point-marker) entries)))
+         "" scope)
+        (cond
+         ((null entries)
+          (message "I did not find any pending drill items."))
+         (t
+          (let ((start-time (float-time (current-time))))
+            (dolist (m (if (and org-drill-maximum-items-per-session
+                                (> (length entries)
+                                   org-drill-maximum-items-per-session))
+                           (subseq (shuffle-list entries) 0
+                                   org-drill-maximum-items-per-session)
+                         (shuffle-list entries)))
+              (save-restriction
+                (switch-to-buffer (marker-buffer m))
+                (goto-char (marker-position m))
+                (setq result (org-drill-entry))
+                (cond
+                 ((null result)
+                  (message "Quit")
+                  (return-from org-drill nil))
+                 ((eql result 'edit)
+                  (setq end-pos (point-marker))
+                  (return-from org-drill nil))
+                 ((and org-drill-maximum-duration
+                       (> (- (float-time (current-time)) start-time)
+                          (* org-drill-maximum-duration 60)))
+                  (message "This drill session has reached its maximum duration.")
+                  (return-from org-drill nil)))))
+            (message "Drill session finished!")
+            )))))
+    (when end-pos
+      (switch-to-buffer (marker-buffer end-pos))
+      (goto-char (marker-position end-pos))
+      (message "Edit topic."))))
+
+
+
+(provide 'org-drill)