org-drill: prevent errors caused by attempting to display inline images on a non-graphical display.

contrib/lisp/org-drill.el

@@ -1,28 +1,28 @@
-;; -*- coding: utf-8-unix -*-
-;; org-drill.el - Self-testing using spaced repetition
-;;
-;; Author: Paul Sexton <eeeickythump@gmail.com>
-;; Version: 2.3.5
-;; Repository at http://bitbucket.org/eeeickythump/org-drill/
-;;
-;; This file is not part of GNU Emacs.
-;;
-;; Synopsis
-;; ========
-;;
-;; Uses the SuperMemo spaced repetition algorithms to conduct interactive
-;; "drill sessions", where the material to be remembered is presented to the
-;; student in random order. The student rates his or her recall of each item,
-;; and this information is used to schedule the item for later revision.
-;;
-;; Each drill session can be restricted to topics in the current buffer
-;; (default), one or several files, all agenda files, or a subtree. A single
-;; topic can also be drilled.
-;;
-;; Different "card types" can be defined, which present their information to
-;; the student in different ways.
-;;
-;; See the file README.org in the repository for more detailed documentation.
+;;; -*- coding: utf-8-unix -*-
+;;; org-drill.el - Self-testing using spaced repetition
+;;;
+;;; Author: Paul Sexton <eeeickythump@gmail.com>
+;;; Version: 2.3.6
+;;; Repository at http://bitbucket.org/eeeickythump/org-drill/
+;;;
+;;;
+;;; Synopsis
+;;; ========
+;;;
+;;; Uses the SuperMemo spaced repetition algorithms to conduct interactive
+;;; "drill sessions", where the material to be remembered is presented to the
+;;; student in random order. The student rates his or her recall of each item,
+;;; and this information is used to schedule the item for later revision.
+;;;
+;;; Each drill session can be restricted to topics in the current buffer
+;;; (default), one or several files, all agenda files, or a subtree. A single
+;;; topic can also be drilled.
+;;;
+;;; Different "card types" can be defined, which present their information to
+;;; the student in different ways.
+;;;
+;;; See the file README.org for more detailed documentation.
+
 
 (eval-when-compile (require 'cl))
 (eval-when-compile (require 'hi-lock))
@@ -37,6 +37,7 @@
   :group 'org-link)
 
 
+
 (defcustom org-drill-question-tag
   "drill"
   "Tag which topics must possess in order to be identified as review topics
@@ -53,6 +54,7 @@ Nil means unlimited."
   :type '(choice integer (const nil)))
 
 
+
 (defcustom org-drill-maximum-duration
   20
   "Maximum duration of a drill session, in minutes.
@@ -105,7 +107,7 @@ Possible values:
   but a warning message is printed when each leech item is
   presented."
   :group 'org-drill
-  :type '(choice (const warn) (const skip) (const nil)))
+  :type '(choice (const 'warn) (const 'skip) (const nil)))
 
 
 (defface org-drill-visible-cloze-face
@@ -260,9 +262,9 @@ directory            All files with the extension '.org' in the same
   ;; 'file-no-restriction' means current file/buffer, ignoring restrictions
   ;; 'directory' means all *.org files in current directory
   :group 'org-drill
-  :type '(choice (const file) (const tree) (const file-no-restriction)
-                 (const file-with-archives) (const agenda)
-                 (const agenda-with-archives) (const directory)
+  :type '(choice (const 'file) (const 'tree) (const 'file-no-restriction)
+                 (const 'file-with-archives) (const 'agenda)
+                 (const 'agenda-with-archives) (const 'directory)
                  list))
 
 
@@ -288,7 +290,7 @@ Available choices are:
   adjusting intervals when items are reviewed early or late has been taken
   from SM11, a later version of the algorithm, and included in Simple8."
   :group 'org-drill
-  :type '(choice (const sm2) (const sm5) (const simple8)))
+  :type '(choice (const 'sm2) (const 'sm5) (const 'simple8)))
 
 
 (defcustom org-drill-optimal-factor-matrix
@@ -619,7 +621,7 @@ situation use `org-part-of-drill-entry-p'."
 
 
 (defun org-drill-goto-entry (marker)
-  (org-pop-to-buffer-same-window (marker-buffer marker))
+  (switch-to-buffer (marker-buffer marker))
   (goto-char marker))
 
 
@@ -1507,18 +1509,38 @@ concealed by an overlay that displays the string TEXT."
        (org-drill-unreplace-entry-text))))
 
 
-(defun org-drill-replace-entry-text (text)
+(defmacro with-replaced-entry-text-multi (replacements &rest body)
+  "During the execution of BODY, the entire text of the current entry is
+concealed by an overlay that displays the overlays in REPLACEMENTS."
+  `(progn
+     (org-drill-replace-entry-text ,replacements t)
+     (unwind-protect
+         (progn
+           ,@body)
+       (org-drill-unreplace-entry-text))))
+
+
+(defun org-drill-replace-entry-text (text &optional multi-p)
   "Make an overlay that conceals the entire text of the item, not
 including properties or the contents of subheadings. The overlay shows
 the string TEXT.
+If MULTI-P is non-nil, TEXT must be a list of values which are legal
+for the `display' text property. The text of the item will be temporarily
+replaced by all of these items, in the order in which they appear in
+the list.
 Note: does not actually alter the item."
-  (let ((ovl (make-overlay (point-min)
-                           (save-excursion
-                             (outline-next-heading)
-                             (point)))))
-    (overlay-put ovl 'category
-                 'org-drill-replaced-text-overlay)
-    (overlay-put ovl 'display text)))
+  (cond
+   ((and multi-p
+         (listp text))
+    (org-drill-replace-entry-text-multi text))
+   (t
+    (let ((ovl (make-overlay (point-min)
+                             (save-excursion
+                               (outline-next-heading)
+                               (point)))))
+      (overlay-put ovl 'category
+                   'org-drill-replaced-text-overlay)
+      (overlay-put ovl 'display text)))))
 
 
 (defun org-drill-unreplace-entry-text ()
@@ -1528,6 +1550,27 @@ Note: does not actually alter the item."
         (delete-overlay ovl)))))
 
 
+(defun org-drill-replace-entry-text-multi (replacements)
+  "Make overlays that conceal the entire text of the item, not
+including properties or the contents of subheadings. The overlay shows
+the string TEXT.
+Note: does not actually alter the item."
+  (let ((ovl nil)
+        (p-min (point-min))
+        (p-max (save-excursion
+                 (outline-next-heading)
+                 (point))))
+    (assert (>= (- p-max p-min) (length replacements)))
+    (dotimes (i (length replacements))
+      (setq ovl (make-overlay (+ p-min (* 2 i))
+                              (if (= i (1- (length replacements)))
+                                  p-max
+                                (+ p-min (* 2 i) 1))))
+      (overlay-put ovl 'category
+                   'org-drill-replaced-text-overlay)
+      (overlay-put ovl 'display (nth i replacements)))))
+
+
 (defmacro with-replaced-entry-heading (heading &rest body)
   `(progn
      (org-drill-replace-entry-heading ,heading)
@@ -1577,7 +1620,8 @@ Note: does not actually alter the item."
    (with-hidden-cloze-hints
     (with-hidden-cloze-text
      (org-drill-hide-all-subheadings-except nil)
-     (org-display-inline-images t)
+     (ignore-errors
+       (org-display-inline-images t))
      (org-cycle-hide-drawers 'all)
      (prog1 (org-drill-presentation-prompt)
        (org-drill-hide-subheadings-if 'org-drill-entry-p))))))
@@ -1586,6 +1630,8 @@ 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)))
 
@@ -1600,7 +1646,8 @@ Note: does not actually alter the item."
            (goto-char (nth (random* (min 2 (length drill-sections)))
                            drill-sections))
            (org-show-subtree)))
-       (org-display-inline-images t)
+       (ignore-errors
+         (org-display-inline-images t))
        (org-cycle-hide-drawers 'all)
        (prog1 (org-drill-presentation-prompt)
          (org-drill-hide-subheadings-if 'org-drill-entry-p)))))))
@@ -1616,7 +1663,8 @@ Note: does not actually alter the item."
          (save-excursion
            (goto-char (nth (random* (length drill-sections)) drill-sections))
            (org-show-subtree)))
-       (org-display-inline-images t)
+       (ignore-errors
+         (org-display-inline-images t))
        (org-cycle-hide-drawers 'all)
        (prog1 (org-drill-presentation-prompt)
          (org-drill-hide-subheadings-if 'org-drill-entry-p)))))))
@@ -1694,7 +1742,8 @@ items if FORCE-SHOW-FIRST or FORCE-SHOW-LAST is non-nil)."
       ;;  while (org-pos-in-regexp (match-beginning 0)
       ;;                           org-bracket-link-regexp 1))
       ;; (org-drill-hide-matched-cloze-text)))))
-      (org-display-inline-images t)
+      (ignore-errors
+        (org-display-inline-images t))
       (org-cycle-hide-drawers 'all)
       (prog1 (org-drill-presentation-prompt)
         (org-drill-hide-subheadings-if 'org-drill-entry-p)
@@ -1741,7 +1790,8 @@ the second to last, etc."
               (incf cnt)
               (if (= cnt to-hide)
                   (org-drill-hide-matched-cloze-text)))))))
