Entries in 'org-drill-card-type-alist' can now take a fourth argument, 'drill-empty-p' (boolean). If true, items of this type are not skipped if their bodies are empty.

Bugfixes related to cram mode.
Cram mode displays a coloured 'C' in the mode line.
Sped up testing whether items have empty bodies.
Updated documentation.

1 files changed, 105 insertions, 64 deletions

diff --git a/org-drill.el b/org-drill.el
index b71b1bd..bfce766 100755
--- a/org-drill.el
+++ b/org-drill.el
@@ -2,7 +2,7 @@
 ;;; org-drill.el - Self-testing using spaced repetition
 ;;;
 ;;; Author: Paul Sexton <eeeickythump@gmail.com>
-;;; Version: 2.3.6
+;;; Version: 2.3.7
 ;;; Repository at http://bitbucket.org/eeeickythump/org-drill/
 ;;;
 ;;;
@@ -209,38 +209,48 @@ the hidden cloze during a test.")
 
 
 (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
+  '((nil org-drill-present-simple-card)
+    ("simple" org-drill-present-simple-card)
+    ("twosided" org-drill-present-two-sided-card nil t)
+    ("multisided" org-drill-present-multi-sided-card nil t)
+    ("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)
+    ("spanish_verb" org-drill-present-spanish-verb)
     ("translate_number" org-drill-present-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)."
+  "Alist associating card types with presentation functions. Each
+entry in the alist takes the form:
+
+;;; (CARDTYPE QUESTION-FN [ANSWER-FN DRILL-EMPTY-P])
+
+Where CARDTYPE is a string or nil (for default), and QUESTION-FN
+is a function which takes no arguments and returns a boolean
+value.
+
+When supplied, ANSWER-FN is a function that takes one argument --
+that argument is a function of no arguments, which when called,
+prompts the user to rate their recall and performs rescheduling
+of the drill item. 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.
+
+When supplied, DRILL-EMPTY-P is a boolean value, default nil.
+When non-nil, cards of this type will be presented during tests
+even if their bodies are empty."
   :group 'org-drill
-  :type '(alist :key-type (choice string (const nil)) :value-type function))
+  :type '(alist :key-type (choice string (const nil))
+                :value-type function))
 
 
 (defcustom org-drill-scope
@@ -1276,28 +1286,29 @@ How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"
      ((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)))
+        (unless *org-drill-cram-mode*
+          (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)
@@ -1376,9 +1387,13 @@ the current topic."
           (format "%s %s %s %s %s %s"
                   (propertize
                    (char-to-string
-                    (case status
-                      (:new ?N) (:young ?Y) (:old ?o) (:overdue ?!)
-                      (:failed ?F) (t ??)))
+                    (cond
+                     ((eql status :failed) ?F)
+                     (*org-drill-cram-mode* ?C)
+                     (t
+                      (case status
+                        (:new ?N) (:young ?Y) (:old ?o) (:overdue ?!)
+                        (t ??)))))
                    'face `(:foreground
                            ,(case status
                               (:new org-drill-new-count-color)
@@ -1619,9 +1634,20 @@ Note: does not actually alter the item."
       (substring-no-properties text))))
 
 
-(defun org-drill-entry-empty-p ()
-  (zerop (length (org-drill-get-entry-text))))
+;; (defun org-entry-empty-p ()
+;;   (zerop (length (org-drill-get-entry-text))))
+
+;; This version is about 5x faster than the old version, above.
+(defun org-entry-empty-p ()
+  (save-excursion
+    (org-back-to-heading t)
+    (let ((lim (save-excursion
+                 (outline-next-heading) (point))))
+      (org-end-of-meta-data-and-drawers)
+      (or (>= (point) lim)
+          (null (re-search-forward "[[:graph:]]" lim t))))))
 
+(defun org-drill-entry-empty-p () (org-entry-empty-p))
 
 
 ;;; Presentation functions ====================================================
