summaryrefslogtreecommitdiff
path: root/contrib/lisp/org-drill.el
diff options
context:
space:
mode:
authorSébastien Delafond <sdelafond@gmail.com>2014-07-13 13:35:27 +0200
committerSébastien Delafond <sdelafond@gmail.com>2014-07-13 13:35:27 +0200
commite32a45ed36d6000db4b39171149072d11b77af72 (patch)
treeb5f4a7d43022c08c3298e82b3e9fc50f68be660f /contrib/lisp/org-drill.el
parent7697fa4daf3ec84f85711a84035d8f0224afd4e3 (diff)
Imported Upstream version 8.0.7
Diffstat (limited to 'contrib/lisp/org-drill.el')
-rw-r--r--contrib/lisp/org-drill.el756
1 files changed, 372 insertions, 384 deletions
diff --git a/contrib/lisp/org-drill.el b/contrib/lisp/org-drill.el
index 2ffc201..5bf6dd4 100644
--- a/contrib/lisp/org-drill.el
+++ b/contrib/lisp/org-drill.el
@@ -1,28 +1,42 @@
-;;; -*- coding: utf-8-unix -*-
+;; -*- 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/
+;; Author: Paul Sexton <eeeickythump@gmail.com>
+;; Version: 2.3.7
+;; Repository at http://bitbucket.org/eeeickythump/org-drill/
+;;
+;; This file is not part of GNU Emacs.
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary and synopsis:
;;;
-;;;
-;;; 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.
-
+;; 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.
+;;
+;;; Code:
(eval-when-compile (require 'cl))
(eval-when-compile (require 'hi-lock))
@@ -30,41 +44,30 @@
(require 'org-id)
(require 'org-learn)
-
(defgroup org-drill nil
"Options concerning interactive drill sessions in Org mode (org-drill)."
:tag "Org-Drill"
:group 'org-link)
-
-
-(defcustom org-drill-question-tag
- "drill"
+(defcustom org-drill-question-tag "drill"
"Tag which topics must possess in order to be identified as review topics
by `org-drill'."
:group 'org-drill
:type 'string)
-
-(defcustom org-drill-maximum-items-per-session
- 30
+(defcustom org-drill-maximum-items-per-session 30
"Each drill session will present at most this many topics for review.
Nil means unlimited."
:group 'org-drill
:type '(choice integer (const nil)))
-
-
-(defcustom org-drill-maximum-duration
- 20
+(defcustom org-drill-maximum-duration 20
"Maximum duration of a drill session, in minutes.
Nil means unlimited."
:group 'org-drill
:type '(choice integer (const nil)))
-
-(defcustom org-drill-failure-quality
- 2
+(defcustom org-drill-failure-quality 2
"If the quality of recall for an item is this number or lower,
it is regarded as an unambiguous failure, and the repetition
interval for the card is reset to 0 days. If the quality is higher
@@ -78,9 +81,7 @@ really sensible."
:group 'org-drill
:type '(choice (const 2) (const 1)))
-
-(defcustom org-drill-forgetting-index
- 10
+(defcustom org-drill-forgetting-index 10
"What percentage of items do you consider it is 'acceptable' to
forget each drill session? The default is 10%. A warning message
is displayed at the end of the session if the percentage forgotten
@@ -88,17 +89,13 @@ climbs above this number."
:group 'org-drill
:type 'integer)
-
-(defcustom org-drill-leech-failure-threshold
- 15
+(defcustom org-drill-leech-failure-threshold 15
"If an item is forgotten more than this many times, it is tagged
as a 'leech' item."
:group 'org-drill
:type '(choice integer (const nil)))
-
-(defcustom org-drill-leech-method
- 'skip
+(defcustom org-drill-leech-method 'skip
"How should 'leech items' be handled during drill sessions?
Possible values:
- nil :: Leech items are treated the same as normal items.
@@ -109,71 +106,58 @@ Possible values:
:group 'org-drill
:type '(choice (const 'warn) (const 'skip) (const nil)))
-
(defface org-drill-visible-cloze-face
'((t (:foreground "darkseagreen")))
"The face used to hide the contents of cloze phrases."
:group 'org-drill)
-
(defface org-drill-visible-cloze-hint-face
'((t (:foreground "dark slate blue")))
"The face used to hide the contents of cloze phrases."
:group 'org-drill)
-
(defface org-drill-hidden-cloze-face
'((t (:foreground "deep sky blue" :background "blue")))
"The face used to hide the contents of cloze phrases."
:group 'org-drill)
-
-(defcustom org-drill-use-visible-cloze-face-p
- nil
+(defcustom org-drill-use-visible-cloze-face-p nil
"Use a special face to highlight cloze-deleted text in org mode
buffers?"
:group 'org-drill
:type 'boolean)
-
-(defcustom org-drill-hide-item-headings-p
- nil
+(defcustom org-drill-hide-item-headings-p nil
"Conceal the contents of the main heading of each item during drill
sessions? You may want to enable this behaviour if item headings or tags
contain information that could 'give away' the answer."
:group 'org-drill
:type 'boolean)
-
-(defcustom org-drill-new-count-color
- "royal blue"
+(defcustom org-drill-new-count-color "royal blue"
"Foreground colour used to display the count of remaining new items
during a drill session."
:group 'org-drill
:type 'color)
-(defcustom org-drill-mature-count-color
- "green"
+(defcustom org-drill-mature-count-color "green"
"Foreground colour used to display the count of remaining mature items
during a drill session. Mature items are due for review, but are not new."
:group 'org-drill
:type 'color)
-(defcustom org-drill-failed-count-color
- "red"
+(defcustom org-drill-failed-count-color "red"
"Foreground colour used to display the count of remaining failed items
during a drill session."
:group 'org-drill
:type 'color)
-(defcustom org-drill-done-count-color
- "sienna"
+(defcustom org-drill-done-count-color "sienna"
"Foreground colour used to display the count of reviewed items
during a drill session."
:group 'org-drill
:type 'color)
-
(setplist 'org-drill-cloze-overlay-defaults
'(display "[...]"
face org-drill-hidden-cloze-face
@@ -187,60 +171,70 @@ during a drill session."
face default
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
`((,org-drill-cloze-regexp
(1 'org-drill-visible-cloze-face nil)
(2 'org-drill-visible-cloze-hint-face t)
- (3 'org-drill-visible-cloze-face nil)
- )))
-
+ (3 'org-drill-visible-cloze-face nil))))
(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
- 'file
+(defcustom org-drill-scope 'file
"The scope in which to search for drill items when conducting a
drill session. This can be any of:
@@ -267,17 +261,13 @@ directory All files with the extension '.org' in the same
(const 'agenda-with-archives) (const 'directory)
list))
-
-(defcustom org-drill-save-buffers-after-drill-sessions-p
- t
+(defcustom org-drill-save-buffers-after-drill-sessions-p t
"If non-nil, prompt to save all modified buffers after a drill session
finishes."
:group 'org-drill
:type 'boolean)
-
-(defcustom org-drill-spaced-repetition-algorithm
- 'sm5
+(defcustom org-drill-spaced-repetition-algorithm 'sm5
"Which SuperMemo spaced repetition algorithm to use for scheduling items.
Available choices are:
- SM2 :: the SM2 algorithm, used in SuperMemo 2.0
@@ -292,9 +282,7 @@ Available choices are:
:group 'org-drill
:type '(choice (const 'sm2) (const 'sm5) (const 'simple8)))
-
-(defcustom org-drill-optimal-factor-matrix
- nil
+(defcustom org-drill-optimal-factor-matrix nil
"DO NOT CHANGE THE VALUE OF THIS VARIABLE.
Persistent matrix of optimal factors, used by the SuperMemo SM5 algorithm.
@@ -306,18 +294,14 @@ pace of learning."
:group 'org-drill
:type 'sexp)
-
-(defcustom org-drill-sm5-initial-interval
- 4.0
+(defcustom org-drill-sm5-initial-interval 4.0
"In the SM5 algorithm, the initial interval after the first
successful presentation of an item is always 4 days. If you wish to change
this, you can do so here."
:group 'org-drill
:type 'float)
-
-(defcustom org-drill-add-random-noise-to-intervals-p
- nil
+(defcustom org-drill-add-random-noise-to-intervals-p nil
"If true, the number of days until an item's next repetition
will vary slightly from the interval calculated by the SM2
algorithm. The variation is very small when the interval is
@@ -325,9 +309,7 @@ small, but scales up with the interval."
:group 'org-drill
:type 'boolean)
-
-(defcustom org-drill-adjust-intervals-for-early-and-late-repetitions-p
- nil
+(defcustom org-drill-adjust-intervals-for-early-and-late-repetitions-p nil
"If true, when the student successfully reviews an item 1 or more days
before or after the scheduled review date, this will affect that date of
the item's next scheduled review, according to the algorithm presented at
@@ -342,9 +324,7 @@ is used."
:group 'org-drill
:type 'boolean)
-
-(defcustom org-drill-cloze-text-weight
- 4
+(defcustom org-drill-cloze-text-weight 4
"For card types 'hide1_firstmore', 'show1_lastmore' and 'show1_firstless',
this number determines how often the 'less favoured' situation
should arise. It will occur 1 in every N trials, where N is the
@@ -363,15 +343,12 @@ all weighted card types are treated as their unweighted equivalents."
:group 'org-drill
:type '(choice integer (const nil)))
-
-(defcustom org-drill-cram-hours
- 12
+(defcustom org-drill-cram-hours 12
"When in cram mode, items are considered due for review if
they were reviewed at least this many hours ago."
:group 'org-drill
:type 'integer)
-
;;; NEW items have never been presented in a drill session before.
;;; MATURE items HAVE been presented at least once before.
;;; - YOUNG mature items were scheduled no more than
@@ -384,17 +361,13 @@ they were reviewed at least this many hours ago."
;;; LAST-INTERVAL * (ORG-DRILL-OVERDUE-INTERVAL-FACTOR - 1) days,
;;; regardless of young/old status.
-
-(defcustom org-drill-days-before-old
- 10
+(defcustom org-drill-days-before-old 10
"When an item's inter-repetition interval rises above this value in days,
it is no longer considered a 'young' (recently learned) item."
:group 'org-drill
:type 'integer)
-
-(defcustom org-drill-overdue-interval-factor
- 1.2
+(defcustom org-drill-overdue-interval-factor 1.2
"An item is considered overdue if its scheduled review date is
more than (ORG-DRILL-OVERDUE-INTERVAL-FACTOR - 1) * LAST-INTERVAL
days in the past. For example, a value of 1.2 means an additional
@@ -406,9 +379,7 @@ should never be less than 1.0."
:group 'org-drill
:type 'float)
-
-(defcustom org-drill-learn-fraction
- 0.5
+(defcustom org-drill-learn-fraction 0.5
"Fraction between 0 and 1 that governs how quickly the spaces
between successive repetitions increase, for all items. The
default value is 0.5. Higher values make spaces increase more
@@ -418,6 +389,15 @@ exponential effect on inter-repetition spacing."
:group 'org-drill
: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)
@@ -448,10 +428,8 @@ for review unless they were already reviewed in the recent past?")
"DRILL_TOTAL_REPEATS" "DRILL_FAILURE_COUNT" "DRILL_AVERAGE_QUALITY"
"DRILL_EASE" "DRILL_LAST_QUALITY" "DRILL_LAST_REVIEWED"))
-
;;; Make the above settings safe as file-local variables.
-
(put 'org-drill-question-tag 'safe-local-variable 'stringp)
(put 'org-drill-maximum-items-per-session 'safe-local-variable
'(lambda (val) (or (integerp val) (null val))))
@@ -480,14 +458,11 @@ for review unless they were already reviewed in the recent past?")
(put 'org-drill-cloze-text-weight 'safe-local-variable
'(lambda (val) (or (null val) (integerp val))))
-
;;;; Utilities ================================================================
-
(defun free-marker (m)
(set-marker m nil))
-
(defmacro pop-random (place)
(let ((idx (gensym)))
`(if (null ,place)
@@ -497,13 +472,11 @@ for review unless they were already reviewed in the recent past?")
(setq ,place (append (subseq ,place 0 ,idx)
(subseq ,place (1+ ,idx)))))))))
-
(defmacro push-end (val place)
"Add VAL to the end of the sequence stored in PLACE. Return the new
value."
`(setq ,place (append ,place (list ,val))))
-
(defun shuffle-list (list)
"Randomly permute the elements of LIST (all permutations equally likely)."
;; Adapted from 'shuffle-vector' in cookie1.el
@@ -519,27 +492,23 @@ value."
(setq i (1+ i))))
list)
-
(defun round-float (floatnum fix)
"Round the floating point number FLOATNUM to FIX decimal places.
Example: (round-float 3.56755765 3) -> 3.568"
(let ((n (expt 10 fix)))
(/ (float (round (* floatnum n))) n)))
-
(defun command-keybinding-to-string (cmd)
"Return a human-readable description of the key/keys to which the command
CMD is bound, or nil if it is not bound to a key."
(let ((key (where-is-internal cmd overriding-local-map t)))
(if key (key-description key))))
-
(defun time-to-inactive-org-timestamp (time)
(format-time-string
(concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]")
time))
-
(defun org-map-drill-entries (func &optional scope &rest skip)
"Like `org-map-entries', but only drill entries are processed."
(let ((org-drill-scope (or scope org-drill-scope)))
@@ -554,7 +523,6 @@ CMD is bound, or nil if it is not bound to a key."
(t org-drill-scope))
skip)))
-
(defmacro with-hidden-cloze-text (&rest body)
`(progn
(org-drill-hide-clozed-text)
@@ -563,7 +531,6 @@ CMD is bound, or nil if it is not bound to a key."
,@body)
(org-drill-unhide-clozed-text))))
-
(defmacro with-hidden-cloze-hints (&rest body)
`(progn
(org-drill-hide-cloze-hints)
@@ -572,7 +539,6 @@ CMD is bound, or nil if it is not bound to a key."
,@body)
(org-drill-unhide-text))))
-
(defmacro with-hidden-comments (&rest body)
`(progn
(if org-drill-hide-item-headings-p
@@ -583,7 +549,6 @@ CMD is bound, or nil if it is not bound to a key."
,@body)
(org-drill-unhide-text))))
-
(defun org-drill-days-since-last-review ()
"Nil means a last review date has not yet been stored for
the item.
@@ -597,7 +562,6 @@ this should never happen."
(time-to-days (apply 'encode-time
(org-parse-time-string datestr)))))))
-
(defun org-drill-hours-since-last-review ()
"Like `org-drill-days-since-last-review', but return value is
in hours rather than days."
@@ -609,7 +573,6 @@ in hours rather than days."
(org-parse-time-string datestr))))
(* 60 60))))))
-
(defun org-drill-entry-p (&optional marker)
"Is MARKER, or the point, in a 'drill item'? This will return nil if
the point is inside a subheading of a drill item -- to handle that
@@ -619,12 +582,10 @@ situation use `org-part-of-drill-entry-p'."
(org-drill-goto-entry marker))
(member org-drill-question-tag (org-get-local-tags))))
-
(defun org-drill-goto-entry (marker)
(switch-to-buffer (marker-buffer marker))
(goto-char marker))
-
(defun org-part-of-drill-entry-p ()
"Is the current entry either the main heading of a 'drill item',
or a subheading within a drill item?"
@@ -632,7 +593,6 @@ or a subheading within a drill item?"
;; Does this heading INHERIT the drill tag
(member org-drill-question-tag (org-get-tags-at))))
-
(defun org-drill-goto-drill-entry-heading ()
"Move the point to the heading which holds the :drill: tag for this
drill entry."
@@ -644,14 +604,11 @@ drill entry."
(unless (org-up-heading-safe)
(error "Cannot find a parent heading that is marked as a drill entry"))))
-
-
(defun org-drill-entry-leech-p ()
"Is the current entry a 'leech item'?"
(and (org-drill-entry-p)
(member "leech" (org-get-local-tags))))
-
;; (defun org-drill-entry-due-p ()
;; (cond
;; (*org-drill-cram-mode*
@@ -669,7 +626,6 @@ drill entry."
;; (- (time-to-days (current-time))
;; (time-to-days item-time))))))))))
-
(defun org-drill-entry-days-overdue ()
"Returns:
- NIL if the item is not to be regarded as scheduled for review at all.
@@ -699,7 +655,6 @@ drill entry."
(- (time-to-days (current-time))
(time-to-days item-time))))))))
-
(defun org-drill-entry-overdue-p (&optional days-overdue last-interval)
"Returns true if entry that is scheduled DAYS-OVERDUE dasy in the past,
and whose last inter-repetition interval was LAST-INTERVAL, should be
@@ -715,34 +670,28 @@ from the entry at point."
(> (/ (+ days-overdue last-interval 1.0) last-interval)
org-drill-overdue-interval-factor)))
-
-
(defun org-drill-entry-due-p ()
(let ((due (org-drill-entry-days-overdue)))
(and (not (null due))
(not (minusp due)))))
-
(defun org-drill-entry-new-p ()
(and (org-drill-entry-p)
(let ((item-time (org-get-scheduled-time (point))))
(null item-time))))
-
(defun org-drill-entry-last-quality (&optional default)
(let ((quality (org-entry-get (point) "DRILL_LAST_QUALITY")))
(if quality
(string-to-number quality)
default)))
-
(defun org-drill-entry-failure-count ()
(let ((quality (org-entry-get (point) "DRILL_FAILURE_COUNT")))
(if quality
(string-to-number quality)
0)))
-
(defun org-drill-entry-average-quality (&optional default)
(let ((val (org-entry-get (point) "DRILL_AVERAGE_QUALITY")))
(if val
@@ -773,7 +722,6 @@ from the entry at point."
(string-to-number val)
default)))
-
;;; From http://www.supermemo.com/english/ol/sm5.htm
(defun org-drill-random-dispersal-factor ()
"Returns a random number between 0.5 and 1.5."
@@ -796,10 +744,9 @@ from the entry at point."
(- variation)
mean))
-
(defun org-drill-early-interval-factor (optimal-factor
- optimal-interval
- days-ahead)
+ optimal-interval
+ days-ahead)
"Arguments:
- OPTIMAL-FACTOR: interval-factor if the item had been tested
exactly when it was supposed to be.
@@ -816,7 +763,6 @@ in the matrix."
(- optimal-factor
(* delta-ofmax (/ days-ahead (+ days-ahead (* 0.6 optimal-interval)))))))
-
(defun org-drill-get-item-data ()
"Returns a list of 6 items, containing all the stored recall
data for the item at point:
@@ -854,7 +800,6 @@ in the matrix."
(t ; virgin item
(list 0 0 0 0 nil nil)))))
-
(defun org-drill-store-item-data (last-interval repeats failures
total-repeats meanq
ease)
@@ -870,11 +815,8 @@ in the matrix."
(org-set-property "DRILL_EASE"
(number-to-string (round-float ease 3))))
-
-
;;; SM2 Algorithm =============================================================
-
(defun determine-next-interval-sm2 (last-interval n ef quality
failures meanq total-repeats)
"Arguments:
@@ -923,8 +865,6 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
;;; SM5 Algorithm =============================================================
-
-
(defun initial-optimal-factor-sm5 (n ef)
(if (= 1 n)
org-drill-sm5-initial-interval
@@ -937,7 +877,6 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
(and ef-of (cdr ef-of))))
(initial-optimal-factor-sm5 n ef))))
-
(defun inter-repetition-interval-sm5 (last-interval n ef &optional of-matrix)
(let ((of (get-optimal-factor-sm5 n ef (or of-matrix
org-drill-optimal-factor-matrix))))
@@ -945,7 +884,6 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
of
(* of last-interval))))
-
(defun determine-next-interval-sm5 (last-interval n ef quality
failures meanq total-repeats
of-matrix &optional delta-days)
@@ -956,12 +894,10 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
(unless of-matrix
(setq of-matrix org-drill-optimal-factor-matrix))
(setq of-matrix (cl-copy-tree of-matrix))
-
(setq meanq (if meanq
(/ (+ quality (* meanq total-repeats 1.0))
(1+ total-repeats))
quality))
-
(let ((next-ef (modify-e-factor ef quality))
(old-ef ef)
(new-of (modify-of (get-optimal-factor-sm5 n ef of-matrix)
@@ -974,13 +910,10 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
(inter-repetition-interval-sm5
last-interval n ef of-matrix)
delta-days)))
-
(setq of-matrix
(set-optimal-factor n next-ef of-matrix
(round-float new-of 3))) ; round OF to 3 d.p.
-
(setq ef next-ef)
-
(cond
;; "Failed" -- reset repetitions to 0,
((<= quality org-drill-failure-quality)
@@ -1005,10 +938,8 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
(1+ total-repeats)
of-matrix)))))
-
;;; Simple8 Algorithm =========================================================
-
(defun org-drill-simple8-first-interval (failures)
"Arguments:
- FAILURES: integer >= 0. The total number of times the item has
@@ -1018,7 +949,6 @@ Returns the optimal FIRST interval for an item which has previously been
forgotten on FAILURES occasions."
(* 2.4849 (exp (* -0.057 failures))))
-
(defun org-drill-simple8-interval-factor (ease repetition)
"Arguments:
- EASE: floating point number >= 1.2. Corresponds to `AF' in SM8 algorithm.
@@ -1029,7 +959,6 @@ The factor by which the last interval should be
multiplied to give the next interval. Corresponds to `RF' or `OF'."
(+ 1.2 (* (- ease 1.2) (expt org-drill-learn-fraction (log repetition 2)))))
-
(defun org-drill-simple8-quality->ease (quality)
"Returns the ease (`AF' in the SM8 algorithm) which corresponds
to a mean item quality of QUALITY."
@@ -1039,7 +968,6 @@ to a mean item quality of QUALITY."
(* -1.2403 quality)
1.4515))
-
(defun determine-next-interval-simple8 (last-interval repeats quality
failures meanq totaln
&optional delta-days)
@@ -1106,11 +1034,7 @@ See the documentation for `org-drill-get-item-data' for a description of these."
(org-drill-simple8-quality->ease meanq)
failures
meanq
- totaln
- )))
-
-
-
+ totaln)))
;;; Essentially copied from `org-learn.el', but modified to
;;; optionally call the SM2 or simple8 functions.
@@ -1261,35 +1185,35 @@ 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)
(t
nil))))
-
;; (defun org-drill-hide-all-subheadings-except (heading-list)
;; "Returns a list containing the position of each immediate subheading of
;; the current topic."
@@ -1310,8 +1234,6 @@ How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"
;; "" 'tree))
;; (reverse drill-sections)))
-
-
(defun org-drill-hide-subheadings-if (test)
"TEST is a function taking no arguments. TEST will be called for each
of the immediate subheadings of the current drill item, with the point
@@ -1334,13 +1256,11 @@ the current topic."
"" 'tree))
(reverse drill-sections)))
-
(defun org-drill-hide-all-subheadings-except (heading-list)
(org-drill-hide-subheadings-if
(lambda () (let ((drill-heading (org-get-heading t)))
(not (member drill-heading heading-list))))))
-
(defun org-drill-presentation-prompt (&rest fmt-and-args)
(let* ((item-start-time (current-time))
(input nil)
@@ -1361,9 +1281,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)
@@ -1417,13 +1341,11 @@ Consider reformulating the item to make it easier to remember.\n"
(?s 'skip)
(otherwise t))))
-
(defun org-pos-in-regexp (pos regexp &optional nlines)
(save-excursion
(goto-char pos)
(org-in-regexp regexp nlines)))
-
(defun org-drill-hide-region (beg end &optional text)
"Hide the buffer region between BEG and END with an 'invisible text'
visual overlay, or with the string TEXT if it is supplied."
@@ -1435,22 +1357,19 @@ visual overlay, or with the string TEXT if it is supplied."
(overlay-put ovl 'face 'default)
(overlay-put ovl 'display text))))
-
(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)
(org-drill-hide-region beg (point) text))))
-
(defun org-drill-hide-comments ()
(save-excursion
(while (re-search-forward "^#.*$" nil t)
(org-drill-hide-region (match-beginning 0) (match-end 0)))))
-
(defun org-drill-unhide-text ()
;; This will also unhide the item's heading.
(save-excursion
@@ -1458,7 +1377,6 @@ visual overlay, or with the string TEXT if it is supplied."
(when (eql 'org-drill-hidden-text-overlay (overlay-get ovl 'category))
(delete-overlay ovl)))))
-
(defun org-drill-hide-clozed-text ()
(save-excursion
(while (re-search-forward org-drill-cloze-regexp nil t)
@@ -1469,25 +1387,26 @@ visual overlay, or with the string TEXT if it is supplied."
org-bracket-link-regexp 1))
(org-drill-hide-matched-cloze-text)))))
-
(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))))))
-
(defun org-drill-hide-cloze-hints ()
(save-excursion
(while (re-search-forward org-drill-cloze-regexp nil t)
@@ -1497,7 +1416,6 @@ visual overlay, or with the string TEXT if it is supplied."
(null (match-beginning 2))) ; hint subexpression matched
(org-drill-hide-region (match-beginning 2) (match-end 2))))))
-
(defmacro with-replaced-entry-text (text &rest body)
"During the execution of BODY, the entire text of the current entry is
concealed by an overlay that displays the string TEXT."
@@ -1508,7 +1426,6 @@ concealed by an overlay that displays the string TEXT."
,@body)
(org-drill-unreplace-entry-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."
@@ -1519,7 +1436,6 @@ concealed by an overlay that displays the overlays in REPLACEMENTS."
,@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
@@ -1542,14 +1458,12 @@ Note: does not actually alter the item."
'org-drill-replaced-text-overlay)
(overlay-put ovl 'display text)))))
-
(defun org-drill-unreplace-entry-text ()
(save-excursion
(dolist (ovl (overlays-in (point-min) (point-max)))
(when (eql 'org-drill-replaced-text-overlay (overlay-get ovl 'category))
(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
@@ -1570,7 +1484,6 @@ Note: does not actually alter the item."
'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)
@@ -1579,21 +1492,18 @@ Note: does not actually alter the item."
,@body)
(org-drill-unhide-text))))
-
(defun org-drill-replace-entry-heading (heading)
"Make an overlay that conceals the heading of the item. The overlay shows
the string TEXT.
Note: does not actually alter the item."
(org-drill-hide-heading-at-point heading))
-
(defun org-drill-unhide-clozed-text ()
(save-excursion
(dolist (ovl (overlays-in (point-min) (point-max)))
(when (eql 'org-drill-cloze-overlay-defaults (overlay-get ovl 'category))
(delete-overlay ovl)))))
-
(defun org-drill-get-entry-text (&optional keep-properties-p)
(let ((text (org-agenda-get-some-entry-text (point-marker) 100)))
(if keep-properties-p
@@ -1601,13 +1511,23 @@ 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
@@ -1626,15 +1546,22 @@ Note: does not actually alter the item."
(prog1 (org-drill-presentation-prompt)
(org-drill-hide-subheadings-if 'org-drill-entry-p))))))
-
(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 ()
(with-hidden-comments
@@ -1652,8 +1579,6 @@ Note: does not actually alter the item."
(prog1 (org-drill-presentation-prompt)
(org-drill-hide-subheadings-if 'org-drill-entry-p)))))))
-
-
(defun org-drill-present-multi-sided-card ()
(with-hidden-comments
(with-hidden-cloze-hints
@@ -1669,7 +1594,6 @@ Note: does not actually alter the item."
(prog1 (org-drill-presentation-prompt)
(org-drill-hide-subheadings-if 'org-drill-entry-p)))))))
-
(defun org-drill-present-multicloze-hide-n (number-to-hide
&optional
force-show-first
@@ -1749,7 +1673,6 @@ items if FORCE-SHOW-FIRST or FORCE-SHOW-LAST is non-nil)."
(org-drill-hide-subheadings-if 'org-drill-entry-p)
(org-drill-unhide-clozed-text))))))
-
(defun org-drill-present-multicloze-hide-nth (to-hide)
"Hide the TO-HIDE'th piece of clozed text. 1 is the first piece. If
TO-HIDE is negative, count backwards, so -1 means the last item, -2
@@ -1797,29 +1720,24 @@ the second to last, etc."
(org-drill-hide-subheadings-if 'org-drill-entry-p)
(org-drill-unhide-clozed-text))))))
-
(defun org-drill-present-multicloze-hide1 ()
"Hides one of the pieces of text that are marked for cloze deletion,
chosen at random."
(org-drill-present-multicloze-hide-n 1))
-
(defun org-drill-present-multicloze-hide2 ()
"Hides two of the pieces of text that are marked for cloze deletion,
chosen at random."
(org-drill-present-multicloze-hide-n 2))
-
(defun org-drill-present-multicloze-hide-first ()
"Hides the first piece of text that is marked for cloze deletion."
(org-drill-present-multicloze-hide-nth 1))
-
(defun org-drill-present-multicloze-hide-last ()
"Hides the last piece of text that is marked for cloze deletion."
(org-drill-present-multicloze-hide-nth -1))
-
(defun org-drill-present-multicloze-hide1-firstmore ()
"Commonly, hides the FIRST piece of text that is marked for
cloze deletion. Uncommonly, hide one of the other pieces of text,
@@ -1849,7 +1767,6 @@ the value of `org-drill-cloze-text-weight'."
;; Commonly, hide first item
(org-drill-present-multicloze-hide-first))))
-
(defun org-drill-present-multicloze-show1-lastmore ()
"Commonly, hides all pieces except the last. Uncommonly, shows
any random piece. The effect is similar to 'show1cloze' except
@@ -1874,7 +1791,6 @@ the value of `org-drill-cloze-text-weight'."
;; Commonly, show the LAST item
(org-drill-present-multicloze-hide-n -1 nil t))))
-
(defun org-drill-present-multicloze-show1-firstless ()
"Commonly, hides all pieces except one, where the shown piece
is guaranteed NOT to be the first piece. Uncommonly, shows any
@@ -1900,20 +1816,17 @@ the value of `org-drill-cloze-text-weight'."
;; Commonly, show any item, except the first
(org-drill-present-multicloze-hide-n -1 nil nil t))))
-
(defun org-drill-present-multicloze-show1 ()
"Similar to `org-drill-present-multicloze-hide1', but hides all
the pieces of text that are marked for cloze deletion, except for one
piece which is chosen at random."
(org-drill-present-multicloze-hide-n -1))
-
(defun org-drill-present-multicloze-show2 ()
"Similar to `org-drill-present-multicloze-show1', but reveals two
pieces rather than one."
(org-drill-present-multicloze-hide-n -2))
-
;; (defun org-drill-present-multicloze-show1 ()
;; "Similar to `org-drill-present-multicloze-hide1', but hides all
;; the pieces of text that are marked for cloze deletion, except for one
@@ -1947,12 +1860,13 @@ pieces rather than one."
;; (org-drill-hide-subheadings-if 'org-drill-entry-p)
;; (org-drill-unhide-clozed-text))))))
-
(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
@@ -1960,11 +1874,12 @@ pieces rather than one."
(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."
+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
@@ -1975,7 +1890,6 @@ visible content of the card."
(prog1 (org-drill-presentation-prompt)
(org-drill-hide-subheadings-if 'org-drill-entry-p)))))
-
(defun org-drill-entry ()
"Present the current topic for interactive review, as in `org-drill'.
Review will occur regardless of whether the topic is due for review or whether
@@ -1995,20 +1909,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)
@@ -2031,9 +1949,9 @@ See `org-drill' for more details."
(funcall answer-fn
(lambda () (org-drill-reschedule)))))))))))))
-
(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*
@@ -2043,33 +1961,32 @@ See `org-drill' for more details."
*org-drill-overdue-entries*
*org-drill-again-entries*))))
-
(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*)
(length *org-drill-overdue-entries*)
(length *org-drill-again-entries*)))
-
(defun org-drill-maximum-duration-reached-p ()
"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))))
-
(defun org-drill-maximum-item-count-reached-p ()
"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)))
-
(defun org-drill-pop-next-pending-entry ()
(block org-drill-pop-next-pending-entry
(let ((m nil))
@@ -2117,7 +2034,6 @@ maximum number of items."
(return-from org-drill-pop-next-pending-entry nil)))))
m)))
-
(defun org-drill-entries (&optional resuming-p)
"Returns nil, t, or a list of markers representing entries that were
'failed' and need to be presented again before the session ends.
@@ -2157,6 +2073,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,9 +2083,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))))))))))
(defun org-drill-final-report ()
(let ((pass-percent
@@ -2176,7 +2092,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.
@@ -2255,10 +2172,7 @@ order to make items appear more frequently over time."
*org-drill-overdue-entry-count*
(round (* 100 *org-drill-overdue-entry-count*)
(+ *org-drill-dormant-entry-count*
- *org-drill-due-entry-count*)))
- ))))
-
-
+ *org-drill-due-entry-count*)))))))
(defun org-drill-free-markers (markers)
"MARKERS is a list of markers, all of which will be freed (set to
@@ -2305,8 +2219,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 +2366,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 +2386,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
@@ -2515,8 +2405,7 @@ than starting a new one."
(org-drill-save-optimal-factor-matrix))
(if org-drill-save-buffers-after-drill-sessions-p
(save-some-buffers))
- (message "Drill session finished!")
- ))))
+ (message "Drill session finished!")))))
(defun org-drill-save-optimal-factor-matrix ()
@@ -2531,8 +2420,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 +2444,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*)
@@ -2675,9 +2565,7 @@ the tag 'imported'."
(outline-next-heading)
(newline)
(forward-line -1)
- (paste-tree-here (1+ (or (org-current-level) 0)))
- )))))
-
+ (paste-tree-here (1+ (or (org-current-level) 0))))))))
(defun org-drill-merge-buffers (src &optional dest ignore-new-items-p)
@@ -2770,15 +2658,12 @@ copy them across."
(free-marker m))
*org-drill-dest-id-table*))))
-
-
;;; Card types for learning languages =========================================
;;; Get spell-number.el from:
;;; http://www.emacswiki.org/emacs/spell-number.el
(autoload 'spelln-integer-in-words "spell-number")
-
;;; `conjugate' card type =====================================================
;;; See spanish.org for usage
@@ -2883,19 +2768,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 +2894,48 @@ 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 ==================================================