-      (org-display-inline-images t)
+      (ignore-errors
+        (org-display-inline-images t))
       (org-cycle-hide-drawers 'all)
       (prog1 (org-drill-presentation-prompt)
         (org-drill-hide-subheadings-if 'org-drill-entry-p)
@@ -1905,6 +1955,23 @@ pieces rather than one."
     question
     (org-drill-hide-all-subheadings-except nil)
     (org-cycle-hide-drawers 'all)
+    (ignore-errors
+      (org-display-inline-images t))
+    (prog1 (org-drill-presentation-prompt)
+      (org-drill-hide-subheadings-if 'org-drill-entry-p)))))
+
+
+(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."
+  (with-hidden-comments
+   (with-replaced-entry-text-multi
+    replacements
+    (org-drill-hide-all-subheadings-except nil)
+    (org-cycle-hide-drawers 'all)
+    (ignore-errors
+      (org-display-inline-images t))
     (prog1 (org-drill-presentation-prompt)
       (org-drill-hide-subheadings-if 'org-drill-entry-p)))))
 
@@ -2356,12 +2423,12 @@ than starting a new one."
                 (org-map-drill-entries
                  (lambda ()
                    (org-drill-progress-message
-                              (+ (length *org-drill-new-entries*)
-                                 (length *org-drill-overdue-entries*)
-                                 (length *org-drill-young-mature-entries*)
-                                 (length *org-drill-old-mature-entries*)
-                                 (length *org-drill-failed-entries*))
-                              (incf cnt))
+                    (+ (length *org-drill-new-entries*)
+                       (length *org-drill-overdue-entries*)
+                       (length *org-drill-young-mature-entries*)
+                       (length *org-drill-old-mature-entries*)
+                       (length *org-drill-failed-entries*))
+                    (incf cnt))
                    (cond
                     ((not (org-drill-entry-p))
                      nil)               ; skip
@@ -2448,7 +2515,9 @@ than starting a new one."
     (cond
      (end-pos
       (when (markerp end-pos)
-        (org-drill-goto-entry end-pos))
+        (org-drill-goto-entry end-pos)
+        (org-reveal)
+        (org-show-entry))
       (let ((keystr (command-keybinding-to-string 'org-drill-resume)))
         (message
          "You can continue the drill session with the command `org-drill-resume'.%s"
@@ -2600,7 +2669,7 @@ the tag 'imported'."
           (unless path
             (setq path (org-get-outline-path)))
           (org-copy-subtree)
-          (org-pop-to-buffer-same-window dest)
+          (switch-to-buffer dest)
           (setq m
                 (condition-case nil
                     (org-find-olp path t)
@@ -2682,7 +2751,7 @@ copy them across."
                        scheduled-time (org-get-scheduled-time (point)))
                  (save-excursion
                    ;; go to matching entry in destination buffer
-                   (org-pop-to-buffer-same-window (marker-buffer marker))
+                   (switch-to-buffer (marker-buffer marker))
                    (goto-char marker)
                    (org-drill-strip-entry-data)
                    (unless (zerop total-repeats)
@@ -2738,7 +2807,14 @@ copy them across."
     ("imperfect" "darkturquoise")
     ("present perfect" "royalblue")
     ;; future tenses
-    ("future" "green"))
+    ("future" "green")
+    ;; moods (backgrounds).
+    ("indicative" nil)                  ; default
+    ("subjunctive" "medium blue")
+    ("conditional" "grey30")
+    ("negative imperative" "red4")
+    ("positive imperative" "darkgreen")
+    )
   "Alist where each entry has the form (TENSE COLOUR), where
 TENSE is a string naming a tense in which verbs can be
 conjugated, and COLOUR is a string specifying a foreground colour
@@ -2754,50 +2830,72 @@ the name of the tense.")
         (inf-hint (org-entry-get (point) "VERB_INFINITIVE_HINT" t))
         (translation (org-entry-get (point) "VERB_TRANSLATION" t))
         (tense (org-entry-get (point) "VERB_TENSE" nil))
+        (mood (org-entry-get (point) "VERB_MOOD" nil))
         (highlight-face nil))
-    (unless (and infinitive translation tense)
-      (error "Missing information for verb conjugation card (%s, %s, %s) at %s"
-             infinitive translation tense (point)))
-    (setq tense (downcase (car (read-from-string tense)))
+    (unless (and infinitive translation (or tense mood))
+      (error "Missing information for verb conjugation card (%s, %s, %s, %s) at %s"
+             infinitive translation tense mood (point)))
+    (setq tense (if tense (downcase (car (read-from-string tense))))
+          mood (if mood (downcase (car (read-from-string mood))))
           infinitive (car (read-from-string infinitive))
           inf-hint (if inf-hint (car (read-from-string inf-hint)))
           translation (car (read-from-string translation)))
     (setq highlight-face
           (list :foreground
                 (or (second (assoc-string tense org-drill-verb-tense-alist t))
-                    "red")))
+                    "hotpink")
+                :background
+                (second (assoc-string mood org-drill-verb-tense-alist t))))
     (setq infinitive (propertize infinitive 'face highlight-face))
     (setq translation (propertize translation 'face highlight-face))
-    (setq tense (propertize tense 'face highlight-face))
-    (list infinitive inf-hint translation tense)))
+    (if tense (setq tense (propertize tense 'face highlight-face)))
+    (if mood (setq mood (propertize mood 'face highlight-face)))
+    (list infinitive inf-hint translation tense mood)))
 
 
 (defun org-drill-present-verb-conjugation ()
   "Present a drill entry whose card type is 'conjugate'."
-  (destructuring-bind (infinitive inf-hint translation tense)
-      (org-drill-get-verb-conjugation-info)
-    (org-drill-present-card-using-text
-     (cond
-      ((zerop (random* 2))
-       (format "\nTranslate the verb\n\n%s\n\nand conjugate for the %s tense.\n\n"
-               infinitive tense))
-      (t
-       (format "\nGive the verb that means\n\n%s %s\n
-and conjugate for the %s tense.\n\n"
-               translation
-               (if inf-hint (format "  [HINT: %s]" inf-hint) "")
-               tense))))))
+  (flet ((tense-and-mood-to-string
+          (tense mood)
+          (cond
+           ((and tense mood)
+            (format "%s tense, %s mood" tense mood))
+           (tense
+            (format "%s tense" tense))
+           (mood
+            (format "%s mood" mood)))))
+    (destructuring-bind (infinitive inf-hint translation tense mood)
+        (org-drill-get-verb-conjugation-info)
+      (org-drill-present-card-using-text
+       (cond
+        ((zerop (random* 2))
+         (format "\nTranslate the verb\n\n%s\n\nand conjugate for the %s.\n\n"
+                 infinitive (tense-and-mood-to-string tense mood)))
+
+        (t
+         (format "\nGive the verb that means\n\n%s %s\n
+and conjugate for the %s.\n\n"
+                 translation
+                 (if inf-hint (format "  [HINT: %s]" inf-hint) "")
+                 (tense-and-mood-to-string tense mood))))))))
 
 
 (defun org-drill-show-answer-verb-conjugation (reschedule-fn)
   "Show the answer for a drill item whose card type is 'conjugate'.
 RESCHEDULE-FN must be a function that calls `org-drill-reschedule' and
 returns its return value."
-  (destructuring-bind (infinitive inf-hint translation tense)
+  (destructuring-bind (infinitive inf-hint translation tense mood)
       (org-drill-get-verb-conjugation-info)
     (with-replaced-entry-heading
-     (format "%s tense of %s ==> %s\n\n"
-             (capitalize tense)
+     (format "%s of %s ==> %s\n\n"
+             (capitalize
+              (cond
+               ((and tense mood)
+                (format "%s tense, %s mood" tense mood))
+               (tense
+                (format "%s tense" tense))
+               (mood
+                (format "%s mood" mood))))
              infinitive translation)
      (funcall reschedule-fn))))
 
@@ -2915,3 +3013,4 @@ returns its return value."
 
 
 (provide 'org-drill)
+