Browse Source

contrib/lisp/: Update org-drill.el to version 2.3.7

Thanks to Paul Sexton for maintaining org-drill.el!
Bastien Guerry 12 years ago
parent
commit
0030e16002
1 changed files with 311 additions and 159 deletions
  1. 311 159
      contrib/lisp/org-drill.el

+ 311 - 159
contrib/lisp/org-drill.el

@@ -2,7 +2,7 @@
 ;;; org-drill.el - Self-testing using spaced repetition
 ;;; org-drill.el - Self-testing using spaced repetition
 ;;;
 ;;;
 ;;; Author: Paul Sexton <eeeickythump@gmail.com>
 ;;; Author: Paul Sexton <eeeickythump@gmail.com>
-;;; Version: 2.3.6
+;;; Version: 2.3.7
 ;;; Repository at http://bitbucket.org/eeeickythump/org-drill/
 ;;; Repository at http://bitbucket.org/eeeickythump/org-drill/
 ;;;
 ;;;
 ;;;
 ;;;
@@ -188,11 +188,16 @@ during a drill session."
                     window t))
                     window t))
 
 
 
 
+(defvar org-drill-hint-separator "||"
+  "String which, if it occurs within a cloze expression, signifies that the
+rest of the expression after the string is a `hint', to be displayed instead of
+the hidden cloze during a test.")
+
+
 (defvar org-drill-cloze-regexp
 (defvar org-drill-cloze-regexp
-  ;; ver 1   "[^][]\\(\\[[^][][^]]*\\]\\)"
-  ;; ver 2   "\\(\\[.*?\\]\\|^[^[[:cntrl:]]*?\\]\\|\\[.*?$\\)"
-  ;; ver 3!  "\\(\\[.*?\\]\\|\\[.*?[[:cntrl:]]+.*?\\]\\)"
-  "\\(\\[[[:cntrl:][:graph:][:space:]]*?\\)\\(\\||.+?\\)\\(\\]\\)")
+  (concat "\\(\\[[[:cntrl:][:graph:][:space:]]+?\\)\\(\\|"
+          (regexp-quote org-drill-hint-separator)
+          ".+?\\)\\(\\]\\)"))
 
 
 
 
 (defvar org-drill-cloze-keywords
 (defvar org-drill-cloze-keywords
@@ -204,39 +209,51 @@ during a drill session."
 
 
 
 
 (defcustom org-drill-card-type-alist
 (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)
      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)."
+    ("decline_noun"
+     org-drill-present-noun-declension
+     org-drill-show-answer-noun-declension)
+    ("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 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
   :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
 (defcustom org-drill-scope
@@ -419,6 +436,17 @@ exponential effect on inter-repetition spacing."
   :type 'float)
   :type 'float)
 
 
 
 
+(defvar drill-answer nil
+  "Global variable that can be bound to a correct answer when an
+item is being presented. If this variable is non-nil, the default
+presentation function will show its value instead of the default
+behaviour of revealing the contents of the drilled item.
+
+This variable is useful for card types that compute their answers
+-- for example, a card type that asks the student to translate a
+random number to another language. ")
+
+
 (defvar *org-drill-session-qualities* nil)
 (defvar *org-drill-session-qualities* nil)
 (defvar *org-drill-start-time* 0)
 (defvar *org-drill-start-time* 0)
 (defvar *org-drill-new-entries* nil)
 (defvar *org-drill-new-entries* nil)
@@ -1261,28 +1289,29 @@ How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"
      ((and (>= ch ?0) (<= ch ?5))
      ((and (>= ch ?0) (<= ch ?5))
       (let ((quality (- ch ?0))
       (let ((quality (- ch ?0))
             (failures (org-drill-entry-failure-count)))
             (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))
         quality))
      ((= ch ?e)
      ((= ch ?e)
       'edit)
       'edit)
@@ -1361,9 +1390,13 @@ the current topic."
           (format "%s %s %s %s %s %s"
           (format "%s %s %s %s %s %s"
                   (propertize
                   (propertize
                    (char-to-string
                    (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
                    'face `(:foreground
                            ,(case status
                            ,(case status
                               (:new org-drill-new-count-color)
                               (:new org-drill-new-count-color)
@@ -1438,7 +1471,7 @@ visual overlay, or with the string TEXT if it is supplied."
 
 
 (defun org-drill-hide-heading-at-point (&optional text)
 (defun org-drill-hide-heading-at-point (&optional text)
   (unless (org-at-heading-p)
   (unless (org-at-heading-p)
-    (error "Point is not on a heading"))
+    (error "Point is not on a heading."))
   (save-excursion
   (save-excursion
     (let ((beg (point)))
     (let ((beg (point)))
       (end-of-line)
       (end-of-line)
@@ -1472,19 +1505,22 @@ visual overlay, or with the string TEXT if it is supplied."
 
 
 (defun org-drill-hide-matched-cloze-text ()
 (defun org-drill-hide-matched-cloze-text ()
   "Hide the current match with a 'cloze' visual overlay."
   "Hide the current match with a 'cloze' visual overlay."
-  (let ((ovl (make-overlay (match-beginning 0) (match-end 0))))
+  (let ((ovl (make-overlay (match-beginning 0) (match-end 0)))
+        (hint-sep-pos (string-match-p (regexp-quote org-drill-hint-separator)
+                                      (match-string 0))))
     (overlay-put ovl 'category
     (overlay-put ovl 'category
                  'org-drill-cloze-overlay-defaults)
                  'org-drill-cloze-overlay-defaults)
-    (when (find ?| (match-string 0))
+    (when (and hint-sep-pos
+               (> hint-sep-pos 1))
       (let ((hint (substring-no-properties
       (let ((hint (substring-no-properties
                    (match-string 0)
                    (match-string 0)
-                   (1+ (position ?| (match-string 0)))
+                   (+ hint-sep-pos (length org-drill-hint-separator))
                    (1- (length (match-string 0))))))
                    (1- (length (match-string 0))))))
         (overlay-put
         (overlay-put
          ovl 'display
          ovl 'display
          ;; If hint is like `X...' then display [X...]
          ;; If hint is like `X...' then display [X...]
          ;; otherwise display [...X]
          ;; otherwise display [...X]
-         (format (if (string-match-p "\\.\\.\\." hint) "[%s]" "[%s...]")
+         (format (if (string-match-p (regexp-quote "...") hint) "[%s]" "[%s...]")
                  hint))))))
                  hint))))))
 
 
 
 
@@ -1601,13 +1637,24 @@ Note: does not actually alter the item."
       (substring-no-properties text))))
       (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 ====================================================
 ;;; Presentation functions ====================================================
-
+;;
 ;; Each of these is called with point on topic heading.  Each needs to show the
 ;; 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
 ;; 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
 ;; appropriate for the card type. The user should then be prompted to press a
@@ -1628,12 +1675,21 @@ Note: does not actually alter the item."
 
 
 
 
 (defun org-drill-present-default-answer (reschedule-fn)
 (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)))
+  (cond
+   (drill-answer
+    (with-replaced-entry-text
+     (format "\nAnswer:\n\n  %s\n" drill-answer)
+     (prog1
+         (funcall reschedule-fn)
+       (setq drill-answer nil))))
+   (t
+    (org-drill-hide-subheadings-if 'org-drill-entry-p)
+    (org-drill-unhide-clozed-text)
+    (ignore-errors
+      (org-display-inline-images t))
+    (org-cycle-hide-drawers 'all)
+    (with-hidden-cloze-hints
+     (funcall reschedule-fn)))))
 
 
 
 
 (defun org-drill-present-two-sided-card ()
 (defun org-drill-present-two-sided-card ()
@@ -1949,10 +2005,12 @@ pieces rather than one."
 
 
 
 
 (defun org-drill-present-card-using-text (question &optional answer)
 (defun org-drill-present-card-using-text (question &optional answer)
-  "Present the string QUESTION as the only visible content of the card."
+  "Present the string QUESTION as the only visible content of the card.
+If ANSWER is supplied, set the global variable `drill-answer' to its value."
+  (if answer (setq drill-answer answer))
   (with-hidden-comments
   (with-hidden-comments
    (with-replaced-entry-text
    (with-replaced-entry-text
-    question
+    (concat "\n" question)
     (org-drill-hide-all-subheadings-except nil)
     (org-drill-hide-all-subheadings-except nil)
     (org-cycle-hide-drawers 'all)
     (org-cycle-hide-drawers 'all)
     (ignore-errors
     (ignore-errors
@@ -1964,7 +2022,9 @@ pieces rather than one."
 (defun org-drill-present-card-using-multiple-overlays (replacements &optional answer)
 (defun org-drill-present-card-using-multiple-overlays (replacements &optional answer)
   "TEXTS is a list of valid values for the 'display' text property.
   "TEXTS is a list of valid values for the 'display' text property.
 Present these overlays, in sequence, as the only
 Present these overlays, in sequence, as the only
-visible content of the card."
+visible content of the card.
+If ANSWER is supplied, set the global variable `drill-answer' to its value."
+  (if answer (setq drill-answer answer))
   (with-hidden-comments
   (with-hidden-comments
    (with-replaced-entry-text-multi
    (with-replaced-entry-text-multi
     replacements
     replacements
@@ -1995,20 +2055,24 @@ See `org-drill' for more details."
   ;;  (org-back-to-heading))
   ;;  (org-back-to-heading))
   (let ((card-type (org-entry-get (point) "DRILL_CARD_TYPE"))
   (let ((card-type (org-entry-get (point) "DRILL_CARD_TYPE"))
         (answer-fn 'org-drill-present-default-answer)
         (answer-fn 'org-drill-present-default-answer)
+        (present-empty-cards nil)
         (cont nil)
         (cont nil)
         ;; fontification functions in `outline-view-change-hook' can cause big
         ;; fontification functions in `outline-view-change-hook' can cause big
         ;; slowdowns, so we temporarily bind this variable to nil here.
         ;; slowdowns, so we temporarily bind this variable to nil here.
         (outline-view-change-hook nil))
         (outline-view-change-hook nil))
+    (setq drill-answer nil)
     (org-save-outline-visibility t
     (org-save-outline-visibility t
       (save-restriction
       (save-restriction
         (org-narrow-to-subtree)
         (org-narrow-to-subtree)
         (org-show-subtree)
         (org-show-subtree)
         (org-cycle-hide-drawers 'all)
         (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)
           (if (listp presentation-fn)
               (psetq answer-fn (or (second presentation-fn)
               (psetq answer-fn (or (second presentation-fn)
                                    'org-drill-present-default-answer)
                                    'org-drill-present-default-answer)
+                     present-empty-cards (third presentation-fn)
                      presentation-fn (first presentation-fn)))
                      presentation-fn (first presentation-fn)))
           (cond
           (cond
            ((null presentation-fn)
            ((null presentation-fn)
@@ -2034,6 +2098,7 @@ See `org-drill' for more details."
 
 
 (defun org-drill-entries-pending-p ()
 (defun org-drill-entries-pending-p ()
   (or *org-drill-again-entries*
   (or *org-drill-again-entries*
+      *org-drill-current-item*
       (and (not (org-drill-maximum-item-count-reached-p))
       (and (not (org-drill-maximum-item-count-reached-p))
            (not (org-drill-maximum-duration-reached-p))
            (not (org-drill-maximum-duration-reached-p))
            (or *org-drill-new-entries*
            (or *org-drill-new-entries*
@@ -2045,7 +2110,8 @@ See `org-drill' for more details."
 
 
 
 
 (defun org-drill-pending-entry-count ()
 (defun org-drill-pending-entry-count ()
-  (+ (length *org-drill-new-entries*)
+  (+ (if (markerp *org-drill-current-item*) 1 0)
+     (length *org-drill-new-entries*)
      (length *org-drill-failed-entries*)
      (length *org-drill-failed-entries*)
      (length *org-drill-young-mature-entries*)
      (length *org-drill-young-mature-entries*)
      (length *org-drill-old-mature-entries*)
      (length *org-drill-old-mature-entries*)
@@ -2057,6 +2123,7 @@ See `org-drill' for more details."
   "Returns true if the current drill session has continued past its
   "Returns true if the current drill session has continued past its
 maximum duration."
 maximum duration."
   (and org-drill-maximum-duration
   (and org-drill-maximum-duration
+       (not *org-drill-cram-mode*)
        *org-drill-start-time*
        *org-drill-start-time*
        (> (- (float-time (current-time)) *org-drill-start-time*)
        (> (- (float-time (current-time)) *org-drill-start-time*)
           (* org-drill-maximum-duration 60))))
           (* org-drill-maximum-duration 60))))
@@ -2066,6 +2133,7 @@ maximum duration."
   "Returns true if the current drill session has reached the
   "Returns true if the current drill session has reached the
 maximum number of items."
 maximum number of items."
   (and org-drill-maximum-items-per-session
   (and org-drill-maximum-items-per-session
+       (not *org-drill-cram-mode*)
        (>= (length *org-drill-done-entries*)
        (>= (length *org-drill-done-entries*)
            org-drill-maximum-items-per-session)))
            org-drill-maximum-items-per-session)))
 
 
@@ -2157,6 +2225,7 @@ RESUMING-P is true if we are resuming a suspended drill session."
               (setq end-pos (point-marker))
               (setq end-pos (point-marker))
               (return-from org-drill-entries nil))
               (return-from org-drill-entries nil))
              ((eql result 'skip)
              ((eql result 'skip)
+              (setq *org-drill-current-item* nil)
               nil)                      ; skip this item
               nil)                      ; skip this item
              (t
              (t
               (cond
               (cond
@@ -2166,7 +2235,8 @@ RESUMING-P is true if we are resuming a suspended drill session."
                           (shuffle-list *org-drill-again-entries*)))
                           (shuffle-list *org-drill-again-entries*)))
                 (push-end m *org-drill-again-entries*))
                 (push-end m *org-drill-again-entries*))
                (t
                (t
-                (push m *org-drill-done-entries*))))))))))))
+                (push m *org-drill-done-entries*)))
+              (setq *org-drill-current-item* nil))))))))))
 
 
 
 
 
 
@@ -2176,7 +2246,8 @@ RESUMING-P is true if we are resuming a suspended drill session."
                                    (> qual org-drill-failure-quality))
                                    (> qual org-drill-failure-quality))
                                  *org-drill-session-qualities*))
                                  *org-drill-session-qualities*))
                 (max 1 (length *org-drill-session-qualities*))))
                 (max 1 (length *org-drill-session-qualities*))))
