You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
3496 lines
134 KiB
3496 lines
134 KiB
;;; -*- coding: utf-8-unix -*-
|
|
;;; org-drill.el - Self-testing using spaced repetition
|
|
;;;
|
|
;;; Copyright (C) 2010-2015 Paul Sexton
|
|
;;;
|
|
;;; Author: Paul Sexton <eeeickythump@gmail.com>
|
|
;;; Version: 2.6.1
|
|
;;; Keywords: flashcards, memory, learning, memorization
|
|
;;; 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 of the License, 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 this program. If not, see <http://www.gnu.org/licenses/>.
|
|
;;;
|
|
;;;
|
|
;;; Synopsis
|
|
;;; ========
|
|
;;;
|
|
;;; Within an Org mode outline or outlines, headings and associated content are
|
|
;;; treated as "flashcards". Spaced repetition algorithms are used to conduct
|
|
;;; interactive "drill sessions", where a selection of these flashcards 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 tested.
|
|
;;;
|
|
;;; 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))
|
|
(require 'cl-lib)
|
|
(require 'hi-lock)
|
|
(require 'org)
|
|
(require 'org-id)
|
|
(require 'org-learn)
|
|
(require 'savehist)
|
|
|
|
|
|
(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"
|
|
"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
|
|
"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
|
|
"Maximum duration of a drill session, in minutes.
|
|
Nil means unlimited."
|
|
:group 'org-drill
|
|
:type '(choice integer (const nil)))
|
|
|
|
|
|
(defcustom org-drill-item-count-includes-failed-items-p
|
|
nil
|
|
"If non-nil, when you fail an item it still counts towards the
|
|
count of items reviewed for the current session. If nil (default),
|
|
only successful items count towards this total."
|
|
:group 'org-drill
|
|
:type 'boolean)
|
|
|
|
|
|
(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
|
|
than this number, it is regarded as successfully recalled, but the
|
|
time interval to the next repetition will be lowered if the quality
|
|
was near to a fail.
|
|
|
|
By default this is 2, for SuperMemo-like behaviour. For
|
|
Mnemosyne-like behaviour, set it to 1. Other values are not
|
|
really sensible."
|
|
:group 'org-drill
|
|
:type '(choice (const 2) (const 1)))
|
|
|
|
|
|
(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
|
|
climbs above this number."
|
|
:group 'org-drill
|
|
:type 'integer)
|
|
|
|
|
|
(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
|
|
"How should 'leech items' be handled during drill sessions?
|
|
Possible values:
|
|
- nil :: Leech items are treated the same as normal items.
|
|
- skip :: Leech items are not included in drill sessions.
|
|
- warn :: Leech items are still included in drill sessions,
|
|
but a warning message is printed when each leech item is
|
|
presented."
|
|
: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
|
|
"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
|
|
"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"
|
|
"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"
|
|
"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"
|
|
"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"
|
|
"Foreground colour used to display the count of reviewed items
|
|
during a drill session."
|
|
:group 'org-drill
|
|
:type 'color)
|
|
|
|
(defcustom org-drill-left-cloze-delimiter
|
|
"["
|
|
"String used within org buffers to delimit cloze deletions."
|
|
:group 'org-drill
|
|
:type 'string)
|
|
|
|
(defcustom org-drill-right-cloze-delimiter
|
|
"]"
|
|
"String used within org buffers to delimit cloze deletions."
|
|
:group 'org-drill
|
|
:type 'string)
|
|
|
|
|
|
(setplist 'org-drill-cloze-overlay-defaults
|
|
`(display ,(format "%s...%s"
|
|
org-drill-left-cloze-delimiter
|
|
org-drill-right-cloze-delimiter)
|
|
face org-drill-hidden-cloze-face
|
|
window t))
|
|
|
|
(setplist 'org-drill-hidden-text-overlay
|
|
'(invisible t))
|
|
|
|
(setplist 'org-drill-replaced-text-overlay
|
|
'(display "Replaced text"
|
|
face default
|
|
window t))
|
|
|
|
(add-hook 'org-font-lock-set-keywords-hook 'org-drill-add-cloze-fontification)
|
|
|
|
|
|
(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.")
|
|
|
|
(defun org-drill--compute-cloze-regexp ()
|
|
(concat "\\("
|
|
(regexp-quote org-drill-left-cloze-delimiter)
|
|
"[[:cntrl:][:graph:][:space:]]+?\\)\\(\\|"
|
|
(regexp-quote org-drill-hint-separator)
|
|
".+?\\)\\("
|
|
(regexp-quote org-drill-right-cloze-delimiter)
|
|
"\\)"))
|
|
|
|
(defun org-drill--compute-cloze-keywords ()
|
|
(list (list (org-drill--compute-cloze-regexp)
|
|
(copy-list '(1 'org-drill-visible-cloze-face nil))
|
|
(copy-list '(2 'org-drill-visible-cloze-hint-face t))
|
|
(copy-list '(3 'org-drill-visible-cloze-face nil))
|
|
)))
|
|
|
|
(defvar-local org-drill-cloze-regexp
|
|
(org-drill--compute-cloze-regexp))
|
|
|
|
|
|
(defvar-local org-drill-cloze-keywords
|
|
(org-drill--compute-cloze-keywords))
|
|
|
|
|
|
;; Variables defining what keys can be pressed during drill sessions to quit the
|
|
;; session, edit the item, etc.
|
|
(defvar org-drill--quit-key ?q
|
|
"If this character is pressed during a drill session, quit the session.")
|
|
(defvar org-drill--edit-key ?e
|
|
"If this character is pressed during a drill session, suspend the session
|
|
with the cursor at the current item..")
|
|
(defvar org-drill--help-key ??
|
|
"If this character is pressed during a drill session, show help.")
|
|
(defvar org-drill--skip-key ?s
|
|
"If this character is pressed during a drill session, skip to the next
|
|
item.")
|
|
(defvar org-drill--tags-key ?t
|
|
"If this character is pressed during a drill session, edit the tags for
|
|
the current item.")
|
|
|
|
|
|
(defcustom org-drill-card-type-alist
|
|
'((nil org-drill-present-simple-card)
|
|
("simple" org-drill-present-simple-card)
|
|
("simpletyped" org-drill-present-simple-card-with-typed-answer)
|
|
("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)
|
|
("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))
|
|
|
|
|
|
(defcustom org-drill-scope
|
|
'file
|
|
"The scope in which to search for drill items when conducting a
|
|
drill session. This can be any of:
|
|
|
|
file The current buffer, respecting the restriction if any.
|
|
This is the default.
|
|
tree The subtree started with the entry at point
|
|
file-no-restriction The current buffer, without restriction
|
|
file-with-archives The current buffer, and any archives associated with it.
|
|
agenda All agenda files
|
|
agenda-with-archives All agenda files with any archive files associated
|
|
with them.
|
|
directory All files with the extension '.org' in the same
|
|
directory as the current file (includes the current
|
|
file if it is an .org file.)
|
|
(FILE1 FILE2 ...) If this is a list, all files in the list will be scanned.
|
|
"
|
|
;; Note -- meanings differ slightly from the argument to org-map-entries:
|
|
;; 'file' means current file/buffer, respecting any restriction
|
|
;; 'file-no-restriction' means current file/buffer, ignoring restrictions
|
|
;; 'directory' means all *.org files in current directory
|
|
:group 'org-drill
|
|
:type '(choice (const :tag "The current buffer, respecting the restriction if any." file)
|
|
(const :tag "The subtree started with the entry at point" tree)
|
|
(const :tag "The current buffer, without restriction" file-no-restriction)
|
|
(const :tag "The current buffer, and any archives associated with it." file-with-archives)
|
|
(const :tag "All agenda files" agenda)
|
|
(const :tag "All agenda files with any archive files associated with them." agenda-with-archives)
|
|
(const :tag "All files with the extension '.org' in the same directory as the current file (includes the current file if it is an .org file.)" directory)
|
|
(repeat :tag "List of files to scan for drill items." file)))
|
|
|
|
|
|
(defcustom org-drill-match
|
|
nil
|
|
"If non-nil, a string specifying a tags/property/TODO query. During
|
|
drill sessions, only items that match this query will be considered."
|
|
:group 'org-drill
|
|
:type '(choice (const nil) string))
|
|
|
|
|
|
(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
|
|
"Which SuperMemo spaced repetition algorithm to use for scheduling items.
|
|
Available choices are:
|
|
- SM2 :: the SM2 algorithm, used in SuperMemo 2.0
|
|
- SM5 :: the SM5 algorithm, used in SuperMemo 5.0
|
|
- Simple8 :: a modified version of the SM8 algorithm. SM8 is used in
|
|
SuperMemo 98. The version implemented here is simplified in that while it
|
|
'learns' the difficulty of each item using quality grades and number of
|
|
failures, it does not modify the matrix of values that
|
|
governs how fast the inter-repetition intervals increase. A method for
|
|
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)))
|
|
|
|
|
|
(defcustom org-drill-optimal-factor-matrix
|
|
nil
|
|
"Obsolete and will be removed in future. The SM5 optimal factor
|
|
matrix data is now stored in the variable
|
|
`org-drill-sm5-optimal-factor-matrix'."
|
|
:group 'org-drill
|
|
:type 'sexp)
|
|
|
|
|
|
(defvar org-drill-sm5-optimal-factor-matrix
|
|
nil
|
|
"DO NOT CHANGE THE VALUE OF THIS VARIABLE.
|
|
|
|
Persistent matrix of optimal factors, used by the SuperMemo SM5
|
|
algorithm. The matrix is saved at the end of each drill session.
|
|
|
|
Over time, values in the matrix will adapt to the individual user's
|
|
pace of learning.")
|
|
|
|
|
|
(add-to-list 'savehist-additional-variables
|
|
'org-drill-sm5-optimal-factor-matrix)
|
|
(unless savehist-mode
|
|
(savehist-mode 1))
|
|
|
|
|
|
(defun org-drill--transfer-optimal-factor-matrix ()
|
|
(if (and org-drill-optimal-factor-matrix
|
|
(null org-drill-sm5-optimal-factor-matrix))
|
|
(setq org-drill-sm5-optimal-factor-matrix
|
|
org-drill-optimal-factor-matrix)))
|
|
|
|
(add-hook 'after-init-hook 'org-drill--transfer-optimal-factor-matrix)
|
|
|
|
|
|
(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
|
|
"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
|
|
small, but scales up with the interval."
|
|
:group 'org-drill
|
|
:type 'boolean)
|
|
|
|
|
|
(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
|
|
[[http://www.supermemo.com/english/algsm11.htm#Advanced%20repetitions]].
|
|
|
|
Items that were reviewed early will have their next review date brought
|
|
forward. Those that were reviewed late will have their next review
|
|
date postponed further.
|
|
|
|
Note that this option currently has no effect if the SM2 algorithm
|
|
is used."
|
|
:group 'org-drill
|
|
:type 'boolean)
|
|
|
|
|
|
(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
|
|
value of the variable.
|
|
|
|
For example, with the hide1_firstmore card type, the first piece
|
|
of clozed text should be hidden more often than the other
|
|
pieces. If this variable is set to 4 (default), the first item
|
|
will only be shown 25% of the time (1 in 4 trials). Similarly for
|
|
show1_lastmore, the last item will be shown 75% of the time, and
|
|
for show1_firstless, the first item would only be shown 25% of the
|
|
time.
|
|
|
|
If the value of this variable is NIL, then weighting is disabled, and
|
|
all weighted card types are treated as their unweighted equivalents."
|
|
:group 'org-drill
|
|
:type '(choice integer (const nil)))
|
|
|
|
|
|
(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
|
|
;;; ORG-DRILL-DAYS-BEFORE-OLD days after their last
|
|
;;; repetition. These items will have been learned 'recently' and will have a
|
|
;;; low repetition count.
|
|
;;; - OLD mature items have intervals greater than
|
|
;;; ORG-DRILL-DAYS-BEFORE-OLD.
|
|
;;; - OVERDUE items are past their scheduled review date by more than
|
|
;;; LAST-INTERVAL * (ORG-DRILL-OVERDUE-INTERVAL-FACTOR - 1) days,
|
|
;;; regardless of young/old status.
|
|
|
|
|
|
(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
|
|
"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
|
|
20% of the last scheduled interval is allowed to elapse before
|
|
the item is overdue. A value of 1.0 means no extra time is
|
|
allowed at all - items are immediately considered overdue if
|
|
there is even one day's delay in reviewing them. This variable
|
|
should never be less than 1.0."
|
|
:group 'org-drill
|
|
:type 'float)
|
|
|
|
|
|
(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
|
|
quickly with each successful repetition. You should only change
|
|
this in small increments (for example 0.05-0.1) as it has an
|
|
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 drill-typed-answer nil
|
|
"Global variable that can be bound to the last answer typed by
|
|
the user. Used by card types that ask the user to type in an
|
|
answer, rather than just pressing spacebar to reveal the
|
|
answer.")
|
|
|
|
|
|
(defcustom org-drill-cloze-length-matches-hidden-text-p
|
|
nil
|
|
"If non-nil, when concealing cloze deletions, force the length of
|
|
the ellipsis to match the length of the missing text. This may be useful
|
|
to preserve the formatting in a displayed table, for example."
|
|
:group 'org-drill
|
|
:type 'boolean)
|
|
|
|
|
|
(defvar *org-drill-session-qualities* nil)
|
|
(defvar *org-drill-start-time* 0)
|
|
(defvar *org-drill-new-entries* nil)
|
|
(defvar *org-drill-dormant-entry-count* 0)
|
|
(defvar *org-drill-due-entry-count* 0)
|
|
(defvar *org-drill-overdue-entry-count* 0)
|
|
(defvar *org-drill-due-tomorrow-count* 0)
|
|
(defvar *org-drill-overdue-entries* nil
|
|
"List of markers for items that are considered 'overdue', based on
|
|
the value of ORG-DRILL-OVERDUE-INTERVAL-FACTOR.")
|
|
(defvar *org-drill-young-mature-entries* nil
|
|
"List of markers for mature entries whose last inter-repetition
|
|
interval was <= ORG-DRILL-DAYS-BEFORE-OLD days.")
|
|
(defvar *org-drill-old-mature-entries* nil
|
|
"List of markers for mature entries whose last inter-repetition
|
|
interval was greater than ORG-DRILL-DAYS-BEFORE-OLD days.")
|
|
(defvar *org-drill-failed-entries* nil)
|
|
(defvar *org-drill-again-entries* nil)
|
|
(defvar *org-drill-done-entries* nil)
|
|
(defvar *org-drill-current-item* nil
|
|
"Set to the marker for the item currently being tested.")
|
|
(defvar *org-drill-cram-mode* nil
|
|
"Are we in 'cram mode', where all items are considered due
|
|
for review unless they were already reviewed in the recent past?")
|
|
(defvar org-drill-scheduling-properties
|
|
'("LEARN_DATA" "DRILL_LAST_INTERVAL" "DRILL_REPEATS_SINCE_FAIL"
|
|
"DRILL_TOTAL_REPEATS" "DRILL_FAILURE_COUNT" "DRILL_AVERAGE_QUALITY"
|
|
"DRILL_EASE" "DRILL_LAST_QUALITY" "DRILL_LAST_REVIEWED"))
|
|
(defvar org-drill--lapse-very-overdue-entries-p nil
|
|
"If non-nil, entries more than 90 days overdue are regarded as 'lapsed'.
|
|
This means that when the item is eventually re-tested it will be
|
|
treated as 'failed' (quality 2) for rescheduling purposes,
|
|
regardless of whether the test was successful.")
|
|
|
|
|
|
;;; 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))))
|
|
(put 'org-drill-maximum-duration 'safe-local-variable
|
|
'(lambda (val) (or (integerp val) (null val))))
|
|
(put 'org-drill-failure-quality 'safe-local-variable 'integerp)
|
|
(put 'org-drill-forgetting-index 'safe-local-variable 'integerp)
|
|
(put 'org-drill-leech-failure-threshold 'safe-local-variable 'integerp)
|
|
(put 'org-drill-leech-method 'safe-local-variable
|
|
'(lambda (val) (memq val '(nil skip warn))))
|
|
(put 'org-drill-use-visible-cloze-face-p 'safe-local-variable 'booleanp)
|
|
(put 'org-drill-hide-item-headings-p 'safe-local-variable 'booleanp)
|
|
(put 'org-drill-spaced-repetition-algorithm 'safe-local-variable
|
|
'(lambda (val) (memq val '(simple8 sm5 sm2))))
|
|
(put 'org-drill-sm5-initial-interval 'safe-local-variable 'floatp)
|
|
(put 'org-drill-add-random-noise-to-intervals-p 'safe-local-variable 'booleanp)
|
|
(put 'org-drill-adjust-intervals-for-early-and-late-repetitions-p
|
|
'safe-local-variable 'booleanp)
|
|
(put 'org-drill-cram-hours 'safe-local-variable 'integerp)
|
|
(put 'org-drill-learn-fraction 'safe-local-variable 'floatp)
|
|
(put 'org-drill-days-before-old 'safe-local-variable 'integerp)
|
|
(put 'org-drill-overdue-interval-factor 'safe-local-variable 'floatp)
|
|
(put 'org-drill-scope 'safe-local-variable
|
|
'(lambda (val) (or (symbolp val) (listp val))))
|
|
(put 'org-drill-match 'safe-local-variable
|
|
'(lambda (val) (or (stringp val) (null val))))
|
|
(put 'org-drill-save-buffers-after-drill-sessions-p 'safe-local-variable 'booleanp)
|
|
(put 'org-drill-cloze-text-weight 'safe-local-variable
|
|
'(lambda (val) (or (null val) (integerp val))))
|
|
(put 'org-drill-left-cloze-delimiter 'safe-local-variable 'stringp)
|
|
(put 'org-drill-right-cloze-delimiter 'safe-local-variable 'stringp)
|
|
|
|
|
|
;;;; Utilities ================================================================
|
|
|
|
|
|
(defun free-marker (m)
|
|
(set-marker m nil))
|
|
|
|
|
|
(defmacro pop-random (place)
|
|
(let ((idx (gensym)))
|
|
`(if (null ,place)
|
|
nil
|
|
(let ((,idx (random* (length ,place))))
|
|
(prog1 (nth ,idx ,place)
|
|
(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
|
|
(let ((i 0)
|
|
j
|
|
temp
|
|
(len (length list)))
|
|
(while (< i len)
|
|
(setq j (+ i (random* (- len i))))
|
|
(setq temp (nth i list))
|
|
(setf (nth i list) (nth j list))
|
|
(setf (nth j list) temp)
|
|
(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 time-to-active-org-timestamp (time)
|
|
(format-time-string
|
|
(concat "<" (substring (cdr org-time-stamp-formats) 1 -1) ">")
|
|
time))
|
|
|
|
|
|
(defun org-map-drill-entries (func &optional scope drill-match &rest skip)
|
|
"Like `org-map-entries', but only drill entries are processed."
|
|
(let ((org-drill-scope (or scope org-drill-scope))
|
|
(org-drill-match (or drill-match org-drill-match)))
|
|
(apply 'org-map-entries func
|
|
(concat "+" org-drill-question-tag
|
|
(if (and (stringp org-drill-match)
|
|
(not (member '(?+ ?- ?|) (elt org-drill-match 0))))
|
|
"+" "")
|
|
(or org-drill-match ""))
|
|
(case org-drill-scope
|
|
(file nil)
|
|
(file-no-restriction 'file)
|
|
(directory
|
|
(directory-files (file-name-directory (buffer-file-name))
|
|
t "\\.org$"))
|
|
(t org-drill-scope))
|
|
skip)))
|
|
|
|
|
|
(defmacro with-hidden-cloze-text (&rest body)
|
|
`(progn
|
|
(org-drill-hide-clozed-text)
|
|
(unwind-protect
|
|
(progn
|
|
,@body)
|
|
(org-drill-unhide-clozed-text))))
|
|
|
|
|
|
(defmacro with-hidden-cloze-hints (&rest body)
|
|
`(progn
|
|
(org-drill-hide-cloze-hints)
|
|
(unwind-protect
|
|
(progn
|
|
,@body)
|
|
(org-drill-unhide-text))))
|
|
|
|
|
|
(defmacro with-hidden-comments (&rest body)
|
|
`(progn
|
|
(if org-drill-hide-item-headings-p
|
|
(org-drill-hide-heading-at-point))
|
|
(org-drill-hide-comments)
|
|
(unwind-protect
|
|
(progn
|
|
,@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.
|
|
Zero means it was reviewed today.
|
|
A positive number means it was reviewed that many days ago.
|
|
A negative number means the date of last review is in the future --
|
|
this should never happen."
|
|
(let ((datestr (org-entry-get (point) "DRILL_LAST_REVIEWED")))
|
|
(when datestr
|
|
(- (time-to-days (current-time))
|
|
(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."
|
|
(let ((datestr (org-entry-get (point) "DRILL_LAST_REVIEWED")))
|
|
(when datestr
|
|
(floor
|
|
(/ (- (time-to-seconds (current-time))
|
|
(time-to-seconds (apply 'encode-time
|
|
(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
|
|
situation use `org-part-of-drill-entry-p'."
|
|
(save-excursion
|
|
(when marker
|
|
(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?"
|
|
(or (org-drill-entry-p)
|
|
;; 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."
|
|
(unless (org-at-heading-p)
|
|
(org-back-to-heading))
|
|
(unless (org-part-of-drill-entry-p)
|
|
(error "Point is not inside a drill entry"))
|
|
(while (not (org-drill-entry-p))
|
|
(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*
|
|
;; (let ((hours (org-drill-hours-since-last-review)))
|
|
;; (and (org-drill-entry-p)
|
|
;; (or (null hours)
|
|
;; (>= hours org-drill-cram-hours)))))
|
|
;; (t
|
|
;; (let ((item-time (org-get-scheduled-time (point))))
|
|
;; (and (org-drill-entry-p)
|
|
;; (or (not (eql 'skip org-drill-leech-method))
|
|
;; (not (org-drill-entry-leech-p)))
|
|
;; (or (null item-time) ; not scheduled
|
|
;; (not (minusp ; scheduled for today/in past
|
|
;; (- (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.
|
|
This is the case if it is not a drill item, or if it is a leech item
|
|
that we wish to skip, or if we are in cram mode and have already reviewed
|
|
the item within the last few hours.
|
|
- 0 if the item is new, or if it scheduled for review today.
|
|
- A negative integer - item is scheduled that many days in the future.
|
|
- A positive integer - item is scheduled that many days in the past."
|
|
(cond
|
|
(*org-drill-cram-mode*
|
|
(let ((hours (org-drill-hours-since-last-review)))
|
|
(and (org-drill-entry-p)
|
|
(or (null hours)
|
|
(>= hours org-drill-cram-hours))
|
|
0)))
|
|
(t
|
|
(let ((item-time (org-get-scheduled-time (point))))
|
|
(cond
|
|
((or (not (org-drill-entry-p))
|
|
(and (eql 'skip org-drill-leech-method)
|
|
(org-drill-entry-leech-p)))
|
|
nil)
|
|
((null item-time) ; not scheduled -> due now
|
|
0)
|
|
(t
|
|
(- (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
|
|
considered 'overdue'. If the arguments are not given they are extracted
|
|
from the entry at point."
|
|
(unless days-overdue
|
|
(setq days-overdue (org-drill-entry-days-overdue)))
|
|
(unless last-interval
|
|
(setq last-interval (org-drill-entry-last-interval 1)))
|
|
(and (numberp days-overdue)
|
|
(> days-overdue 1) ; enforce a sane minimum 'overdue' gap
|
|
;;(> due org-drill-days-before-overdue)
|
|
(> (/ (+ 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
|
|
(string-to-number val)
|
|
(or default nil))))
|
|
|
|
(defun org-drill-entry-last-interval (&optional default)
|
|
(let ((val (org-entry-get (point) "DRILL_LAST_INTERVAL")))
|
|
(if val
|
|
(string-to-number val)
|
|
(or default 0))))
|
|
|
|
(defun org-drill-entry-repeats-since-fail (&optional default)
|
|
(let ((val (org-entry-get (point) "DRILL_REPEATS_SINCE_FAIL")))
|
|
(if val
|
|
(string-to-number val)
|
|
(or default 0))))
|
|
|
|
(defun org-drill-entry-total-repeats (&optional default)
|
|
(let ((val (org-entry-get (point) "DRILL_TOTAL_REPEATS")))
|
|
(if val
|
|
(string-to-number val)
|
|
(or default 0))))
|
|
|
|
(defun org-drill-entry-ease (&optional default)
|
|
(let ((val (org-entry-get (point) "DRILL_EASE")))
|
|
(if val
|
|
(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."
|
|
(let ((a 0.047)
|
|
(b 0.092)
|
|
(p (- (random* 1.0) 0.5)))
|
|
(cl-flet ((sign (n)
|
|
(cond ((zerop n) 0)
|
|
((plusp n) 1)
|
|
(t -1))))
|
|
(/ (+ 100 (* (* (/ -1 b) (log (- 1 (* (/ b a ) (abs p)))))
|
|
(sign p)))
|
|
100.0))))
|
|
|
|
(defun pseudonormal (mean variation)
|
|
"Random numbers in a pseudo-normal distribution with mean MEAN, range
|
|
MEAN-VARIATION to MEAN+VARIATION"
|
|
(+ (random* variation)
|
|
(random* variation)
|
|
(- variation)
|
|
mean))
|
|
|
|
|
|
(defun org-drill-early-interval-factor (optimal-factor
|
|
optimal-interval
|
|
days-ahead)
|
|
"Arguments:
|
|
- OPTIMAL-FACTOR: interval-factor if the item had been tested
|
|
exactly when it was supposed to be.
|
|
- OPTIMAL-INTERVAL: interval for next repetition (days) if the item had been
|
|
tested exactly when it was supposed to be.
|
|
- DAYS-AHEAD: how many days ahead of time the item was reviewed.
|
|
|
|
Returns an adjusted optimal factor which should be used to
|
|
calculate the next interval, instead of the optimal factor found
|
|
in the matrix."
|
|
(let ((delta-ofmax (* (1- optimal-factor)
|
|
(/ (+ optimal-interval
|
|
(* 0.6 optimal-interval) -1) (1- optimal-interval)))))
|
|
(- 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:
|
|
- LAST-INTERVAL is the interval in days that was used to schedule the item's
|
|
current review date.
|
|
- REPEATS is the number of items the item has been successfully recalled without
|
|
without any failures. It is reset to 0 upon failure to recall the item.
|
|
- FAILURES is the total number of times the user has failed to recall the item.
|
|
- TOTAL-REPEATS includes both successful and unsuccessful repetitions.
|
|
- AVERAGE-QUALITY is the mean quality of recall of the item over
|
|
all its repetitions, successful and unsuccessful.
|
|
- EASE is a number reflecting how easy the item is to learn. Higher is easier.
|
|
"
|
|
(let ((learn-str (org-entry-get (point) "LEARN_DATA"))
|
|
(repeats (org-drill-entry-total-repeats :missing)))
|
|
(cond
|
|
(learn-str
|
|
(let ((learn-data (or (and learn-str
|
|
(read learn-str))
|
|
(copy-list initial-repetition-state))))
|
|
(list (nth 0 learn-data) ; last interval
|
|
(nth 1 learn-data) ; repetitions
|
|
(org-drill-entry-failure-count)
|
|
(nth 1 learn-data)
|
|
(org-drill-entry-last-quality)
|
|
(nth 2 learn-data) ; EF
|
|
)))
|
|
((not (eql :missing repeats))
|
|
(list (org-drill-entry-last-interval)
|
|
(org-drill-entry-repeats-since-fail)
|
|
(org-drill-entry-failure-count)
|
|
(org-drill-entry-total-repeats)
|
|
(org-drill-entry-average-quality)
|
|
(org-drill-entry-ease)))
|
|
(t ; virgin item
|
|
(list 0 0 0 0 nil nil)))))
|
|
|
|
|
|
(defun org-drill-store-item-data (last-interval repeats failures
|
|
total-repeats meanq
|
|
ease)
|
|
"Stores the given data in the item at point."
|
|
(org-entry-delete (point) "LEARN_DATA")
|
|
(org-set-property "DRILL_LAST_INTERVAL"
|
|
(number-to-string (round-float last-interval 4)))
|
|
(org-set-property "DRILL_REPEATS_SINCE_FAIL" (number-to-string repeats))
|
|
(org-set-property "DRILL_TOTAL_REPEATS" (number-to-string total-repeats))
|
|
(org-set-property "DRILL_FAILURE_COUNT" (number-to-string failures))
|
|
(org-set-property "DRILL_AVERAGE_QUALITY"
|
|
(number-to-string (round-float meanq 3)))
|
|
(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:
|
|
- LAST-INTERVAL -- the number of days since the item was last reviewed.
|
|
- REPEATS -- the number of times the item has been successfully reviewed
|
|
- EF -- the 'easiness factor'
|
|
- QUALITY -- 0 to 5
|
|
|
|
Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), where:
|
|
- INTERVAL is the number of days until the item should next be reviewed
|
|
- REPEATS is incremented by 1.
|
|
- EF is modified based on the recall quality for the item.
|
|
- OF-MATRIX is not modified."
|
|
(if (zerop n) (setq n 1))
|
|
(if (null ef) (setq ef 2.5))
|
|
(setq meanq (if meanq
|
|
(/ (+ quality (* meanq total-repeats 1.0))
|
|
(1+ total-repeats))
|
|
quality))
|
|
(assert (> n 0))
|
|
(assert (and (>= quality 0) (<= quality 5)))
|
|
(if (<= quality org-drill-failure-quality)
|
|
;; When an item is failed, its interval is reset to 0,
|
|
;; but its EF is unchanged
|
|
(list -1 1 ef (1+ failures) meanq (1+ total-repeats)
|
|
org-drill-sm5-optimal-factor-matrix)
|
|
;; else:
|
|
(let* ((next-ef (modify-e-factor ef quality))
|
|
(interval
|
|
(cond
|
|
((<= n 1) 1)
|
|
((= n 2)
|
|
(cond
|
|
(org-drill-add-random-noise-to-intervals-p
|
|
(case quality
|
|
(5 6)
|
|
(4 4)
|
|
(3 3)
|
|
(2 1)
|
|
(t -1)))
|
|
(t 6)))
|
|
(t (* last-interval next-ef)))))
|
|
(list (if org-drill-add-random-noise-to-intervals-p
|
|
(+ last-interval (* (- interval last-interval)
|
|
(org-drill-random-dispersal-factor)))
|
|
interval)
|
|
(1+ n)
|
|
next-ef
|
|
failures meanq (1+ total-repeats)
|
|
org-drill-sm5-optimal-factor-matrix))))
|
|
|
|
|
|
;;; SM5 Algorithm =============================================================
|
|
|
|
|
|
|
|
(defun initial-optimal-factor-sm5 (n ef)
|
|
(if (= 1 n)
|
|
org-drill-sm5-initial-interval
|
|
ef))
|
|
|
|
(defun get-optimal-factor-sm5 (n ef of-matrix)
|
|
(let ((factors (assoc n of-matrix)))
|
|
(or (and factors
|
|
(let ((ef-of (assoc ef (cdr factors))))
|
|
(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-sm5-optimal-factor-matrix))))
|
|
(if (= 1 n)
|
|
of
|
|
(* of last-interval))))
|
|
|
|
|
|
(defun determine-next-interval-sm5 (last-interval n ef quality
|
|
failures meanq total-repeats
|
|
of-matrix &optional delta-days)
|
|
(if (zerop n) (setq n 1))
|
|
(if (null ef) (setq ef 2.5))
|
|
(assert (> n 0))
|
|
(assert (and (>= quality 0) (<= quality 5)))
|
|
(unless of-matrix
|
|
(setq of-matrix org-drill-sm5-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)
|
|
quality org-drill-learn-fraction))
|
|
(interval nil))
|
|
(when (and org-drill-adjust-intervals-for-early-and-late-repetitions-p
|
|
delta-days (minusp delta-days))
|
|
(setq new-of (org-drill-early-interval-factor
|
|
(get-optimal-factor-sm5 n ef of-matrix)
|
|
(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)
|
|
(list -1 1 old-ef (1+ failures) meanq (1+ total-repeats)
|
|
of-matrix)) ; Not clear if OF matrix is supposed to be
|
|
; preserved
|
|
;; For a zero-based quality of 4 or 5, don't repeat
|
|
;; ((and (>= quality 4)
|
|
;; (not org-learn-always-reschedule))
|
|
;; (list 0 (1+ n) ef failures meanq
|
|
;; (1+ total-repeats) of-matrix)) ; 0 interval = unschedule
|
|
(t
|
|
(setq interval (inter-repetition-interval-sm5
|
|
last-interval n ef of-matrix))
|
|
(if org-drill-add-random-noise-to-intervals-p
|
|
(setq interval (* interval (org-drill-random-dispersal-factor))))
|
|
(list interval
|
|
(1+ n)
|
|
ef
|
|
failures
|
|
meanq
|
|
(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
|
|
been forgotten, ever.
|
|
|
|
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.
|
|
- REPETITION: the number of times the item has been tested.
|
|
1 is the first repetition (ie the second trial).
|
|
Returns:
|
|
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."
|
|
(+ (* 0.0542 (expt quality 4))
|
|
(* -0.4848 (expt quality 3))
|
|
(* 1.4916 (expt quality 2))
|
|
(* -1.2403 quality)
|
|
1.4515))
|
|
|
|
|
|
(defun determine-next-interval-simple8 (last-interval repeats quality
|
|
failures meanq totaln
|
|
&optional delta-days)
|
|
"Arguments:
|
|
- LAST-INTERVAL -- the number of days since the item was last reviewed.
|
|
- REPEATS -- the number of times the item has been successfully reviewed
|
|
- EASE -- the 'easiness factor'
|
|
- QUALITY -- 0 to 5
|
|
- DELTA-DAYS -- how many days overdue was the item when it was reviewed.
|
|
0 = reviewed on the scheduled day. +N = N days overdue.
|
|
-N = reviewed N days early.
|
|
|
|
Returns the new item data, as a list of 6 values:
|
|
- NEXT-INTERVAL
|
|
- REPEATS
|
|
- EASE
|
|
- FAILURES
|
|
- AVERAGE-QUALITY
|
|
- TOTAL-REPEATS.
|
|
See the documentation for `org-drill-get-item-data' for a description of these."
|
|
(assert (>= repeats 0))
|
|
(assert (and (>= quality 0) (<= quality 5)))
|
|
(assert (or (null meanq) (and (>= meanq 0) (<= meanq 5))))
|
|
(let ((next-interval nil))
|
|
(setf meanq (if meanq
|
|
(/ (+ quality (* meanq totaln 1.0)) (1+ totaln))
|
|
quality))
|
|
(cond
|
|
((<= quality org-drill-failure-quality)
|
|
(incf failures)
|
|
(setf repeats 0
|
|
next-interval -1))
|
|
((or (zerop repeats)
|
|
(zerop last-interval))
|
|
(setf next-interval (org-drill-simple8-first-interval failures))
|
|
(incf repeats)
|
|
(incf totaln))
|
|
(t
|
|
(let* ((use-n
|
|
(if (and
|
|
org-drill-adjust-intervals-for-early-and-late-repetitions-p
|
|
(numberp delta-days) (plusp delta-days)
|
|
(plusp last-interval))
|
|
(+ repeats (min 1 (/ delta-days last-interval 1.0)))
|
|
repeats))
|
|
(factor (org-drill-simple8-interval-factor
|
|
(org-drill-simple8-quality->ease meanq) use-n))
|
|
(next-int (* last-interval factor)))
|
|
(when (and org-drill-adjust-intervals-for-early-and-late-repetitions-p
|
|
(numberp delta-days) (minusp delta-days))
|
|
;; The item was reviewed earlier than scheduled.
|
|
(setf factor (org-drill-early-interval-factor
|
|
factor next-int (abs delta-days))
|
|
next-int (* last-interval factor)))
|
|
(setf next-interval next-int)
|
|
(incf repeats)
|
|
(incf totaln))))
|
|
(list
|
|
(if (and org-drill-add-random-noise-to-intervals-p
|
|
(plusp next-interval))
|
|
(* next-interval (org-drill-random-dispersal-factor))
|
|
next-interval)
|
|
repeats
|
|
(org-drill-simple8-quality->ease meanq)
|
|
failures
|
|
meanq
|
|
totaln
|
|
)))
|
|
|
|
|
|
|
|
|
|
;;; Essentially copied from `org-learn.el', but modified to
|
|
;;; optionally call the SM2 or simple8 functions.
|
|
(defun org-drill-smart-reschedule (quality &optional days-ahead)
|
|
"If DAYS-AHEAD is supplied it must be a positive integer. The
|
|
item will be scheduled exactly this many days into the future."
|
|
(let ((delta-days (- (time-to-days (current-time))
|
|
(time-to-days (or (org-get-scheduled-time (point))
|
|
(current-time)))))
|
|
(ofmatrix org-drill-sm5-optimal-factor-matrix)
|
|
;; Entries can have weights, 1 by default. Intervals are divided by the
|
|
;; item's weight, so an item with a weight of 2 will have all intervals
|
|
;; halved, meaning you will end up reviewing it twice as often.
|
|
;; Useful for entries which randomly present any of several facts.
|
|
(weight (org-entry-get (point) "DRILL_CARD_WEIGHT")))
|
|
(if (stringp weight)
|
|
(setq weight (read weight)))
|
|
(destructuring-bind (last-interval repetitions failures
|
|
total-repeats meanq ease)
|
|
(org-drill-get-item-data)
|
|
(destructuring-bind (next-interval repetitions ease
|
|
failures meanq total-repeats
|
|
&optional new-ofmatrix)
|
|
(case org-drill-spaced-repetition-algorithm
|
|
(sm5 (determine-next-interval-sm5 last-interval repetitions
|
|
ease quality failures
|
|
meanq total-repeats ofmatrix))
|
|
(sm2 (determine-next-interval-sm2 last-interval repetitions
|
|
ease quality failures
|
|
meanq total-repeats))
|
|
(simple8 (determine-next-interval-simple8 last-interval repetitions
|
|
quality failures meanq
|
|
total-repeats
|
|
delta-days)))
|
|
(if (numberp days-ahead)
|
|
(setq next-interval days-ahead))
|
|
|
|
(if (and (null days-ahead)
|
|
(numberp weight) (plusp weight)
|
|
(not (minusp next-interval)))
|
|
(setq next-interval
|
|
(max 1.0 (+ last-interval
|
|
(/ (- next-interval last-interval) weight)))))
|
|
|
|
(org-drill-store-item-data next-interval repetitions failures
|
|
total-repeats meanq ease)
|
|
|
|
(if (eql 'sm5 org-drill-spaced-repetition-algorithm)
|
|
(setq org-drill-sm5-optimal-factor-matrix new-ofmatrix))
|
|
|
|
(cond
|
|
((= 0 days-ahead)
|
|
(org-schedule '(4)))
|
|
((minusp days-ahead)
|
|
(org-schedule nil (current-time)))
|
|
(t
|
|
(org-schedule nil (time-add (current-time)
|
|
(days-to-time
|
|
(round next-interval))))))))))
|
|
|
|
|
|
(defun org-drill-hypothetical-next-review-date (quality)
|
|
"Returns an integer representing the number of days into the future
|
|
that the current item would be scheduled, based on a recall quality
|
|
of QUALITY."
|
|
(let ((weight (org-entry-get (point) "DRILL_CARD_WEIGHT")))
|
|
(destructuring-bind (last-interval repetitions failures
|
|
total-repeats meanq ease)
|
|
(org-drill-get-item-data)
|
|
(if (stringp weight)
|
|
(setq weight (read weight)))
|
|
(destructuring-bind (next-interval repetitions ease
|
|
failures meanq total-repeats
|
|
&optional ofmatrix)
|
|
(case org-drill-spaced-repetition-algorithm
|
|
(sm5 (determine-next-interval-sm5 last-interval repetitions
|
|
ease quality failures
|
|
meanq total-repeats
|
|
org-drill-sm5-optimal-factor-matrix))
|
|
(sm2 (determine-next-interval-sm2 last-interval repetitions
|
|
ease quality failures
|
|
meanq total-repeats))
|
|
(simple8 (determine-next-interval-simple8 last-interval repetitions
|
|
quality failures meanq
|
|
total-repeats)))
|
|
(cond
|
|
((not (plusp next-interval))
|
|
0)
|
|
((and (numberp weight) (plusp weight))
|
|
(+ last-interval
|
|
(max 1.0 (/ (- next-interval last-interval) weight))))
|
|
(t
|
|
next-interval))))))
|
|
|
|
|
|
(defun org-drill-hypothetical-next-review-dates ()
|
|
(let ((intervals nil))
|
|
(dotimes (q 6)
|
|
(push (max (or (car intervals) 0)
|
|
(org-drill-hypothetical-next-review-date q))
|
|
intervals))
|
|
(reverse intervals)))
|
|
|
|
(defun org-drill--read-key-sequence (prompt)
|
|
"Just like `read-key-sequence' but with input method turned off."
|
|
(let ((old-input-method current-input-method))
|
|
(unwind-protect
|
|
(progn
|
|
(set-input-method nil)
|
|
(read-key-sequence prompt))
|
|
(set-input-method old-input-method))))
|
|
|
|
(defun org-drill-reschedule ()
|
|
"Returns quality rating (0-5), or nil if the user quit."
|
|
(let ((ch nil)
|
|
(input nil)
|
|
(next-review-dates (org-drill-hypothetical-next-review-dates))
|
|
(typed-answer-statement (if drill-typed-answer
|
|
(format "Your answer: %s\n"
|
|
drill-typed-answer)
|
|
""))
|
|
(key-prompt (format "(0-5, %c=help, %c=edit, %c=tags, %c=quit)"
|
|
org-drill--help-key
|
|
org-drill--edit-key
|
|
org-drill--tags-key
|
|
org-drill--quit-key)))
|
|
(save-excursion
|
|
(while (not (memq ch (list org-drill--quit-key
|
|
org-drill--edit-key
|
|
7 ; C-g
|
|
?0 ?1 ?2 ?3 ?4 ?5)))
|
|
(setq input (org-drill--read-key-sequence
|
|
(if (eq ch org-drill--help-key)
|
|
(format "0-2 Means you have forgotten the item.
|
|
3-5 Means you have remembered the item.
|
|
|
|
0 - Completely forgot.
|
|
1 - Even after seeing the answer, it still took a bit to sink in.
|
|
2 - After seeing the answer, you remembered it.
|
|
3 - It took you awhile, but you finally remembered. (+%s days)
|
|
4 - After a little bit of thought you remembered. (+%s days)
|
|
5 - You remembered the item really easily. (+%s days)
|
|
|
|
%sHow well did you do? %s"
|
|
(round (nth 3 next-review-dates))
|
|
(round (nth 4 next-review-dates))
|
|
(round (nth 5 next-review-dates))
|
|
typed-answer-statement
|
|
key-prompt)
|
|
(format "%sHow well did you do? %s"
|
|
typed-answer-statement key-prompt))))
|
|
(cond
|
|
((stringp input)
|
|
(setq ch (elt input 0)))
|
|
((and (vectorp input) (symbolp (elt input 0)))
|
|
(case (elt input 0)
|
|
(up (ignore-errors (forward-line -1)))
|
|
(down (ignore-errors (forward-line 1)))
|
|
(left (ignore-errors (backward-char)))
|
|
(right (ignore-errors (forward-char)))
|
|
(prior (ignore-errors (scroll-down))) ; pgup
|
|
(next (ignore-errors (scroll-up))))) ; pgdn
|
|
((and (vectorp input) (listp (elt input 0))
|
|
(eventp (elt input 0)))
|
|
(case (car (elt input 0))
|
|
(wheel-up (ignore-errors (mwheel-scroll (elt input 0))))
|
|
(wheel-down (ignore-errors (mwheel-scroll (elt input 0)))))))
|
|
(if (eql ch org-drill--tags-key)
|
|
(org-set-tags-command))))
|
|
(cond
|
|
((and (>= ch ?0) (<= ch ?5))
|
|
(let ((quality (- ch ?0))
|
|
(failures (org-drill-entry-failure-count)))
|
|
(unless *org-drill-cram-mode*
|
|
(save-excursion
|
|
(let ((quality (if (org-drill--entry-lapsed-p) 2 quality)))
|
|
(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 org-drill--edit-key)
|
|
'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."
|
|
;; (let ((drill-entry-level (org-current-level))
|
|
;; (drill-sections nil)
|
|
;; (drill-heading nil))
|
|
;; (org-show-subtree)
|
|
;; (save-excursion
|
|
;; (org-map-entries
|
|
;; (lambda ()
|
|
;; (when (and (not (outline-invisible-p))
|
|
;; (> (org-current-level) drill-entry-level))
|
|
;; (setq drill-heading (org-get-heading t))
|
|
;; (unless (and (= (org-current-level) (1+ drill-entry-level))
|
|
;; (member drill-heading heading-list))
|
|
;; (hide-subtree))
|
|
;; (push (point) drill-sections)))
|
|
;; "" '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
|
|
on the relevant subheading. TEST should return nil if the subheading is
|
|
to be revealed, non-nil if it is to be hidden.
|
|
Returns a list containing the position of each immediate subheading of
|
|
the current topic."
|
|
(let ((drill-entry-level (org-current-level))
|
|
(drill-sections nil))
|
|
(org-show-subtree)
|
|
(save-excursion
|
|
(org-map-entries
|
|
(lambda ()
|
|
(when (and (not (outline-invisible-p))
|
|
(> (org-current-level) drill-entry-level))
|
|
(when (or (/= (org-current-level) (1+ drill-entry-level))
|
|
(funcall test))
|
|
(hide-subtree))
|
|
(push (point) drill-sections)))
|
|
"" '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--make-minibuffer-prompt (prompt)
|
|
(let ((status (first (org-drill-entry-status)))
|
|
(mature-entry-count (+ (length *org-drill-young-mature-entries*)
|
|
(length *org-drill-old-mature-entries*)
|
|
(length *org-drill-overdue-entries*))))
|
|
(format "%s %s %s %s %s %s"
|
|
(propertize
|
|
(char-to-string
|
|
(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)
|
|
((:young :old) org-drill-mature-count-color)
|
|
((:overdue :failed) org-drill-failed-count-color)
|
|
(t org-drill-done-count-color))))
|
|
(propertize
|
|
(number-to-string (length *org-drill-done-entries*))
|
|
'face `(:foreground ,org-drill-done-count-color)
|
|
'help-echo "The number of items you have reviewed this session.")
|
|
(propertize
|
|
(number-to-string (+ (length *org-drill-again-entries*)
|
|
(length *org-drill-failed-entries*)))
|
|
'face `(:foreground ,org-drill-failed-count-color)
|
|
'help-echo (concat "The number of items that you failed, "
|
|
"and need to review again."))
|
|
(propertize
|
|
(number-to-string mature-entry-count)
|
|
'face `(:foreground ,org-drill-mature-count-color)
|
|
'help-echo "The number of old items due for review.")
|
|
(propertize
|
|
(number-to-string (length *org-drill-new-entries*))
|
|
'face `(:foreground ,org-drill-new-count-color)
|
|
'help-echo (concat "The number of new items that you "
|
|
"have never reviewed."))
|
|
prompt)))
|
|
|
|
|
|
(cl-defun org-drill-presentation-prompt (&key prompt
|
|
returns
|
|
(start-time (current-time)))
|
|
"Create a card prompt with a timer and user-specified menu.
|
|
|
|
Arguments:
|
|
|
|
PROMPT: A string that overrides the standard prompt.
|
|
|
|
RETURNS: An alist of the form ((<char> . <symbol>)...) where
|
|
<char> is the character pressed and <symbol> is the
|
|
returned value, which will normally be either a symbol,
|
|
`t' or `nil'.
|
|
|
|
START-TIME: The time the card started to be displayed. This
|
|
defaults to (current-time), however, if the function
|
|
is called multiple times from one card then it might
|
|
be convenient to override this default.
|
|
"
|
|
(let* ((item-start-time start-time)
|
|
(input nil)
|
|
(ch nil)
|
|
(last-second 0)
|
|
(prompt
|
|
(or prompt
|
|
(format (concat "Press key for answer, "
|
|
"%c=edit, %c=tags, %c=skip, %c=quit.")
|
|
org-drill--edit-key
|
|
org-drill--tags-key
|
|
org-drill--skip-key
|
|
org-drill--quit-key)))
|
|
(full-prompt
|
|
(org-drill--make-minibuffer-prompt prompt)))
|
|
(if (and (eql 'warn org-drill-leech-method)
|
|
(org-drill-entry-leech-p))
|
|
(setq full-prompt (concat
|
|
(propertize "!!! LEECH ITEM !!!
|
|
You seem to be having a lot of trouble memorising this item.
|
|
Consider reformulating the item to make it easier to remember.\n"
|
|
'face '(:foreground "red"))
|
|
full-prompt)))
|
|
(while (memq ch '(nil org-drill--tags-key))
|
|
(setq ch nil)
|
|
(while (not (input-pending-p))
|
|
(let ((elapsed (time-subtract (current-time) item-start-time)))
|
|
(message (concat (if (>= (time-to-seconds elapsed) (* 60 60))
|
|
"++:++ "
|
|
(format-time-string "%M:%S " elapsed))
|
|
full-prompt))
|
|
(sit-for 1)))
|
|
(setq input (org-drill--read-key-sequence nil))
|
|
(if (stringp input) (setq ch (elt input 0)))
|
|
(if (eql ch org-drill--tags-key)
|
|
(org-set-tags-command)))
|
|
(if returns
|
|
(or (cdr (assoc ch returns)))
|
|
(cond
|
|
((eql ch org-drill--quit-key) nil)
|
|
((eql ch org-drill--edit-key) 'edit)
|
|
((eql ch org-drill--skip-key) 'skip)
|
|
(t t)))))
|
|
|
|
|
|
(cl-defun org-drill-presentation-prompt-for-string (prompt)
|
|
"Create a card prompt with a timer and user-specified menu.
|
|
|
|
Arguments:
|
|
|
|
PROMPT: A string that overrides the standard prompt.
|
|
|
|
START-TIME: The time the card started to be displayed. This
|
|
defaults to (current-time), however, if the function
|
|
is called multiple times from one card then it might
|
|
be convenient to override this default.
|
|
"
|
|
(let* ((prompt
|
|
(or prompt
|
|
"Type your answer and press <Enter>: "))
|
|
(full-prompt
|
|
(org-drill--make-minibuffer-prompt prompt)))
|
|
(if (and (eql 'warn org-drill-leech-method)
|
|
(org-drill-entry-leech-p))
|
|
(setq full-prompt (concat
|
|
(propertize "!!! LEECH ITEM !!!
|
|
You seem to be having a lot of trouble memorising this item.
|
|
Consider reformulating the item to make it easier to remember.\n"
|
|
'face '(:foreground "red"))
|
|
full-prompt)))
|
|
(setq drill-typed-answer (read-string full-prompt nil nil nil 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."
|
|
(let ((ovl (make-overlay beg end)))
|
|
(overlay-put ovl 'category
|
|
'org-drill-hidden-text-overlay)
|
|
(overlay-put ovl 'priority 9999)
|
|
(when (stringp text)
|
|
(overlay-put ovl 'invisible nil)
|
|
(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."))
|
|
(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
|
|
(dolist (ovl (overlays-in (point-min) (point-max)))
|
|
(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)
|
|
;; Don't hide:
|
|
;; - org links, partly because they might contain inline
|
|
;; images which we want to keep visible.
|
|
;; - LaTeX math fragments
|
|
;; - the contents of SRC blocks
|
|
(unless (save-match-data
|
|
(or (org-pos-in-regexp (match-beginning 0)
|
|
org-bracket-link-regexp 1)
|
|
(org-in-src-block-p)
|
|
(org-inside-LaTeX-fragment-p)))
|
|
(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)))
|
|
(hint-sep-pos (string-match-p (regexp-quote org-drill-hint-separator)
|
|
(match-string 0))))
|
|
(overlay-put ovl 'category
|
|
'org-drill-cloze-overlay-defaults)
|
|
(overlay-put ovl 'priority 9999)
|
|
(if org-drill-cloze-length-matches-hidden-text-p
|
|
(overlay-put ovl 'display
|
|
(concat "[" (make-string (max 1 (- (length (match-string 0)) 2)) ?.) "]")))
|
|
(when (and hint-sep-pos
|
|
(> hint-sep-pos 1))
|
|
(let ((hint (substring-no-properties
|
|
(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 "[%s%s%s]"
|
|
hint
|
|
(if (string-match-p (regexp-quote "...") hint) "" "...")
|
|
(if org-drill-cloze-length-matches-hidden-text-p
|
|
(make-string (max 0 (- (length (match-string 0))
|
|
(length hint)
|
|
(if (string-match-p (regexp-quote "...") hint) 0 3)
|
|
2))
|
|
?.)
|
|
"")))))))
|
|
|
|
|
|
(defun org-drill-hide-cloze-hints ()
|
|
(save-excursion
|
|
(while (re-search-forward org-drill-cloze-regexp nil t)
|
|
(unless (or (save-match-data
|
|
(org-pos-in-regexp (match-beginning 0)
|
|
org-bracket-link-regexp 1))
|
|
(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."
|
|
`(progn
|
|
(org-drill-replace-entry-text ,text)
|
|
(unwind-protect
|
|
(progn
|
|
,@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."
|
|
`(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 'priority 9999)
|
|
(overlay-put ovl 'category
|
|
'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
|
|
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 'priority 9999)
|
|
(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)
|
|
(unwind-protect
|
|
(progn
|
|
,@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
|
|
text
|
|
(substring-no-properties 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))))
|
|
(if (fboundp 'org-end-of-meta-data-and-drawers)
|
|
(org-end-of-meta-data-and-drawers) ; function removed Feb 2015
|
|
(org-end-of-meta-data t))
|
|
(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
|
|
;; key. The function should then reveal either the 'answer' or the entire
|
|
;; topic, and should return t if the user chose to see the answer and rate their
|
|
;; recall, nil if they chose to quit.
|
|
|
|
|
|
(defun org-drill-present-simple-card ()
|
|
(with-hidden-comments
|
|
(with-hidden-cloze-hints
|
|
(with-hidden-cloze-text
|
|
(org-drill-hide-all-subheadings-except nil)
|
|
(org-drill--show-latex-fragments) ; overlay all LaTeX fragments with images
|
|
(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))))))
|
|
|
|
|
|
(defun org-drill-present-default-answer (reschedule-fn)
|
|
(prog1 (cond
|
|
(drill-answer
|
|
(with-replaced-entry-text
|
|
(format "\nAnswer:\n\n %s\n" drill-answer)
|
|
(funcall reschedule-fn)
|
|
))
|
|
(t
|
|
(org-drill-hide-subheadings-if 'org-drill-entry-p)
|
|
(org-drill-unhide-clozed-text)
|
|
(org-drill--show-latex-fragments)
|
|
(ignore-errors
|
|
(org-display-inline-images t))
|
|
(org-cycle-hide-drawers 'all)
|
|
(with-hidden-cloze-hints
|
|
(funcall reschedule-fn))))
|
|
(setq drill-answer nil
|
|
drill-typed-answer nil)))
|
|
|
|
|
|
(defun org-drill-present-simple-card-with-typed-answer ()
|
|
(with-hidden-comments
|
|
(with-hidden-cloze-hints
|
|
(with-hidden-cloze-text
|
|
(org-drill-hide-all-subheadings-except nil)
|
|
(org-drill--show-latex-fragments) ; overlay all LaTeX fragments with images
|
|
(ignore-errors
|
|
(org-display-inline-images t))
|
|
(org-cycle-hide-drawers 'all)
|
|
(prog1 (org-drill-presentation-prompt-for-string nil)
|
|
(org-drill-hide-subheadings-if 'org-drill-entry-p))))))
|
|
|
|
|
|
(defun org-drill--show-latex-fragments ()
|
|
(org-remove-latex-fragment-image-overlays)
|
|
(if (fboundp 'org-toggle-latex-fragment)
|
|
(org-toggle-latex-fragment '(4))
|
|
(org-preview-latex-fragment '(4))))
|
|
|
|
|
|
(defun org-drill-present-two-sided-card ()
|
|
(with-hidden-comments
|
|
(with-hidden-cloze-hints
|
|
(with-hidden-cloze-text
|
|
(let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
|
|
(when drill-sections
|
|
(save-excursion
|
|
(goto-char (nth (random* (min 2 (length drill-sections)))
|
|
drill-sections))
|
|
(org-show-subtree)))
|
|
(org-drill--show-latex-fragments)
|
|
(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)))))))
|
|
|
|
|
|
|
|
(defun org-drill-present-multi-sided-card ()
|
|
(with-hidden-comments
|
|
(with-hidden-cloze-hints
|
|
(with-hidden-cloze-text
|
|
(let ((drill-sections (org-drill-hide-all-subheadings-except nil)))
|
|
(when drill-sections
|
|
(save-excursion
|
|
(goto-char (nth (random* (length drill-sections)) drill-sections))
|
|
(org-show-subtree)))
|
|
(org-drill--show-latex-fragments)
|
|
(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)))))))
|
|
|
|
|
|
(defun org-drill-present-multicloze-hide-n (number-to-hide
|
|
&optional
|
|
force-show-first
|
|
force-show-last
|
|
force-hide-first)
|
|
"Hides NUMBER-TO-HIDE pieces of text that are marked for cloze deletion,
|
|
chosen at random.
|
|
If NUMBER-TO-HIDE is negative, show only (ABS NUMBER-TO-HIDE) pieces,
|
|
hiding all the rest.
|
|
If FORCE-HIDE-FIRST is non-nil, force the first piece of text to be one of
|
|
the hidden items.
|
|
If FORCE-SHOW-FIRST is non-nil, never hide the first piece of text.
|
|
If FORCE-SHOW-LAST is non-nil, never hide the last piece of text.
|
|
If the number of text pieces in the item is less than
|
|
NUMBER-TO-HIDE, then all text pieces will be hidden (except the first or last
|
|
items if FORCE-SHOW-FIRST or FORCE-SHOW-LAST is non-nil)."
|
|
(with-hidden-comments
|
|
(with-hidden-cloze-hints
|
|
(let ((item-end nil)
|
|
(match-count 0)
|
|
(body-start (or (cdr (org-get-property-block))
|
|
(point))))
|
|
(if (and force-hide-first force-show-first)
|
|
(error "FORCE-HIDE-FIRST and FORCE-SHOW-FIRST are mutually exclusive"))
|
|
(org-drill-hide-all-subheadings-except nil)
|
|
(save-excursion
|
|
(outline-next-heading)
|
|
(setq item-end (point)))
|
|
(save-excursion
|
|
(goto-char body-start)
|
|
(while (re-search-forward org-drill-cloze-regexp item-end t)
|
|
(let ((in-regexp? (save-match-data
|
|
(org-pos-in-regexp (match-beginning 0)
|
|
org-bracket-link-regexp 1))))
|
|
(unless (or in-regexp?
|
|
(org-inside-LaTeX-fragment-p))
|
|
(incf match-count)))))
|
|
(if (minusp number-to-hide)
|
|
(setq number-to-hide (+ match-count number-to-hide)))
|
|
(when (plusp match-count)
|
|
(let* ((positions (shuffle-list (loop for i from 1
|
|
to match-count
|
|
collect i)))
|
|
(match-nums nil)
|
|
(cnt nil))
|
|
(if force-hide-first
|
|
;; Force '1' to be in the list, and to be the first item
|
|
;; in the list.
|
|
(setq positions (cons 1 (remove 1 positions))))
|
|
(if force-show-first
|
|
(setq positions (remove 1 positions)))
|
|
(if force-show-last
|
|
(setq positions (remove match-count positions)))
|
|
(setq match-nums
|
|
(subseq positions
|
|
0 (min number-to-hide (length positions))))
|
|
;; (dolist (pos-to-hide match-nums)
|
|
(save-excursion
|
|
(goto-char body-start)
|
|
(setq cnt 0)
|
|
(while (re-search-forward org-drill-cloze-regexp item-end t)
|
|
(unless (save-match-data
|
|
(or (org-pos-in-regexp (match-beginning 0)
|
|
org-bracket-link-regexp 1)
|
|
(org-inside-LaTeX-fragment-p)))
|
|
(incf cnt)
|
|
(if (memq cnt match-nums)
|
|
(org-drill-hide-matched-cloze-text)))))))
|
|
;; (loop
|
|
;; do (re-search-forward org-drill-cloze-regexp
|
|
;; item-end t pos-to-hide)
|
|
;; while (org-pos-in-regexp (match-beginning 0)
|
|
;; org-bracket-link-regexp 1))
|
|
;; (org-drill-hide-matched-cloze-text)))))
|
|
(org-drill--show-latex-fragments)
|
|
(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)
|
|
(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
|
|
the second to last, etc."
|
|
(with-hidden-comments
|
|
(with-hidden-cloze-hints
|
|
(let ((item-end nil)
|
|
(match-count 0)
|
|
(body-start (or (cdr (org-get-property-block))
|
|
(point)))
|
|
(cnt 0))
|
|
(org-drill-hide-all-subheadings-except nil)
|
|
(save-excursion
|
|
(outline-next-heading)
|
|
(setq item-end (point)))
|
|
(save-excursion
|
|
(goto-char body-start)
|
|
(while (re-search-forward org-drill-cloze-regexp item-end t)
|
|
(let ((in-regexp? (save-match-data
|
|
(org-pos-in-regexp (match-beginning 0)
|
|
org-bracket-link-regexp 1))))
|
|
(unless (or in-regexp?
|
|
(org-inside-LaTeX-fragment-p))
|
|
(incf match-count)))))
|
|
(if (minusp to-hide)
|
|
(setq to-hide (+ 1 to-hide match-count)))
|
|
(cond
|
|
((or (not (plusp match-count))
|
|
(> to-hide match-count))
|
|
nil)
|
|
(t
|
|
(save-excursion
|
|
(goto-char body-start)
|
|
(setq cnt 0)
|
|
(while (re-search-forward org-drill-cloze-regexp item-end t)
|
|
(unless (save-match-data
|
|
;; Don't consider this a cloze region if it is part of an
|
|
;; org link, or if it occurs inside a LaTeX math
|
|
;; fragment
|
|
(or (org-pos-in-regexp (match-beginning 0)
|
|
org-bracket-link-regexp 1)
|
|
(org-inside-LaTeX-fragment-p)))
|
|
(incf cnt)
|
|
(if (= cnt to-hide)
|
|
(org-drill-hide-matched-cloze-text)))))))
|
|
(org-drill--show-latex-fragments)
|
|
(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)
|
|
(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,
|
|
chosen at random.
|
|
|
|
The definitions of 'commonly' and 'uncommonly' are determined by
|
|
the value of `org-drill-cloze-text-weight'."
|
|
;; The 'firstmore' and 'lastmore' functions used to randomly choose whether
|
|
;; to hide the 'favoured' piece of text. However even when the chance of
|
|
;; hiding it was set quite high (80%), the outcome was too unpredictable over
|
|
;; the small number of repetitions where most learning takes place for each
|
|
;; item. In other words, the actual frequency during the first 10 repetitions
|
|
;; was often very different from 80%. Hence we use modulo instead.
|
|
(cond
|
|
((null org-drill-cloze-text-weight)
|
|
;; Behave as hide1cloze
|
|
(org-drill-present-multicloze-hide1))
|
|
((not (and (integerp org-drill-cloze-text-weight)
|
|
(plusp org-drill-cloze-text-weight)))
|
|
(error "Illegal value for org-drill-cloze-text-weight: %S"
|
|
org-drill-cloze-text-weight))
|
|
((zerop (mod (1+ (org-drill-entry-total-repeats 0))
|
|
org-drill-cloze-text-weight))
|
|
;; Uncommonly, hide any item except the first
|
|
(org-drill-present-multicloze-hide-n 1 t))
|
|
(t
|
|
;; 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
|
|
that the last item is much less likely to be the item that is
|
|
visible.
|
|
|
|
The definitions of 'commonly' and 'uncommonly' are determined by
|
|
the value of `org-drill-cloze-text-weight'."
|
|
(cond
|
|
((null org-drill-cloze-text-weight)
|
|
;; Behave as show1cloze
|
|
(org-drill-present-multicloze-show1))
|
|
((not (and (integerp org-drill-cloze-text-weight)
|
|
(plusp org-drill-cloze-text-weight)))
|
|
(error "Illegal value for org-drill-cloze-text-weight: %S"
|
|
org-drill-cloze-text-weight))
|
|
((zerop (mod (1+ (org-drill-entry-total-repeats 0))
|
|
org-drill-cloze-text-weight))
|
|
;; Uncommonly, show any item except the last
|
|
(org-drill-present-multicloze-hide-n -1 nil nil t))
|
|
(t
|
|
;; 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
|
|
random piece. The effect is similar to 'show1cloze' except that
|
|
the first item is much less likely to be the item that is
|
|
visible.
|
|
|
|
The definitions of 'commonly' and 'uncommonly' are determined by
|
|
the value of `org-drill-cloze-text-weight'."
|
|
(cond
|
|
((null org-drill-cloze-text-weight)
|
|
;; Behave as show1cloze
|
|
(org-drill-present-multicloze-show1))
|
|
((not (and (integerp org-drill-cloze-text-weight)
|
|
(plusp org-drill-cloze-text-weight)))
|
|
(error "Illegal value for org-drill-cloze-text-weight: %S"
|
|
org-drill-cloze-text-weight))
|
|
((zerop (mod (1+ (org-drill-entry-total-repeats 0))
|
|
org-drill-cloze-text-weight))
|
|
;; Uncommonly, show the first item
|
|
(org-drill-present-multicloze-hide-n -1 t))
|
|
(t
|
|
;; 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-card-using-text (question &optional answer)
|
|
"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
|
|
(concat "\n" 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.
|
|
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
|
|
(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-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
|
|
it meets the definition of a 'review topic' used by `org-drill'.
|
|
|
|
Returns a quality rating from 0 to 5, or nil if the user quit, or the symbol
|
|
EDIT if the user chose to exit the drill and edit the current item. Choosing
|
|
the latter option leaves the drill session suspended; it can be resumed
|
|
later using `org-drill-resume'.
|
|
|
|
See `org-drill' for more details."
|
|
(interactive)
|
|
(org-drill-goto-drill-entry-heading)
|
|
;;(unless (org-part-of-drill-entry-p)
|
|
;; (error "Point is not inside a drill entry"))
|
|
;;(unless (org-at-heading-p)
|
|
;; (org-back-to-heading))
|
|
(let ((card-type (org-entry-get (point) "DRILL_CARD_TYPE" t))
|
|
(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))))
|
|
(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)))
|
|
(prog1
|
|
(cond
|
|
((null presentation-fn)
|
|
(message "%s:%d: Unrecognised card type '%s', skipping..."
|
|
(buffer-name) (point) card-type)
|
|
(sit-for 0.5)
|
|
'skip)
|
|
(t
|
|
(setq cont (funcall presentation-fn))
|
|
(cond
|
|
((not cont)
|
|
(message "Quit")
|
|
nil)
|
|
((eql cont 'edit)
|
|
'edit)
|
|
((eql cont 'skip)
|
|
'skip)
|
|
(t
|
|
(save-excursion
|
|
(funcall answer-fn
|
|
(lambda () (org-drill-reschedule))))))))
|
|
(org-remove-latex-fragment-image-overlays)))))))
|
|
|
|
|
|
(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*
|
|
*org-drill-failed-entries*
|
|
*org-drill-young-mature-entries*
|
|
*org-drill-old-mature-entries*
|
|
*org-drill-overdue-entries*
|
|
*org-drill-again-entries*))))
|
|
|
|
|
|
(defun org-drill-pending-entry-count ()
|
|
(+ (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*)
|
|
(>= (if org-drill-item-count-includes-failed-items-p
|
|
(+ (length *org-drill-done-entries*)
|
|
(length *org-drill-again-entries*))
|
|
(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))
|
|
(while (or (null m)
|
|
(not (org-drill-entry-p m)))
|
|
(setq
|
|
m
|
|
(cond
|
|
;; First priority is items we failed in a prior session.
|
|
((and *org-drill-failed-entries*
|
|
(not (org-drill-maximum-item-count-reached-p))
|
|
(not (org-drill-maximum-duration-reached-p)))
|
|
(pop-random *org-drill-failed-entries*))
|
|
;; Next priority is overdue items.
|
|
((and *org-drill-overdue-entries*
|
|
(not (org-drill-maximum-item-count-reached-p))
|
|
(not (org-drill-maximum-duration-reached-p)))
|
|
;; We use `pop', not `pop-random', because we have already
|
|
;; sorted overdue items into a random order which takes
|
|
;; number of days overdue into account.
|
|
(pop *org-drill-overdue-entries*))
|
|
;; Next priority is 'young' items.
|
|
((and *org-drill-young-mature-entries*
|
|
(not (org-drill-maximum-item-count-reached-p))
|
|
(not (org-drill-maximum-duration-reached-p)))
|
|
(pop-random *org-drill-young-mature-entries*))
|
|
;; Next priority is newly added items, and older entries.
|
|
;; We pool these into a single group.
|
|
((and (or *org-drill-new-entries*
|
|
*org-drill-old-mature-entries*)
|
|
(not (org-drill-maximum-item-count-reached-p))
|
|
(not (org-drill-maximum-duration-reached-p)))
|
|
(cond
|
|
((< (random* (+ (length *org-drill-new-entries*)
|
|
(length *org-drill-old-mature-entries*)))
|
|
(length *org-drill-new-entries*))
|
|
(pop-random *org-drill-new-entries*))
|
|
(t
|
|
(pop-random *org-drill-old-mature-entries*))))
|
|
;; After all the above are done, last priority is items
|
|
;; that were failed earlier THIS SESSION.
|
|
(*org-drill-again-entries*
|
|
(pop *org-drill-again-entries*))
|
|
(t ; nothing left -- return nil
|
|
(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.
|
|
|
|
RESUMING-P is true if we are resuming a suspended drill session."
|
|
(block org-drill-entries
|
|
(while (org-drill-entries-pending-p)
|
|
(let ((m (cond
|
|
((or (not resuming-p)
|
|
(null *org-drill-current-item*)
|
|
(not (org-drill-entry-p *org-drill-current-item*)))
|
|
(org-drill-pop-next-pending-entry))
|
|
(t ; resuming a suspended session.
|
|
(setq resuming-p nil)
|
|
*org-drill-current-item*))))
|
|
(setq *org-drill-current-item* m)
|
|
(unless m
|
|
(error "Unexpectedly ran out of pending drill items"))
|
|
(save-excursion
|
|
(org-drill-goto-entry m)
|
|
(message "[debug] org-drill: at marker position %s" (marker-position m))
|
|
(cond
|
|
((not (org-at-heading-p))
|
|
(error "Not at heading for entry %s" m))
|
|
((not (org-drill-entry-due-p))
|
|
;; The entry is not due anymore. This could arise if the user
|
|
;; suspends a drill session, then drills an individual entry,
|
|
;; then resumes the session.
|
|
(message "Entry no longer due, skipping...")
|
|
(sit-for 0.3)
|
|
nil)
|
|
(t
|
|
(org-show-entry)
|
|
(setq result (org-drill-entry))
|
|
(cond
|
|
((null result)
|
|
(message "Quit")
|
|
(setq end-pos :quit)
|
|
(return-from org-drill-entries nil))
|
|
((eql result 'edit)
|
|
(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
|
|
((<= result org-drill-failure-quality)
|
|
(if *org-drill-again-entries*
|
|
(setq *org-drill-again-entries*
|
|
(shuffle-list *org-drill-again-entries*)))
|
|
(push-end m *org-drill-again-entries*))
|
|
(t
|
|
(push m *org-drill-done-entries*)))
|
|
(setq *org-drill-current-item* nil))))))))))
|
|
|
|
|
|
|
|
(defun org-drill-final-report ()
|
|
(let ((pass-percent
|
|
(round (* 100 (count-if (lambda (qual)
|
|
(> qual org-drill-failure-quality))
|
|
*org-drill-session-qualities*))
|
|
(max 1 (length *org-drill-session-qualities*))))
|
|
(prompt nil)
|
|
(max-mini-window-height 0.6))
|
|
(setq prompt
|
|
(format
|
|
"%d items reviewed. Session duration %s.
|
|
Recall of reviewed items:
|
|
Excellent (5): %3d%% | Near miss (2): %3d%%
|
|
Good (4): %3d%% | Failure (1): %3d%%
|
|
Hard (3): %3d%% | Abject failure (0): %3d%%
|
|
|
|
You successfully recalled %d%% of reviewed items (quality > %s)
|
|
%d/%d items still await review (%s, %s, %s, %s, %s).
|
|
Tomorrow, %d more items will become due for review.
|
|
Session finished. Press a key to continue..."
|
|
(length *org-drill-done-entries*)
|
|
(format-seconds "%h:%.2m:%.2s"
|
|
(- (float-time (current-time)) *org-drill-start-time*))
|
|
(round (* 100 (count 5 *org-drill-session-qualities*))
|
|
(max 1 (length *org-drill-session-qualities*)))
|
|
(round (* 100 (count 2 *org-drill-session-qualities*))
|
|
(max 1 (length *org-drill-session-qualities*)))
|
|
(round (* 100 (count 4 *org-drill-session-qualities*))
|
|
(max 1 (length *org-drill-session-qualities*)))
|
|
(round (* 100 (count 1 *org-drill-session-qualities*))
|
|
(max 1 (length *org-drill-session-qualities*)))
|
|
(round (* 100 (count 3 *org-drill-session-qualities*))
|
|
(max 1 (length *org-drill-session-qualities*)))
|
|
(round (* 100 (count 0 *org-drill-session-qualities*))
|
|
(max 1 (length *org-drill-session-qualities*)))
|
|
pass-percent
|
|
org-drill-failure-quality
|
|
(org-drill-pending-entry-count)
|
|
(+ (org-drill-pending-entry-count)
|
|
*org-drill-dormant-entry-count*)
|
|
(propertize
|
|
(format "%d failed"
|
|
(+ (length *org-drill-failed-entries*)
|
|
(length *org-drill-again-entries*)))
|
|
'face `(:foreground ,org-drill-failed-count-color))
|
|
(propertize
|
|
(format "%d overdue"
|
|
(length *org-drill-overdue-entries*))
|
|
'face `(:foreground ,org-drill-failed-count-color))
|
|
(propertize
|
|
(format "%d new"
|
|
(length *org-drill-new-entries*))
|
|
'face `(:foreground ,org-drill-new-count-color))
|
|
(propertize
|
|
(format "%d young"
|
|
(length *org-drill-young-mature-entries*))
|
|
'face `(:foreground ,org-drill-mature-count-color))
|
|
(propertize
|
|
(format "%d old"
|
|
(length *org-drill-old-mature-entries*))
|
|
'face `(:foreground ,org-drill-mature-count-color))
|
|
*org-drill-due-tomorrow-count*
|
|
))
|
|
|
|
(while (not (input-pending-p))
|
|
(message "%s" prompt)
|
|
(sit-for 0.5))
|
|
(read-char-exclusive)
|
|
|
|
(if (and *org-drill-session-qualities*
|
|
(< pass-percent (- 100 org-drill-forgetting-index)))
|
|
(read-char-exclusive
|
|
(format
|
|
"%s
|
|
You failed %d%% of the items you reviewed during this session.
|
|
%d (%d%%) of all items scanned were overdue.
|
|
|
|
Are you keeping up with your items, and reviewing them
|
|
when they are scheduled? If so, you may want to consider
|
|
lowering the value of `org-drill-learn-fraction' slightly in
|
|
order to make items appear more frequently over time."
|
|
(propertize "WARNING!" 'face 'org-warning)
|
|
(- 100 pass-percent)
|
|
*org-drill-overdue-entry-count*
|
|
(round (* 100 *org-drill-overdue-entry-count*)
|
|
(+ *org-drill-dormant-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
|
|
point nowhere). Alternatively, MARKERS can be 't', in which case
|
|
all the markers used by Org-Drill will be freed."
|
|
(dolist (m (if (eql t markers)
|
|
(append *org-drill-done-entries*
|
|
*org-drill-new-entries*
|
|
*org-drill-failed-entries*
|
|
*org-drill-again-entries*
|
|
*org-drill-overdue-entries*
|
|
*org-drill-young-mature-entries*
|
|
*org-drill-old-mature-entries*)
|
|
markers))
|
|
(free-marker m)))
|
|
|
|
|
|
;;; overdue-data is a list of entries, each entry has the form (POS DUE AGE)
|
|
;;; where POS is a marker pointing to the start of the entry, and
|
|
;;; DUE is a number indicating how many days ago the entry was due.
|
|
;;; AGE is the number of days elapsed since item creation (nil if unknown).
|
|
;;; if age > lapse threshold (default 90), sort by age (oldest first)
|
|
;;; if age < lapse threshold, sort by due (biggest first)
|
|
|
|
|
|
(defun org-drill-order-overdue-entries (overdue-data)
|
|
(let* ((lapsed-days (if org-drill--lapse-very-overdue-entries-p
|
|
90 most-positive-fixnum))
|
|
(not-lapsed (remove-if (lambda (a) (> (or (second a) 0) lapsed-days))
|
|
overdue-data))
|
|
(lapsed (remove-if-not (lambda (a) (> (or (second a) 0)
|
|
lapsed-days)) overdue-data)))
|
|
(setq *org-drill-overdue-entries*
|
|
(mapcar 'first
|
|
(append
|
|
(sort (shuffle-list not-lapsed)
|
|
(lambda (a b) (> (second a) (second b))))
|
|
(sort lapsed
|
|
(lambda (a b) (> (third a) (third b)))))))))
|
|
|
|
|
|
(defun org-drill--entry-lapsed-p ()
|
|
(let ((lapsed-days 90))
|
|
(and org-drill--lapse-very-overdue-entries-p
|
|
(> (or (org-drill-entry-days-overdue) 0) lapsed-days))))
|
|
|
|
|
|
|
|
|
|
(defun org-drill-entry-days-since-creation (&optional use-last-interval-p)
|
|
"If USE-LAST-INTERVAL-P is non-nil, and DATE_ADDED is missing, use the
|
|
value of DRILL_LAST_INTERVAL instead (as the item's age must be at least
|
|
that many days)."
|
|
(let ((timestamp (org-entry-get (point) "DATE_ADDED")))
|
|
(cond
|
|
(timestamp
|
|
(- (org-time-stamp-to-now timestamp)))
|
|
(use-last-interval-p
|
|
(+ (or (org-drill-entry-days-overdue) 0)
|
|
(read (or (org-entry-get (point) "DRILL_LAST_INTERVAL") "0"))))
|
|
(t nil))))
|
|
|
|
|
|
(defun org-drill-entry-status ()
|
|
"Returns a list (STATUS DUE AGE) where DUE is the number of days overdue,
|
|
zero being due today, -1 being scheduled 1 day in the future.
|
|
AGE is the number of days elapsed since the item was created (nil if unknown).
|
|
STATUS is one of the following values:
|
|
- nil, if the item is not a drill entry, or has an empty body
|
|
- :unscheduled
|
|
- :future
|
|
- :new
|
|
- :failed
|
|
- :overdue
|
|
- :young
|
|
- :old
|
|
"
|
|
(save-excursion
|
|
(unless (org-at-heading-p)
|
|
(org-back-to-heading))
|
|
(let ((due (org-drill-entry-days-overdue))
|
|
(age (org-drill-entry-days-since-creation t))
|
|
(last-int (org-drill-entry-last-interval 1)))
|
|
(list
|
|
(cond
|
|
((not (org-drill-entry-p))
|
|
nil)
|
|
((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)
|
|
;; :tomorrow)
|
|
((minusp due) ; scheduled in the future
|
|
:future)
|
|
;; The rest of the stati all denote 'due' items ==========================
|
|
((<= (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.
|
|
:failed)
|
|
((org-drill-entry-new-p)
|
|
:new)
|
|
((org-drill-entry-overdue-p due last-int)
|
|
;; Overdue status overrides young versus old
|
|
;; distinction.
|
|
;; Store marker + due, for sorting of overdue entries
|
|
:overdue)
|
|
((<= (org-drill-entry-last-interval 9999)
|
|
org-drill-days-before-old)
|
|
:young)
|
|
(t
|
|
:old))
|
|
due age))))
|
|
|
|
|
|
(defun org-drill-progress-message (collected scanned)
|
|
(when (zerop (% scanned 50))
|
|
(let* ((meter-width 40)
|
|
(sym1 (if (oddp (floor scanned (* 50 meter-width))) ?| ?.))
|
|
(sym2 (if (eql sym1 ?.) ?| ?.)))
|
|
(message "Collecting due drill items:%4d %s%s"
|
|
collected
|
|
(make-string (% (ceiling scanned 50) meter-width)
|
|
sym2)
|
|
(make-string (- meter-width (% (ceiling scanned 50) meter-width))
|
|
sym1)))))
|
|
|
|
|
|
(defun org-map-drill-entry-function ()
|
|
(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))
|
|
(cond
|
|
((not (org-drill-entry-p))
|
|
nil) ; skip
|
|
(t
|
|
(when (and (not warned-about-id-creation)
|
|
(null (org-id-get)))
|
|
(message (concat "Creating unique IDs for items "
|
|
"(slow, but only happens once)"))
|
|