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

This commit is contained in:
Paul Sexton 2012-05-05 08:09:22 +12:00
parent 6a38c1fac3
commit 5412883c1d
1 changed files with 176 additions and 77 deletions

View File

@ -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."
(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)))
(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)))))
@ -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)
(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 tense.\n\n"
infinitive tense))
(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 tense.\n\n"
and conjugate for the %s.\n\n"
translation
(if inf-hint (format " [HINT: %s]" inf-hint) "")
tense))))))
(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)