-        (prompt nil))
+        (prompt nil)
+        (max-mini-window-height 0.6))
     (setq prompt
     (setq prompt
           (format
           (format
            "%d items reviewed. Session duration %s.
            "%d items reviewed. Session duration %s.
@@ -2305,8 +2376,14 @@ one of the following values:
        (cond
        (cond
         ((not (org-drill-entry-p))
         ((not (org-drill-entry-p))
          nil)
          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
         ((null due)                     ; unscheduled - usually a skipped leech
          :unscheduled)
          :unscheduled)
         ;; ((eql -1 due)
         ;; ((eql -1 due)
@@ -2446,47 +2523,16 @@ than starting a new one."
                          (:overdue
                          (:overdue
                           (push (cons (point-marker) due) overdue-data))
                           (push (cons (point-marker) due) overdue-data))
                          (:old
                          (:old
-                          (push (point-marker) *org-drill-old-mature-entries*)))))))
+                          (push (point-marker) *org-drill-old-mature-entries*))
+                         )))))
                  scope)
                  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)
                 (org-drill-order-overdue-entries overdue-data)
                 (setq *org-drill-overdue-entry-count*
                 (setq *org-drill-overdue-entry-count*
                       (length *org-drill-overdue-entries*))))
                       (length *org-drill-overdue-entries*))))
             (setq *org-drill-due-entry-count* (org-drill-pending-entry-count))
             (setq *org-drill-due-entry-count* (org-drill-pending-entry-count))
             (cond
             (cond
-             ((and (null *org-drill-new-entries*)
+             ((and (null *org-drill-current-item*)
+                   (null *org-drill-new-entries*)
                    (null *org-drill-failed-entries*)
                    (null *org-drill-failed-entries*)
                    (null *org-drill-overdue-entries*)
                    (null *org-drill-overdue-entries*)
                    (null *org-drill-young-mature-entries*)
                    (null *org-drill-young-mature-entries*)
@@ -2497,6 +2543,7 @@ than starting a new one."
               (message "Drill session finished!"))))
               (message "Drill session finished!"))))
         (progn
         (progn
           (unless end-pos
           (unless end-pos
+            (setq *org-drill-cram-mode* nil)
             (org-drill-free-markers *org-drill-done-entries*)))))
             (org-drill-free-markers *org-drill-done-entries*)))))
     (cond
     (cond
      (end-pos
      (end-pos
@@ -2531,8 +2578,8 @@ all drill items are considered to be due for review, unless they
 have been reviewed within the last `org-drill-cram-hours'
 have been reviewed within the last `org-drill-cram-hours'
 hours."
 hours."
   (interactive)
   (interactive)
-  (let ((*org-drill-cram-mode* t))
-    (org-drill scope)))
+  (setq *org-drill-cram-mode* t)
+  (org-drill scope))
 
 
 
 
 (defun org-drill-tree ()
 (defun org-drill-tree ()
@@ -2555,6 +2602,7 @@ were not reviewed during the last session, rather than scanning for
 unreviewed items. If there are no leftover items in memory, a full
 unreviewed items. If there are no leftover items in memory, a full
 scan will be performed."
 scan will be performed."
   (interactive)
   (interactive)
+  (setq *org-drill-cram-mode* nil)
   (cond
   (cond
    ((plusp (org-drill-pending-entry-count))
    ((plusp (org-drill-pending-entry-count))
     (org-drill-free-markers *org-drill-done-entries*)
     (org-drill-free-markers *org-drill-done-entries*)
@@ -2883,19 +2931,120 @@ returns its return value."
                (mood
                (mood
                 (format "%s mood" mood))))
                 (format "%s mood" mood))))
              infinitive translation)
              infinitive translation)
+     (org-cycle-hide-drawers 'all)
+     (funcall reschedule-fn))))
+
+
+;;; `decline_noun' card type ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(defvar org-drill-noun-gender-alist
+  '(("masculine" "dodgerblue")
+    ("masc" "dodgerblue")
+    ("male" "dodgerblue")
+    ("m" "dodgerblue")
+    ("feminine" "orchid")
+    ("fem" "orchid")
+    ("female" "orchid")
+    ("f" "orchid")
+    ("neuter" "green")
+    ("neutral" "green")
+    ("neut" "green")
+    ("n" "green")
+    ))
+
+
+(defun org-drill-get-noun-info ()
+  "Auxiliary function used by `org-drill-present-noun-declension' and
+`org-drill-show-answer-noun-declension'."
+  (let ((noun (org-entry-get (point) "NOUN" t))
+        (noun-hint (org-entry-get (point) "NOUN_HINT" t))
+        (noun-root (org-entry-get (point) "NOUN_ROOT" t))
+        (noun-gender (org-entry-get (point) "NOUN_GENDER" t))
+        (translation (org-entry-get (point) "NOUN_TRANSLATION" t))
+        (highlight-face nil))
+    (unless (and noun translation)
+      (error "Missing information for `decline_noun' card (%s, %s, %s, %s) at %s"
+             noun translation noun-hint noun-root (point)))
+    (setq noun-root (if noun-root (car (read-from-string noun-root)))
+          noun (car (read-from-string noun))
+          noun-gender (downcase (car (read-from-string noun-gender)))
+          noun-hint (if noun-hint (car (read-from-string noun-hint)))
+          translation (car (read-from-string translation)))
+    (setq highlight-face
+          (list :foreground
+                (or (second (assoc-string noun-gender
+                                          org-drill-noun-gender-alist t))
+                    "red")))
+    (setq noun (propertize noun 'face highlight-face))
+    (setq translation (propertize translation 'face highlight-face))
+    (list noun noun-root noun-gender noun-hint translation)))
+
+
+(defun org-drill-present-noun-declension ()
+  "Present a drill entry whose card type is 'decline_noun'."
+  (destructuring-bind (noun noun-root noun-gender noun-hint translation)
+      (org-drill-get-noun-info)
+    (let* ((props (org-entry-properties (point)))
+           (definite
+             (cond
+              ((assoc "DECLINE_DEFINITE" props)
+               (propertize (if (org-entry-get (point) "DECLINE_DEFINITE")
+                               "definite" "indefinite")
+                           'face 'warning))
+              (t nil)))
+           (plural
+            (cond
+             ((assoc "DECLINE_PLURAL" props)
+              (propertize (if (org-entry-get (point) "DECLINE_PLURAL")
+                              "plural" "singular")
+                          'face 'warning))
+             (t nil))))
+      (org-drill-present-card-using-text
+       (cond
+        ((zerop (random* 2))
+         (format "\nTranslate the noun\n\n%s (%s)\n\nand list its declensions%s.\n\n"
+                 noun noun-gender
+                 (if (or plural definite)
+                     (format " for the %s %s form" definite plural)
+                   "")))
+        (t
+         (format "\nGive the noun that means\n\n%s %s\n
+and list its declensions%s.\n\n"
+                 translation
+                 (if noun-hint (format "  [HINT: %s]" noun-hint) "")
+                 (if (or plural definite)
+                     (format " for the %s %s form" definite plural)
+                   ""))))))))
+
+
+(defun org-drill-show-answer-noun-declension (reschedule-fn)
+  "Show the answer for a drill item whose card type is 'decline_noun'.
+RESCHEDULE-FN must be a function that calls `org-drill-reschedule' and
+returns its return value."
+  (destructuring-bind (noun noun-root noun-gender noun-hint translation)
+      (org-drill-get-noun-info)
+    (with-replaced-entry-heading
+     (format "Declensions of %s (%s) ==> %s\n\n"
+             noun noun-gender translation)
+     (org-cycle-hide-drawers 'all)
      (funcall reschedule-fn))))
      (funcall reschedule-fn))))
 
 
 
 
 ;;; `translate_number' card type ==============================================
 ;;; `translate_number' card type ==============================================
 ;;; See spanish.org for usage
 ;;; See spanish.org for usage
 
 
-(defvar *drilled-number* 0)
-(defvar *drilled-number-direction* 'to-english)
+
+(defun spelln-integer-in-language (n lang)
+  (let ((spelln-language lang))
+    (spelln-integer-in-words n)))
 
 
 (defun org-drill-present-translate-number ()
 (defun org-drill-present-translate-number ()
   (let ((num-min (read (org-entry-get (point) "DRILL_NUMBER_MIN")))
   (let ((num-min (read (org-entry-get (point) "DRILL_NUMBER_MIN")))
         (num-max (read (org-entry-get (point) "DRILL_NUMBER_MAX")))
         (num-max (read (org-entry-get (point) "DRILL_NUMBER_MAX")))
         (language (read (org-entry-get (point) "DRILL_LANGUAGE" t)))
         (language (read (org-entry-get (point) "DRILL_LANGUAGE" t)))
+        (drilled-number 0)
+        (drilled-number-direction 'to-english)
         (highlight-face 'font-lock-warning-face))
         (highlight-face 'font-lock-warning-face))
     (cond
     (cond
      ((not (fboundp 'spelln-integer-in-words))
      ((not (fboundp 'spelln-integer-in-words))
@@ -2908,46 +3057,49 @@ returns its return value."
       (if (> num-min num-max)
       (if (> num-min num-max)
           (psetf num-min num-max
           (psetf num-min num-max
                  num-max num-min))
                  num-max num-min))
-      (setq *drilled-number*
+      (setq drilled-number
             (+ num-min (random* (abs (1+ (- num-max num-min))))))
             (+ num-min (random* (abs (1+ (- num-max num-min))))))
-      (setq *drilled-number-direction*
+      (setq drilled-number-direction
             (if (zerop (random* 2)) 'from-english 'to-english))
             (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)))
+      (cond
+       ((eql 'to-english drilled-number-direction)
+        (org-drill-present-card-using-text
+         (format "\nTranslate into English:\n\n%s\n"
+                 (propertize
+                  (spelln-integer-in-language drilled-number language)
+                  'face highlight-face))
+         (spelln-integer-in-language drilled-number 'english-gb)))
+       (t
+        (org-drill-present-card-using-text
          (format "\nTranslate into %s:\n\n%s\n"
          (format "\nTranslate into %s:\n\n%s\n"
                  (capitalize (format "%s" language))
                  (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))))
+                 (propertize
+                  (spelln-integer-in-language drilled-number 'english-gb)
+                  'face highlight-face))
+         (spelln-integer-in-language drilled-number language))))))))
+
+
+;; (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 ==================================================
 ;;; `spanish_verb' card type ==================================================