forked from mirrors/org-mode
org-drill: prevent errors caused by attempting to display inline images on a non-graphical display.
This commit is contained in:
Paul Sexton
parent
6a38c1fac3
commit
5412883c1d
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue