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

Thanks to Paul Sexton for maintaining org-drill.el!

1 files changed, 311 insertions, 159 deletions

diff --git a/contrib/lisp/org-drill.el b/contrib/lisp/org-drill.el
index 2ffc201..5d8569d 100644
--- a/contrib/lisp/org-drill.el
+++ b/contrib/lisp/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/
 ;;;
 ;;;
@@ -188,11 +188,16 @@ during a drill session."
                     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
-  ;; 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
@@ -204,39 +209,51 @@ during a drill session."
 
 
 (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)
-    ("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
-  :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
@@ -419,6 +436,17 @@ exponential effect on inter-repetition spacing."
   :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-start-time* 0)
 (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))
       (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)
@@ -1361,9 +1390,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)
@@ -1438,7 +1471,7 @@ visual overlay, or with the string TEXT if it is supplied."
 
 (defun org-drill-hide-heading-at-point (&optional text)
   (unless (org-at-heading-p)
-    (error "Point is not on a heading"))
+    (error "Point is not on a heading."))
   (save-excursion
     (let ((beg (point)))
       (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 ()
   "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
                  'org-drill-cloze-overlay-defaults)
-    (when (find ?| (match-string 0))
+    (when (and hint-sep-pos
+               (> hint-sep-pos 1))
       (let ((hint (substring-no-properties
                    (match-string 0)
-                   (1+ (position ?| (match-string 0)))
+                   (+ hint-sep-pos (length org-drill-hint-separator))
                    (1- (length (match-string 0))))))
         (overlay-put
          ovl 'display
          ;; If hint is like `X...' then display [X...]
          ;; otherwise display [...X]
-         (format (if (string-match-p "\\.\\.\\." hint) "[%s]" "[%s...]")
+         (format (if (string-match-p (regexp-quote "...") hint) "[%s]" "[%s...]")
                  hint))))))
 
 
@@ -1601,13 +1637,24 @@ 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 ====================================================
-
+;;
 ;; 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
@@ -1628,12 +1675,21 @@ Note: does not actually alter the item."
 
 
 (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 ()
@@ -1949,10 +2005,12 @@ pieces rather than one."
 
 
 (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-replaced-entry-text
-    question
+    (concat "\n" question)
     (org-drill-hide-all-subheadings-except nil)
     (org-cycle-hide-drawers 'all)
     (ignore-errors
@@ -1964,7 +2022,9 @@ pieces rather than one."
 (defun org-drill-present-card-using-multiple-overlays (replacements &optional answer)
   "TEXTS is a list of valid values for the 'display' text property.
 Present these overlays, in sequence, as the only
-visible content of the card."
+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-replaced-entry-text-multi
     replacements
@@ -1995,20 +2055,24 @@ 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.
         (outline-view-change-hook nil))
+    (setq drill-answer nil)
     (org-save-outline-visibility t
       (save-restriction
         (org-narrow-to-subtree)
         (org-show-subtree)
         (org-cycle-hide-drawers 'all)
 
-        (let ((presentation-fn (cdr (assoc card-type org-drill-card-type-alist))))
+        (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)
@@ -2034,6 +2098,7 @@ See `org-drill' for more details."
 
 (defun org-drill-entries-pending-p ()
   (or *org-drill-again-entries*
+      *org-drill-current-item*
       (and (not (org-drill-maximum-item-count-reached-p))
            (not (org-drill-maximum-duration-reached-p))
            (or *org-drill-new-entries*
@@ -2045,7 +2110,8 @@ See `org-drill' for more details."
 
 
 (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-young-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
 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))))
@@ -2066,6 +2133,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)))
 
@@ -2157,6 +2225,7 @@ RESUMING-P is true if we are resuming a suspended drill session."
               (setq end-pos (point-marker))
               (return-from org-drill-entries nil))
              ((eql result 'skip)
+              (setq *org-drill-current-item* nil)
               nil)                      ; skip this item
              (t
               (cond
@@ -2166,7 +2235,8 @@ RESUMING-P is true if we are resuming a suspended drill session."
                           (shuffle-list *org-drill-again-entries*)))
                 (push-end m *org-drill-again-entries*))
                (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))
                                  *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.
@@ -2305,8 +2376,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)
@@ -2446,47 +2523,16 @@ 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)
-                ;; (let ((due (org-drill-entry-days-overdue))
-                ;;       (last-int (org-drill-entry-last-interval 1)))
-                ;;   (cond
-                ;;    ((org-drill-entry-empty-p)
-                ;;     nil)           ; skip -- item body is empty
-                ;;    ((or (null due) ; unscheduled - usually a skipped leech
-                ;;         (minusp due)) ; scheduled in the future
-                ;;     (incf *org-drill-dormant-entry-count*)
-                ;;     (if (eq -1 due)
-                ;;         (incf *org-drill-due-tomorrow-count*)))
-                ;;    ((org-drill-entry-new-p)
-                ;;     (push (point-marker) *org-drill-new-entries*))
-                ;;    ((<= (org-drill-entry-last-quality 9999)
-                ;;         org-drill-failure-quality)
-                ;;     ;; Mature entries that were failed last time are
-                ;;     ;; FAILED, regardless of how young, old or overdue
-                ;;     ;; they are.
-                ;;     (push (point-marker) *org-drill-failed-entries*))
-                ;;    ((org-drill-entry-overdue-p due last-int)
-                ;;     ;; Overdue status overrides young versus old
-                ;;     ;; distinction.
-                ;;     ;; Store marker + due, for sorting of overdue entries
-                ;;     (push (cons (point-marker) due) overdue-data))
-                ;;    ((<= (org-drill-entry-last-interval 9999)
-                ;;         org-drill-days-before-old)
-                ;;     ;; Item is 'young'.
-                ;;     (push (point-marker)
-                ;;           *org-drill-young-mature-entries*))
-                ;;    (t
-                ;;     (push (point-marker)
-                ;;           *org-drill-old-mature-entries*))))
-                ;; Order 'overdue' items so that the most overdue will tend to
-                ;; come up for review first, while keeping exact order random
                 (org-drill-order-overdue-entries overdue-data)
                 (setq *org-drill-overdue-entry-count*
                       (length *org-drill-overdue-entries*))))
             (setq *org-drill-due-entry-count* (org-drill-pending-entry-count))
             (cond
-             ((and (null *org-drill-new-entries*)
+             ((and (null *org-drill-current-item*)
+                   (null *org-drill-new-entries*)
                    (null *org-drill-failed-entries*)
                    (null *org-drill-overdue-entries*)
                    (null *org-drill-young-mature-entries*)
@@ -2497,6 +2543,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
@@ -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'
 hours."
   (interactive)
-  (let ((*org-drill-cram-mode* t))
-    (org-drill scope)))
+  (setq *org-drill-cram-mode* t)
+  (org-drill scope))
 
 
 (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
 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*)
@@ -2883,19 +2931,120 @@ returns its return value."
                (mood
                 (format "%s mood" mood))))
              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))))
 
 
 ;;; `translate_number' card type ==============================================
 ;;; 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 ()
   (let ((num-min (read (org-entry-get (point) "DRILL_NUMBER_MIN")))
         (num-max (read (org-entry-get (point) "DRILL_NUMBER_MAX")))
         (language (read (org-entry-get (point) "DRILL_LANGUAGE" t)))
+        (drilled-number 0)
+        (drilled-number-direction 'to-english)
         (highlight-face 'font-lock-warning-face))
     (cond
      ((not (fboundp 'spelln-integer-in-words))
@@ -2908,46 +3057,49 @@ returns its return value."
       (if (> num-min num-max)
           (psetf num-min num-max
                  num-max num-min))
-      (setq *drilled-number*
+      (setq drilled-number
             (+ 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))
-      (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"
                  (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 ==================================================