Update org-drill.el to version 1.4

1 files changed, 588 insertions, 219 deletions

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