@@ -2025,6 +2051,7 @@ See `org-drill' for more details."
   ;;  (org-back-to-heading))
   (let ((card-type (org-entry-get (point) "DRILL_CARD_TYPE"))
         (answer-fn 'org-drill-present-default-answer)
+        (present-empty-cards nil)
         (cont nil)
         ;; fontification functions in `outline-view-change-hook' can cause big
         ;; slowdowns, so we temporarily bind this variable to nil here.
@@ -2036,10 +2063,12 @@ See `org-drill' for more details."
         (org-show-subtree)
         (org-cycle-hide-drawers 'all)
 
-        (let ((presentation-fn (cdr (assoc card-type org-drill-card-type-alist))))
+        (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)
+                     present-empty-cards (third presentation-fn)
                      presentation-fn (first presentation-fn)))
           (cond
            ((null presentation-fn)
@@ -2090,6 +2119,7 @@ See `org-drill' for more details."
   "Returns true if the current drill session has continued past its
 maximum duration."
   (and org-drill-maximum-duration
+       (not *org-drill-cram-mode*)
        *org-drill-start-time*
        (> (- (float-time (current-time)) *org-drill-start-time*)
           (* org-drill-maximum-duration 60))))
@@ -2099,6 +2129,7 @@ maximum duration."
   "Returns true if the current drill session has reached the
 maximum number of items."
   (and org-drill-maximum-items-per-session
+       (not *org-drill-cram-mode*)
        (>= (length *org-drill-done-entries*)
            org-drill-maximum-items-per-session)))
 
@@ -2211,7 +2242,8 @@ RESUMING-P is true if we are resuming a suspended drill session."
                                    (> qual org-drill-failure-quality))
                                  *org-drill-session-qualities*))
                 (max 1 (length *org-drill-session-qualities*))))
-        (prompt nil))
+        (prompt nil)
+        (max-mini-window-height 0.6))
     (setq prompt
           (format
            "%d items reviewed. Session duration %s.
@@ -2340,8 +2372,14 @@ one of the following values:
        (cond
         ((not (org-drill-entry-p))
          nil)
-        ((org-drill-entry-empty-p)
-         nil)                           ; skip -- item body is empty
+        ((and (org-entry-empty-p)
+              (let* ((card-type (org-entry-get (point) "DRILL_CARD_TYPE" nil))
+                    (dat (cdr (assoc card-type org-drill-card-type-alist))))
+                (or (null card-type)
+                    (not (third dat)))))
+         ;; body is empty, and this is not a card type where empty bodies are
+         ;; meaningful, so skip it.
+         nil)
         ((null due)                     ; unscheduled - usually a skipped leech
          :unscheduled)
         ;; ((eql -1 due)
@@ -2481,7 +2519,8 @@ than starting a new one."
                          (:overdue
                           (push (cons (point-marker) due) overdue-data))
                          (:old
-                          (push (point-marker) *org-drill-old-mature-entries*)))))))
+                          (push (point-marker) *org-drill-old-mature-entries*))
+                         )))))
                  scope)
                 (org-drill-order-overdue-entries overdue-data)
                 (setq *org-drill-overdue-entry-count*
@@ -2500,6 +2539,7 @@ than starting a new one."
               (message "Drill session finished!"))))
         (progn
           (unless end-pos
+            (setq *org-drill-cram-mode* nil)
             (org-drill-free-markers *org-drill-done-entries*)))))
     (cond
      (end-pos
@@ -2534,8 +2574,8 @@ 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)))
+  (setq *org-drill-cram-mode* t)
+  (org-drill scope))
 
 
 (defun org-drill-tree ()
@@ -2558,6 +2598,7 @@ 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)
+  (setq *org-drill-cram-mode* nil)
   (cond
    ((plusp (org-drill-pending-entry-count))
     (org-drill-free-markers *org-drill-done-entries*)