diff --git a/contrib/lisp/org-drill.el b/contrib/lisp/org-drill.el index 4adaf5833..7d3217644 100644 --- a/contrib/lisp/org-drill.el +++ b/contrib/lisp/org-drill.el @@ -1,28 +1,28 @@ -;; -*- coding: utf-8-unix -*- -;; org-drill.el - Self-testing using spaced repetition -;; -;; Author: Paul Sexton -;; 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 +;;; 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) +